fsharp/step5_tco.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 defBangForm env = function
  21         | [sym; form] ->
  22             match sym with
  23             | Symbol(sym) ->
  24                 let node = eval env form
  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 letStarForm outer = function
  38         | [bindings; form] ->
  39             let inner = Env.makeNew outer [] []
  40             let binder = setBinding inner
  41             match bindings with
  42             | List(_, _) | Vector(_, _)-> iterPairs binder bindings
  43             | _ -> raise <| Error.errExpectedX "list or vector"
  44             inner, form
  45         | _ -> raise <| Error.wrongArity ()
  46
  47     and ifForm env = function
  48         | [condForm; trueForm; falseForm] -> ifForm3 env condForm trueForm falseForm
  49         | [condForm; trueForm] -> ifForm3 env condForm trueForm Nil
  50         | _ -> raise <| Error.wrongArity ()
  51
  52     and ifForm3 env condForm trueForm falseForm =
  53         match eval env condForm with
  54         | Bool(false) | Nil -> falseForm
  55         | _ -> trueForm
  56
  57     and doForm env = function
  58         | [a] -> a
  59         | a::rest ->
  60             eval env a |> ignore
  61             doForm env rest
  62         | _ -> raise <| Error.wrongArity ()
  63
  64     and fnStarForm outer nodes =
  65         let makeFunc binds body =
  66             let f = fun nodes ->
  67                         let inner = Env.makeNew outer binds nodes
  68                         eval inner body
  69             Env.makeFunc f body binds outer
  70
  71         match nodes with
  72         | [List(_, binds); body] -> makeFunc binds body
  73         | [Vector(_, seg); body] -> makeFunc (List.ofSeq seg) body
  74         | [_; _] -> raise <| Error.errExpectedX "bindings of list or vector"
  75         | _ -> raise <| Error.wrongArity ()
  76
  77     and eval env = function
  78         | List(_, Symbol("def!")::rest) -> defBangForm env rest
  79         | List(_, Symbol("let*")::rest) ->
  80             let inner, form = letStarForm env rest
  81             form |> eval inner
  82         | List(_, Symbol("if")::rest) -> ifForm env rest |> eval env
  83         | List(_, Symbol("do")::rest) -> doForm env rest |> eval env
  84         | List(_, Symbol("fn*")::rest) -> fnStarForm env rest
  85         | List(_, _) as node ->
  86             let resolved = node |> eval_ast env
  87             match resolved with
  88             | List(_, BuiltInFunc(_, _, f)::rest) -> f rest
  89             | List(_, Func(_, _, _, body, binds, outer)::rest) ->
  90                 let inner = Env.makeNew outer binds rest
  91                 body |> eval inner
  92             | _ -> raise <| Error.errExpectedX "func"
  93         | node -> node |> eval_ast env
  94
  95     let READ input =
  96         try
  97             Reader.read_str input
  98         with
  99         | Error.ReaderError(msg) ->
 100             printfn "%s" msg
 101             []
 102
 103     let EVAL env ast =
 104         try
 105             Some(eval env ast)
 106         with
 107         | Error.EvalError(msg)
 108         | Error.ReaderError(msg) ->
 109             printfn "%s" msg
 110             None
 111
 112     let PRINT v =
 113         v
 114         |> Seq.singleton
 115         |> Printer.pr_str
 116         |> printfn "%s"
 117
 118     let RE env input =
 119         READ input
 120         |> Seq.ofList
 121         |> Seq.choose (fun form -> EVAL env form)
 122
 123     let REP env input =
 124         input
 125         |> RE env
 126         |> Seq.iter (fun value -> PRINT value)
 127
 128     let getReadlineMode args =
 129         if args |> Array.exists (fun e -> e = "--raw") then
 130             Readline.Mode.Raw
 131         else
 132             Readline.Mode.Terminal
 133
 134     [<EntryPoint>]
 135     let main args =
 136         let mode = getReadlineMode args
 137         let env = Env.makeRootEnv ()
 138
 139         RE env "(def! not (fn* (a) (if a false true)))" |> Seq.iter ignore
 140
 141         let rec loop () =
 142             match Readline.read "user> " mode with
 143             | null -> 0
 144             | input ->
 145                 REP env input
 146                 loop ()
 147         loop ()