shithub: martian9

ref: 02e52de48838943242250b85d2bf23c97755111f
dir: /types.ml/

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 M9map.t with_meta
    | Bool of bool
    | Char of char
    | Nil
    | Unspecified
    | Eof_object
    (* | Pair of t with_meta * t list *)
    | Proc of (t list -> t) with_meta
    | Symbol of string with_meta
    | Macro of t with_meta
    | Bytevector of t list
    | Number of float with_meta
    | Port of bool (* not sure how to represent this *)
    | String of string
    | Record of t with_meta
end =
  Types

and Value : sig
  type t = Types.t

  val compare : t -> t -> int
end = struct
  type t = Types.t

  let compare = Stdlib.compare
end

and M9map : (Map.S with type key = Value.t) = Map.Make (Value)

let to_bool x =
  match x with
  | Types.Nil | Types.Bool false -> false
  | _ -> true
;;

type m9type = Value.t

let macro_literals = Types.String "literals"
let macro_transformers = Types.String "transformers"

exception M9exn of Types.t

let to_bool x =
  match x with
  | Types.Nil | Types.Bool false -> false
  | _ -> true
;;

let is_float v =
  let c = classify_float (fst (Float.modf v)) in
  c != FP_zero
;;

let list x = Types.List { Types.value = x; meta = Types.Nil }
let map x = Types.Map { Types.value = x; meta = Types.Nil }

(* let pair x xs = Types.Pair ({ Types.value = x; meta = Types.Nil }, Types.List { Types.value = xs; meta = Types.Nil }) *)
let proc x = Types.Proc { Types.value = x; meta = Types.Nil }
let symbol x = Types.Symbol { Types.value = x; meta = Types.Nil }
let vector x = Types.Vector { Types.value = x; meta = Types.Nil }
let record x = Types.Record { Types.value = x; meta = Types.Nil }
let number x = Types.Number { Types.value = x; meta = Types.Bool (is_float x) }

let macro sym literals transformers =
  let meta = ref M9map.empty in
  meta
    := M9map.add macro_literals literals !meta
       |> M9map.add macro_transformers transformers;
  Types.Macro { Types.value = symbol sym; meta = map !meta }
;;