ref: 778e0a846e76d2118f2917637eef1b7580331727
parent: 7b3f26f19c9862d8b79db7ab06cd9b545595b824
author: smazga <[email protected]>
date: Wed Aug 5 07:35:16 EDT 2020
about to start step2
--- /dev/null
+++ b/printer.ml
@@ -1,0 +1,33 @@
+module T = Types.Types
+
+let meta obj =
+ match obj with
+ | T.List { T.meta } -> meta+ | T.Proc { T.meta } -> meta+ | T.Symbol { T.meta } -> meta+ | T.Vector { T.meta } -> meta+ | T.Record { T.meta } -> meta+ | _ -> T.Nil
+
+let rec print obj readable =
+ let r = readable in
+ match obj with
+ | T.Bool true -> "#t"
+ | T.Bool false -> "#f"
+ | T.Char c -> Char.escaped c
+ | T.Nil -> "nil"
+ | T.Comment -> "" (* TODO: this leaves a space in the output for block comments *)
+ (* | T.Pair { T.value = one, two } -> "(" ^ one ^ " . " ^ two ^ ")" *)+ | T.Pair (p, q) -> "<pair unsupported>"
+ | T.Proc p -> "#<proc>"
+ | T.Symbol {T.value = s} -> s+ | T.Bytevector bv -> "<bytevector unsupported>"
+ | T.Eof_object -> "<eof>"
+ | T.Number n -> string_of_int n
+ | T.Port p -> "<port unsupported>"
+ | T.String s -> s (* need to handle escaping and stuff *)
+ | T.List { T.value = xs } ->+ "(" ^ (String.concat " " (List.map (fun s -> print s r) xs)) ^ ")"+ | T.Vector {T.value = v} -> "#(" ^ (String.concat " " (List.map (fun s -> print s r) v)) ^ ")"+ | T.Record r -> "<record supported>"
+
--- /dev/null
+++ b/types.ml
@@ -1,0 +1,43 @@
+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 int (* needs to handle more than one type *)
+ | 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 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 }