Elm step A: GC working

[jackhill/mal.git] / elm / step7_quote.elm

diff --git a/elm/step7_quote.elm b/elm/step7_quote.elm
index 5c5fd13..8a09aaa 100644 (file)
--- a/elm/step7_quote.elm
+++ b/elm/step7_quote.elm
@@ -8,7 +8,7 @@ import Platform exposing (programWithFlags)
 import Types exposing (..)
 import Reader exposing (readString)
 import Printer exposing (printString)
-import Utils exposing (maybeToList, zip, last, justValues)
+import Utils exposing (maybeToList, zip, last, justValues, makeCall)
 import Env
 import Core
 import Eval
@@ -53,7 +53,7 @@ init { args } =
                 |> Env.set "*ARGV*" (MalList (args |> List.map MalString))
 
         evalMalInit =
-            Core.malInit
+            malInit
                 |> List.map rep
                 |> justValues
                 |> List.foldl
@@ -63,6 +63,18 @@ init { args } =
         runInit args initEnv evalMalInit
 
 
+malInit : List String
+malInit =
+    [ """(def! not
+            (fn* (a)
+                (if a false true)))"""
+    , """(def! load-file
+            (fn* (f)
+                (eval (read-string
+                    (str "(do " (slurp f) ")")))))"""
+    ]
+
+
 update : Msg -> Model -> ( Model, Cmd Msg )
 update msg model =
     case model of
@@ -134,7 +146,7 @@ runInit args env expr =
 
         ( env, EvalErr msg ) ->
             -- Init failed, don't start REPL.
-            ( Stopped, writeLine ("ERR:" ++ msg) )
+            ( Stopped, writeLine (printError env msg) )
 
         ( env, EvalIO cmd cont ) ->
             -- IO in init.
@@ -166,7 +178,7 @@ runScriptLoop env expr =
             ( Stopped, Cmd.none )
 
         ( env, EvalErr msg ) ->
-            ( Stopped, writeLine ("ERR:" ++ msg) )
+            ( Stopped, writeLine (printError env msg) )
 
         ( env, EvalIO cmd cont ) ->
             ( ScriptIO env cont, cmd )
@@ -179,7 +191,7 @@ run env expr =
             ( ReplActive env, writeLine (print env expr) )
 
         ( env, EvalErr msg ) ->
-            ( ReplActive env, writeLine ("ERR:" ++ msg) )
+            ( ReplActive env, writeLine (printError env msg) )
 
         ( env, EvalIO cmd cont ) ->
             ( ReplIO env cont, cmd )
@@ -214,7 +226,7 @@ debug msg f e =
 eval : MalExpr -> Eval MalExpr
 eval ast =
     let
-        apply expr =
+        apply expr env =
             case expr of
                 MalApply app ->
                     Left
@@ -234,7 +246,12 @@ malEval : List MalExpr -> Eval MalExpr
 malEval args =
     case args of
         [ expr ] ->
-            eval expr
+            Eval.withEnv
+                (\env ->
+                    Eval.modifyEnv (Env.jump Env.globalFrameId)
+                        |> Eval.andThen (\_ -> eval expr)
+                        |> Eval.finally Env.leave
+                )
 
         _ ->
             Eval.fail "unsupported arguments"
@@ -246,11 +263,8 @@ evalApply { frameId, bound, body } =
         (\env ->
             Eval.modifyEnv (Env.enter frameId bound)
                 |> Eval.andThen (\_ -> evalNoApply body)
-                |> Eval.andThen
-                    (\res ->
-                        Eval.modifyEnv (Env.leave env.currentFrameId)
-                            |> Eval.map (\_ -> res)
-                    )
+                |> Eval.finally Env.leave
+                |> Eval.gcPass []
         )
 
 
@@ -277,6 +291,18 @@ evalNoApply ast =
             MalList ((MalSymbol "fn*") :: args) ->
                 evalFn args
 
