Common Lisp: Add documentation

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

diff --git a/fsharp/step5_tco.fs b/fsharp/step5_tco.fs
index d20edaa..7c0a7d3 100644 (file)
--- a/fsharp/step5_tco.fs
+++ b/fsharp/step5_tco.fs
@@ -1,7 +1,99 @@
 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 defBangForm env = function
+        | [sym; form] ->
+            match sym with
+            | Symbol(sym) ->
+                let node = eval env form
+                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 letStarForm outer = function
+        | [bindings; form] ->
+            let inner = Env.makeNew outer [] []
+            let binder = setBinding inner
+            match bindings with
+            | List(_, _) | Vector(_, _)-> iterPairs binder bindings
+            | _ -> raise <| Error.errExpectedX "list or vector"
+            inner, form
+        | _ -> raise <| Error.wrongArity ()
+
+    and ifForm env = function
+        | [condForm; trueForm; falseForm] -> ifForm3 env condForm trueForm falseForm
+        | [condForm; trueForm] -> ifForm3 env condForm trueForm Nil
+        | _ -> raise <| Error.wrongArity ()
+
+    and ifForm3 env condForm trueForm falseForm =
+        match eval env condForm with
+        | Bool(false) | Nil -> falseForm
+        | _ -> trueForm
+
+    and doForm env = function
+        | [a] -> a
+        | a::rest ->
+            eval env a |> ignore
+            doForm env rest
+        | _ -> raise <| Error.wrongArity ()
+
+    and fnStarForm outer nodes =
+        let makeFunc binds body =
+            let f = fun nodes ->
+                        let inner = Env.makeNew outer binds nodes
+                        eval inner body
+            Env.makeFunc f body binds outer
+
+        match nodes with
+        | [List(_, binds); body] -> makeFunc binds body
+        | [Vector(_, seg); body] -> makeFunc (List.ofSeq seg) body
+        | [_; _] -> raise <| Error.errExpectedX "bindings of list or vector"
+        | _ -> raise <| Error.wrongArity ()
+
+    and eval env = function
+        | List(_, []) as emptyList -> emptyList
+        | List(_, Symbol("def!")::rest) -> defBangForm env rest
+        | List(_, Symbol("let*")::rest) ->
+            let inner, form = letStarForm env rest
+            form |> eval inner
+        | List(_, Symbol("if")::rest) -> ifForm env rest |> eval env
+        | List(_, Symbol("do")::rest) -> doForm env rest |> eval env
+        | List(_, Symbol("fn*")::rest) -> fnStarForm env rest
+        | List(_, _) as node ->
+            let resolved = node |> eval_ast env
+            match resolved with
+            | List(_, BuiltInFunc(_, _, f)::rest) -> f rest
+            | List(_, Func(_, _, _, body, binds, outer)::rest) ->
+                let inner = Env.makeNew outer binds rest
+                body |> eval inner
+            | _ -> raise <| Error.errExpectedX "func"
+        | node -> node |> eval_ast env
+
+    let READ input =
         try
             Reader.read_str input
         with
@@ -9,33 +101,33 @@ module REPL
             printfn "%s" msg
             []
 
-    let eval env ast =
+    let EVAL env ast =
         try
-            Some(Eval.eval env ast)
+            Some(eval env ast)
         with
         | 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 re env input =
-        read input
+    let RE env input =
+        READ input
         |> Seq.ofList
-        |> Seq.choose (fun form -> eval env form)
+        |> Seq.choose (fun form -> EVAL env form)
 
-    let rep env input =
+    let REP env input =
         input
-        |> re env
-        |> Seq.iter (fun value -> print value)
+        |> RE env
+        |> 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
@@ -45,12 +137,12 @@ module REPL
         let mode = getReadlineMode args
         let env = Env.makeRootEnv ()
 
-        re env "(def! not (fn* (a) (if a false true)))" |> Seq.iter ignore
+        RE env "(def! not (fn* (a) (if a false true)))" |> Seq.iter ignore
 
         let rec loop () =
             match Readline.read "user> " mode with
             | null -> 0
             | input ->
-                rep env input
+                REP env input
                 loop ()
         loop ()