diff --git a/bin/dune b/bin/dune index 920ba34..6d8e558 100644 --- a/bin/dune +++ b/bin/dune @@ -6,6 +6,8 @@ (env (dev - (flags (:standard -w +42))) + (flags + (:standard -w +42))) (release - (ocamlopt_flags (:standard -O3)))) + (ocamlopt_flags + (:standard -O3)))) diff --git a/bin/main.ml b/bin/main.ml index 86c0007..c53417b 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -27,8 +27,7 @@ let () = let input_channel = get_input_channel () in let stream = if input_channel = stdin then ( - print_endline - "MLisp v0.1.5 (main, 2023-01-02 8:47 PM) [OCaml 5.0.0]\n"; + print_endline "MLisp v0.1.6 (main, 2023-01-02 9:19 PM) [OCaml 5.0.0]\n"; make_filestream input_channel) else make_filestream input_channel ~file_name:Sys.argv.(1) in diff --git a/lib/ast.ml b/lib/ast.ml index e4dffcf..bd2dffd 100644 --- a/lib/ast.ml +++ b/lib/ast.ml @@ -82,10 +82,11 @@ and if_expr cond if_true if_false = and record_expr name fields = Defexpr (Defrecord (name, assert_unique_args fields)) -and lambda_expr args body = Lambda (assert_unique_args args, build_ast body) +and lambda_expr args body = + Lambda ("lambda", assert_unique_args args, build_ast body) and defun_expr fn_name args body = - let lam = Lambda (assert_unique_args args, build_ast body) in + let lam = Lambda (fn_name, assert_unique_args args, build_ast body) in Defexpr (Setq (fn_name, Let (LETREC, [ (fn_name, lam) ], Var fn_name))) and apply_expr fn_expr args = Apply (build_ast fn_expr, build_ast args) @@ -121,7 +122,7 @@ let rec string_expr = | Call (f, es) -> if List.length es == 0 then "(" ^ string_expr f ^ spacesep_exp es ^ ")" else "(" ^ string_expr f ^ " " ^ spacesep_exp es ^ ")" - | Lambda (args, body) -> + | Lambda (_, args, body) -> "(lambda (" ^ Utils.spacesep args ^ ") " ^ string_expr body ^ ")" | Defexpr (Setq (n, e)) -> "(setq " ^ n ^ " " ^ string_expr e ^ ")" | Defexpr (Defun (n, ns, e)) -> diff --git a/lib/eval.ml b/lib/eval.ml index 808d44f..f4a4500 100644 --- a/lib/eval.ml +++ b/lib/eval.ml @@ -52,7 +52,7 @@ let rec eval_expr expr env = eval_apply (eval fn) (Object.pair_to_list (eval args)) env | Call (Var "env", []) -> Environment.env_to_val env | Call (fn, args) -> eval_apply (eval fn) (List.map eval args) env - | Lambda (args, body) -> Closure (args, body, env) + | Lambda (name, args, body) -> Closure (name, args, body, env) | Let (LET, bindings, body) -> let eval_binding (n, e) = (n, ref (Some (eval e))) in eval_expr body (extend (List.map eval_binding bindings) env) @@ -81,7 +81,7 @@ let rec eval_expr expr env = and eval_apply fn_expr args env = match fn_expr with | Primitive (_, fn) -> fn args - | Closure (names, expr, clenv) -> eval_closure names expr args clenv env + | Closure (_, names, expr, clenv) -> eval_closure names expr args clenv env | _ -> raise (Parse_error_exn (Type_error "(apply prim '(args)) or (prim args)")) @@ -95,13 +95,14 @@ and eval_def def env = (v, Environment.bind (name, v, env)) | Defun (name, args, body) -> let formals, body', cl_env = - match eval_expr (Lambda (args, body)) env with - | Closure (fs, bod, env) -> (fs, bod, env) + match eval_expr (Lambda (name, args, body)) env with + | Closure (_, fs, bod, env) -> (fs, bod, env) | _ -> raise (Parse_error_exn (Type_error "Expecting closure.")) in let loc = Environment.make_local () in let clo = - Closure (formals, body', Environment.bind_local (name, loc, cl_env)) + Closure + (name, formals, body', Environment.bind_local (name, loc, cl_env)) in let () = loc := Some clo in (clo, Environment.bind_local (name, loc, env)) diff --git a/lib/object.ml b/lib/object.ml index c2bc49c..bd55820 100644 --- a/lib/object.ml +++ b/lib/object.ml @@ -90,8 +90,8 @@ let rec string_object e = | Pair _ -> "(" ^ (if is_list e then string_list e else string_pair e) ^ ")\n" | Primitive (name, _) -> "#" | Quote expr -> "'" ^ string_object expr - | Closure (name_list, _, _) -> - "#" + | Closure (name, name_list, _, _) -> + "#<" ^ name ^ ":(" ^ String.concat " " name_list ^ ")>" | Record (name, fields) -> let fields_string = let to_string field = object_type field ^ " : " ^ string_object field in diff --git a/lib/reader.ml b/lib/reader.ml index ff5ea6d..8114743 100644 --- a/lib/reader.ml +++ b/lib/reader.ml @@ -50,39 +50,34 @@ let read_char stream = ch let unread_char stream ch = stream.chrs <- ch :: stream.chrs -let is_whitespace ch = match ch with ' ' | '\t' | '\n' -> true | _ -> false let rec eat_whitespace stream = let ch = read_char stream in - if is_whitespace ch then eat_whitespace stream else unread_char stream ch + if Core.Char.is_whitespace ch then eat_whitespace stream + else unread_char stream ch let rec eat_comment stream = if read_char stream = '\n' then () else eat_comment stream -let is_digit ch = - let code = Char.code ch in - code >= Char.code '0' && code <= Char.code '9' - let read_fixnum stream acc = let rec loop acc = let num_char = read_char stream in - if is_digit num_char then num_char |> Char.escaped |> ( ^ ) acc |> loop + if Core.Char.is_digit num_char then + num_char |> Char.escaped |> ( ^ ) acc |> loop else let _ = unread_char stream num_char in Fixnum (int_of_string acc) in loop acc -let is_symbol_start_char = - let is_alpha = function 'A' .. 'Z' | 'a' .. 'z' -> true | _ -> false in - function +let is_symbol_start_char = function | '*' | '/' | '>' | '<' | '=' | '?' | '!' | '-' | '+' -> true - | ch -> is_alpha ch + | ch -> Core.Char.is_alpha ch let rec read_symbol stream = let is_delimiter = function | '(' | ')' | '{' | '}' | ';' -> true - | ch -> is_whitespace ch + | ch -> Core.Char.is_whitespace ch in let next_char = read_char stream in if is_delimiter next_char then @@ -115,7 +110,7 @@ let rec read_sexpr stream = read_sexpr stream) else if is_symbol_start_char ch then Symbol (Object.string_of_char ch ^ read_symbol stream) - else if is_digit ch || Char.equal ch '~' then + else if Core.Char.is_digit ch || Char.equal ch '~' then (if Char.equal '~' ch then '-' else ch) |> Char.escaped |> read_fixnum stream else if Char.equal ch '(' then read_list stream diff --git a/lib/stdlib.ml b/lib/stdlib.ml index f64ab9d..f8ccb0d 100644 --- a/lib/stdlib.ml +++ b/lib/stdlib.ml @@ -31,4 +31,4 @@ let rec slurp stm env = let stdlib = let stm = Reader.make_stringstream Mlisp_stdlib.Stdlib.stdlib_string in - slurp stm Environment.basis \ No newline at end of file + slurp stm Environment.basis diff --git a/lib/stdlib/dune b/lib/stdlib/dune index e16f469..8872956 100644 --- a/lib/stdlib/dune +++ b/lib/stdlib/dune @@ -1,3 +1,3 @@ (library (name mlisp_stdlib) - (libraries core)) \ No newline at end of file + (libraries core)) diff --git a/lib/stdlib/stdlib.ml b/lib/stdlib/stdlib.ml index c8ae47b..a5f8a47 100644 --- a/lib/stdlib/stdlib.ml +++ b/lib/stdlib/stdlib.ml @@ -187,4 +187,4 @@ let stdlib_string = \ (half (/ size 2))\n\ \ (first (take half ls))\n\ \ (second (drop half ls)))\n\ - \ (merge (mergesort first) (mergesort second))))))\n\n" \ No newline at end of file + \ (merge (mergesort first) (mergesort second))))))\n\n" diff --git a/lib/types.ml b/lib/types.ml index 22700e1..bfbc115 100644 --- a/lib/types.ml +++ b/lib/types.ml @@ -33,7 +33,7 @@ module Object = struct | Record of name * lobject list | Primitive of string * (lobject list -> lobject) | Quote of value - | Closure of name list * expr * value Environment.env + | Closure of name * name list * expr * value Environment.env and value = lobject and name = string @@ -49,7 +49,7 @@ module Object = struct | Call of expr * expr list | Defexpr of def | Consexpr of cons - | Lambda of name list * expr + | Lambda of name * name list * expr | Let of let_kind * (name * expr) list * expr and def = diff --git a/lib/utils.ml b/lib/utils.ml index 1b8d93f..cd9abd0 100644 --- a/lib/utils.ml +++ b/lib/utils.ml @@ -31,4 +31,4 @@ let read_lines filename = close_in chan; List.rev !lines -let spacesep ns = String.concat " " ns \ No newline at end of file +let spacesep ns = String.concat " " ns diff --git a/test/05_mutually_recursive_functions.mlisp b/test/05_mutually_recursive_functions.mlisp index ae51a03..1e71084 100644 --- a/test/05_mutually_recursive_functions.mlisp +++ b/test/05_mutually_recursive_functions.mlisp @@ -26,4 +26,4 @@ 3 (f (- x 2)))) -(println (f 10)) +(f 10) \ No newline at end of file diff --git a/test/dune b/test/dune index 20acb3f..ad75236 100644 --- a/test/dune +++ b/test/dune @@ -1,4 +1,5 @@ (test (name mlisp) - (flags (:standard -w -32)) + (flags + (:standard -w -32)) (libraries mlisp)) diff --git a/test/mlisp.ml b/test/mlisp.ml index 30ca6fd..8276bda 100644 --- a/test/mlisp.ml +++ b/test/mlisp.ml @@ -23,21 +23,16 @@ let is_mlisp_file file_name = match String.split_on_char '.' file_name with | _ :: [ "mlisp" ] -> true | _ -> false -;; let test_mlisp_file file_name = Sys.command (exec_path ^ " " ^ test_path ^ file_name) |> ignore -;; let test_files = - test_path - |> Sys.readdir + test_path |> Sys.readdir |> Array.iter (fun file_name -> - if is_mlisp_file file_name - then ( + if is_mlisp_file file_name then ( flush_all (); Printf.printf "Test %s ..." file_name; test_mlisp_file file_name; print_endline "done!") else ()) -;;