From 52c921241bf93b4e13b8472a9dabfde36975eaf5 Mon Sep 17 00:00:00 2001 From: Peter Stephens Date: Thu, 2 Jul 2015 19:04:33 -0500 Subject: [PATCH] fsharp: eval 'shared across the time dimension' for step6. --- fsharp/step0_repl.fs | 4 +- fsharp/step1_read_print.fs | 4 +- fsharp/step2_eval.fs | 4 +- fsharp/step3_env.fs | 4 +- fsharp/step4_if_fn_do.fs | 4 +- fsharp/step5_tco.fs | 4 +- fsharp/step6_file.fs | 119 ++++++++++++++++++++++++++++++++----- 7 files changed, 117 insertions(+), 26 deletions(-) diff --git a/fsharp/step0_repl.fs b/fsharp/step0_repl.fs index e15a8cca..6d8d4574 100644 --- a/fsharp/step0_repl.fs +++ b/fsharp/step0_repl.fs @@ -14,8 +14,8 @@ module REPL |> EVAL |> PRINT - 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 diff --git a/fsharp/step1_read_print.fs b/fsharp/step1_read_print.fs index 6d8c9a3e..27751f51 100644 --- a/fsharp/step1_read_print.fs +++ b/fsharp/step1_read_print.fs @@ -25,8 +25,8 @@ module REPL |> Seq.filter Option.isSome |> Seq.iter (fun value -> PRINT value.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 diff --git a/fsharp/step2_eval.fs b/fsharp/step2_eval.fs index f74ef841..f78082db 100644 --- a/fsharp/step2_eval.fs +++ b/fsharp/step2_eval.fs @@ -46,8 +46,8 @@ module REPL |> 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 diff --git a/fsharp/step3_env.fs b/fsharp/step3_env.fs index 7980a55c..6a2ae2c3 100644 --- a/fsharp/step3_env.fs +++ b/fsharp/step3_env.fs @@ -83,8 +83,8 @@ module REPL |> 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 diff --git a/fsharp/step4_if_fn_do.fs b/fsharp/step4_if_fn_do.fs index f97e4f16..9d208858 100644 --- a/fsharp/step4_if_fn_do.fs +++ b/fsharp/step4_if_fn_do.fs @@ -123,8 +123,8 @@ module REPL |> 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 diff --git a/fsharp/step5_tco.fs b/fsharp/step5_tco.fs index abfc68b7..73ea4462 100644 --- a/fsharp/step5_tco.fs +++ b/fsharp/step5_tco.fs @@ -125,8 +125,8 @@ module REPL |> 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 diff --git a/fsharp/step6_file.fs b/fsharp/step6_file.fs index 598b577b..821a19db 100644 --- a/fsharp/step6_file.fs +++ b/fsharp/step6_file.fs @@ -1,7 +1,98 @@ 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) |> List + | Vector(seg) -> seg |> Seq.map (eval env) |> Array.ofSeq |> Node.ofArray + | Map(map) -> map |> Map.map (fun k v -> eval env v) |> Map + | 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(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(Func(_, f, _, _, [])::rest) -> f rest + | List(Func(_, _, body, binds, outer)::rest) -> + let inner = Env.makeNew outer binds rest + body |> eval inner + | _ -> raise <| Error.errExpectedX "function" + | node -> node |> eval_ast env + + let READ input = try Reader.read_str input with @@ -9,30 +100,30 @@ 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 = if args |> Array.exists (fun e -> e = "--raw") then @@ -41,7 +132,7 @@ module REPL Readline.Mode.Terminal let eval_func env = function - | [ast] -> Eval.eval env ast + | [ast] -> eval env ast | _ -> raise <| Error.wrongArity () let argv_func = function @@ -54,7 +145,7 @@ module REPL Env.set env "eval" <| Env.makeBuiltInFunc (fun nodes -> eval_func env nodes) Env.set env "*ARGV*" <| argv_func args - re env """ + RE env """ (def! not (fn* (a) (if a false true))) (def! load-file (fn* (f) (eval (read-string (slurp f))))) """ |> Seq.iter ignore @@ -70,13 +161,13 @@ module REPL match args with | file::_ -> System.IO.File.ReadAllText file - |> rep env + |> REP env 0 | _ -> let rec loop () = match Readline.read "user> " mode with | null -> 0 | input -> - rep env input + REP env input loop () loop () -- 2.20.1