From 0a6323d4930609387ae11a4e290f46d5edf7520e Mon Sep 17 00:00:00 2001
From: Peter Stephens <code@diligentsoftware.com>
Date: Sun, 19 Apr 2015 21:13:23 -0500
Subject: [PATCH] step7: Streamlined pattern matching with some active
 patterns.

---
 fsharp/eval.fs   | 34 +++++++++++++---------------------
 fsharp/reader.fs |  2 +-
 fsharp/types.fs  | 47 +++++++++++++++++++++++++++++++++++++++--------
 3 files changed, 53 insertions(+), 30 deletions(-)

diff --git a/fsharp/eval.fs b/fsharp/eval.fs
index db3c6bc4..4d3e8993 100644
--- a/fsharp/eval.fs
+++ b/fsharp/eval.fs
@@ -18,31 +18,27 @@ module Eval
         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
 
@@ -104,10 +100,6 @@ module Eval
         | [_; _] -> 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) -> 
diff --git a/fsharp/reader.fs b/fsharp/reader.fs
index 37ba56c2..f21e1b97 100644
--- a/fsharp/reader.fs
+++ b/fsharp/reader.fs
@@ -42,7 +42,7 @@ module Reader
             | 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
diff --git a/fsharp/types.fs b/fsharp/types.fs
index f272b0eb..b6997c28 100644
--- a/fsharp/types.fs
+++ b/fsharp/types.fs
@@ -117,6 +117,17 @@ module Types
                 | :? 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
 
@@ -128,11 +139,31 @@ module Types
     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
-- 
2.20.1