fsharp/step3_env.fs

   1 module REPL
   2     open System
   3     open Node
   4     open Types
   5
   6     let rec iterPairs f = function
   7         | Pair(first, second, t) ->
   8             f first second
   9             iterPairs f t
  10         | Empty -> ()
  11         | _ -> raise <| Error.errExpectedX "list or vector"
  12
  13     let rec eval_ast env = function
  14         | Symbol(sym) -> Env.get env sym
  15         | List(_, lst) -> lst |> List.map (eval env) |> makeList
  16         | Vector(_, seg) -> seg |> Seq.map (eval env) |> Array.ofSeq |> Node.ofArray
  17         | Map(_, map) -> map |> Map.map (fun k v -> eval env v) |> makeMap
  18         | node -> node
  19
  20     and defBang env = function
  21         | [sym; node] ->
  22             match sym with
  23             | Symbol(sym) ->
  24                 let node = eval env node
  25                 Env.set env sym node
  26                 node
  27             | _ -> raise <| Error.errExpectedX "symbol"
  28         | _ -> raise <| Error.wrongArity ()
  29
  30     and setBinding env first second =
  31         let s = match first with
  32                 | Symbol(s) -> s
  33                 | _ -> raise <| Error.errExpectedX "symbol"
  34         let form = eval env second
  35         Env.set env s form
  36
  37     and letStar env = function
  38         | [bindings; form] ->
  39             let newEnv = Env.makeNew env [] []
  40             let binder = setBinding newEnv
  41             match bindings with
  42             | List(_, _) | Vector(_, _) -> iterPairs binder bindings
  43             | _ -> raise <| Error.errExpectedX "list or vector"
  44             eval newEnv form
  45         | _ -> raise <| Error.wrongArity ()
  46
  47     and eval env = function
  48         | List(_, Symbol("def!")::rest) -> defBang env rest
  49         | List(_, Symbol("let*")::rest) -> letStar env rest
  50         | List(_, _) as node ->
  51             let resolved = node |> eval_ast env
  52             match resolved with
  53             | List(_, BuiltInFunc(_, _, f)::rest) -> f rest
  54             | _ -> raise <| Error.errExpectedX "func"
  55         | node -> node |> eval_ast env
  56
  57     let READ input =
  58         try
  59             Reader.read_str input
  60         with
  61         | Error.ReaderError(msg) ->
  62             printfn "%s" msg
  63             []
  64
  65     let EVAL env ast =
  66         try
  67             Some(eval env ast)
  68         with
  69         | Error.EvalError(msg)
  70         | Error.ReaderError(msg) ->
  71             printfn "%s" msg
  72             None
  73
  74     let PRINT v =
  75         v
  76         |> Seq.singleton
  77         |> Printer.pr_str
  78         |> printfn "%s"
  79
  80     let REP env input =
  81         READ input
  82         |> Seq.ofList
  83         |> Seq.choose (fun form -> EVAL env form)
  84         |> Seq.iter (fun value -> PRINT value)
  85
  86     let getReadlineMode args =
  87         if args |> Array.exists (fun e -> e = "--raw") then
  88             Readline.Mode.Raw
  89         else
  90             Readline.Mode.Terminal
  91
  92     [<EntryPoint>]
  93     let main args =
  94         let mode = getReadlineMode args
  95         let env = Env.makeRootEnv ()
  96         let rec loop () =
  97             match Readline.read "user> " mode with
  98             | null -> 0
  99             | input ->
 100                 REP env input
 101                 loop ()
 102         loop ()