python: remove extraneous macroexpand call.
[jackhill/mal.git] / ocaml / types.ml
dissimilarity index 100%
index 60d3725..45d10bd 100644 (file)
@@ -1,9 +1,69 @@
-type mal_type =
-  | MalList of mal_type list
-  | Int of int
-  | Symbol of string
-  | Keyword of string
-  | Nil
-  | Bool of bool
-  | String of string
-  | Fn of (mal_type list -> mal_type)
+module rec Types
+  : sig
+  type 'a with_meta = { value : 'a; meta : t }
+  and t =
+    | List of t list with_meta
+    | Vector of t list with_meta
+    | Map of t MalMap.t with_meta
+    | Int of int
+    | Symbol of string with_meta
+    | Keyword of string
+    | Nil
+    | Bool of bool
+    | String of string
+    | Fn of (t list -> t) with_meta
+    | Atom of t ref
+  end = Types
+
+and MalValue
+  : sig
+    type t = Types.t
+    val compare : t -> t -> int
+  end
+  = struct
+    type t = Types.t
+    let compare = Pervasives.compare
+  end
+
+and MalMap
+  : Map.S with type key = MalValue.t
+  = Map.Make(MalValue)
+
+exception MalExn of Types.t
+
+let to_bool x = match x with
+  | Types.Nil | Types.Bool false -> false
+  | _ -> true
+
+type mal_type = MalValue.t
+
+let list   x = Types.List   { Types.value = x; meta = Types.Nil }
+let map    x = Types.Map    { Types.value = x; meta = Types.Nil }
+let vector x = Types.Vector { Types.value = x; meta = Types.Nil }
+let symbol x = Types.Symbol { Types.value = x; meta = Types.Nil }
+let fn     f = Types.Fn     { Types.value = f; meta = Types.Nil }
+
+let rec list_into_map target source =
+  match source with
+    | k :: v :: more -> list_into_map (MalMap.add k v target) more
+    | [] -> map target
+    | _ :: [] -> raise (Invalid_argument "Literal maps must contain an even number of forms")
+
+let rec mal_list_equal a b =
+  List.length a = List.length b && List.for_all2 mal_equal a b
+
+and mal_hash_equal a b =
+  if MalMap.cardinal a = MalMap.cardinal b
+  then
+    let identical_to_b k v = MalMap.mem k b && mal_equal v (MalMap.find k b) in
+    MalMap.for_all identical_to_b a
+  else false
+
+and mal_equal a b =
+  match (a, b) with
+    | (Types.List a, Types.List b)
+    | (Types.List a, Types.Vector b)
+    | (Types.Vector a, Types.List b)
+    | (Types.Vector a, Types.Vector b) -> mal_list_equal a.Types.value b.Types.value
+    | (Types.Map a, Types.Map b) -> mal_hash_equal a.Types.value b.Types.value
+    | _ -> a = b