diff --git a/lib/linguist/languages.yml b/lib/linguist/languages.yml index 5f0aeccf..d3cef7c1 100755 --- a/lib/linguist/languages.yml +++ b/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: diff --git a/samples/E/atomic-updates.E b/samples/E/atomic-updates.E new file mode 100644 index 00000000..39e95f66 --- /dev/null +++ b/samples/E/atomic-updates.E @@ -0,0 +1,123 @@ +#!/usr/bin/env rune +pragma.syntax("0.9") + +def pi := (-1.0).acos() +def makeEPainter := +def colors := + +# -------------------------------------------------------------- +# --- 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((500, 300)) + return c +} + +# -------------------------------------------------------------- +# --- Application setup + +def buckets := makeBuckets(100) +def done # Promise indicating when the window is closed + +# Create the window +def frame := ("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) diff --git a/samples/Haskell/maze-solving.hs b/samples/Haskell/maze-solving.hs new file mode 100644 index 00000000..80b95411 --- /dev/null +++ b/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 diff --git a/samples/Pascal/read-a-configuration-file.pascal b/samples/Pascal/read-a-configuration-file.pascal new file mode 100644 index 00000000..f90a53c7 --- /dev/null +++ b/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; + TConfigStorage = class(specialize THashMap) + 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.