Common Lisp: Add documentation
[jackhill/mal.git] / fsharp / core.fs
CommitLineData
6c47cf67
PS
1module Core
2
50bb9060 3 open System
a836d8f3 4 open Types
6c47cf67 5
f877bf26 6 let inline toBool b = if b then Node.TRUE else Node.FALSE
6c47cf67 7
a836d8f3
PS
8 let inline twoNumberOp (f : int64 -> int64 -> Node) = function
9 | [Number(a); Number(b)] -> f a b
6d809e32
PS
10 | [_; _] -> raise <| Error.argMismatch ()
11 | _ -> raise <| Error.wrongArity ()
a836d8f3
PS
12
13 let inline twoNodeOp (f : Node -> Node -> Node) = function
14 | [a; b] -> f a b
6d809e32 15 | _ -> raise <| Error.wrongArity ()
a836d8f3
PS
16
17 let add = twoNumberOp (fun a b -> a + b |> Number)
18 let subtract = twoNumberOp (fun a b -> a - b |> Number)
19 let multiply = twoNumberOp (fun a b -> a * b |> Number)
20 let divide = twoNumberOp (fun a b -> a / b |> Number)
21 let lt = twoNodeOp (fun a b -> a < b |> toBool)
22 let le = twoNodeOp (fun a b -> a <= b |> toBool)
23 let ge = twoNodeOp (fun a b -> a >= b |> toBool)
24 let gt = twoNodeOp (fun a b -> a > b |> toBool)
7822be33 25 let eq = twoNodeOp (fun a b -> a = b |> toBool)
6c47cf67 26
50bb9060
JM
27 let time_ms _ =
28 DateTime.Now.Ticks / TimeSpan.TicksPerMillisecond |> int64 |> Number
29
a71aefe1 30 let list = Node.makeList
a836d8f3 31 let isList = function
a71aefe1 32 | [List(_, _)] -> Node.TRUE
f877bf26 33 | [_] -> Node.FALSE
6d809e32 34 | _ -> raise <| Error.wrongArity ()
6c47cf67 35
a836d8f3 36 let isEmpty = function
a71aefe1
PS
37 | [List(_, [])] -> Node.TRUE
38 | [Vector(_, seg)] when seg.Count <= 0 -> Node.TRUE
f877bf26 39 | _ -> Node.FALSE
6c47cf67 40
a836d8f3 41 let count = function
a71aefe1
PS
42 | [List(_, lst)] -> lst |> List.length |> int64 |> Number
43 | [Vector(_, seg)] -> seg.Count |> int64 |> Number
f877bf26 44 | [Nil] -> Node.ZERO
6d809e32
PS
45 | [_] -> raise <| Error.argMismatch ()
46 | _ -> raise <| Error.wrongArity ()
6a4627fb
PS
47
48 let pr_str nodes = nodes |> Printer.pr_str |> String
49 let str nodes = nodes |> Printer.str |> String
50 let prn nodes = nodes |> Printer.prn |> printfn "%s"; Nil
51 let println nodes = nodes |> Printer.println |> printfn "%s"; Nil
8d4a06e0
PS
52
53 let read_str = function
54 | [String(s)] ->
55 match Reader.read_str s with
56 | [node] -> node
a71aefe1 57 | nodes -> Symbol("do")::nodes |> Node.makeList
6d809e32
PS
58 | [_] -> raise <| Error.argMismatch ()
59 | _ -> raise <| Error.wrongArity ()
8d4a06e0
PS
60
61 let slurp = function
62 | [String(s)] -> System.IO.File.ReadAllText s |> String
6d809e32
PS
63 | [_] -> raise <| Error.argMismatch ()
64 | _ -> raise <| Error.wrongArity ()
aa2e1438
PS
65
66 let cons = function
a71aefe1
PS
67 | [node; List(_, lst)] -> node::lst |> Node.makeList
68 | [node; Vector(_, seg)] -> node::(List.ofSeq seg) |> Node.makeList
6d809e32
PS
69 | [_; _] -> raise <| Error.argMismatch ()
70 | _ -> raise <| Error.wrongArity ()
aa2e1438
PS
71
72 let concat nodes =
aac99bed
PS
73 let cons st node = node::st
74 let accumNode acc = function
a71aefe1
PS
75 | List(_, lst) -> lst |> List.fold cons acc
76 | Vector(_, seg) -> seg |> Seq.fold cons acc
6d809e32 77 | _ -> raise <| Error.argMismatch ()
aac99bed 78
aa2e1438 79 nodes
aac99bed
PS
80 |> List.fold accumNode []
81 |> List.rev
a71aefe1 82 |> Node.makeList
f0e1608b
PS
83
84 let nth = function
a71aefe1 85 | [List(_, lst); Number(n)] ->
f0e1608b
PS
86 let rec nth_list n = function
87 | [] -> raise <| Error.indexOutOfBounds ()
88 | h::_ when n = 0L -> h
89 | _::t -> nth_list (n - 1L) t
90 nth_list n lst
a71aefe1 91 | [Vector(_, seg); Number(n)] ->
f0e1608b
PS
92 if n < 0L || n >= int64(seg.Count) then
93 raise <| Error.indexOutOfBounds ()
94 else
95 seg.Array.[int(n)]
96 | [_; _] -> raise <| Error.argMismatch ()
97 | _ -> raise <| Error.wrongArity ()
98
99 let first = function
a71aefe1
PS
100 | [List(_, [])] -> Node.NIL
101 | [List(_, h::_)] -> h
102 | [Vector(_, seg)] when seg.Count > 0 -> seg.Array.[0]
103 | [Vector(_, _)] -> Node.NIL
f0e1608b
PS
104 | [Nil] -> Node.NIL
105 | [_] -> raise <| Error.argMismatch ()
106 | _ -> raise <| Error.wrongArity ()
107
108 let rest = function
a71aefe1
PS
109 | [List(_, [])] -> Node.EmptyLIST
110 | [List(_, _::t)] -> t |> Node.makeList
111 | [Vector(_, seg)] when seg.Count < 2 -> Node.EmptyLIST
112 | [Vector(_, seg)] -> seg |> Seq.skip 1 |> List.ofSeq |> Node.makeList
283779ea 113 | [Nil] -> Node.EmptyLIST
f0e1608b
PS
114 | [_] -> raise <| Error.argMismatch ()
115 | _ -> raise <| Error.wrongArity ()
224d2396
PS
116
117 let throw = function
118 | [node] -> raise <| Error.MalError(node)
119 | _ -> raise <| Error.wrongArity ()
120
121 let map = function
a71aefe1
PS
122 | [BuiltInFunc(_, _, f); Node.Seq seq]
123 | [Func(_, _, f, _, _, _); Node.Seq seq] ->
124 seq |> Seq.map (fun node -> f [node]) |> List.ofSeq |> Node.makeList
224d2396
PS
125 | [_; _] -> raise <| Error.argMismatch ()
126 | _ -> raise <| Error.wrongArity ()
127
128 let apply = function
a71aefe1
PS
129 | BuiltInFunc(_, _, f)::rest
130 | Func(_, _, f, _, _, _)::rest ->
224d2396
PS
131 let rec getArgsAndCall acc = function
132 | [] -> raise <| Error.wrongArity ()
133 | [Node.Seq seq] ->
134 seq |> Seq.fold (fun acc node -> node::acc) acc |> List.rev |> f
135 | [_] -> raise <| Error.argMismatch ()
136 | h::rest -> getArgsAndCall (h::acc) rest
137 getArgsAndCall [] rest
138 | _::_ -> raise <| Error.argMismatch ()
139 | [] -> raise <| Error.wrongArity ()
140
141 let isConst cmp = function
142 | [node] -> if node = cmp then Node.TRUE else Node.FALSE
143 | _ -> raise <| Error.wrongArity ()
144
0fb8a944
PS
145 let isPattern f = function
146 | [node] -> if f node then Node.TRUE else Node.FALSE
147 | _ -> raise <| Error.wrongArity ()
148
149 let isSymbol = isPattern (function Symbol(_) -> true | _ -> false)
150 let isKeyword = isPattern (function Keyword(_) -> true | _ -> false)
7b25f92c 151 let isString = isPattern (function String(_) -> true | _ -> false)
0fb8a944 152 let isSequential = isPattern (function Node.Seq(_) -> true | _ -> false)
a71aefe1
PS
153 let isVector = isPattern (function Vector(_, _) -> true | _ -> false)
154 let isMap = isPattern (function Map(_, _) -> true | _ -> false)
155 let isAtom = isPattern (function Atom(_, _) -> true | _ -> false)
0fb8a944
PS
156
157 let fromString f = function
158 | [String(str)] -> f str
159 | [_] -> raise <| Error.argMismatch ()
224d2396 160 | _ -> raise <| Error.wrongArity ()
0fb8a944
PS
161
162 let symbol = fromString (fun s -> Symbol(s))
163 let keyword = fromString (fun s -> Keyword(s))
164 let vector lst = lst |> Array.ofList |> Node.ofArray
165
166 let rec getPairs lst =
167 seq {
168 match lst with
169 | first::second::t ->
170 yield first, second
171 yield! getPairs t
172 | [_] -> raise <| Error.expectedEvenNodeCount ()
173 | [] -> ()
174 }
175
176 let mapOpN f = function
a71aefe1 177 | Map(_, map)::rest -> f rest map
0fb8a944
PS
178 | [_] -> raise <| Error.argMismatch ()
179 | _ -> raise <| Error.wrongArity ()
180
181 let mapOp1 f =
182 mapOpN (fun rest map ->
183 match rest with
184 | [v] -> f v map
185 | _ -> raise <| Error.wrongArity ())
186
187 let mapOp0 f =
188 mapOpN (fun rest map ->
189 match rest with
190 | [] -> f map
191 | _ -> raise <| Error.wrongArity ())
192
193 let mapKV f =
a71aefe1 194 mapOp0 (fun map -> map |> Map.toSeq |> Seq.map f |> List.ofSeq |> Node.makeList)
0fb8a944 195
a71aefe1 196 let hashMap lst = lst |> getPairs |> Map.ofSeq |> Node.makeMap
0fb8a944
PS
197 let assoc = mapOpN (fun rest map ->
198 rest
199 |> getPairs
200 |> Seq.fold (fun map (k, v) -> Map.add k v map) map
a71aefe1 201 |> Node.makeMap)
0fb8a944
PS
202 let dissoc = mapOpN (fun keys map ->
203 keys
204 |> List.fold (fun map k -> Map.remove k map) map
a71aefe1 205 |> Node.makeMap)
0fb8a944
PS
206 let get = function
207 | [Nil; _] -> Node.NIL
208 | _ as rest ->
209 rest |> mapOp1 (fun key map ->
210 match Map.tryFind key map with
211 | Some(node) -> node
212 | None -> Node.NIL)
213 let containsKey key map = if Map.containsKey key map then Node.TRUE else Node.FALSE
214 let contains = mapOp1 containsKey
215 let keys = mapKV (fun (k, v) -> k)
216 let vals = mapKV (fun (k, v) -> v)
66913ea4
PS
217
218 let atom nextValue = function
219 | [node] -> Atom((nextValue ()), ref node)
220 | _ -> raise <| Error.wrongArity ()
221
222 let deref = function
223 | [Atom(_, r)] -> !r
224 | [_] -> raise <| Error.argMismatch ()
225 | _ -> raise <| Error.wrongArity ()
226
227 let reset = function
228 | [Atom(_, r); node] ->
229 r := node
230 !r
231 | [_; _] -> raise <| Error.argMismatch ()
232 | _ -> raise <| Error.wrongArity ()
233
234 let swap = function
235 | Atom(_, r)
a71aefe1 236 ::(BuiltInFunc(_, _, f) | Func(_, _, f, _, _, _))
66913ea4
PS
237 ::rest ->
238 r := f (!r::rest)
239 !r
240 | [_; _] -> raise <| Error.argMismatch ()
241 | _ -> raise <| Error.wrongArity ()
a71aefe1
PS
242
243 let conj = function
244 | List(_, lst)::rest ->
245 rest
246 |> List.fold (fun lst node -> node::lst) lst
247 |> Node.makeList
248 | Vector(_, seg)::rest ->
249 (* Might be nice to implement a persistent vector here someday. *)
250 let cnt = List.length rest
251 if cnt > 0 then
252 let target : Node array = seg.Count + cnt |> Array.zeroCreate
253 System.Array.Copy(seg.Array :> System.Array, seg.Offset,
254 target :> System.Array, 0, seg.Count)
255 let rec copyElem i = function
256 | h::t ->
257 Array.set target i h
258 copyElem (i + 1) t
259 | [] -> ()
260 copyElem (seg.Count) rest
261 target |> Node.ofArray
262 else
263 seg |> Node.makeVector
264 | [_; _] -> raise <| Error.argMismatch ()
265 | _ -> raise <| Error.wrongArity ()
266
7b25f92c
DM
267 let seq = function
268 | [Nil] -> Node.NIL
269 | [List(_, [])] -> Node.NIL
270 | [List(_, _) as l] -> l
271 | [Vector(_, seg)] when seg.Count < 1 -> Node.NIL
272 | [Vector(_, seg)] -> seg |> List.ofSeq |> Node.makeList
273 | [String(s)] when String.length s < 1 -> Node.NIL
274 | [String(s)] -> s |> Seq.map Node.ofChar |> List.ofSeq |> Node.makeList
275 | [_] -> raise <| Error.argMismatch ()
276 | _ -> raise <| Error.wrongArity ()
277
a71aefe1
PS
278 let withMeta = function
279 | [List(_, lst); m] -> List(m, lst)
280 | [Vector(_, seg); m] -> Vector(m, seg)
281 | [Map(_, map); m] -> Map(m, map)
282 | [BuiltInFunc(_, tag, f); m] -> BuiltInFunc(m, tag, f)
283 | [Func(_, tag, f, a, b, c); m] -> Func(m, tag, f, a, b, c)
284 | [Macro(_, tag, f, a, b, c); m] -> Macro(m, tag, f, a, b, c)
285 | [_; _] -> raise <| Error.argMismatch ()
286 | _ -> raise <| Error.wrongArity ()
287
288 let meta = function
289 | [List(m, _)]
290 | [Vector(m, _)]
291 | [Map(m, _)]
292 | [BuiltInFunc(m, _, _)]
293 | [Func(m, _, _, _, _, _)]
294 | [Macro(m, _, _, _, _, _)] -> m
295 | [_] -> Node.NIL
296 | _ -> raise <| Error.wrongArity ()