+            MalList ((MalSymbol "quote") :: args) ->
+                evalQuote args
+
+            MalList ((MalSymbol "quasiquote") :: args) ->
+                case args of
+                    [ expr ] ->
+                        -- TCO.
+                        evalNoApply (evalQuasiQuote expr)
+
+                    _ ->
+                        Eval.fail "unsupported arguments"
+
             MalList list ->
                 evalList list
                     |> Eval.andThen
@@ -390,11 +416,7 @@ evalLet args =
             Eval.modifyEnv Env.push
                 |> Eval.andThen (\_ -> evalBinds binds)
                 |> Eval.andThen (\_ -> evalNoApply body)
-                |> Eval.andThen
-                    (\res ->
-                        Eval.modifyEnv Env.pop
-                            |> Eval.map (\_ -> res)
-                    )
+                |> Eval.finally Env.pop
     in
         case args of
             [ MalList binds, body ] ->
@@ -517,8 +539,6 @@ evalFn args =
                             >> Eval.fromResult
                             >> Eval.map
                                 (\bound ->
-                                    -- TODO : choice Env.enter prematurely?
-                                    -- I think it is needed by the garbage collect..
                                     MalApply
                                         { frameId = frameId
                                         , bound = bound
@@ -529,24 +549,23 @@ evalFn args =
                     UserFunc
                         { frameId = frameId
                         , lazyFn = lazyFn
-                        , eagerFn = lazyFn >> Eval.andThen eval
+                        , eagerFn = \_ -> lazyFn >> Eval.andThen eval
+                        , isMacro = False
+                        , meta = Nothing
                         }
 
         go bindsList body =
             extractAndParse bindsList
                 |> Eval.fromResult
+                -- reference the current frame.
+                |> Eval.ignore (Eval.modifyEnv Env.ref)
                 |> Eval.andThen
                     (\binder ->
-                        Eval.modifyEnv Env.ref
-                            -- reference the current frame.
-                            |> Eval.andThen
-                                (\_ ->
-                                    Eval.withEnv
-                                        (\env ->
-                                            Eval.succeed
-                                                (makeFn env.currentFrameId binder body)
-                                        )
-                                )
+                        Eval.withEnv
+                            (\env ->
+                                Eval.succeed
+                                    (makeFn env.currentFrameId binder body)
+                            )
                     )
     in
         case args of
@@ -560,11 +579,60 @@ evalFn args =
                 Eval.fail "fn* expected two args: binds list and body"
 
 
+evalQuote : List MalExpr -> Eval MalExpr
+evalQuote args =
+    case args of
+        [ expr ] ->
+            Eval.succeed expr
+
+        _ ->
+            Eval.fail "unsupported arguments"
+
+
+evalQuasiQuote : MalExpr -> MalExpr
+evalQuasiQuote expr =
+    let
+        apply list empty =
+            case list of
+                [ MalSymbol "unquote", ast ] ->
+                    ast
+
+                (MalList [ MalSymbol "splice-unquote", ast ]) :: rest ->
+                    makeCall "concat"
+                        [ ast
+                        , evalQuasiQuote (MalList rest)
+                        ]
+
+                ast :: rest ->
+                    makeCall "cons"
+                        [ evalQuasiQuote ast
+                        , evalQuasiQuote (MalList rest)
+                        ]
+
+                _ ->
+                    makeCall "quote" [ empty ]
+    in
+        case expr of
+            MalList list ->
+                apply list (MalList [])
+
+            MalVector vec ->
+                apply (Array.toList vec) (MalVector Array.empty)
+
+            ast ->
+                makeCall "quote" [ ast ]
+
+
 print : Env -> MalExpr -> String
 print env =
     printString env True
 
 
+printError : Env -> MalExpr -> String
+printError env expr =
+    "ERR:" ++ (printString env False expr)
+
+
 {-| Read-Eval-Print.
 
 Doesn't actually run the Eval but returns the monad.