Travis: add remaining implementations.

[jackhill/mal.git] / fsharp / step3_env.fs

diff --git a/fsharp/step3_env.fs b/fsharp/step3_env.fs
index 0b22dc8..309a0a0 100644 (file)
--- a/fsharp/step3_env.fs
+++ b/fsharp/step3_env.fs
@@ -1,36 +1,90 @@
 module REPL
     open System
+    open Node
+    open Types
 
-    let read input =
+    let rec iterPairs f = function
+        | Pair(first, second, t) ->
+            f first second
+            iterPairs f t
+        | Empty -> ()
+        | _ -> raise <| Error.errExpectedX "list or vector"
+
+    let rec eval_ast env = function
+        | Symbol(sym) -> Env.get env sym
+        | List(_, lst) -> lst |> List.map (eval env) |> makeList
+        | Vector(_, seg) -> seg |> Seq.map (eval env) |> Array.ofSeq |> Node.ofArray
+        | Map(_, map) -> map |> Map.map (fun k v -> eval env v) |> makeMap
+        | node -> node
+
+    and defBang env = function
+        | [sym; node] ->
+            match sym with
+            | Symbol(sym) ->
+                let node = eval env node
+                Env.set env sym node
+                node
+            | _ -> raise <| Error.errExpectedX "symbol"
+        | _ -> raise <| Error.wrongArity ()
+
+    and setBinding env first second =
+        let s = match first with
+                | Symbol(s) -> s
+                | _ -> raise <| Error.errExpectedX "symbol"
+        let form = eval env second
+        Env.set env s form
+
+    and letStar env = function
+        | [bindings; form] ->
+            let newEnv = Env.makeNew env [] []
+            let binder = setBinding newEnv
+            match bindings with
+            | List(_, _) | Vector(_, _) -> iterPairs binder bindings
+            | _ -> raise <| Error.errExpectedX "list or vector"
+            eval newEnv form
+        | _ -> raise <| Error.wrongArity ()
+
+    and eval env = function
+        | List(_, Symbol("def!")::rest) -> defBang env rest
+        | List(_, Symbol("let*")::rest) -> letStar env rest
+        | List(_, _) as node ->
+            let resolved = node |> eval_ast env
+            match resolved with
+            | List(_, BuiltInFunc(_, _, f)::rest) -> f rest
+            | _ -> raise <| Error.errExpectedX "func"
+        | node -> node |> eval_ast env
+
+    let READ input =
         try
             Reader.read_str input
         with
-        | Types.ReaderError(msg) ->
+        | Error.ReaderError(msg) ->
             printfn "%s" msg
             []
 
-    let eval env ast =
+    let EVAL env ast =
         try
-            Some(Eval.eval env ast)
+            Some(eval env ast)
         with
-        | Types.EvalError(msg) ->
+        | Error.EvalError(msg) 
+        | Error.ReaderError(msg) ->
             printfn "%s" msg
             None
 
-    let print v =
+    let PRINT v =
         v
         |> Seq.singleton
         |> Printer.pr_str
         |> printfn "%s"
 
-    let rep env input =
-        read input
+    let REP env input =
+        READ input
         |> Seq.ofList
-        |> Seq.choose (fun form -> eval env form)
-        |> Seq.iter (fun value -> print value)
+        |> Seq.choose (fun form -> EVAL env form)
+        |> Seq.iter (fun value -> PRINT value)
 
-    let getReadlineMode (args : string array) =
-        if args.Length > 0 && args.[0] = "--raw" then
+    let getReadlineMode args =
+        if args |> Array.exists (fun e -> e = "--raw") then
             Readline.Mode.Raw
         else
             Readline.Mode.Terminal
@@ -43,6 +97,6 @@ module REPL
             match Readline.read "user> " mode with
             | null -> 0
             | input ->
-                rep env input
+                REP env input
                 loop ()
         loop ()