Fix metacircular bugs

bin/main.ml

@@ -16,31 +16,30 @@
 (* along with this program.  If not, see <https://www.gnu.org/licenses/>.   *)
 (****************************************************************************)
 
-open Mlisp.Stream
+open Mlisp.Reader
 open Mlisp.Eval
 open Mlisp.Environment
 open Mlisp.Ast
-open Mlisp.Types.Stream
+open Mlisp.Types.Reader
 
 let get_input_channel () =
   try open_in Sys.argv.(1) with
   | Invalid_argument _ -> stdin
 ;;
 
 let rec repl a_stream env =
-  if a_stream.chan = stdin
+  if a_stream.stdin
   then (
     print_string "> ";
     flush stdout);
   let ast = build_ast (read_sexpr a_stream) in
   let result, env' = eval ast env in
-  if a_stream.chan = stdin then print_endline (string_object result);
+  if a_stream.stdin then print_endline (string_object result);
   repl a_stream env'
 ;;
 
 let () =
   let input_channel = get_input_channel () in
-  let a_stream = { chrs = []; line_num = 1; chan = input_channel } in
-  try repl a_stream basis with
-  | End_of_file -> if input_channel <> stdin then close_in input_channel
+  try repl (make_filestream input_channel) basis with
+  | Stream.Failure -> if input_channel <> stdin then close_in input_channel
 ;;

lib/ast.ml

@@ -42,16 +42,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 "lambda"; ns; e ] when Object.is_list ns ->
+    | [ Symbol "lambda"; args; body ] when Object.is_list args ->
       let names =
         List.map
           (function
             | Symbol symbol -> symbol
             | _ -> raise (Type_error_exn "(lambda (formals) body)"))
-          (Object.pair_to_list ns)
+          (Object.pair_to_list args)
       in
       let () = assert_unique names in
-      Lambda (names, build_ast e)
+      Lambda (names, build_ast body)
     | [ Symbol "defun"; Symbol name; args; expr ] ->
       let names =
         List.map

lib/dune

@@ -1,6 +1,7 @@
 (library
  (name mlisp)
- (modes byte native))
+ (modes byte native)
+ (libraries camlp-streams))
 
 (env
  (dev

lib/eval.ml

@@ -33,6 +33,7 @@ let rec unzip l =
 
 let rec eval_expr expr env =
   let rec eval = function
+    | Literal (Quote expr) -> expr
     | Literal l -> l
     | Var n -> Environment.lookup (n, env)
     | If (cond, if_true, _) when eval cond = Boolean true -> eval if_true
@@ -83,16 +84,16 @@ let eval_def def env =
   | Setq (name, expr) ->
     let v = eval_expr expr env in
     v, Environment.bind (name, v, env)
-  | Defun (n, ns, e) ->
-    let formals, body, cl_env =
-      match eval_expr (Lambda (ns, e)) env with
+  | Defun (name, args, body) ->
+    let formals, body', cl_env =
+      match eval_expr (Lambda (args, body)) env with
       | Closure (fs, bod, env) -> fs, bod, env
       | _ -> raise (Type_error_exn "Expecting closure.")
     in
     let loc = Environment.make_local () in
-    let clo = Closure (formals, body, Environment.bind_local (n, loc, cl_env)) in
+    let clo = Closure (formals, body', Environment.bind_local (name, loc, cl_env)) in
     let () = loc := Some clo in
-    clo, Environment.bind_local (n, loc, env)
+    clo, Environment.bind_local (name, loc, env)
   | Expr e -> eval_expr e env, env
 ;;
 

lib/types.ml

@@ -65,12 +65,13 @@ module Ast = struct
   exception Unique_error_exn of string
 end
 
-module Stream = struct
+module Reader = struct
   exception Syntax_error_exn of string
 
-  type stream =
+  type 'a stream =
     { mutable line_num : int
     ; mutable chrs : char list
-    ; chan : in_channel
+    ; stm : 'a Stream.t
+    ; stdin : bool
     }
 end

test/dune

@@ -1,4 +1,4 @@
 (test
  (name mlisp)
  (flags (:standard -w -32))
- (libraries mlisp alcotest))
+ (libraries mlisp))