try to support record, Enhanced REPL

lib/ast.ml

@@ -32,7 +32,7 @@ let to_kind s = List.assoc s let_kinds
 let rec build_ast sexpr =
   match sexpr with
   | Primitive _ | Closure _ -> raise This_can't_happen_exn
-  | Fixnum _ | Boolean _ | Quote _ | String _ | Nil -> Literal sexpr
+  | Fixnum _ | Boolean _ | Quote _ | String _ | Record _ | Nil -> Literal sexpr
   | Symbol symbol -> Var symbol
   | Pair _ when Object.is_list sexpr ->
     (match Object.pair_to_list sexpr with
@@ -43,6 +43,16 @@ let rec build_ast sexpr =
     | [ Symbol "or"; cond_x; cond_y ] -> Or (build_ast cond_x, build_ast cond_y)
     | [ Symbol "quote"; expr ] -> Literal (Quote expr)
     | [ Symbol "setq"; Symbol name; expr ] -> Defexpr (Setq (name, build_ast expr))
+    | [ Symbol "record"; Symbol name; field_list ] ->
+      let names =
+        List.map
+          (function
+            | Symbol s -> s
+            | _ -> raise (Parse_error_exn (Type_error "(record name (fields)")))
+          (Object.pair_to_list field_list)
+      in
+      let () = assert_unique names in
+      Defexpr (Defrecord (name, names))
     | [ Symbol "lambda"; args; body ] when Object.is_list args ->
       let names =
         List.map

lib/eval.ml

@@ -80,7 +80,7 @@ and eval_closure names expr args clenv env =
   eval_expr expr (extend (Environment.bind_list names args clenv) env)
 ;;
 
-let eval_def def env =
+let rec eval_def def env =
   match def with
   | Setq (name, expr) ->
     let v = eval_expr expr env in
@@ -95,6 +95,16 @@ let eval_def def env =
     let clo = Closure (formals, body', Environment.bind_local (name, loc, cl_env)) in
     let () = loc := Some clo in
     clo, Environment.bind_local (name, loc, env)
+  | Defrecord (name, name_list) ->
+    eval_def
+      (Defun
+         ( name
+         , name_list
+         , Literal
+             (Record
+                (name, List.map (fun name -> Environment.lookup (name, env)) name_list))
+         ))
+      env
   | Expr e -> eval_expr e env, env
 ;;
 

lib/object.ml

@@ -84,6 +84,8 @@ let rec string_expr =
   | Defexpr (Defun (n, ns, e)) ->
     "(defun " ^ n ^ "(" ^ spacesep ns ^ ") " ^ string_expr e ^ ")"
   | Defexpr (Expr e) -> string_expr e
+  | Defexpr (Defrecord (name, field_list)) ->
+    "(record " ^ name ^ spacesep field_list ^ ")"
   | Let (kind, bs, e) ->
     let str =
       match kind with
@@ -112,10 +114,16 @@ and string_object e =
   | String s -> "\"" ^ s ^ "\""
   | Symbol s -> s
   | Nil -> "nil"
-  | Pair (_, _) -> "(" ^ (if is_list e then string_list e else string_pair e) ^ ")"
+  | Pair _ -> "(" ^ (if is_list e then string_list e else string_pair e) ^ ")"
   | Primitive (name, _) -> "#<primitive:" ^ name ^ ">"
   | Quote expr -> "'" ^ string_object expr
-  | Closure (_, _, _) -> "#<closure>"
+  | Closure (name_list, _, _) -> "#<closure:(" ^ String.concat " " name_list ^ ")>"
+  | Record (name, field_list) ->
+    "#<record:"
+    ^ name
+    ^ "("
+    ^ String.concat " " (List.map string_object field_list)
+    ^ ")>"
 ;;
 
 let object_type = function
@@ -128,4 +136,5 @@ let object_type = function
   | Primitive _ -> "primitive"
   | Quote _ -> "quote"
   | Closure _ -> "closure"
+  | Record _ -> "record"
 ;;

lib/types.ml

@@ -30,6 +30,7 @@ module Object = struct
     | String of string
     | Nil
     | Pair of lobject * lobject
+    | Record of name * lobject list
     | Primitive of string * (lobject list -> lobject)
     | Quote of value
     | Closure of name list * expr * value Environment.env
@@ -57,7 +58,10 @@ module Object = struct
   and def =
     | Setq of name * expr
     | Defun of name * name list * expr
+    | Defrecord of name * name list
     | Expr of expr
+
+  and cons = Consrecord of name * value list
 end
 
 module Ast = struct

test/05_mutually_recursive_functions.mlisp

@@ -25,5 +25,5 @@
   (if (< x 2)
       3
       (f (- x 2))))
-  
-(println (f 10))
+
+(println (f 10))