shithub: martian9

ref: 465362387ca57cd00f2b4be4f4a9c75b6c15d793
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"
let macro_variants = Types.String "variants"

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 variants =
  let meta = ref M9map.empty in
  meta :=
    M9map.add macro_literals literals !meta
    |> M9map.add macro_transformers transformers
    |> M9map.add macro_variants (map variants) ;
  Types.Macro {Types.value= sym; meta= map !meta}