New interpreters from RosettaCode (#3087)

lib/linguist/languages.yml

@@ -860,6 +860,8 @@ Dart:
   color: "#00B4AB"
   extensions:
   - .dart
+  interpreters:
+  - dart
   ace_mode: dart
 
 Diff:
@@ -904,6 +906,8 @@ E:
   color: "#ccce35"
   extensions:
   - .E
+  interpreters:
+  - rune
   tm_scope: none
   ace_mode: text
 
@@ -1544,6 +1548,8 @@ Haskell:
   extensions:
   - .hs
   - .hsc
+  interpreters:
+  - runhaskell
   ace_mode: haskell
 
 Haxe:
@@ -1647,6 +1653,8 @@ Io:
   color: "#a9188d"
   extensions:
   - .io
+  interpreters:
+  - io
   ace_mode: io
 
 Ioke:
@@ -2516,6 +2524,7 @@ OCaml:
   interpreters:
   - ocaml
   - ocamlrun
+  - ocamlscript
   tm_scope: source.ocaml
 
 ObjDump:
@@ -2780,6 +2789,8 @@ Pascal:
   - .lpr
   - .pascal
   - .pp
+  interpreters:
+  - instantfpc
   ace_mode: pascal
 
 Perl:

samples/E/atomic-updates.E

@@ -0,0 +1,123 @@
+#!/usr/bin/env rune
+pragma.syntax("0.9")
+
+def pi := (-1.0).acos()
+def makeEPainter := <unsafe:com.zooko.tray.makeEPainter>
+def colors := <awt:makeColor>
+
+# --------------------------------------------------------------
+# --- Definitions
+
+/** Execute 'task' repeatedly as long 'indicator' is unresolved. */
+def doWhileUnresolved(indicator, task) {
+  def loop() {
+    if (!Ref.isResolved(indicator)) {
+      task()
+      loop <- ()
+    }
+  }
+  loop <- ()
+}
+
+/** The data structure specified for the task. */
+def makeBuckets(size) {
+    def values := ([100] * size).diverge() # storage
+    def buckets {
+        to size() :int { return size }
+        /** get current quantity in bucket 'i' */
+        to get(i :int) { return values[i] }
+        /** transfer 'amount' units, as much as possible, from bucket 'i' to bucket 'j'
+            or vice versa if 'amount' is negative */
+        to transfer(i :int, j :int, amount :int) {
+            def amountLim := amount.min(values[i]).max(-(values[j]))
+            values[i] -= amountLim
+            values[j] += amountLim
+        }
+    }
+    return buckets
+}
+
+/** A view of the current state of the buckets. */
+def makeDisplayComponent(buckets) {
+  def c := makeEPainter(def paintCallback {
+    to paintComponent(g) {
+      def pixelsW := c.getWidth()
+      def pixelsH := c.getHeight()
+      def bucketsW := buckets.size()
+
+      g.setColor(colors.getWhite())
+      g.fillRect(0, 0, pixelsW, pixelsH)
+
+      g.setColor(colors.getDarkGray())
+      var sum := 0
+      for i in 0..!bucketsW {
+        sum += def value := buckets[i]
+        def x0 := (i       * pixelsW / bucketsW).floor()
+        def x1 := ((i + 1) * pixelsW / bucketsW).floor()
+        g.fillRect(x0 + 1, pixelsH - value,
+                   x1 - x0 - 1, value)
+      }
+
+      g.setColor(colors.getBlack())
+      g."drawString(String, int, int)"(`Total: $sum`, 2, 20)
+    }
+  })
+  c.setPreferredSize(<awt:makeDimension>(500, 300))
+  return c
+}
+
+# --------------------------------------------------------------
+# --- Application setup
+
+def buckets := makeBuckets(100)
+def done # Promise indicating when the window is closed
+
+# Create the window
+def frame := <unsafe:javax.swing.makeJFrame>("Atomic transfers")
+frame.setContentPane(def display := makeDisplayComponent(buckets))
+frame.addWindowListener(def mainWindowListener {
+  to windowClosing(event) :void {
+    bind done := null
+  }
+  match _ {}
+})
+frame.setLocation(50, 50)
+frame.pack()
+
+# --------------------------------------------------------------
+# --- Tasks
+
+# Neatens up buckets
+var ni := 0
+doWhileUnresolved(done, fn {
+  def i := ni
+  def j := (ni + 1) %% buckets.size()
+  buckets.transfer(i, j, (buckets[i] - buckets[j]) // 4)
+  ni := j
+})
+
+# Messes up buckets
+var mi := 0
+doWhileUnresolved(done, fn {
+    def i := (mi + entropy.nextInt(3)) %% buckets.size()
+    def j := (i + entropy.nextInt(3)) %% buckets.size() #entropy.nextInt(buckets.size())
+    buckets.transfer(i, j, (buckets[i] / pi).floor())
+    mi := j
+})
+
+# Updates display at fixed 10 Hz
+# (Note: tries to catch up; on slow systems slow this down or it will starve the other tasks)
+def clock := timer.every(100, def _(_) {
+  if (Ref.isResolved(done)) {
+    clock.stop()
+  } else {
+    display.repaint()
+  }
+})
+clock.start()
+
+# --------------------------------------------------------------
+# --- All ready, go visible and wait
+
+frame.show()
+interp.waitAtTop(done)

samples/Haskell/maze-solving.hs

@@ -0,0 +1,62 @@
+#!/usr/bin/runhaskell
+
+import Data.Maybe
+
+-- given two points, returns the average of them
+average :: (Int, Int) -> (Int, Int) -> (Int, Int)
+average (x, y) (x', y') = ((x + x') `div` 2, (y + y') `div` 2)
+
+-- given a maze and a tuple of position and wall position, returns
+-- true if the wall position is not blocked (first position is unused)
+notBlocked :: [String] -> ((Int, Int), (Int, Int)) -> Bool
+notBlocked maze (_, (x, y)) = ' ' == (maze !! y) !! x
+
+-- given a list, a position, and an element, returns a new list
+-- with the new element substituted at the position
+-- (it seems such a function should exist in the standard library;
+-- I must be missing it)
+substitute :: [a] -> Int -> a -> [a]
+substitute orig pos el =
+  let (before, after) = splitAt pos orig
+  in before ++ [el] ++ tail after
+
+-- given a maze and a position, draw a '*' at that position in the maze
+draw :: [String] -> (Int, Int) -> [String]
+draw maze (x,y) = substitute maze y $ substitute row x '*'
+  where row = maze !! y
+
+-- given a maze, a previous position, and a list of tuples of potential
+-- new positions and their wall positions, returns the solved maze, or
+-- None if it cannot be solved
+tryMoves :: [String] -> (Int, Int) -> [((Int, Int), (Int, Int))] -> Maybe [String]
+tryMoves _ _ [] = Nothing
+tryMoves maze prevPos ((newPos,wallPos):more) =
+  case solve' maze newPos prevPos
+       of Nothing -> tryMoves maze prevPos more
+          Just maze' -> Just $ foldl draw maze' [newPos, wallPos]
+
+-- given a maze, a new position, and a previous position, returns
+-- the solved maze, or None if it cannot be solved
+-- (assumes goal is upper-left corner of maze)
+solve' :: [String] -> (Int, Int) -> (Int, Int) -> Maybe [String]
+solve' maze (2, 1) _ = Just maze
+solve' maze pos@(x, y) prevPos =
+  let newPositions = [(x, y - 2), (x + 4, y), (x, y + 2), (x - 4, y)]
+      notPrev pos' = pos' /= prevPos
+      newPositions' = filter notPrev newPositions
+      wallPositions = map (average pos) newPositions'
+      zipped = zip newPositions' wallPositions
+      legalMoves = filter (notBlocked maze) zipped
+  in tryMoves maze pos legalMoves
+
+-- given a maze, returns a solved maze, or None if it cannot be solved
+-- (starts at lower right corner and goes to upper left corner)
+solve :: [String] -> Maybe [String]
+solve maze = solve' (draw maze start) start (-1, -1)
+  where startx = length (head maze) - 3
+        starty = length maze - 2
+        start = (startx, starty)
+
+-- takes unsolved maze on standard input, prints solved maze on standard output
+main = interact main'
+  where main' x = unlines $ fromMaybe ["can't solve"] $ solve $ lines x

samples/Pascal/read-a-configuration-file.pascal

@@ -0,0 +1,100 @@
+#!/usr/bin/instantfpc
+
+{$if not defined(fpc) or (fpc_fullversion < 20600)}
+  {$error FPC 2.6.0 or greater required}
+{$endif}
+
+{$mode objfpc}{$H+}
+
+uses
+  Classes,SysUtils,gvector,ghashmap;
+
+type
+  TStrHashCaseInsensitive = class
+    class function hash(s: String; n: Integer): Integer;
+  end;
+
+class function TStrHashCaseInsensitive.hash(s: String; n: Integer): Integer;
+var
+  x: Integer;
+  c: Char;
+begin
+  x := 0;
+  for c in UpCase(s) do Inc(x,Ord(c));
+  Result := x mod n;
+end;
+
+type
+  TConfigValues  = specialize TVector<String>;
+  TConfigStorage = class(specialize THashMap<String,TConfigValues,TStrHashCaseInsensitive>)
+    destructor Destroy; override;
+  end;
+
+destructor TConfigStorage.Destroy;
+var
+  It: TIterator;
+begin
+  if Size > 0 then begin
+    It := Iterator;
+    repeat
+      It.Value.Free;
+    until not It.Next;
+    It.Free;
+  end;
+  inherited Destroy;
+end;
+
+var
+  ConfigStrings,ConfigValues: TStrings;
+  ConfigStorage: TConfigStorage;
+  ConfigLine,ConfigName,ConfigValue: String;
+  SeparatorPos: Integer;
+begin
+  ConfigStrings := TStringList.Create;
+  ConfigValues  := TStringList.Create;
+  ConfigValues.Delimiter := ',';
+  ConfigValues.StrictDelimiter := true;
+  ConfigStorage := TConfigStorage.Create;
+
+  ConfigStrings.LoadFromFile('config.test');
+  for ConfigLine in ConfigStrings do begin
+    if Length(ConfigLine) > 0 then begin
+      case ConfigLine[1] of
+        '#',';': ; // ignore
+        else begin
+          // look for = first
+          SeparatorPos := Pos('=',ConfigLine);
+          // if not found, then look for space
+          if SeparatorPos = 0 then begin
+            SeparatorPos := Pos(' ',ConfigLine);
+          end;
+          // found space
+          if SeparatorPos <> 0 then begin
+            ConfigName := UpCase(Copy(ConfigLine,1,SeparatorPos - 1));
+            ConfigValues.DelimitedText := Copy(ConfigLine,SeparatorPos + 1,Length(ConfigLine) - SeparatorPos);
+          // no = or space found, take the whole line as a key name
+          end else begin
+            ConfigName := UpCase(Trim(ConfigLine));
+          end;
+          if not ConfigStorage.Contains(ConfigName) then begin
+            ConfigStorage[ConfigName] := TConfigValues.Create;
+          end;
+          for ConfigValue in ConfigValues do begin
+            ConfigStorage[ConfigName].PushBack(Trim(ConfigValue));
+          end;
+        end;
+      end;
+    end;
+  end;
+
+  WriteLn('FULLNAME = ' + ConfigStorage['FULLNAME'][0]);
+  WriteLn('FAVOURITEFRUIT = ' + ConfigStorage['FAVOURITEFRUIT'][0]);
+  WriteLn('NEEDSPEELING = ' + BoolToStr(ConfigStorage.Contains('NEEDSPEELING'),true));
+  WriteLn('SEEDSREMOVED = ' + BoolToStr(ConfigStorage.Contains('SEEDSREMOVED'),true));
+  WriteLn('OTHERFAMILY(1) = ' + ConfigStorage['OTHERFAMILY'][0]);
+  WriteLn('OTHERFAMILY(2) = ' + ConfigStorage['OTHERFAMILY'][1]);
+
+  ConfigStorage.Free;
+  ConfigValues.Free;
+  ConfigStrings.Free;
+end.