ocaml/types.ml

   1 module rec Types
   2   : sig
   3   type 'a with_meta = { value : 'a; meta : t }
   4   and t =
   5     | List of t list with_meta
   6     | Vector of t list with_meta
   7     | Map of t MalMap.t with_meta
   8     | Int of int
   9     | Symbol of string with_meta
  10     | Keyword of string
  11     | Nil
  12     | Bool of bool
  13     | String of string
  14     | Fn of (t list -> t) with_meta
  15     | Atom of t ref
  16   end = Types
  17
  18 and MalValue
  19   : sig
  20     type t = Types.t
  21     val compare : t -> t -> int
  22   end
  23   = struct
  24     type t = Types.t
  25     let compare = Pervasives.compare
  26   end
  27
  28 and MalMap
  29   : Map.S with type key = MalValue.t
  30   = Map.Make(MalValue)
  31
  32 exception MalExn of Types.t
  33
  34 let to_bool x = match x with
  35   | Types.Nil | Types.Bool false -> false
  36   | _ -> true
  37
  38 type mal_type = MalValue.t
  39
  40 let list   x = Types.List   { Types.value = x; meta = Types.Nil }
  41 let map    x = Types.Map    { Types.value = x; meta = Types.Nil }
  42 let vector x = Types.Vector { Types.value = x; meta = Types.Nil }
  43 let symbol x = Types.Symbol { Types.value = x; meta = Types.Nil }
  44 let fn     f = Types.Fn     { Types.value = f; meta = Types.Nil }
  45
  46 let rec list_into_map target source =
  47   match source with
  48     | k :: v :: more -> list_into_map (MalMap.add k v target) more
  49     | [] -> map target
  50     | _ :: [] -> raise (Invalid_argument "Literal maps must contain an even number of forms")
  51
  52 let rec mal_list_equal a b =
  53   List.length a = List.length b && List.for_all2 mal_equal a b
  54
  55 and mal_hash_equal a b =
  56   if MalMap.cardinal a = MalMap.cardinal b
  57   then
  58     let identical_to_b k v = MalMap.mem k b && mal_equal v (MalMap.find k b) in
  59     MalMap.for_all identical_to_b a
  60   else false
  61
  62 and mal_equal a b =
  63   match (a, b) with
  64     | (Types.List a, Types.List b)
  65     | (Types.List a, Types.Vector b)
  66     | (Types.Vector a, Types.List b)
  67     | (Types.Vector a, Types.Vector b) -> mal_list_equal a.Types.value b.Types.value
  68     | (Types.Map a, Types.Map b) -> mal_hash_equal a.Types.value b.Types.value
  69     | _ -> a = b