fsharp/types.fs

   1 module Types
   2
   3     exception ReaderError of string
   4     exception EvalError of string
   5
   6     [<CustomEquality; CustomComparison>]
   7     type Node =
   8         | Nil
   9         | List of Node list
  10         | Vector of Node System.ArraySegment
  11         | Map of Collections.Map<Node, Node>
  12         | Symbol of string
  13         | Keyword of string
  14         | Number of int64
  15         | String of string
  16         | Bool of bool
  17         | Func of int * (Node list -> Node) * Node * Node list * EnvChain
  18
  19         static member private hashSeq (s : seq<Node>) =
  20             let iter st node = (st * 397) ^^^ node.GetHashCode()
  21             s |> Seq.fold iter 0
  22
  23         static member private allEqual (x : seq<Node>) (y : seq<Node>) =
  24             use ex = x.GetEnumerator()
  25             use ey = y.GetEnumerator()
  26             let rec loop () =
  27                 match ex.MoveNext(), ey.MoveNext() with
  28                 | false, false -> true
  29                 | false, true
  30                 | true, false -> false
  31                 | true, true ->
  32                     if ex.Current = ey.Current then
  33                         loop ()
  34                     else
  35                         false
  36             loop ()
  37
  38         static member private allCompare (x : seq<Node>) (y : seq<Node>) =
  39             use ex = x.GetEnumerator()
  40             use ey = y.GetEnumerator()
  41             let rec loop () =
  42                 match ex.MoveNext(), ey.MoveNext() with
  43                 | false, false -> 0
  44                 | false, true -> -1
  45                 | true, false -> 1
  46                 | true, true ->
  47                     let cmp = compare ex.Current ey.Current
  48                     if cmp = 0 then loop () else cmp
  49             loop ()
  50
  51         static member private rank x =
  52             match x with
  53             | Nil -> 0
  54             | List(_) -> 1
  55             | Vector(_) -> 2
  56             | Map(_) -> 3
  57             | Symbol(_) -> 4
  58             | Keyword(_) -> 5
  59             | Number(_) -> 6
  60             | String(_) -> 7
  61             | Bool(_) -> 8
  62             | Func(_, _, _, _, _) -> 9
  63
  64         static member private equals x y =
  65             match x, y with
  66             | Nil, Nil -> true
  67             | List(a), List(b) -> a = b
  68             | List(a), Vector(b) -> Node.allEqual a b
  69             | Vector(a), List(b) -> Node.allEqual a b
  70             | Vector(a), Vector(b) -> Node.allEqual a b
  71             | Map(a), Map(b) -> a = b
  72             | Symbol(a), Symbol(b) -> a = b
  73             | Keyword(a), Keyword(b) -> a = b
  74             | Number(a), Number(b) -> a = b
  75             | String(a), String(b) -> a = b
  76             | Bool(a), Bool(b) -> a = b
  77             | Func(a, _, _, _, _), Func(b, _, _, _, _) -> a = b
  78             | _, _ -> false
  79
  80         static member private compare x y =
  81             match x, y with
  82             | Nil, Nil -> 0
  83             | List(a), List(b) -> compare a b
  84             | List(a), Vector(b) -> Node.allCompare a b
  85             | Vector(a), List(b) -> Node.allCompare a b
  86             | Vector(a), Vector(b) -> Node.allCompare a b
  87             | Map(a), Map(b) -> compare a b
  88             | Symbol(a), Symbol(b) -> compare a b
  89             | Keyword(a), Keyword(b) -> compare a b
  90             | Number(a), Number(b) -> compare a b
  91             | String(a), String(b) -> compare a b
  92             | Bool(a), Bool(b) -> compare a b
  93             | Func(a, _, _, _, _), Func(b, _, _, _, _) -> compare a b
  94             | a, b -> compare (Node.rank a) (Node.rank b)
  95
  96         override x.Equals yobj =
  97             match yobj with
  98             | :? Node as y -> Node.equals x y
  99             | _ -> false
 100
 101         override x.GetHashCode() =
 102             match x with
 103             | Nil -> 0
 104             | List(lst) -> hash lst
 105             | Vector(vec) -> Node.hashSeq vec
 106             | Map(map) -> hash map
 107             | Symbol(sym) -> hash sym
 108             | Keyword(key) -> hash key
 109             | Number(num) -> hash num
 110             | String(str) -> hash str
 111             | Bool(b) -> hash b
 112             | Func(tag, _, _, _, _) -> hash tag
 113
 114         interface System.IComparable with
 115             member x.CompareTo yobj =
 116                 match yobj with
 117                 | :? Node as y -> Node.compare x y
 118                 | _ -> invalidArg "yobj" "Cannot compare values of different types."
 119
 120         static member ofArray arr = System.ArraySegment(arr) |> Vector
 121         static member toArray = function
 122             | List(lst) -> Array.ofList lst
 123             | Vector(seg) -> Array.sub seg.Array seg.Offset seg.Count
 124             | node -> [| node |]
 125         static member length = function
 126             | List(lst) -> List.length lst
 127             | Vector(seg) -> seg.Count
 128             | Map(m) -> m.Count
 129             | _ -> 1
 130
 131     and Env = System.Collections.Generic.Dictionary<string, Node>
 132     and EnvChain = Env list
 133
 134     let TRUE = Bool(true)
 135     let SomeTRUE = Some(TRUE)
 136     let FALSE = Bool(false)
 137     let SomeFALSE = Some(FALSE)
 138     let NIL = Nil
 139     let SomeNIL = Some(NIL)
 140     let ZERO = Number(0L)
 141
 142     (* Active Patterns to help with pattern matching nodes *)
 143     let (|Elements|_|) num node =
 144         let rec accumList acc idx lst =
 145             let len = Array.length acc
 146             match lst with
 147             | [] when idx = len -> Some(Elements acc)
 148             | h::t when idx < len ->
 149                 acc.[idx] <- h
 150                 accumList acc (idx + 1) t
 151             | _ -> None
 152         match node with
 153         | List(lst) -> accumList (Array.zeroCreate num) 0 lst
 154         | Vector(seg) when seg.Count = num -> Some(Node.toArray node)
 155         | _ -> None
 156
 157     let (|Head|_|) = function
 158         | List(h::t) -> Some(Head(h, List(t)))
 159         | Vector(seg) when seg.Count > 0 ->
 160             let h = seg.Array.[seg.Offset]
 161             let t = System.ArraySegment(seg.Array, seg.Offset + 1, seg.Count - 1)
 162                     |> Vector
 163             Some(Head(h, t))
 164         | _ -> None
 165
 166     let (|Empty|_|) = function
 167         | List([]) -> Some(Empty)
 168         | Vector(seg) when seg.Count = 0 -> Some(Empty)
 169         | _ -> None