shithub: martian9

ref: ae95184e6aa4685bbd13ed4b58df2fcc3e1f625c
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
    | Comment
    (* | Pair of t with_meta * t list *)
    | Proc of (t list -> t) with_meta
    | Symbol of string with_meta
    | Bytevector of t list
    | Eof_object
    | 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

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) }