loop ()
let quasiquoteForm nodes =
- let identity n = n
- let singleNodeTransform f = function
- | [node] -> f node
+ let transformNode f = function
+ | Elements 1 [|a|] -> f a
| _ -> raise <| Core.errArity ()
+ let singleNode = transformNode (fun n -> n)
let rec quasiquote node =
match node with
- | Vector(seg) when seg.Count > 0 -> quasiquote (List(List.ofSeq seg))
- | List(Symbol("unquote")::rest) -> rest |> singleNodeTransform identity
- | List(List(Symbol("splice-unquote")::spliceRest)::rest) ->
- List([
- Symbol("concat")
- (singleNodeTransform identity spliceRest)
- (quasiquote (List(rest)))])
- | List(node::rest) ->
- List([
- Symbol("cons")
- (quasiquote node)
- (quasiquote (List(rest)))])
+ | Head(Symbol("unquote"), rest) -> rest |> singleNode
+ | Head(Head(Symbol("splice-unquote"), spliceRest), rest) ->
+ List([Symbol("concat"); singleNode spliceRest; quasiquote rest])
+ | Head(h, t) -> List([Symbol("cons"); quasiquote h; quasiquote t])
| n -> List([Symbol("quote"); n])
- nodes |> singleNodeTransform quasiquote
+ List(nodes) |> transformNode quasiquote
+
+ let quoteForm = function
+ | [node] -> node
+ | _ -> raise <| Core.errArity ()
let rec eval_ast env = function
| Symbol(sym) -> Env.get env sym
| List(lst) -> lst |> List.map (eval env) |> List
- | Vector(seg) -> seg |> Seq.map (eval env) |> Array.ofSeq |> makeVector
+ | Vector(seg) -> seg |> Seq.map (eval env) |> Array.ofSeq |> Node.ofArray
| Map(map) -> map |> Map.map (fun k v -> eval env v) |> Map
| node -> node
| [_; _] -> raise <| errExpected "bindings of list or vector"
| _ -> raise <| Core.errArity ()
- and quoteForm = function
- | [node] -> node
- | _ -> raise <| Core.errArity ()
-
and eval env = function
| List(Symbol("def!")::rest) -> defBangForm env rest
| List(Symbol("let*")::rest) ->
| None, _ -> raise <| errExpectedButEOF "')'"
and readVector acc = function
- | CloseBracket::rest -> Some(acc.ToArray() |> makeVector), rest
+ | CloseBracket::rest -> Some(acc.ToArray() |> Node.ofArray), rest
| [] -> raise <| errExpectedButEOF "']'"
| tokens ->
match readForm tokens with
| :? Node as y -> Node.compare x y
| _ -> invalidArg "yobj" "Cannot compare values of different types."
+ static member ofArray arr = System.ArraySegment(arr) |> Vector
+ static member toArray = function
+ | List(lst) -> Array.ofList lst
+ | Vector(seg) -> Array.sub seg.Array seg.Offset seg.Count
+ | node -> [| node |]
+ static member length = function
+ | List(lst) -> List.length lst
+ | Vector(seg) -> seg.Count
+ | Map(m) -> m.Count
+ | _ -> 1
+
and Env = System.Collections.Generic.Dictionary<string, Node>
and EnvChain = Env list
let SomeNIL = Some(NIL)
let ZERO = Number(0L)
- let makeVector vec = System.ArraySegment(vec) |> Vector
- // TODO: Not currently using sliceVector.
- let sliceVector offset count vec =
- match vec with
- | Vector(seg) ->
- System.ArraySegment(seg.Array, seg.Offset + offset, count)
- |> Vector
- | _ -> invalidArg "vec" "Value passed in must be a Vector."
+ (* Active Patterns to help with pattern matching nodes *)
+ let (|Elements|_|) num node =
+ let rec accumList acc idx lst =
+ let len = Array.length acc
+ match lst with
+ | [] when idx = len -> Some(Elements acc)
+ | h::t when idx < len ->
+ acc.[idx] <- h
+ accumList acc (idx + 1) t
+ | _ -> None
+ match node with
+ | List(lst) -> accumList (Array.zeroCreate num) 0 lst
+ | Vector(seg) when seg.Count = num -> Some(Node.toArray node)
+ | _ -> None
+
+ let (|Head|_|) = function
+ | List(h::t) -> Some(Head(h, List(t)))
+ | Vector(seg) when seg.Count > 0 ->
+ let h = seg.Array.[seg.Offset]
+ let t = System.ArraySegment(seg.Array, seg.Offset + 1, seg.Count - 1)
+ |> Vector
+ Some(Head(h, t))
+ | _ -> None
+
+ let (|Empty|_|) = function
+ | List([]) -> Some(Empty)
+ | Vector(seg) when seg.Count = 0 -> Some(Empty)
+ | _ -> None