shithub: martian9

ref: 6b925d234d3c62667127dca76b91fea5ec03204e
dir: /types.ml/

module rec Types : sig
  type 'a with_meta =
    { value : 'a
    ; meta : t
    }

  and t =
    | List of t list with_meta
    | Bool of bool
    | Char of char
    | Nil
    | Comment
    | Pair of t * t
    | 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
    | Vector of t list with_meta
    | 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

type m9type = Value.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 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) }