diff --git a/impls/elm/Core.elm b/impls/elm/Core.elm index 10ead00b95..09f7ba6b84 100644 --- a/impls/elm/Core.elm +++ b/impls/elm/Core.elm @@ -1,16 +1,16 @@ module Core exposing (..) -import Types exposing (..) -import Env -import Eval -import Printer exposing (printString) import Array import Dict +import Env +import Eval import IO exposing (IO(..)) +import Printer exposing (printString) import Reader -import Utils exposing (zip) -import Time import Task +import Time +import Types exposing (..) +import Utils exposing (zip) ns : Env @@ -75,6 +75,7 @@ ns = ( x :: xs, y :: ys ) -> if deepEquals x y then equalLists xs ys + else False @@ -95,6 +96,7 @@ ns = equalMaps a b = if Dict.keys a /= Dict.keys b then False + else zip (Dict.values a) (Dict.values b) |> List.map (\(x,y) -> deepEquals x y) @@ -290,7 +292,7 @@ ns = value = Env.getAtom atomId env in - callFn func (value :: moreArgs) + callFn func (value :: moreArgs) ) |> Eval.andThen (\res -> @@ -384,8 +386,8 @@ ns = _ -> Eval.fail "unsupported arguments" in - List.foldl (go >> Eval.andThen) (Eval.succeed []) args - |> Eval.map (MalList Nothing) + List.foldl (go >> Eval.andThen) (Eval.succeed []) args + |> Eval.map (MalList Nothing) core_vec args = case args of @@ -399,8 +401,10 @@ ns = get list index = if index < 0 then Nothing + else if index == 0 then List.head list + else case list of [] -> @@ -417,33 +421,33 @@ ns = Nothing -> Eval.fail "index out of bounds" in - case args of - [ MalList _ list, MalInt index ] -> - make <| get list index + case args of + [ MalList _ list, MalInt index ] -> + make <| get list index - [ MalVector _ vec, MalInt index ] -> - make <| Array.get index vec + [ MalVector _ vec, MalInt index ] -> + make <| Array.get index vec - _ -> - Eval.fail "unsupported arguments" + _ -> + Eval.fail "unsupported arguments" first args = let make = Eval.succeed << Maybe.withDefault MalNil in - case args of - [ MalNil ] -> - Eval.succeed MalNil + case args of + [ MalNil ] -> + Eval.succeed MalNil - [ MalList _ list ] -> - make <| List.head list + [ MalList _ list ] -> + make <| List.head list - [ MalVector _ vec ] -> - make <| Array.get 0 vec + [ MalVector _ vec ] -> + make <| Array.get 0 vec - _ -> - Eval.fail "unsupported arguments" + _ -> + Eval.fail "unsupported arguments" core_rest args = case args of @@ -507,15 +511,15 @@ ns = Eval.pushRef outv (go func rest (outv :: acc)) ) in - case args of - [ MalFunction func, MalList _ list ] -> - Eval.withStack (go func list []) + case args of + [ MalFunction func, MalList _ list ] -> + Eval.withStack (go func list []) - [ MalFunction func, MalVector _ vec ] -> - go func (Array.toList vec) [] + [ MalFunction func, MalVector _ vec ] -> + go func (Array.toList vec) [] - _ -> - Eval.fail "unsupported arguments" + _ -> + Eval.fail "unsupported arguments" isNil args = Eval.succeed <| @@ -627,10 +631,7 @@ ns = (MalFunction (CoreFunc _ _)) :: _ -> True (MalFunction (UserFunc fn)) :: _ -> - if fn.isMacro then - False - else - True + not fn.isMacro _ -> False @@ -640,10 +641,7 @@ ns = MalBool <| case args of (MalFunction (UserFunc fn)) :: _ -> - if fn.isMacro then - True - else - False + fn.isMacro _ -> False @@ -723,12 +721,12 @@ ns = go rest (Dict.remove k acc) ) in - case args of - (MalMap _ dict) :: keys -> - go keys dict + case args of + (MalMap _ dict) :: keys -> + go keys dict - _ -> - Eval.fail "unsupported arguments" + _ -> + Eval.fail "unsupported arguments" core_get args = case args of @@ -763,6 +761,7 @@ ns = Just ( prefix, rest ) -> if prefix == keywordPrefix then MalKeyword rest + else MalString key @@ -854,7 +853,7 @@ ns = (MalList _ list) :: rest -> Eval.succeed <| MalList Nothing <| - (List.reverse rest) + List.reverse rest ++ list (MalVector _ vec) :: rest -> @@ -885,6 +884,7 @@ ns = Eval.succeed <| if Array.isEmpty vec then MalNil + else MalList Nothing <| Array.toList vec @@ -920,69 +920,69 @@ ns = _ -> Eval.fail "time-ms takes no arguments" in - Env.global - |> Env.set "+" (makeFn <| binaryOp (+) MalInt) - |> Env.set "-" (makeFn <| binaryOp (-) MalInt) - |> Env.set "*" (makeFn <| binaryOp (*) MalInt) - |> Env.set "/" (makeFn <| binaryOp (//) MalInt) - |> Env.set "<" (makeFn <| binaryOp (<) MalBool) - |> Env.set ">" (makeFn <| binaryOp (>) MalBool) - |> Env.set "<=" (makeFn <| binaryOp (<=) MalBool) - |> Env.set ">=" (makeFn <| binaryOp (>=) MalBool) - |> Env.set "list" (makeFn core_list) - |> Env.set "list?" (makeFn isList) - |> Env.set "empty?" (makeFn isEmpty) - |> Env.set "count" (makeFn count) - |> Env.set "=" (makeFn equals) - |> Env.set "pr-str" (makeFn prStr) - |> Env.set "str" (makeFn core_str) - |> Env.set "prn" (makeFn prn) - |> Env.set "println" (makeFn println) - |> Env.set "pr-env" (makeFn printEnv) - |> Env.set "read-string" (makeFn readString) - |> Env.set "slurp" (makeFn slurp) - |> Env.set "atom" (makeFn atom) - |> Env.set "atom?" (makeFn isAtom) - |> Env.set "deref" (makeFn deref) - |> Env.set "reset!" (makeFn reset) - |> Env.set "swap!" (makeFn swap) - |> Env.set "gc" (makeFn gc) - |> Env.set "debug!" (makeFn debug) - |> Env.set "typeof" (makeFn typeof) - |> Env.set "cons" (makeFn cons) - |> Env.set "concat" (makeFn concat) - |> Env.set "vec" (makeFn core_vec) - |> Env.set "nth" (makeFn nth) - |> Env.set "first" (makeFn first) - |> Env.set "rest" (makeFn core_rest) - |> Env.set "throw" (makeFn throw) - |> Env.set "apply" (makeFn apply) - |> Env.set "map" (makeFn core_map) - |> Env.set "nil?" (makeFn isNil) - |> Env.set "true?" (makeFn isTrue) - |> Env.set "false?" (makeFn isFalse) - |> Env.set "number?" (makeFn isNumber) - |> Env.set "symbol?" (makeFn isSymbol) - |> Env.set "keyword?" (makeFn isKeyword) - |> Env.set "vector?" (makeFn isVector) - |> Env.set "map?" (makeFn isMap) - |> Env.set "string?" (makeFn isString) - |> Env.set "sequential?" (makeFn isSequential) - |> Env.set "fn?" (makeFn isFn) - |> Env.set "macro?" (makeFn isMacro) - |> Env.set "symbol" (makeFn symbol) - |> Env.set "keyword" (makeFn core_keyword) - |> Env.set "vector" (makeFn vector) - |> Env.set "hash-map" (makeFn hashMap) - |> Env.set "assoc" (makeFn assoc) - |> Env.set "dissoc" (makeFn dissoc) - |> Env.set "get" (makeFn core_get) - |> Env.set "contains?" (makeFn contains) - |> Env.set "keys" (makeFn core_keys) - |> Env.set "vals" (makeFn vals) - |> Env.set "readline" (makeFn readLine) - |> Env.set "with-meta" (makeFn withMeta) - |> Env.set "meta" (makeFn core_meta) - |> Env.set "conj" (makeFn conj) - |> Env.set "seq" (makeFn seq) - |> Env.set "time-ms" (makeFn timeMs) + Env.global + |> Env.set "+" (makeFn <| binaryOp (+) MalInt) + |> Env.set "-" (makeFn <| binaryOp (-) MalInt) + |> Env.set "*" (makeFn <| binaryOp (*) MalInt) + |> Env.set "/" (makeFn <| binaryOp (//) MalInt) + |> Env.set "<" (makeFn <| binaryOp (<) MalBool) + |> Env.set ">" (makeFn <| binaryOp (>) MalBool) + |> Env.set "<=" (makeFn <| binaryOp (<=) MalBool) + |> Env.set ">=" (makeFn <| binaryOp (>=) MalBool) + |> Env.set "list" (makeFn core_list) + |> Env.set "list?" (makeFn isList) + |> Env.set "empty?" (makeFn isEmpty) + |> Env.set "count" (makeFn count) + |> Env.set "=" (makeFn equals) + |> Env.set "pr-str" (makeFn prStr) + |> Env.set "str" (makeFn core_str) + |> Env.set "prn" (makeFn prn) + |> Env.set "println" (makeFn println) + |> Env.set "pr-env" (makeFn printEnv) + |> Env.set "read-string" (makeFn readString) + |> Env.set "slurp" (makeFn slurp) + |> Env.set "atom" (makeFn atom) + |> Env.set "atom?" (makeFn isAtom) + |> Env.set "deref" (makeFn deref) + |> Env.set "reset!" (makeFn reset) + |> Env.set "swap!" (makeFn swap) + |> Env.set "gc" (makeFn gc) + |> Env.set "debug!" (makeFn debug) + |> Env.set "typeof" (makeFn typeof) + |> Env.set "cons" (makeFn cons) + |> Env.set "concat" (makeFn concat) + |> Env.set "vec" (makeFn core_vec) + |> Env.set "nth" (makeFn nth) + |> Env.set "first" (makeFn first) + |> Env.set "rest" (makeFn core_rest) + |> Env.set "throw" (makeFn throw) + |> Env.set "apply" (makeFn apply) + |> Env.set "map" (makeFn core_map) + |> Env.set "nil?" (makeFn isNil) + |> Env.set "true?" (makeFn isTrue) + |> Env.set "false?" (makeFn isFalse) + |> Env.set "number?" (makeFn isNumber) + |> Env.set "symbol?" (makeFn isSymbol) + |> Env.set "keyword?" (makeFn isKeyword) + |> Env.set "vector?" (makeFn isVector) + |> Env.set "map?" (makeFn isMap) + |> Env.set "string?" (makeFn isString) + |> Env.set "sequential?" (makeFn isSequential) + |> Env.set "fn?" (makeFn isFn) + |> Env.set "macro?" (makeFn isMacro) + |> Env.set "symbol" (makeFn symbol) + |> Env.set "keyword" (makeFn core_keyword) + |> Env.set "vector" (makeFn vector) + |> Env.set "hash-map" (makeFn hashMap) + |> Env.set "assoc" (makeFn assoc) + |> Env.set "dissoc" (makeFn dissoc) + |> Env.set "get" (makeFn core_get) + |> Env.set "contains?" (makeFn contains) + |> Env.set "keys" (makeFn core_keys) + |> Env.set "vals" (makeFn vals) + |> Env.set "readline" (makeFn readLine) + |> Env.set "with-meta" (makeFn withMeta) + |> Env.set "meta" (makeFn core_meta) + |> Env.set "conj" (makeFn conj) + |> Env.set "seq" (makeFn seq) + |> Env.set "time-ms" (makeFn timeMs) diff --git a/impls/elm/Env.elm b/impls/elm/Env.elm index 0763ba2d61..27ee0d0032 100644 --- a/impls/elm/Env.elm +++ b/impls/elm/Env.elm @@ -1,33 +1,33 @@ -module Env - exposing - ( debug - , globalFrameId - , global - , get - , set - , newAtom - , getAtom - , setAtom - , push - , pop - , enter - , leave - , ref - , pushRef - , restoreRefs - , gc - ) +module Env exposing + ( debug + , enter + , gc + , get + , getAtom + , global + , globalFrameId + , leave + , newAtom + , pop + , push + , pushRef + , ref + , restoreRefs + , set + , setAtom + ) -import Types exposing (MalExpr(..), MalFunction(..), Frame, Env) -import Dict import Array +import Dict import Set +import Types exposing (Env, Frame, MalExpr(..), MalFunction(..)) debug : Env -> String -> a -> a debug env msg value = if env.debug then Debug.log msg value + else value @@ -64,7 +64,7 @@ getFrame env frameId = frame Nothing -> - Debug.todo <| "frame #" ++ (String.fromInt frameId) ++ " not found" + Debug.todo <| "frame #" ++ String.fromInt frameId ++ " not found" emptyFrame : Maybe Int -> Maybe Int -> Frame @@ -91,7 +91,7 @@ set name expr env = newFrames = Dict.update frameId updateFrame env.frames in - { env | frames = newFrames } + { env | frames = newFrames } get : String -> Env -> Result String MalExpr @@ -102,16 +102,16 @@ get name env = frame = getFrame env frameId in - case Dict.get name frame.data of - Just value -> - Ok value - - Nothing -> - frame.outerId - |> Maybe.map go - |> Maybe.withDefault (Err <| "'" ++ name ++ "' not found") + case Dict.get name frame.data of + Just value -> + Ok value + + Nothing -> + frame.outerId + |> Maybe.map go + |> Maybe.withDefault (Err <| "'" ++ name ++ "' not found") in - go env.currentFrameId + go env.currentFrameId newAtom : MalExpr -> Env -> ( Env, Int ) @@ -126,7 +126,7 @@ newAtom value env = , nextAtomId = atomId + 1 } in - ( newEnv, atomId ) + ( newEnv, atomId ) getAtom : Int -> Env -> MalExpr @@ -136,7 +136,7 @@ getAtom atomId env = value Nothing -> - Debug.todo <| "atom " ++ (String.fromInt atomId) ++ " not found" + Debug.todo <| "atom " ++ String.fromInt atomId ++ " not found" setAtom : Int -> MalExpr -> Env -> Env @@ -158,11 +158,11 @@ push env = bogus = debug env "push" frameId in - { env - | currentFrameId = frameId - , frames = Dict.insert frameId newFrame env.frames - , nextFrameId = env.nextFrameId + 1 - } + { env + | currentFrameId = frameId + , frames = Dict.insert frameId newFrame env.frames + , nextFrameId = env.nextFrameId + 1 + } pop : Env -> Env @@ -177,15 +177,15 @@ pop env = bogus = debug env "pop" frameId in - case frame.outerId of - Just outerId -> - { env - | currentFrameId = outerId - , frames = Dict.update frameId free env.frames - } + case frame.outerId of + Just outerId -> + { env + | currentFrameId = outerId + , frames = Dict.update frameId free env.frames + } - _ -> - Debug.todo "tried to pop global frame" + _ -> + Debug.todo "tried to pop global frame" setBinds : List ( String, MalExpr ) -> Frame -> Frame @@ -213,11 +213,11 @@ enter outerId binds env = newFrame = setBinds binds (emptyFrame (Just outerId) (Just exitId)) in - { env - | currentFrameId = frameId - , frames = Dict.insert frameId newFrame env.frames - , nextFrameId = env.nextFrameId + 1 - } + { env + | currentFrameId = frameId + , frames = Dict.insert frameId newFrame env.frames + , nextFrameId = env.nextFrameId + 1 + } leave : Env -> Env @@ -237,16 +237,16 @@ leave env = Nothing -> Debug.todo <| "frame #" - ++ (String.fromInt frameId) + ++ String.fromInt frameId ++ " doesn't have an exitId" in - { env - | currentFrameId = exitId - , frames = - env.frames - |> Dict.insert frameId { frame | exitId = Nothing } - |> Dict.update frameId free - } + { env + | currentFrameId = exitId + , frames = + env.frames + |> Dict.insert frameId { frame | exitId = Nothing } + |> Dict.update frameId free + } {-| Increase refCnt for the current frame, @@ -266,17 +266,17 @@ ref originalEnv = newEnv = { env | frames = Dict.insert frameId newFrame env.frames } in - case frame.outerId of - Just outerId -> - go outerId newEnv + case frame.outerId of + Just outerId -> + go outerId newEnv - Nothing -> - newEnv + Nothing -> + newEnv newEnv2 = go originalEnv.currentFrameId originalEnv in - { newEnv2 | gcCounter = newEnv2.gcCounter + 1 } + { newEnv2 | gcCounter = newEnv2.gcCounter + 1 } free : Maybe Frame -> Maybe Frame @@ -285,14 +285,15 @@ free = (\frame -> if frame.refCnt == 1 then Nothing + else Just { frame | refCnt = frame.refCnt - 1 } ) pushRef : MalExpr -> Env -> Env -pushRef ref2 env = - { env | stack = ref2 :: env.stack } +pushRef ref_arg env = + { env | stack = ref_arg :: env.stack } restoreRefs : List MalExpr -> Env -> Env @@ -324,7 +325,8 @@ gc expr env = newAcc = Set.insert frameId acc in - countFrame frame newAcc + countFrame frame newAcc + else acc @@ -333,8 +335,8 @@ gc expr env = |> List.map Tuple.second |> countList acc - countExpr expr2 acc = - case expr2 of + countExpr expr_arg acc = + case expr_arg of MalFunction (UserFunc { frameId }) -> recur frameId acc @@ -356,7 +358,7 @@ gc expr env = value = getAtom atomId env in - countExpr value acc + countExpr value acc _ -> acc @@ -385,8 +387,8 @@ gc expr env = frame = getFrame env frameId in - expand frameId frame .outerId - >> expand frameId frame .exitId + expand frameId frame .outerId + >> expand frameId frame .exitId expandParents frames = Set.foldl expandBoth frames frames @@ -399,10 +401,11 @@ gc expr env = newParents = Set.diff newAcc acc in - if Set.isEmpty newParents then - newAcc - else - loop <| countFrames newParents newAcc + if Set.isEmpty newParents then + newAcc + + else + loop <| countFrames newParents newAcc makeNewEnv newFrames = { env @@ -416,9 +419,9 @@ gc expr env = filterFrames frames keep = Dict.filter (keepFilter keep) frames in - countFrames initSet initSet - |> countExpr expr - |> (\acc -> countList acc env.stack) - |> loop - |> filterFrames env.frames - |> makeNewEnv + countFrames initSet initSet + |> countExpr expr + |> (\acc -> countList acc env.stack) + |> loop + |> filterFrames env.frames + |> makeNewEnv diff --git a/impls/elm/Eval.elm b/impls/elm/Eval.elm index b840f0c321..5db9b1bdfa 100644 --- a/impls/elm/Eval.elm +++ b/impls/elm/Eval.elm @@ -1,8 +1,8 @@ module Eval exposing (..) -import Types exposing (..) -import IO exposing (IO) import Env +import IO exposing (IO) +import Types exposing (..) apply : Eval a -> Env -> EvalContext a @@ -96,18 +96,19 @@ gcPass e env0 = -- "" -- |> always ( Env.gc env, t expr ) ( Env.gc expr env, t expr ) + else ( env, t expr ) in - case apply e env0 of - ( env, EvalOk res ) -> - go env EvalOk res + case apply e env0 of + ( env, EvalOk res ) -> + go env EvalOk res - ( env, EvalErr msg ) -> - go env EvalErr msg + ( env, EvalErr msg ) -> + go env EvalErr msg - ( env, EvalIO cmd cont ) -> - ( env, EvalIO cmd (cont >> gcPass) ) + ( env, EvalIO cmd cont ) -> + ( env, EvalIO cmd (cont >> gcPass) ) catchError : (MalExpr -> Eval a) -> Eval a -> Eval a @@ -214,15 +215,16 @@ inGlobal body = , currentFrameId = oldEnv.currentFrameId } in - withEnv - (\env -> - if env.currentFrameId /= Env.globalFrameId then - enter env - |> andThen (always body) - |> finally (leave env) - else - body - ) + withEnv + (\env -> + if env.currentFrameId /= Env.globalFrameId then + enter env + |> andThen (always body) + |> finally (leave env) + + else + body + ) runSimple : Eval a -> Result MalExpr a diff --git a/impls/elm/IO.elm b/impls/elm/IO.elm index 1de75951a0..e565728318 100644 --- a/impls/elm/IO.elm +++ b/impls/elm/IO.elm @@ -1,12 +1,11 @@ -port module IO - exposing - ( IO(..) - , writeLine - , readLine - , readFile - , input - , decodeIO - ) +port module IO exposing + ( IO(..) + , decodeIO + , input + , readFile + , readLine + , writeLine + ) import Json.Decode exposing (..) import Time exposing (Posix) diff --git a/impls/elm/Printer.elm b/impls/elm/Printer.elm index 2e285268b6..1094cea406 100644 --- a/impls/elm/Printer.elm +++ b/impls/elm/Printer.elm @@ -2,9 +2,9 @@ module Printer exposing (..) import Array exposing (Array) import Dict exposing (Dict) -import Types exposing (Env, MalExpr(..), keywordPrefix, MalFunction(..)) -import Utils exposing (encodeString, wrap) import Env +import Types exposing (Env, MalExpr(..), MalFunction(..), keywordPrefix) +import Utils exposing (encodeString, wrap) printStr : Bool -> MalExpr -> String @@ -53,7 +53,7 @@ printString env readably ast = value = Env.getAtom atomId env in - "(atom " ++ (printString env True value) ++ ")" + "(atom " ++ printString env True value ++ ")" MalApply _ -> "#" @@ -63,17 +63,18 @@ printBound : Env -> Bool -> List ( String, MalExpr ) -> String printBound env readably = let printEntry ( name, value ) = - name ++ "=" ++ (printString env readably value) + name ++ "=" ++ printString env readably value in - List.map printEntry - >> String.join " " - >> wrap "(" ")" + List.map printEntry + >> String.join " " + >> wrap "(" ")" printRawString : Env -> Bool -> String -> String printRawString env readably str = if readably then encodeString str + else str @@ -102,6 +103,7 @@ printMap env readably = Just ( prefix, rest ) -> if prefix == keywordPrefix then ":" ++ rest + else printRawString env readably k @@ -109,12 +111,12 @@ printMap env readably = printRawString env readably k printEntry ( k, v ) = - (printKey k) ++ " " ++ (printString env readably v) + printKey k ++ " " ++ printString env readably v in - Dict.toList - >> List.map printEntry - >> String.join " " - >> wrap "{" "}" + Dict.toList + >> List.map printEntry + >> String.join " " + >> wrap "{" "}" printEnv : Env -> String @@ -125,28 +127,28 @@ printEnv env = printHeader frameId { outerId, exitId, refCnt } = "#" - ++ (String.fromInt frameId) + ++ String.fromInt frameId ++ " outer=" ++ printOuterId outerId ++ " exit=" ++ printOuterId exitId ++ " refCnt=" - ++ (String.fromInt refCnt) + ++ String.fromInt refCnt printFrame frameId frame = String.join "\n" - ((printHeader frameId frame) - :: (Dict.foldr printDatum [] frame.data) + (printHeader frameId frame + :: Dict.foldr printDatum [] frame.data ) printFrameAcc k v acc = printFrame k v :: acc printDatum k v acc = - (k ++ " = " ++ (printString env False v)) :: acc + (k ++ " = " ++ printString env False v) :: acc in - "--- Environment ---\n" - ++ "Current frame: #" - ++ (String.fromInt env.currentFrameId) - ++ "\n\n" - ++ String.join "\n\n" (Dict.foldr printFrameAcc [] env.frames) + "--- Environment ---\n" + ++ "Current frame: #" + ++ String.fromInt env.currentFrameId + ++ "\n\n" + ++ String.join "\n\n" (Dict.foldr printFrameAcc [] env.frames) diff --git a/impls/elm/Reader.elm b/impls/elm/Reader.elm index d9297fe63c..32f5439e34 100644 --- a/impls/elm/Reader.elm +++ b/impls/elm/Reader.elm @@ -18,15 +18,15 @@ ws = isSpaceChar : Char -> Bool isSpaceChar c = List.member c [' ', '\n', '\r', ','] in - Parser.succeed () - |. Parser.sequence - { start = "" - , separator = "" - , end = "" - , spaces = Parser.chompWhile isSpaceChar - , item = comment - , trailing = Parser.Optional - } + Parser.succeed () + |. Parser.sequence + { start = "" + , separator = "" + , end = "" + , spaces = Parser.chompWhile isSpaceChar + , item = comment + , trailing = Parser.Optional + } int : Parser MalExpr @@ -39,9 +39,9 @@ int = Just r -> MalInt r Nothing -> Debug.todo "should not happen" in - Parser.map toInt <| Parser.getChompedString <| - Parser.chompIf isDigit - |. Parser.chompWhile isDigit + Parser.map toInt <| Parser.getChompedString <| + Parser.chompIf isDigit + |. Parser.chompWhile isDigit symbolString : Parser String @@ -52,9 +52,9 @@ symbolString = not (List.member c [' ', '\n', '\r', ',', '\\', '[', ']', '{', '}', '(', '\'', '"', '`', ';', ')']) in - Parser.getChompedString <| - Parser.chompIf isSymbolChar - |. Parser.chompWhile isSymbolChar + Parser.getChompedString <| + Parser.chompIf isSymbolChar + |. Parser.chompWhile isSymbolChar symbolOrConst : Parser MalExpr @@ -74,7 +74,7 @@ symbolOrConst = _ -> MalSymbol sym in - Parser.map make symbolString + Parser.map make symbolString keywordString : Parser String @@ -173,7 +173,7 @@ form = , atom ] in - Parser.succeed identity |. ws |= Parser.oneOf parsers + Parser.succeed identity |. ws |= Parser.oneOf parsers simpleMacro : String -> String -> Parser MalExpr @@ -189,10 +189,10 @@ withMeta = make meta expr = makeCall "with-meta" [ expr, meta ] in - Parser.succeed make - |. Parser.token "^" - |= form - |= form + Parser.succeed make + |. Parser.token "^" + |= form + |= form readString : String -> Result String MalExpr @@ -217,7 +217,7 @@ formatError = ++ ":" ++ String.fromInt deadEnd.col in - (++) "end of input\n" << String.join "\n" << List.map format1 + (++) "end of input\n" << String.join "\n" << List.map format1 str : Parser MalExpr @@ -231,17 +231,17 @@ strString = isStringNormalChar : Char -> Bool isStringNormalChar c = not <| List.member c ['"', '\\'] in - Parser.getChompedString <| - Parser.sequence - { start = "\"" - , separator = "" - , end = "\"" - , spaces = Parser.succeed () - , item = Parser.oneOf - [ Parser.chompIf isStringNormalChar - |. Parser.chompWhile isStringNormalChar - , Parser.token "\\" - |. Parser.chompIf (\_ -> True) - ] - , trailing = Parser.Forbidden - } + Parser.getChompedString <| + Parser.sequence + { start = "\"" + , separator = "" + , end = "\"" + , spaces = Parser.succeed () + , item = Parser.oneOf + [ Parser.chompIf isStringNormalChar + |. Parser.chompWhile isStringNormalChar + , Parser.token "\\" + |. Parser.chompIf (\_ -> True) + ] + , trailing = Parser.Forbidden + } diff --git a/impls/elm/Step0_repl.elm b/impls/elm/Step0_repl.elm index 361e9a4aad..8763f090a6 100644 --- a/impls/elm/Step0_repl.elm +++ b/impls/elm/Step0_repl.elm @@ -2,11 +2,12 @@ module Step0_repl exposing (..) import IO exposing (..) import Json.Decode exposing (decodeValue, errorToString) +import Platform exposing (worker) main : Program Flags Model Msg main = - Platform.worker + worker { init = init , update = update , subscriptions = @@ -17,7 +18,6 @@ main = } - type alias Flags = { args : List String } diff --git a/impls/elm/Step1_read_print.elm b/impls/elm/Step1_read_print.elm index 9e294a7e59..57fdc733ab 100644 --- a/impls/elm/Step1_read_print.elm +++ b/impls/elm/Step1_read_print.elm @@ -2,14 +2,15 @@ module Step1_read_print exposing (..) import IO exposing (..) import Json.Decode exposing (decodeValue, errorToString) -import Types exposing (MalExpr(..)) -import Reader exposing (readString) +import Platform exposing (worker) import Printer exposing (printStr) +import Reader exposing (readString) +import Types exposing (MalExpr(..)) main : Program Flags Model Msg main = - Platform.worker + worker { init = init , update = update , subscriptions = @@ -43,7 +44,7 @@ update : Msg -> Model -> ( Model, Cmd Msg ) update msg model = case msg of Input (Ok (LineRead (Just line))) -> - ( model, writeLine (rep line) ) + ( model, writeLine (rep line) ) Input (Ok LineWritten) -> ( model, readLine prompt ) @@ -91,6 +92,6 @@ rep = Err msg -> msg in - readString - >> Result.map (eval >> print) - >> formatResult + readString + >> Result.map (eval >> print) + >> formatResult diff --git a/impls/elm/Step2_eval.elm b/impls/elm/Step2_eval.elm index fb9841cc3c..c4685ebade 100644 --- a/impls/elm/Step2_eval.elm +++ b/impls/elm/Step2_eval.elm @@ -1,20 +1,21 @@ module Step2_eval exposing (..) +import Array +import Dict exposing (Dict) +import Eval import IO exposing (..) import Json.Decode exposing (decodeValue, errorToString) -import Types exposing (..) -import Reader exposing (readString) +import Platform exposing (worker) import Printer exposing (printStr) -import Utils exposing (maybeToList, zip) -import Dict exposing (Dict) +import Reader exposing (readString) import Tuple exposing (mapFirst, second) -import Array -import Eval +import Types exposing (..) +import Utils exposing (maybeToList, zip) main : Program Flags Model Msg main = - Platform.worker + worker { init = init , update = update , subscriptions = @@ -63,12 +64,12 @@ initReplEnv = _ -> Eval.fail "unsupported arguments" in - Dict.fromList - [ ( "+", makeFn <| binaryOp (+) ) - , ( "-", makeFn <| binaryOp (-) ) - , ( "*", makeFn <| binaryOp (*) ) - , ( "/", makeFn <| binaryOp (//) ) - ] + Dict.fromList + [ ( "+", makeFn <| binaryOp (+) ) + , ( "-", makeFn <| binaryOp (-) ) + , ( "*", makeFn <| binaryOp (*) ) + , ( "/", makeFn <| binaryOp (//) ) + ] update : Msg -> Model -> ( Model, Cmd Msg ) @@ -205,8 +206,8 @@ tryMapList fn list = Err msg ) in - List.foldl go (Ok []) list - |> Result.map List.reverse + List.foldl go (Ok []) list + |> Result.map List.reverse print : MalExpr -> String @@ -222,9 +223,9 @@ rep env input = evalPrint = eval env >> mapFirst (Result.map print) in - case readString input of - Err msg -> - ( Err msg, env ) + case readString input of + Err msg -> + ( Err msg, env ) - Ok ast -> - evalPrint ast + Ok ast -> + evalPrint ast diff --git a/impls/elm/Step3_env.elm b/impls/elm/Step3_env.elm index 2fde0894c7..a1028e8ff7 100644 --- a/impls/elm/Step3_env.elm +++ b/impls/elm/Step3_env.elm @@ -1,25 +1,26 @@ module Step3_env exposing (..) +import Array +import Dict exposing (Dict) +import Env +import Eval import IO exposing (..) import Json.Decode exposing (decodeValue, errorToString) -import Types exposing (..) -import Reader exposing (readString) +import Platform exposing (worker) import Printer exposing (printString) -import Utils exposing (maybeToList, zip) -import Dict exposing (Dict) +import Reader exposing (readString) import Tuple exposing (mapFirst, mapSecond, second) -import Array -import Env -import Eval +import Types exposing (..) +import Utils exposing (maybeToList, zip) main : Program Flags Model Msg main = - Platform.worker + worker { init = init , update = update - , subscriptions = \model -> input (decodeValue decodeIO - >> (\x -> case x of + , subscriptions = + \model -> input (decodeValue decodeIO >> (\x -> case x of Err e -> Err (errorToString e) Ok a -> Ok a ) >> Input) @@ -60,11 +61,11 @@ initReplEnv = _ -> Eval.fail "unsupported arguments" in - Env.global - |> Env.set "+" (makeFn <| binaryOp (+)) - |> Env.set "-" (makeFn <| binaryOp (-)) - |> Env.set "*" (makeFn <| binaryOp (*)) - |> Env.set "/" (makeFn <| binaryOp (//)) + Env.global + |> Env.set "+" (makeFn <| binaryOp (+)) + |> Env.set "-" (makeFn <| binaryOp (-)) + |> Env.set "*" (makeFn <| binaryOp (*)) + |> Env.set "/" (makeFn <| binaryOp (//)) update : Msg -> Model -> ( Model, Cmd Msg ) @@ -117,7 +118,7 @@ eval env ast = _ -> Debug.log ("EVAL: " ++ printString env True ast) () -- The output ends with an ugly ": ()", but that does not hurt. in - case ast of + case ast of MalList _ [] -> ( Ok ast, env ) @@ -217,10 +218,10 @@ evalLet env args = newEnv2 = Env.set name value env2 in - if List.isEmpty rest then - Ok newEnv2 - else - evalBinds newEnv2 rest + if List.isEmpty rest then + Ok newEnv2 + else + evalBinds newEnv2 rest ( Err msg, _ ) -> Err msg @@ -237,15 +238,15 @@ evalLet env args = Err msg -> ( Err msg, env ) in - case args of - [ MalList _ binds, body ] -> - go binds body + case args of + [ MalList _ binds, body ] -> + go binds body - [ MalVector _ bindsVec, body ] -> - go (Array.toList bindsVec) body + [ MalVector _ bindsVec, body ] -> + go (Array.toList bindsVec) body - _ -> - ( Err "let* expected two args: binds and a body", env ) + _ -> + ( Err "let* expected two args: binds and a body", env ) {-| Try to map a list with a fn that can return a Err. @@ -269,8 +270,8 @@ tryMapList fn list = Err msg ) in - List.foldl go (Ok []) list - |> Result.map List.reverse + List.foldl go (Ok []) list + |> Result.map List.reverse print : MalExpr -> String @@ -286,9 +287,9 @@ rep env input = evalPrint = eval env >> mapFirst (Result.map print) in - case readString input of - Err msg -> - ( Err msg, env ) + case readString input of + Err msg -> + ( Err msg, env ) - Ok ast -> - evalPrint ast + Ok ast -> + evalPrint ast diff --git a/impls/elm/Step4_if_fn_do.elm b/impls/elm/Step4_if_fn_do.elm index 5030c56c14..7b31229312 100644 --- a/impls/elm/Step4_if_fn_do.elm +++ b/impls/elm/Step4_if_fn_do.elm @@ -1,21 +1,22 @@ module Step4_if_fn_do exposing (..) import Array +import Core import Dict exposing (Dict) +import Env +import Eval import IO exposing (..) import Json.Decode exposing (decodeValue, errorToString) -import Types exposing (..) -import Reader exposing (readString) +import Platform exposing (worker) import Printer exposing (printString) -import Utils exposing (maybeToList, zip, last, justValues) -import Env -import Core -import Eval +import Reader exposing (readString) +import Types exposing (..) +import Utils exposing (justValues, last, maybeToList, zip) main : Program Flags Model Msg main = - Platform.worker + worker { init = init , update = update , subscriptions = @@ -51,7 +52,7 @@ init { args } = (\b a -> a |> Eval.andThen (\_ -> b)) (Eval.succeed MalNil) in - runInit initEnv evalMalInit + runInit initEnv evalMalInit malInit : List String @@ -189,7 +190,7 @@ eval ast = fn :: _ -> Eval.withEnv (\env -> - Eval.fail ((printString env True fn) ++ " is not a function") + Eval.fail (printString env True fn ++ " is not a function") ) ) @@ -237,7 +238,7 @@ evalList list = go rest (val :: acc) ) in - go list [] + go list [] evalDef : List MalExpr -> Eval MalExpr @@ -269,6 +270,7 @@ evalLet args = (\_ -> if List.isEmpty rest then Eval.succeed () + else evalBinds rest ) @@ -287,15 +289,15 @@ evalLet args = |> Eval.map (\_ -> res) ) in - case args of - [ MalList _ binds, body ] -> - go binds body + case args of + [ MalList _ binds, body ] -> + go binds body - [ MalVector _ bindsVec, body ] -> - go (Array.toList bindsVec) body + [ MalVector _ bindsVec, body ] -> + go (Array.toList bindsVec) body - _ -> - Eval.fail "let* expected two args: binds and a body" + _ -> + Eval.fail "let* expected two args: binds and a body" evalDo : List MalExpr -> Eval MalExpr @@ -309,15 +311,15 @@ evalDo args = Nothing -> Eval.fail "do expected at least one arg" in - evalList args - |> Eval.andThen returnLast + evalList args + |> Eval.andThen returnLast evalIf : List MalExpr -> Eval MalExpr evalIf args = let isTruthy expr = - expr /= MalNil && expr /= (MalBool False) + expr /= MalNil && expr /= MalBool False go condition trueExpr falseExpr = eval condition @@ -326,20 +328,21 @@ evalIf args = eval (if isTruthy cond then trueExpr + else falseExpr ) ) in - case args of - [ condition, trueExpr ] -> - go condition trueExpr MalNil + case args of + [ condition, trueExpr ] -> + go condition trueExpr MalNil - [ condition, trueExpr, falseExpr ] -> - go condition trueExpr falseExpr + [ condition, trueExpr, falseExpr ] -> + go condition trueExpr falseExpr - _ -> - Eval.fail "if expected at least two args" + _ -> + Eval.fail "if expected at least two args" evalFn : List MalExpr -> Eval MalExpr @@ -354,6 +357,7 @@ evalFn parms = (MalSymbol name) :: rest -> if List.member name acc then Err "all binds must have unique names" + else extractSymbols (name :: acc) rest @@ -368,6 +372,7 @@ evalFn parms = _ -> if List.member "&" list then Err "varargs separator '&' is used incorrectly" + else Ok <| bindArgs list @@ -379,13 +384,14 @@ evalFn parms = numBinds = List.length binds in - if List.length args /= numBinds then - Err <| - "function expected " - ++ (String.fromInt numBinds) - ++ " arguments" - else - Ok <| zip binds args + if List.length args /= numBinds then + Err <| + "function expected " + ++ String.fromInt numBinds + ++ " arguments" + + else + Ok <| zip binds args bindVarArgs binds var args = let @@ -395,37 +401,38 @@ evalFn parms = varArgs = MalList Nothing (List.drop minArgs args) in - if List.length args < minArgs then - Err <| - "function expected at least " - ++ (String.fromInt minArgs) - ++ " arguments" - else - Ok <| zip binds args ++ [ ( var, varArgs ) ] + if List.length args < minArgs then + Err <| + "function expected at least " + ++ String.fromInt minArgs + ++ " arguments" + + else + Ok <| zip binds args ++ [ ( var, varArgs ) ] makeFn frameId binder body = - let - fn args = - case binder args of - Ok bound -> - Eval.withEnv - (\env -> - Eval.modifyEnv (Env.enter frameId bound) - |> Eval.andThen (always (eval body)) - |> Eval.finally Env.leave - ) + MalFunction <| + let + fn args = + case binder args of + Ok bound -> + Eval.withEnv + (\env -> + Eval.modifyEnv (Env.enter frameId bound) + |> Eval.andThen (always (eval body)) + |> Eval.finally Env.leave + ) - Err msg -> - Eval.fail msg - in - MalFunction <| - UserFunc - { frameId = frameId - , lazyFn = fn - , eagerFn = fn - , isMacro = False - , meta = Nothing - } + Err msg -> + Eval.fail msg + in + UserFunc + { frameId = frameId + , lazyFn = fn + , eagerFn = fn + , isMacro = False + , meta = Nothing + } go bindsList body = case extractAndParse bindsList of @@ -444,15 +451,15 @@ evalFn parms = Err msg -> Eval.fail msg in - case parms of - [ MalList _ bindsList, body ] -> - go bindsList body + case parms of + [ MalList _ bindsList, body ] -> + go bindsList body - [ MalVector _ bindsVec, body ] -> - go (Array.toList bindsVec) body + [ MalVector _ bindsVec, body ] -> + go (Array.toList bindsVec) body - _ -> - Eval.fail "fn* expected two args: binds list and body" + _ -> + Eval.fail "fn* expected two args: binds list and body" print : Env -> MalExpr -> String @@ -462,7 +469,7 @@ print env = printError : Env -> MalExpr -> String printError env expr = - "Error: " ++ (printString env False expr) + "Error: " ++ printString env False expr {-| Read-Eval-Print. diff --git a/impls/elm/Step5_tco.elm b/impls/elm/Step5_tco.elm index e8722f9c12..62f0a22795 100644 --- a/impls/elm/Step5_tco.elm +++ b/impls/elm/Step5_tco.elm @@ -1,21 +1,22 @@ module Step5_tco exposing (..) import Array +import Core import Dict exposing (Dict) +import Env +import Eval import IO exposing (..) import Json.Decode exposing (decodeValue, errorToString) -import Types exposing (..) -import Reader exposing (readString) +import Platform exposing (worker) import Printer exposing (printString) -import Utils exposing (maybeToList, zip, last, justValues) -import Env -import Core -import Eval +import Reader exposing (readString) +import Types exposing (..) +import Utils exposing (justValues, last, maybeToList, zip) main : Program Flags Model Msg main = - Platform.worker + worker { init = init , update = update , subscriptions = @@ -51,7 +52,7 @@ init { args } = (\b a -> a |> Eval.andThen (\_ -> b)) (Eval.succeed MalNil) in - runInit initEnv evalMalInit + runInit initEnv evalMalInit malInit : List String @@ -167,8 +168,8 @@ eval ast = _ -> Right expr in - evalNoApply ast - |> Eval.andThen (Eval.runLoop apply) + evalNoApply ast + |> Eval.andThen (Eval.runLoop apply) evalApply : ApplyRec -> Eval MalExpr @@ -194,43 +195,43 @@ evalNoApply ast = ) |> Eval.andThen (\_ -> case ast of MalList _ [] -> - Eval.succeed ast + Eval.succeed ast MalList _ ((MalSymbol "def!") :: args) -> - evalDef args + evalDef args MalList _ ((MalSymbol "let*") :: args) -> - evalLet args + evalLet args MalList _ ((MalSymbol "do") :: args) -> - evalDo args + evalDo args MalList _ ((MalSymbol "if") :: args) -> - evalIf args + evalIf args MalList _ ((MalSymbol "fn*") :: args) -> - evalFn args + evalFn args MalList _ list -> - evalList list - |> Eval.andThen - (\newList -> - case newList of - [] -> - Eval.fail "can't happen" - - (MalFunction (CoreFunc _ fn)) :: args -> - fn args - - (MalFunction (UserFunc { lazyFn })) :: args -> - lazyFn args - - fn :: _ -> - Eval.withEnv - (\env -> - Eval.fail ((printString env True fn) ++ " is not a function") - ) - ) + evalList list + |> Eval.andThen + (\newList -> + case newList of + [] -> + Eval.fail "can't happen" + + (MalFunction (CoreFunc _ fn)) :: args -> + fn args + + (MalFunction (UserFunc { lazyFn })) :: args -> + lazyFn args + + fn :: _ -> + Eval.withEnv + (\env -> + Eval.fail (printString env True fn ++ " is not a function") + ) + ) MalSymbol sym -> -- Lookup symbol in env and return value or raise error if not found. @@ -276,7 +277,7 @@ evalList list = go rest (val :: acc) ) in - go list [] + go list [] evalDef : List MalExpr -> Eval MalExpr @@ -308,6 +309,7 @@ evalLet args = (\_ -> if List.isEmpty rest then Eval.succeed () + else evalBinds rest ) @@ -326,15 +328,15 @@ evalLet args = |> Eval.map (\_ -> res) ) in - case args of - [ MalList _ binds, body ] -> - go binds body + case args of + [ MalList _ binds, body ] -> + go binds body - [ MalVector _ bindsVec, body ] -> - go (Array.toList bindsVec) body + [ MalVector _ bindsVec, body ] -> + go (Array.toList bindsVec) body - _ -> - Eval.fail "let* expected two args: binds and a body" + _ -> + Eval.fail "let* expected two args: binds and a body" evalDo : List MalExpr -> Eval MalExpr @@ -352,7 +354,7 @@ evalIf : List MalExpr -> Eval MalExpr evalIf args = let isTruthy expr = - expr /= MalNil && expr /= (MalBool False) + expr /= MalNil && expr /= MalBool False go condition trueExpr falseExpr = eval condition @@ -361,20 +363,21 @@ evalIf args = evalNoApply (if isTruthy cond then trueExpr + else falseExpr ) ) in - case args of - [ condition, trueExpr ] -> - go condition trueExpr MalNil + case args of + [ condition, trueExpr ] -> + go condition trueExpr MalNil - [ condition, trueExpr, falseExpr ] -> - go condition trueExpr falseExpr + [ condition, trueExpr, falseExpr ] -> + go condition trueExpr falseExpr - _ -> - Eval.fail "if expected at least two args" + _ -> + Eval.fail "if expected at least two args" evalFn : List MalExpr -> Eval MalExpr @@ -389,6 +392,7 @@ evalFn parms = (MalSymbol name) :: rest -> if List.member name acc then Err "all binds must have unique names" + else extractSymbols (name :: acc) rest @@ -403,6 +407,7 @@ evalFn parms = _ -> if List.member "&" list then Err "varargs separator '&' is used incorrectly" + else Ok <| bindArgs list @@ -414,13 +419,14 @@ evalFn parms = numBinds = List.length binds in - if List.length args /= numBinds then - Err <| - "function expected " - ++ (String.fromInt numBinds) - ++ " arguments" - else - Ok <| zip binds args + if List.length args /= numBinds then + Err <| + "function expected " + ++ String.fromInt numBinds + ++ " arguments" + + else + Ok <| zip binds args bindVarArgs binds var args = let @@ -430,13 +436,14 @@ evalFn parms = varArgs = MalList Nothing (List.drop minArgs args) in - if List.length args < minArgs then - Err <| - "function expected at least " - ++ (String.fromInt minArgs) - ++ " arguments" - else - Ok <| zip binds args ++ [ ( var, varArgs ) ] + if List.length args < minArgs then + Err <| + "function expected at least " + ++ String.fromInt minArgs + ++ " arguments" + + else + Ok <| zip binds args ++ [ ( var, varArgs ) ] makeFn frameId binder body = MalFunction <| @@ -454,13 +461,13 @@ evalFn parms = Err msg -> Eval.fail msg in - UserFunc - { frameId = frameId - , lazyFn = lazyFn - , eagerFn = lazyFn >> Eval.andThen eval - , isMacro = False - , meta = Nothing - } + UserFunc + { frameId = frameId + , lazyFn = lazyFn + , eagerFn = lazyFn >> Eval.andThen eval + , isMacro = False + , meta = Nothing + } go bindsList body = case extractAndParse bindsList of @@ -479,15 +486,15 @@ evalFn parms = Err msg -> Eval.fail msg in - case parms of - [ MalList _ bindsList, body ] -> - go bindsList body + case parms of + [ MalList _ bindsList, body ] -> + go bindsList body - [ MalVector _ bindsVec, body ] -> - go (Array.toList bindsVec) body + [ MalVector _ bindsVec, body ] -> + go (Array.toList bindsVec) body - _ -> - Eval.fail "fn* expected two args: binds list and body" + _ -> + Eval.fail "fn* expected two args: binds list and body" print : Env -> MalExpr -> String @@ -497,7 +504,7 @@ print env = printError : Env -> MalExpr -> String printError env expr = - "Error: " ++ (printString env False expr) + "Error: " ++ printString env False expr {-| Read-Eval-Print. diff --git a/impls/elm/Step6_file.elm b/impls/elm/Step6_file.elm index 6d98cb1d96..e4df50b520 100644 --- a/impls/elm/Step6_file.elm +++ b/impls/elm/Step6_file.elm @@ -1,21 +1,22 @@ module Step6_file exposing (..) import Array +import Core import Dict exposing (Dict) +import Env +import Eval import IO exposing (..) import Json.Decode exposing (decodeValue, errorToString) -import Types exposing (..) -import Reader exposing (readString) +import Platform exposing (worker) import Printer exposing (printString) -import Utils exposing (maybeToList, zip, last, justValues) -import Env -import Core -import Eval +import Reader exposing (readString) +import Types exposing (..) +import Utils exposing (justValues, last, maybeToList, zip) main : Program Flags Model Msg main = - Platform.worker + worker { init = init , update = update , subscriptions = @@ -61,7 +62,7 @@ init { args } = (\b a -> a |> Eval.andThen (\_ -> b)) (Eval.succeed MalNil) in - runInit args initEnv evalMalInit + runInit args initEnv evalMalInit malInit : List String @@ -164,7 +165,7 @@ runScript filename argv env = , MalString filename ] in - runScriptLoop newEnv (eval program) + runScriptLoop newEnv (eval program) runScriptLoop : Env -> Eval MalExpr -> ( Model, Cmd Msg ) @@ -227,8 +228,8 @@ eval ast = _ -> Right expr in - evalNoApply ast - |> Eval.andThen (Eval.runLoop apply) + evalNoApply ast + |> Eval.andThen (Eval.runLoop apply) malEval : List MalExpr -> Eval MalExpr @@ -264,43 +265,43 @@ evalNoApply ast = ) |> Eval.andThen (\_ -> case ast of MalList _ [] -> - Eval.succeed ast + Eval.succeed ast MalList _ ((MalSymbol "def!") :: args) -> - evalDef args + evalDef args MalList _ ((MalSymbol "let*") :: args) -> - evalLet args + evalLet args MalList _ ((MalSymbol "do") :: args) -> - evalDo args + evalDo args MalList _ ((MalSymbol "if") :: args) -> - evalIf args + evalIf args MalList _ ((MalSymbol "fn*") :: args) -> - evalFn args + evalFn args MalList _ list -> - evalList list - |> Eval.andThen - (\newList -> - case newList of - [] -> - Eval.fail "can't happen" - - (MalFunction (CoreFunc _ fn)) :: args -> - fn args - - (MalFunction (UserFunc { lazyFn })) :: args -> - lazyFn args - - fn :: _ -> - Eval.withEnv - (\env -> - Eval.fail ((printString env True fn) ++ " is not a function") - ) - ) + evalList list + |> Eval.andThen + (\newList -> + case newList of + [] -> + Eval.fail "can't happen" + + (MalFunction (CoreFunc _ fn)) :: args -> + fn args + + (MalFunction (UserFunc { lazyFn })) :: args -> + lazyFn args + + fn :: _ -> + Eval.withEnv + (\env -> + Eval.fail (printString env True fn ++ " is not a function") + ) + ) MalSymbol sym -> -- Lookup symbol in env and return value or raise error if not found. @@ -346,7 +347,7 @@ evalList list = go rest (val :: acc) ) in - go list [] + go list [] evalDef : List MalExpr -> Eval MalExpr @@ -378,6 +379,7 @@ evalLet args = (\_ -> if List.isEmpty rest then Eval.succeed () + else evalBinds rest ) @@ -396,15 +398,15 @@ evalLet args = |> Eval.map (\_ -> res) ) in - case args of - [ MalList _ binds, body ] -> - go binds body + case args of + [ MalList _ binds, body ] -> + go binds body - [ MalVector _ bindsVec, body ] -> - go (Array.toList bindsVec) body + [ MalVector _ bindsVec, body ] -> + go (Array.toList bindsVec) body - _ -> - Eval.fail "let* expected two args: binds and a body" + _ -> + Eval.fail "let* expected two args: binds and a body" evalDo : List MalExpr -> Eval MalExpr @@ -422,7 +424,7 @@ evalIf : List MalExpr -> Eval MalExpr evalIf args = let isTruthy expr = - expr /= MalNil && expr /= (MalBool False) + expr /= MalNil && expr /= MalBool False go condition trueExpr falseExpr = eval condition @@ -431,20 +433,21 @@ evalIf args = evalNoApply (if isTruthy cond then trueExpr + else falseExpr ) ) in - case args of - [ condition, trueExpr ] -> - go condition trueExpr MalNil + case args of + [ condition, trueExpr ] -> + go condition trueExpr MalNil - [ condition, trueExpr, falseExpr ] -> - go condition trueExpr falseExpr + [ condition, trueExpr, falseExpr ] -> + go condition trueExpr falseExpr - _ -> - Eval.fail "if expected at least two args" + _ -> + Eval.fail "if expected at least two args" evalFn : List MalExpr -> Eval MalExpr @@ -459,6 +462,7 @@ evalFn parms = (MalSymbol name) :: rest -> if List.member name acc then Err "all binds must have unique names" + else extractSymbols (name :: acc) rest @@ -473,6 +477,7 @@ evalFn parms = _ -> if List.member "&" list then Err "varargs separator '&' is used incorrectly" + else Ok <| bindArgs list @@ -484,13 +489,14 @@ evalFn parms = numBinds = List.length binds in - if List.length args /= numBinds then - Err <| - "function expected " - ++ (String.fromInt numBinds) - ++ " arguments" - else - Ok <| zip binds args + if List.length args /= numBinds then + Err <| + "function expected " + ++ String.fromInt numBinds + ++ " arguments" + + else + Ok <| zip binds args bindVarArgs binds var args = let @@ -500,13 +506,14 @@ evalFn parms = varArgs = MalList Nothing (List.drop minArgs args) in - if List.length args < minArgs then - Err <| - "function expected at least " - ++ (String.fromInt minArgs) - ++ " arguments" - else - Ok <| zip binds args ++ [ ( var, varArgs ) ] + if List.length args < minArgs then + Err <| + "function expected at least " + ++ String.fromInt minArgs + ++ " arguments" + + else + Ok <| zip binds args ++ [ ( var, varArgs ) ] makeFn frameId binder body = MalFunction <| @@ -524,13 +531,13 @@ evalFn parms = Err msg -> Eval.fail msg in - UserFunc - { frameId = frameId - , lazyFn = lazyFn - , eagerFn = lazyFn >> Eval.andThen eval - , isMacro = False - , meta = Nothing - } + UserFunc + { frameId = frameId + , lazyFn = lazyFn + , eagerFn = lazyFn >> Eval.andThen eval + , isMacro = False + , meta = Nothing + } go bindsList body = case extractAndParse bindsList of @@ -549,15 +556,15 @@ evalFn parms = Err msg -> Eval.fail msg in - case parms of - [ MalList _ bindsList, body ] -> - go bindsList body + case parms of + [ MalList _ bindsList, body ] -> + go bindsList body - [ MalVector _ bindsVec, body ] -> - go (Array.toList bindsVec) body + [ MalVector _ bindsVec, body ] -> + go (Array.toList bindsVec) body - _ -> - Eval.fail "fn* expected two args: binds list and body" + _ -> + Eval.fail "fn* expected two args: binds list and body" print : Env -> MalExpr -> String @@ -567,7 +574,7 @@ print env = printError : Env -> MalExpr -> String printError env expr = - "Error: " ++ (printString env False expr) + "Error: " ++ printString env False expr {-| Read-Eval-Print. diff --git a/impls/elm/Step7_quote.elm b/impls/elm/Step7_quote.elm index 10e38a2b62..bebcd0cc38 100644 --- a/impls/elm/Step7_quote.elm +++ b/impls/elm/Step7_quote.elm @@ -1,21 +1,22 @@ module Step7_quote exposing (..) import Array +import Core import Dict exposing (Dict) +import Env +import Eval import IO exposing (..) import Json.Decode exposing (decodeValue, errorToString) -import Types exposing (..) -import Reader exposing (readString) +import Platform exposing (worker) import Printer exposing (printString) -import Utils exposing (maybeToList, zip, last, justValues, makeCall) -import Env -import Core -import Eval +import Reader exposing (readString) +import Types exposing (..) +import Utils exposing (justValues, last, makeCall, maybeToList, zip) main : Program Flags Model Msg main = - Platform.worker + worker { init = init , update = update , subscriptions = @@ -61,7 +62,7 @@ init { args } = (\b a -> a |> Eval.andThen (\_ -> b)) (Eval.succeed MalNil) in - runInit args initEnv evalMalInit + runInit args initEnv evalMalInit malInit : List String @@ -164,7 +165,7 @@ runScript filename argv env = , MalString filename ] in - runScriptLoop newEnv (eval program) + runScriptLoop newEnv (eval program) runScriptLoop : Env -> Eval MalExpr -> ( Model, Cmd Msg ) @@ -227,8 +228,8 @@ eval ast = _ -> Right expr in - evalNoApply ast - |> Eval.andThen (Eval.runLoop apply) + evalNoApply ast + |> Eval.andThen (Eval.runLoop apply) malEval : List MalExpr -> Eval MalExpr @@ -264,55 +265,55 @@ evalNoApply ast = ) |> Eval.andThen (\_ -> case ast of MalList _ [] -> - Eval.succeed ast + Eval.succeed ast MalList _ ((MalSymbol "def!") :: args) -> - evalDef args + evalDef args MalList _ ((MalSymbol "let*") :: args) -> - evalLet args + evalLet args MalList _ ((MalSymbol "do") :: args) -> - evalDo args + evalDo args MalList _ ((MalSymbol "if") :: args) -> - evalIf args + evalIf args MalList _ ((MalSymbol "fn*") :: args) -> - evalFn args + evalFn args MalList _ ((MalSymbol "quote") :: args) -> - evalQuote args + evalQuote args MalList _ ((MalSymbol "quasiquote") :: args) -> - case args of - [ expr ] -> - -- TCO. - evalNoApply (evalQuasiQuote expr) + case args of + [ expr ] -> + -- TCO. + evalNoApply (evalQuasiQuote expr) - _ -> - Eval.fail "unsupported arguments" + _ -> + Eval.fail "unsupported arguments" MalList _ list -> - evalList list - |> Eval.andThen - (\newList -> - case newList of - [] -> - Eval.fail "can't happen" - - (MalFunction (CoreFunc _ fn)) :: args -> - fn args - - (MalFunction (UserFunc { lazyFn })) :: args -> - lazyFn args - - fn :: _ -> - Eval.withEnv - (\env -> - Eval.fail ((printString env True fn) ++ " is not a function") - ) - ) + evalList list + |> Eval.andThen + (\newList -> + case newList of + [] -> + Eval.fail "can't happen" + + (MalFunction (CoreFunc _ fn)) :: args -> + fn args + + (MalFunction (UserFunc { lazyFn })) :: args -> + lazyFn args + + fn :: _ -> + Eval.withEnv + (\env -> + Eval.fail (printString env True fn ++ " is not a function") + ) + ) MalSymbol sym -> -- Lookup symbol in env and return value or raise error if not found. @@ -350,7 +351,7 @@ evalList list = go rest (val :: acc) ) in - go list [] + go list [] evalDef : List MalExpr -> Eval MalExpr @@ -382,6 +383,7 @@ evalLet args = (\_ -> if List.isEmpty rest then Eval.succeed () + else evalBinds rest ) @@ -396,15 +398,15 @@ evalLet args = |> Eval.andThen (\_ -> evalNoApply body) |> Eval.finally Env.pop in - case args of - [ MalList _ binds, body ] -> - go binds body + case args of + [ MalList _ binds, body ] -> + go binds body - [ MalVector _ bindsVec, body ] -> - go (Array.toList bindsVec) body + [ MalVector _ bindsVec, body ] -> + go (Array.toList bindsVec) body - _ -> - Eval.fail "let* expected two args: binds and a body" + _ -> + Eval.fail "let* expected two args: binds and a body" evalDo : List MalExpr -> Eval MalExpr @@ -422,7 +424,7 @@ evalIf : List MalExpr -> Eval MalExpr evalIf args = let isTruthy expr = - expr /= MalNil && expr /= (MalBool False) + expr /= MalNil && expr /= MalBool False go condition trueExpr falseExpr = eval condition @@ -431,20 +433,21 @@ evalIf args = evalNoApply (if isTruthy cond then trueExpr + else falseExpr ) ) in - case args of - [ condition, trueExpr ] -> - go condition trueExpr MalNil + case args of + [ condition, trueExpr ] -> + go condition trueExpr MalNil - [ condition, trueExpr, falseExpr ] -> - go condition trueExpr falseExpr + [ condition, trueExpr, falseExpr ] -> + go condition trueExpr falseExpr - _ -> - Eval.fail "if expected at least two args" + _ -> + Eval.fail "if expected at least two args" evalFn : List MalExpr -> Eval MalExpr @@ -459,6 +462,7 @@ evalFn parms = (MalSymbol name) :: rest -> if List.member name acc then Err "all binds must have unique names" + else extractSymbols (name :: acc) rest @@ -473,6 +477,7 @@ evalFn parms = _ -> if List.member "&" list then Err "varargs separator '&' is used incorrectly" + else Ok <| bindArgs list @@ -484,13 +489,14 @@ evalFn parms = numBinds = List.length binds in - if List.length args /= numBinds then - Err <| - "function expected " - ++ (String.fromInt numBinds) - ++ " arguments" - else - Ok <| zip binds args + if List.length args /= numBinds then + Err <| + "function expected " + ++ String.fromInt numBinds + ++ " arguments" + + else + Ok <| zip binds args bindVarArgs binds var args = let @@ -500,13 +506,14 @@ evalFn parms = varArgs = MalList Nothing (List.drop minArgs args) in - if List.length args < minArgs then - Err <| - "function expected at least " - ++ (String.fromInt minArgs) - ++ " arguments" - else - Ok <| zip binds args ++ [ ( var, varArgs ) ] + if List.length args < minArgs then + Err <| + "function expected at least " + ++ String.fromInt minArgs + ++ " arguments" + + else + Ok <| zip binds args ++ [ ( var, varArgs ) ] makeFn frameId binder body = MalFunction <| @@ -523,13 +530,13 @@ evalFn parms = } ) in - UserFunc - { frameId = frameId - , lazyFn = lazyFn - , eagerFn = lazyFn >> Eval.andThen eval - , isMacro = False - , meta = Nothing - } + UserFunc + { frameId = frameId + , lazyFn = lazyFn + , eagerFn = lazyFn >> Eval.andThen eval + , isMacro = False + , meta = Nothing + } go bindsList body = extractAndParse bindsList @@ -545,15 +552,15 @@ evalFn parms = ) ) in - case parms of - [ MalList _ bindsList, body ] -> - go bindsList body + case parms of + [ MalList _ bindsList, body ] -> + go bindsList body - [ MalVector _ bindsVec, body ] -> - go (Array.toList bindsVec) body + [ MalVector _ bindsVec, body ] -> + go (Array.toList bindsVec) body - _ -> - Eval.fail "fn* expected two args: binds list and body" + _ -> + Eval.fail "fn* expected two args: binds list and body" evalQuote : List MalExpr -> Eval MalExpr @@ -577,19 +584,24 @@ evalQuasiQuote expr = _ -> makeCall "cons" [ evalQuasiQuote elt, acc ] in - case expr of - (MalList _ [MalSymbol "unquote", form]) -> - form - (MalList _ xs) -> - List.foldr qq_loop (MalList Nothing []) xs - (MalVector _ xs) -> - makeCall "vec" [ Array.foldr qq_loop (MalList Nothing []) xs ] - (MalSymbol _) -> - makeCall "quote" [ expr ] - (MalMap _ _) -> - makeCall "quote" [ expr ] - _ -> - expr + case expr of + MalList _ [MalSymbol "unquote", form] -> + form + + MalList _ xs -> + List.foldr qq_loop (MalList Nothing []) xs + + MalVector _ xs -> + makeCall "vec" [ Array.foldr qq_loop (MalList Nothing []) xs ] + + MalSymbol _ -> + makeCall "quote" [ expr ] + + MalMap _ _ -> + makeCall "quote" [ expr ] + + _ -> + expr print : Env -> MalExpr -> String @@ -599,7 +611,7 @@ print env = printError : Env -> MalExpr -> String printError env expr = - "Error: " ++ (printString env False expr) + "Error: " ++ printString env False expr {-| Read-Eval-Print. diff --git a/impls/elm/Step8_macros.elm b/impls/elm/Step8_macros.elm index 180388ab30..b098f97095 100644 --- a/impls/elm/Step8_macros.elm +++ b/impls/elm/Step8_macros.elm @@ -1,21 +1,22 @@ module Step8_macros exposing (..) import Array +import Core import Dict exposing (Dict) +import Env +import Eval import IO exposing (..) import Json.Decode exposing (decodeValue, errorToString) -import Types exposing (..) -import Reader exposing (readString) +import Platform exposing (worker) import Printer exposing (printString) -import Utils exposing (maybeToList, zip, last, justValues, makeCall) -import Env -import Core -import Eval +import Reader exposing (readString) +import Types exposing (..) +import Utils exposing (justValues, last, makeCall, maybeToList, zip) main : Program Flags Model Msg main = - Platform.worker + worker { init = init , update = update , subscriptions = @@ -61,7 +62,7 @@ init { args } = (\b a -> a |> Eval.andThen (\_ -> b)) (Eval.succeed MalNil) in - runInit args initEnv evalMalInit + runInit args initEnv evalMalInit malInit : List String @@ -172,7 +173,7 @@ runScript filename argv env = , MalString filename ] in - runScriptLoop newEnv (eval program) + runScriptLoop newEnv (eval program) runScriptLoop : Env -> Eval MalExpr -> ( Model, Cmd Msg ) @@ -235,8 +236,8 @@ eval ast = _ -> Right expr in - evalNoApply ast - |> Eval.andThen (Eval.runLoop apply) + evalNoApply ast + |> Eval.andThen (Eval.runLoop apply) malEval : List MalExpr -> Eval MalExpr @@ -272,57 +273,58 @@ evalNoApply ast = ) |> Eval.andThen (\_ -> case ast of MalList _ ((MalSymbol "def!") :: args) -> - evalDef args + evalDef args MalList _ ((MalSymbol "let*") :: args) -> - evalLet args + evalLet args MalList _ ((MalSymbol "do") :: args) -> - evalDo args + evalDo args MalList _ ((MalSymbol "if") :: args) -> - evalIf args + evalIf args MalList _ ((MalSymbol "fn*") :: args) -> - evalFn args + evalFn args MalList _ ((MalSymbol "quote") :: args) -> - evalQuote args + evalQuote args MalList _ ((MalSymbol "quasiquote") :: args) -> - case args of - [ expr ] -> - -- TCO. - evalNoApply (evalQuasiQuote expr) + case args of + [ expr ] -> + -- TCO. + evalNoApply (evalQuasiQuote expr) - _ -> - Eval.fail "unsupported arguments" + _ -> + Eval.fail "unsupported arguments" MalList _ ((MalSymbol "defmacro!") :: args) -> - evalDefMacro args + evalDefMacro args MalList _ (a0 :: rest) -> - eval a0 - |> Eval.andThen - (\f -> - case f of - MalFunction (CoreFunc _ fn) -> - let args = evalList rest in Eval.andThen - fn args - - MalFunction (UserFunc {isMacro, eagerFn, lazyFn}) -> - if isMacro then - Eval.andThen evalNoApply (eagerFn rest) - else - let args = evalList rest in Eval.andThen - lazyFn args - - fn -> - Eval.withEnv - (\env -> - Eval.fail ((printString env True fn) ++ " is not a function") - ) + eval a0 + |> Eval.andThen + (\f -> + case f of + MalFunction (CoreFunc _ fn) -> + let args = evalList rest in Eval.andThen + fn args + + MalFunction (UserFunc {isMacro, eagerFn, lazyFn}) -> + if isMacro then + Eval.andThen evalNoApply (eagerFn rest) + + else + let args = evalList rest in Eval.andThen + lazyFn args + + fn -> + Eval.withEnv + (\env -> + Eval.fail (printString env True fn ++ " is not a function") ) + ) MalSymbol sym -> -- Lookup symbol in env and return value or raise error if not found. @@ -360,7 +362,7 @@ evalList list = go rest (val :: acc) ) in - go list [] + go list [] evalDef : List MalExpr -> Eval MalExpr @@ -391,8 +393,8 @@ evalDefMacro args = macroFn = MalFunction (UserFunc { fn | isMacro = True }) in - Eval.modifyEnv (Env.set name macroFn) - |> Eval.andThen (\_ -> Eval.succeed macroFn) + Eval.modifyEnv (Env.set name macroFn) + |> Eval.andThen (\_ -> Eval.succeed macroFn) _ -> Eval.fail "defmacro! is only supported on a user function" @@ -416,6 +418,7 @@ evalLet args = (\_ -> if List.isEmpty rest then Eval.succeed () + else evalBinds rest ) @@ -430,15 +433,15 @@ evalLet args = |> Eval.andThen (\_ -> evalNoApply body) |> Eval.finally Env.pop in - case args of - [ MalList _ binds, body ] -> - go binds body + case args of + [ MalList _ binds, body ] -> + go binds body - [ MalVector _ bindsVec, body ] -> - go (Array.toList bindsVec) body + [ MalVector _ bindsVec, body ] -> + go (Array.toList bindsVec) body - _ -> - Eval.fail "let* expected two args: binds and a body" + _ -> + Eval.fail "let* expected two args: binds and a body" evalDo : List MalExpr -> Eval MalExpr @@ -456,7 +459,7 @@ evalIf : List MalExpr -> Eval MalExpr evalIf args = let isTruthy expr = - expr /= MalNil && expr /= (MalBool False) + expr /= MalNil && expr /= MalBool False go condition trueExpr falseExpr = eval condition @@ -465,20 +468,21 @@ evalIf args = evalNoApply (if isTruthy cond then trueExpr + else falseExpr ) ) in - case args of - [ condition, trueExpr ] -> - go condition trueExpr MalNil + case args of + [ condition, trueExpr ] -> + go condition trueExpr MalNil - [ condition, trueExpr, falseExpr ] -> - go condition trueExpr falseExpr + [ condition, trueExpr, falseExpr ] -> + go condition trueExpr falseExpr - _ -> - Eval.fail "if expected at least two args" + _ -> + Eval.fail "if expected at least two args" evalFn : List MalExpr -> Eval MalExpr @@ -493,6 +497,7 @@ evalFn parms = (MalSymbol name) :: rest -> if List.member name acc then Err "all binds must have unique names" + else extractSymbols (name :: acc) rest @@ -507,6 +512,7 @@ evalFn parms = _ -> if List.member "&" list then Err "varargs separator '&' is used incorrectly" + else Ok <| bindArgs list @@ -518,13 +524,14 @@ evalFn parms = numBinds = List.length binds in - if List.length args /= numBinds then - Err <| - "function expected " - ++ (String.fromInt numBinds) - ++ " arguments" - else - Ok <| zip binds args + if List.length args /= numBinds then + Err <| + "function expected " + ++ String.fromInt numBinds + ++ " arguments" + + else + Ok <| zip binds args bindVarArgs binds var args = let @@ -534,13 +541,14 @@ evalFn parms = varArgs = MalList Nothing (List.drop minArgs args) in - if List.length args < minArgs then - Err <| - "function expected at least " - ++ (String.fromInt minArgs) - ++ " arguments" - else - Ok <| zip binds args ++ [ ( var, varArgs ) ] + if List.length args < minArgs then + Err <| + "function expected at least " + ++ String.fromInt minArgs + ++ " arguments" + + else + Ok <| zip binds args ++ [ ( var, varArgs ) ] makeFn frameId binder body = MalFunction <| @@ -557,13 +565,13 @@ evalFn parms = } ) in - UserFunc - { frameId = frameId - , lazyFn = lazyFn - , eagerFn = lazyFn >> Eval.andThen eval - , isMacro = False - , meta = Nothing - } + UserFunc + { frameId = frameId + , lazyFn = lazyFn + , eagerFn = lazyFn >> Eval.andThen eval + , isMacro = False + , meta = Nothing + } go bindsList body = extractAndParse bindsList @@ -579,15 +587,15 @@ evalFn parms = ) ) in - case parms of - [ MalList _ bindsList, body ] -> - go bindsList body + case parms of + [ MalList _ bindsList, body ] -> + go bindsList body - [ MalVector _ bindsVec, body ] -> - go (Array.toList bindsVec) body + [ MalVector _ bindsVec, body ] -> + go (Array.toList bindsVec) body - _ -> - Eval.fail "fn* expected two args: binds list and body" + _ -> + Eval.fail "fn* expected two args: binds list and body" evalQuote : List MalExpr -> Eval MalExpr @@ -611,19 +619,24 @@ evalQuasiQuote expr = _ -> makeCall "cons" [ evalQuasiQuote elt, acc ] in - case expr of - (MalList _ [MalSymbol "unquote", form]) -> - form - (MalList _ xs) -> - List.foldr qq_loop (MalList Nothing []) xs - (MalVector _ xs) -> - makeCall "vec" [ Array.foldr qq_loop (MalList Nothing []) xs ] - (MalSymbol _) -> - makeCall "quote" [ expr ] - (MalMap _ _) -> - makeCall "quote" [ expr ] - _ -> - expr + case expr of + MalList _ [MalSymbol "unquote", form] -> + form + + MalList _ xs -> + List.foldr qq_loop (MalList Nothing []) xs + + MalVector _ xs -> + makeCall "vec" [ Array.foldr qq_loop (MalList Nothing []) xs ] + + MalSymbol _ -> + makeCall "quote" [ expr ] + + MalMap _ _ -> + makeCall "quote" [ expr ] + + _ -> + expr print : Env -> MalExpr -> String @@ -633,7 +646,7 @@ print env = printError : Env -> MalExpr -> String printError env expr = - "Error: " ++ (printString env False expr) + "Error: " ++ printString env False expr {-| Read-Eval-Print. diff --git a/impls/elm/Step9_try.elm b/impls/elm/Step9_try.elm index fa40d18fdc..da450ec9fb 100644 --- a/impls/elm/Step9_try.elm +++ b/impls/elm/Step9_try.elm @@ -1,21 +1,22 @@ module Step9_try exposing (..) import Array +import Core import Dict exposing (Dict) +import Env +import Eval import IO exposing (..) import Json.Decode exposing (decodeValue, errorToString) -import Types exposing (..) -import Reader exposing (readString) +import Platform exposing (worker) import Printer exposing (printString) -import Utils exposing (maybeToList, zip, last, justValues, makeCall) -import Env -import Core -import Eval +import Reader exposing (readString) +import Types exposing (..) +import Utils exposing (justValues, last, makeCall, maybeToList, zip) main : Program Flags Model Msg main = - Platform.worker + worker { init = init , update = update , subscriptions = @@ -61,7 +62,7 @@ init { args } = (\b a -> a |> Eval.andThen (\_ -> b)) (Eval.succeed MalNil) in - runInit args initEnv evalMalInit + runInit args initEnv evalMalInit malInit : List String @@ -172,7 +173,7 @@ runScript filename argv env = , MalString filename ] in - runScriptLoop newEnv (eval program) + runScriptLoop newEnv (eval program) runScriptLoop : Env -> Eval MalExpr -> ( Model, Cmd Msg ) @@ -235,8 +236,8 @@ eval ast = _ -> Right expr in - evalNoApply ast - |> Eval.andThen (Eval.runLoop apply) + evalNoApply ast + |> Eval.andThen (Eval.runLoop apply) malEval : List MalExpr -> Eval MalExpr @@ -272,60 +273,61 @@ evalNoApply ast = ) |> Eval.andThen (\_ -> case ast of MalList _ ((MalSymbol "def!") :: args) -> - evalDef args + evalDef args MalList _ ((MalSymbol "let*") :: args) -> - evalLet args + evalLet args MalList _ ((MalSymbol "do") :: args) -> - evalDo args + evalDo args MalList _ ((MalSymbol "if") :: args) -> - evalIf args + evalIf args MalList _ ((MalSymbol "fn*") :: args) -> - evalFn args + evalFn args MalList _ ((MalSymbol "quote") :: args) -> - evalQuote args + evalQuote args MalList _ ((MalSymbol "quasiquote") :: args) -> - case args of - [ expr ] -> - -- TCO. - evalNoApply (evalQuasiQuote expr) + case args of + [ expr ] -> + -- TCO. + evalNoApply (evalQuasiQuote expr) - _ -> - Eval.fail "unsupported arguments" + _ -> + Eval.fail "unsupported arguments" MalList _ ((MalSymbol "defmacro!") :: args) -> - evalDefMacro args + evalDefMacro args MalList _ ((MalSymbol "try*") :: args) -> - evalTry args + evalTry args MalList _ (a0 :: rest) -> eval a0 - |> Eval.andThen - (\f -> - case f of - MalFunction (CoreFunc _ fn) -> - let args = evalList rest in Eval.andThen - fn args - - MalFunction (UserFunc {isMacro, eagerFn, lazyFn}) -> - if isMacro then - Eval.andThen evalNoApply (eagerFn rest) - else - let args = evalList rest in Eval.andThen - lazyFn args - - fn -> - Eval.withEnv - (\env -> - Eval.fail ((printString env True fn) ++ " is not a function") - ) - ) + |> Eval.andThen + (\f -> + case f of + MalFunction (CoreFunc _ fn) -> + let args = evalList rest in Eval.andThen + fn args + + MalFunction (UserFunc {isMacro, eagerFn, lazyFn}) -> + if isMacro then + Eval.andThen evalNoApply (eagerFn rest) + + else + let args = evalList rest in Eval.andThen + lazyFn args + + fn -> + Eval.withEnv + (\env -> + Eval.fail (printString env True fn ++ " is not a function") + ) + ) MalSymbol sym -> -- Lookup symbol in env and return value or raise error if not found. @@ -345,7 +347,6 @@ evalNoApply ast = _ -> Eval.succeed ast - ) @@ -364,7 +365,7 @@ evalList list = go rest (val :: acc) ) in - go list [] + go list [] evalDef : List MalExpr -> Eval MalExpr @@ -395,8 +396,8 @@ evalDefMacro args = macroFn = MalFunction (UserFunc { fn | isMacro = True }) in - Eval.modifyEnv (Env.set name macroFn) - |> Eval.andThen (\_ -> Eval.succeed macroFn) + Eval.modifyEnv (Env.set name macroFn) + |> Eval.andThen (\_ -> Eval.succeed macroFn) _ -> Eval.fail "defmacro! is only supported on a user function" @@ -420,6 +421,7 @@ evalLet args = (\_ -> if List.isEmpty rest then Eval.succeed () + else evalBinds rest ) @@ -434,15 +436,15 @@ evalLet args = |> Eval.andThen (\_ -> evalNoApply body) |> Eval.finally Env.pop in - case args of - [ MalList _ binds, body ] -> - go binds body + case args of + [ MalList _ binds, body ] -> + go binds body - [ MalVector _ bindsVec, body ] -> - go (Array.toList bindsVec) body + [ MalVector _ bindsVec, body ] -> + go (Array.toList bindsVec) body - _ -> - Eval.fail "let* expected two args: binds and a body" + _ -> + Eval.fail "let* expected two args: binds and a body" evalDo : List MalExpr -> Eval MalExpr @@ -460,7 +462,7 @@ evalIf : List MalExpr -> Eval MalExpr evalIf args = let isTruthy expr = - expr /= MalNil && expr /= (MalBool False) + expr /= MalNil && expr /= MalBool False go condition trueExpr falseExpr = eval condition @@ -469,20 +471,21 @@ evalIf args = evalNoApply (if isTruthy cond then trueExpr + else falseExpr ) ) in - case args of - [ condition, trueExpr ] -> - go condition trueExpr MalNil + case args of + [ condition, trueExpr ] -> + go condition trueExpr MalNil - [ condition, trueExpr, falseExpr ] -> - go condition trueExpr falseExpr + [ condition, trueExpr, falseExpr ] -> + go condition trueExpr falseExpr - _ -> - Eval.fail "if expected at least two args" + _ -> + Eval.fail "if expected at least two args" evalFn : List MalExpr -> Eval MalExpr @@ -497,6 +500,7 @@ evalFn parms = (MalSymbol name) :: rest -> if List.member name acc then Err "all binds must have unique names" + else extractSymbols (name :: acc) rest @@ -511,6 +515,7 @@ evalFn parms = _ -> if List.member "&" list then Err "varargs separator '&' is used incorrectly" + else Ok <| bindArgs list @@ -522,13 +527,14 @@ evalFn parms = numBinds = List.length binds in - if List.length args /= numBinds then - Err <| - "function expected " - ++ (String.fromInt numBinds) - ++ " arguments" - else - Ok <| zip binds args + if List.length args /= numBinds then + Err <| + "function expected " + ++ String.fromInt numBinds + ++ " arguments" + + else + Ok <| zip binds args bindVarArgs binds var args = let @@ -538,13 +544,14 @@ evalFn parms = varArgs = MalList Nothing (List.drop minArgs args) in - if List.length args < minArgs then - Err <| - "function expected at least " - ++ (String.fromInt minArgs) - ++ " arguments" - else - Ok <| zip binds args ++ [ ( var, varArgs ) ] + if List.length args < minArgs then + Err <| + "function expected at least " + ++ String.fromInt minArgs + ++ " arguments" + + else + Ok <| zip binds args ++ [ ( var, varArgs ) ] makeFn frameId binder body = MalFunction <| @@ -561,13 +568,13 @@ evalFn parms = } ) in - UserFunc - { frameId = frameId - , lazyFn = lazyFn - , eagerFn = lazyFn >> Eval.andThen eval - , isMacro = False - , meta = Nothing - } + UserFunc + { frameId = frameId + , lazyFn = lazyFn + , eagerFn = lazyFn >> Eval.andThen eval + , isMacro = False + , meta = Nothing + } go bindsList body = extractAndParse bindsList @@ -583,15 +590,15 @@ evalFn parms = ) ) in - case parms of - [ MalList _ bindsList, body ] -> - go bindsList body + case parms of + [ MalList _ bindsList, body ] -> + go bindsList body - [ MalVector _ bindsVec, body ] -> - go (Array.toList bindsVec) body + [ MalVector _ bindsVec, body ] -> + go (Array.toList bindsVec) body - _ -> - Eval.fail "fn* expected two args: binds list and body" + _ -> + Eval.fail "fn* expected two args: binds list and body" evalQuote : List MalExpr -> Eval MalExpr @@ -615,19 +622,24 @@ evalQuasiQuote expr = _ -> makeCall "cons" [ evalQuasiQuote elt, acc ] in - case expr of - (MalList _ [MalSymbol "unquote", form]) -> - form - (MalList _ xs) -> - List.foldr qq_loop (MalList Nothing []) xs - (MalVector _ xs) -> - makeCall "vec" [ Array.foldr qq_loop (MalList Nothing []) xs ] - (MalSymbol _) -> - makeCall "quote" [ expr ] - (MalMap _ _) -> - makeCall "quote" [ expr ] - _ -> - expr + case expr of + MalList _ [MalSymbol "unquote", form] -> + form + + MalList _ xs -> + List.foldr qq_loop (MalList Nothing []) xs + + MalVector _ xs -> + makeCall "vec" [ Array.foldr qq_loop (MalList Nothing []) xs ] + + MalSymbol _ -> + makeCall "quote" [ expr ] + + MalMap _ _ -> + makeCall "quote" [ expr ] + + _ -> + expr evalTry : List MalExpr -> Eval MalExpr @@ -635,6 +647,7 @@ evalTry args = case args of [ body ] -> eval body + [ body, MalList _ [ MalSymbol "catch*", MalSymbol sym, handler ] ] -> eval body |> Eval.catchError @@ -659,7 +672,7 @@ print env = printError : Env -> MalExpr -> String printError env expr = - "Error: " ++ (printString env False expr) + "Error: " ++ printString env False expr {-| Read-Eval-Print. diff --git a/impls/elm/StepA_mal.elm b/impls/elm/StepA_mal.elm index bb30517832..55f1379cc4 100644 --- a/impls/elm/StepA_mal.elm +++ b/impls/elm/StepA_mal.elm @@ -1,21 +1,22 @@ module StepA_mal exposing (..) import Array +import Core import Dict exposing (Dict) +import Env +import Eval import IO exposing (..) import Json.Decode exposing (decodeValue, errorToString) -import Types exposing (..) -import Reader exposing (readString) +import Platform exposing (worker) import Printer exposing (printString) -import Utils exposing (maybeToList, zip, last, justValues, makeCall) -import Env -import Core -import Eval +import Reader exposing (readString) +import Types exposing (..) +import Utils exposing (justValues, last, makeCall, maybeToList, zip) main : Program Flags Model Msg main = - Platform.worker + worker { init = init , update = update , subscriptions = @@ -62,7 +63,7 @@ init { args } = (\b a -> a |> Eval.andThen (\_ -> b)) (Eval.succeed MalNil) in - runInit args initEnv evalMalInit + runInit args initEnv evalMalInit malInit : List String @@ -173,7 +174,7 @@ runScript filename argv env = , MalString filename ] in - runScriptLoop newEnv (eval program) + runScriptLoop newEnv (eval program) runScriptLoop : Env -> Eval MalExpr -> ( Model, Cmd Msg ) @@ -236,9 +237,9 @@ eval ast = _ -> Right expr in - evalNoApply ast - |> Eval.andThen (Eval.runLoop apply) - |> Eval.gcPass + evalNoApply ast + |> Eval.andThen (Eval.runLoop apply) + |> Eval.gcPass malEval : List MalExpr -> Eval MalExpr @@ -274,60 +275,61 @@ evalNoApply ast = ) |> Eval.andThen (\_ -> case ast of MalList _ ((MalSymbol "def!") :: args) -> - evalDef args + evalDef args MalList _ ((MalSymbol "let*") :: args) -> - evalLet args + evalLet args MalList _ ((MalSymbol "do") :: args) -> - evalDo args + evalDo args MalList _ ((MalSymbol "if") :: args) -> - evalIf args + evalIf args MalList _ ((MalSymbol "fn*") :: args) -> - evalFn args + evalFn args MalList _ ((MalSymbol "quote") :: args) -> - evalQuote args + evalQuote args MalList _ ((MalSymbol "quasiquote") :: args) -> - case args of - [ expr ] -> - -- TCO. - evalNoApply (evalQuasiQuote expr) + case args of + [ expr ] -> + -- TCO. + evalNoApply (evalQuasiQuote expr) - _ -> - Eval.fail "unsupported arguments" + _ -> + Eval.fail "unsupported arguments" MalList _ ((MalSymbol "defmacro!") :: args) -> - evalDefMacro args + evalDefMacro args MalList _ ((MalSymbol "try*") :: args) -> - evalTry args + evalTry args MalList _ (a0 :: rest) -> - eval a0 - |> Eval.andThen - (\f -> - case f of - MalFunction (CoreFunc _ fn) -> - let args = evalList rest in Eval.andThen - fn args - - MalFunction (UserFunc {isMacro, eagerFn, lazyFn}) -> - if isMacro then - Eval.andThen evalNoApply (eagerFn rest) - else - let args = evalList rest in Eval.andThen - lazyFn args - - fn -> - Eval.withEnv - (\env -> - Eval.fail ((printString env True fn) ++ " is not a function") - ) - ) + eval a0 + |> Eval.andThen + (\f -> + case f of + MalFunction (CoreFunc _ fn) -> + let args = evalList rest in Eval.andThen + fn args + + MalFunction (UserFunc {isMacro, eagerFn, lazyFn}) -> + if isMacro then + Eval.andThen evalNoApply (eagerFn rest) + + else + let args = evalList rest in Eval.andThen + lazyFn args + + fn -> + Eval.withEnv + (\env -> + Eval.fail (printString env True fn ++ " is not a function") + ) + ) MalSymbol sym -> -- Lookup symbol in env and return value or raise error if not found. @@ -370,7 +372,7 @@ evalList list = Eval.pushRef val <| go rest (val :: acc) ) in - Eval.withStack <| go list [] + Eval.withStack <| go list [] evalDef : List MalExpr -> Eval MalExpr @@ -401,8 +403,8 @@ evalDefMacro args = macroFn = MalFunction (UserFunc { fn | isMacro = True }) in - Eval.modifyEnv (Env.set name macroFn) - |> Eval.andThen (\_ -> Eval.succeed macroFn) + Eval.modifyEnv (Env.set name macroFn) + |> Eval.andThen (\_ -> Eval.succeed macroFn) _ -> Eval.fail "defmacro! is only supported on a user function" @@ -426,6 +428,7 @@ evalLet args = (\_ -> if List.isEmpty rest then Eval.succeed () + else evalBinds rest ) @@ -440,15 +443,15 @@ evalLet args = |> Eval.andThen (\_ -> evalNoApply body) |> Eval.finally Env.pop in - case args of - [ MalList _ binds, body ] -> - go binds body + case args of + [ MalList _ binds, body ] -> + go binds body - [ MalVector _ bindsVec, body ] -> - go (Array.toList bindsVec) body + [ MalVector _ bindsVec, body ] -> + go (Array.toList bindsVec) body - _ -> - Eval.fail "let* expected two args: binds and a body" + _ -> + Eval.fail "let* expected two args: binds and a body" evalDo : List MalExpr -> Eval MalExpr @@ -466,7 +469,7 @@ evalIf : List MalExpr -> Eval MalExpr evalIf args = let isTruthy expr = - expr /= MalNil && expr /= (MalBool False) + expr /= MalNil && expr /= MalBool False go condition trueExpr falseExpr = eval condition @@ -475,20 +478,21 @@ evalIf args = evalNoApply (if isTruthy cond then trueExpr + else falseExpr ) ) in - case args of - [ condition, trueExpr ] -> - go condition trueExpr MalNil + case args of + [ condition, trueExpr ] -> + go condition trueExpr MalNil - [ condition, trueExpr, falseExpr ] -> - go condition trueExpr falseExpr + [ condition, trueExpr, falseExpr ] -> + go condition trueExpr falseExpr - _ -> - Eval.fail "if expected at least two args" + _ -> + Eval.fail "if expected at least two args" evalFn : List MalExpr -> Eval MalExpr @@ -503,6 +507,7 @@ evalFn parms = (MalSymbol name) :: rest -> if List.member name acc then Err "all binds must have unique names" + else extractSymbols (name :: acc) rest @@ -517,6 +522,7 @@ evalFn parms = _ -> if List.member "&" list then Err "varargs separator '&' is used incorrectly" + else Ok <| bindArgs list @@ -528,13 +534,14 @@ evalFn parms = numBinds = List.length binds in - if List.length args /= numBinds then - Err <| - "function expected " - ++ (String.fromInt numBinds) - ++ " arguments" - else - Ok <| zip binds args + if List.length args /= numBinds then + Err <| + "function expected " + ++ String.fromInt numBinds + ++ " arguments" + + else + Ok <| zip binds args bindVarArgs binds var args = let @@ -544,13 +551,14 @@ evalFn parms = varArgs = MalList Nothing (List.drop minArgs args) in - if List.length args < minArgs then - Err <| - "function expected at least " - ++ (String.fromInt minArgs) - ++ " arguments" - else - Ok <| zip binds args ++ [ ( var, varArgs ) ] + if List.length args < minArgs then + Err <| + "function expected at least " + ++ String.fromInt minArgs + ++ " arguments" + + else + Ok <| zip binds args ++ [ ( var, varArgs ) ] makeFn frameId binder body = MalFunction <| @@ -567,13 +575,13 @@ evalFn parms = } ) in - UserFunc - { frameId = frameId - , lazyFn = lazyFn - , eagerFn = lazyFn >> Eval.andThen eval - , isMacro = False - , meta = Nothing - } + UserFunc + { frameId = frameId + , lazyFn = lazyFn + , eagerFn = lazyFn >> Eval.andThen eval + , isMacro = False + , meta = Nothing + } go bindsList body = extractAndParse bindsList @@ -589,15 +597,15 @@ evalFn parms = ) ) in - case parms of - [ MalList _ bindsList, body ] -> - go bindsList body + case parms of + [ MalList _ bindsList, body ] -> + go bindsList body - [ MalVector _ bindsVec, body ] -> - go (Array.toList bindsVec) body + [ MalVector _ bindsVec, body ] -> + go (Array.toList bindsVec) body - _ -> - Eval.fail "fn* expected two args: binds list and body" + _ -> + Eval.fail "fn* expected two args: binds list and body" evalQuote : List MalExpr -> Eval MalExpr @@ -621,19 +629,24 @@ evalQuasiQuote expr = _ -> makeCall "cons" [ evalQuasiQuote elt, acc ] in - case expr of - (MalList _ [MalSymbol "unquote", form]) -> - form - (MalList _ xs) -> - List.foldr qq_loop (MalList Nothing []) xs - (MalVector _ xs) -> - makeCall "vec" [ Array.foldr qq_loop (MalList Nothing []) xs ] - (MalSymbol _) -> - makeCall "quote" [ expr ] - (MalMap _ _) -> - makeCall "quote" [ expr ] - _ -> - expr + case expr of + MalList _ [MalSymbol "unquote", form] -> + form + + MalList _ xs -> + List.foldr qq_loop (MalList Nothing []) xs + + MalVector _ xs -> + makeCall "vec" [ Array.foldr qq_loop (MalList Nothing []) xs ] + + MalSymbol _ -> + makeCall "quote" [ expr ] + + MalMap _ _ -> + makeCall "quote" [ expr ] + + _ -> + expr evalTry : List MalExpr -> Eval MalExpr @@ -641,6 +654,7 @@ evalTry args = case args of [ body ] -> eval body + [ body, MalList _ [ MalSymbol "catch*", MalSymbol sym, handler ] ] -> eval body |> Eval.catchError @@ -665,7 +679,7 @@ print env = printError : Env -> MalExpr -> String printError env expr = - "Error: " ++ (printString env False expr) + "Error: " ++ printString env False expr {-| Read-Eval-Print. diff --git a/impls/elm/Types.elm b/impls/elm/Types.elm index 0bc99f39fb..b4e281d463 100644 --- a/impls/elm/Types.elm +++ b/impls/elm/Types.elm @@ -99,7 +99,7 @@ type MalExpr {-| Keywords are prefixed by this char for usage in a MalMap. Elm doesn't support user defined types as keys in a Dict. -The unicode char is: '\x029e' +The unicode char is: '\\x029e' -} keywordPrefix : Char diff --git a/impls/elm/Utils.elm b/impls/elm/Utils.elm index 85228a0ff4..0c0e79d95c 100644 --- a/impls/elm/Utils.elm +++ b/impls/elm/Utils.elm @@ -1,23 +1,18 @@ -module Utils - exposing - ( decodeString - , encodeString - , makeCall - , wrap - , maybeToList - , zip - , last - , justValues - ) - -import Regex exposing (replace) +module Utils exposing + ( decodeString + , encodeString + , justValues + , last + , makeCall + , maybeToList + , wrap + , zip + ) + +import Regex import Types exposing (MalExpr(..)) -regex str = case Regex.fromString str of - Nothing -> Debug.todo "invalid regex" - Just r -> r - decodeString : String -> String decodeString = let @@ -35,8 +30,18 @@ decodeString = other -> other in - String.slice 1 -1 - >> replace (regex "\\\\[\\\"\\\\n]") unescape + String.slice 1 -1 + >> Regex.replace (regex "\\\\[\\\"\\\\n]") unescape + + + +-- helps replace all the encodes found into a string + + +regex : String -> Regex.Regex +regex str = case Regex.fromString str of + Nothing -> Debug.todo "invalid regex" + Just r -> r encodeString : String -> String @@ -56,13 +61,13 @@ encodeString = other -> other in - wrap "\"" "\"" - << replace (regex "[\\n\\\"\\\\]") escape + wrap "\"" "\"" + << Regex.replace (regex "[\\n\\\"\\\\]") escape makeCall : String -> List MalExpr -> MalExpr makeCall symbol args = - MalList Nothing <| (MalSymbol symbol) :: args + MalList Nothing <| MalSymbol symbol :: args wrap : String -> String -> String -> String @@ -113,7 +118,7 @@ justValues list = [] (Just x) :: rest -> - x :: (justValues rest) + x :: justValues rest Nothing :: rest -> justValues rest diff --git a/impls/elm/bootstrap.js b/impls/elm/bootstrap.js index f44390f452..52d2260606 100644 --- a/impls/elm/bootstrap.js +++ b/impls/elm/bootstrap.js @@ -7,9 +7,9 @@ var args = process.argv.slice(2); var mod = require('./' + args[0]); var app = mod.Elm['S' + args[0].slice(1)].init({ - flags: { - args: args.slice(1) - } + flags: { + args: args.slice(1) + } }); // Hook up the writeLine and readLine ports of the app. @@ -25,12 +25,12 @@ app.ports.readLine.subscribe(function(prompt) { // Read the contents of a file. if (4 <= args[0][4] || args[0][4] == 'A') { -app.ports.readFile.subscribe(function(filename) { - try { - var contents = fs.readFileSync(filename, 'utf8'); - app.ports.input.send({"tag": "fileRead", "contents": contents}); - } catch (e) { - app.ports.input.send({"tag": "exception", "message": e.message}); - } -}); + app.ports.readFile.subscribe(function(filename) { + try { + var contents = fs.readFileSync(filename, 'utf8'); + app.ports.input.send({"tag": "fileRead", "contents": contents}); + } catch (e) { + app.ports.input.send({"tag": "exception", "message": e.message}); + } + }); }