1
1
mirror of https://github.com/kanaka/mal.git synced 2024-11-10 12:47:45 +03:00
mal/fsharp/step3_env.fs

103 lines
3.0 KiB
Forth

module REPL
open System
open Node
open Types
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
| Error.ReaderError(msg) ->
printfn "%s" msg
[]
let EVAL env ast =
try
Some(eval env ast)
with
| Error.EvalError(msg)
| Error.ReaderError(msg) ->
printfn "%s" msg
None
let PRINT v =
v
|> Seq.singleton
|> Printer.pr_str
|> printfn "%s"
let REP env input =
READ input
|> Seq.ofList
|> Seq.choose (fun form -> EVAL env form)
|> Seq.iter (fun value -> PRINT value)
let getReadlineMode args =
if args |> Array.exists (fun e -> e = "--raw") then
Readline.Mode.Raw
else
Readline.Mode.Terminal
[<EntryPoint>]
let main args =
let mode = getReadlineMode args
let env = Env.makeRootEnv ()
let rec loop () =
match Readline.read "user> " mode with
| null -> 0
| input ->
REP env input
loop ()
loop ()