2015-03-16 15:09:10 +03:00
|
|
|
module Env
|
|
|
|
|
|
|
|
open Types
|
|
|
|
|
|
|
|
let makeEmpty () = Env()
|
|
|
|
|
|
|
|
let ofList lst =
|
|
|
|
let env = makeEmpty ()
|
|
|
|
let accumulate (e : Env) (k, v) = e.Add(k, v); e
|
|
|
|
List.fold accumulate env lst
|
|
|
|
|
|
|
|
let set (env : EnvChain) key node =
|
|
|
|
match env with
|
|
|
|
| head::_ -> head.[key] <- node
|
2015-05-02 09:50:09 +03:00
|
|
|
| _ -> raise <| Error.noEnvironment ()
|
2015-03-16 15:09:10 +03:00
|
|
|
|
2022-01-10 02:15:40 +03:00
|
|
|
let rec get (chain : EnvChain) key =
|
2015-03-16 15:09:10 +03:00
|
|
|
match chain with
|
|
|
|
| [] -> None
|
|
|
|
| env::rest ->
|
|
|
|
match env.TryGetValue(key) with
|
|
|
|
| true, v -> Some(v)
|
2022-01-10 02:15:40 +03:00
|
|
|
| false, _ -> get rest key
|
2015-03-16 15:09:10 +03:00
|
|
|
|
2015-04-05 06:01:05 +03:00
|
|
|
let private getNextValue =
|
2015-03-26 08:17:46 +03:00
|
|
|
let counter = ref 0
|
2015-04-05 06:01:05 +03:00
|
|
|
fun () -> System.Threading.Interlocked.Increment(counter)
|
|
|
|
|
|
|
|
let makeBuiltInFunc f =
|
2015-07-06 00:23:34 +03:00
|
|
|
BuiltInFunc(Node.NIL, getNextValue (), f)
|
2015-04-05 06:01:05 +03:00
|
|
|
|
|
|
|
let makeFunc f body binds env =
|
2015-07-06 00:23:34 +03:00
|
|
|
Func(Node.NIL, getNextValue (), f, body, binds, env)
|
2015-03-26 08:17:46 +03:00
|
|
|
|
2015-07-03 17:57:15 +03:00
|
|
|
let makeMacro f body binds env =
|
2015-07-06 00:23:34 +03:00
|
|
|
Macro(Node.NIL, getNextValue (), f, body, binds, env)
|
2015-07-03 17:57:15 +03:00
|
|
|
|
2015-03-16 15:09:10 +03:00
|
|
|
let makeRootEnv () =
|
2015-04-05 06:01:05 +03:00
|
|
|
let wrap name f = name, makeBuiltInFunc f
|
2015-03-16 15:09:10 +03:00
|
|
|
let env =
|
2015-04-08 06:14:00 +03:00
|
|
|
[ wrap "+" Core.add
|
|
|
|
wrap "-" Core.subtract
|
|
|
|
wrap "*" Core.multiply
|
|
|
|
wrap "/" Core.divide
|
|
|
|
wrap "list" Core.list
|
|
|
|
wrap "list?" Core.isList
|
|
|
|
wrap "empty?" Core.isEmpty
|
|
|
|
wrap "count" Core.count
|
|
|
|
wrap "=" Core.eq
|
|
|
|
wrap "<" Core.lt
|
|
|
|
wrap "<=" Core.le
|
|
|
|
wrap ">=" Core.ge
|
|
|
|
wrap ">" Core.gt
|
2015-10-24 23:53:41 +03:00
|
|
|
wrap "time-ms" Core.time_ms
|
2015-04-08 06:14:00 +03:00
|
|
|
wrap "pr-str" Core.pr_str
|
|
|
|
wrap "str" Core.str
|
|
|
|
wrap "prn" Core.prn
|
|
|
|
wrap "println" Core.println
|
|
|
|
wrap "read-string" Core.read_str
|
|
|
|
wrap "slurp" Core.slurp
|
|
|
|
wrap "cons" Core.cons
|
2015-07-03 17:57:15 +03:00
|
|
|
wrap "concat" Core.concat
|
2020-07-21 19:01:48 +03:00
|
|
|
wrap "vec" Core.vec
|
2015-07-03 17:57:15 +03:00
|
|
|
wrap "nth" Core.nth
|
|
|
|
wrap "first" Core.first
|
2015-07-03 20:07:57 +03:00
|
|
|
wrap "rest" Core.rest
|
|
|
|
wrap "throw" Core.throw
|
|
|
|
wrap "map" Core.map
|
|
|
|
wrap "apply" Core.apply
|
|
|
|
wrap "nil?" (Core.isConst Node.NIL)
|
|
|
|
wrap "true?" (Core.isConst Node.TRUE)
|
|
|
|
wrap "false?" (Core.isConst Node.FALSE)
|
2015-07-04 01:35:00 +03:00
|
|
|
wrap "symbol?" Core.isSymbol
|
|
|
|
wrap "symbol" Core.symbol
|
2016-02-13 05:01:05 +03:00
|
|
|
wrap "string?" Core.isString
|
2015-07-04 01:35:00 +03:00
|
|
|
wrap "keyword?" Core.isKeyword
|
|
|
|
wrap "keyword" Core.keyword
|
2017-10-19 13:06:40 +03:00
|
|
|
wrap "number?" Core.isNumber
|
|
|
|
wrap "fn?" Core.isFn
|
|
|
|
wrap "macro?" Core.isMacro
|
2015-07-04 01:35:00 +03:00
|
|
|
wrap "sequential?" Core.isSequential
|
|
|
|
wrap "vector?" Core.isVector
|
|
|
|
wrap "vector" Core.vector
|
|
|
|
wrap "map?" Core.isMap
|
|
|
|
wrap "hash-map" Core.hashMap
|
|
|
|
wrap "assoc" Core.assoc
|
|
|
|
wrap "dissoc" Core.dissoc
|
|
|
|
wrap "get" Core.get
|
|
|
|
wrap "contains?" Core.contains
|
|
|
|
wrap "keys" Core.keys
|
2015-07-04 09:02:43 +03:00
|
|
|
wrap "vals" Core.vals
|
|
|
|
wrap "atom" (Core.atom getNextValue)
|
2015-07-06 00:23:34 +03:00
|
|
|
wrap "atom?" Core.isAtom
|
2015-07-04 09:02:43 +03:00
|
|
|
wrap "deref" Core.deref
|
|
|
|
wrap "reset!" Core.reset
|
2015-07-06 00:23:34 +03:00
|
|
|
wrap "swap!" Core.swap
|
|
|
|
wrap "conj" Core.conj
|
2016-02-13 05:01:05 +03:00
|
|
|
wrap "seq" Core.seq
|
2015-07-06 00:23:34 +03:00
|
|
|
wrap "meta" Core.meta
|
|
|
|
wrap "with-meta" Core.withMeta ]
|
2015-03-16 15:09:10 +03:00
|
|
|
|> ofList
|
|
|
|
[ env ]
|
|
|
|
|
2015-03-27 12:21:56 +03:00
|
|
|
let makeNew outer symbols nodes =
|
|
|
|
let env = (makeEmpty ())::outer
|
|
|
|
let rec loop symbols nodes =
|
|
|
|
match symbols, nodes with
|
|
|
|
| [Symbol("&"); Symbol(s)], nodes ->
|
2015-07-06 00:23:34 +03:00
|
|
|
set env s (Node.makeList nodes)
|
2015-03-27 12:21:56 +03:00
|
|
|
env
|
2015-05-02 09:50:09 +03:00
|
|
|
| Symbol("&")::_, _ -> raise <| Error.onlyOneSymbolAfterAmp ()
|
2015-03-27 12:21:56 +03:00
|
|
|
| Symbol(s)::symbols, n::nodes ->
|
|
|
|
set env s n
|
|
|
|
loop symbols nodes
|
|
|
|
| [], [] -> env
|
2015-05-02 09:50:09 +03:00
|
|
|
| _, [] -> raise <| Error.notEnoughValues ()
|
|
|
|
| [], _ -> raise <| Error.tooManyValues ()
|
2015-07-03 01:55:42 +03:00
|
|
|
| _, _ -> raise <| Error.errExpectedX "symbol"
|
2015-03-27 12:21:56 +03:00
|
|
|
loop symbols nodes
|