From 81c349c70a8cf0a026025d3c5d27ff3f66ce9914 Mon Sep 17 00:00:00 2001 From: haxala1r Date: Wed, 12 Nov 2025 23:32:54 +0300 Subject: [PATCH] Added pretty-printing. --- bin/main.ml | 2 +- lib/ast.ml | 23 ++++++++++++++- lib/interpreterStdlib.ml | 61 +++++++++++++++++----------------------- 3 files changed, 49 insertions(+), 37 deletions(-) diff --git a/bin/main.ml b/bin/main.ml index 26b1554..043065d 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -16,7 +16,7 @@ let rec repl env c = try let vals = (parse_str l) in (* dbg_print_all vals; *) - dbg_print_all (eval_all env vals); + pretty_print_all (eval_all env vals); Out_channel.flush Out_channel.stdout; repl env c with diff --git a/lib/ast.ml b/lib/ast.ml index 579084d..e781c6a 100644 --- a/lib/ast.ml +++ b/lib/ast.ml @@ -73,7 +73,7 @@ and dbg_print_one v = | LInt x -> pf "" x | LSymbol s -> pf "" s | LString s -> pf "" s - | LNil -> pf "()" + | LNil -> pf "" | LCons _ -> pf "" (dbg_print_list v) | LDouble d -> pf "" d | LBuiltinSpecial (name, _) @@ -89,6 +89,27 @@ and dbg_print_one v = | LQuoted v -> pf "" (dbg_print_one v) (*| _ -> ""*) +let rec pretty_print_one v = + let pf = Printf.sprintf in + match v with + | LInt x -> pf "%d" x + | LSymbol s -> pf "%s" s + | LString s -> pf "\"%s\"" s + | LNil -> pf "()" + | LCons (a, b) -> pf "(%s)" (dbg_print_list (LCons (a,b))) + | LDouble d -> pf "%f" d + | LQuoted v -> pf "'%s" (pretty_print_one v) + | LBuiltinSpecial _ + | LBuiltinFunction _ + | LLambda _ + | LFunction _ + | LUnnamedMacro _ + | LMacro _ -> dbg_print_one v + +let pretty_print_all vs = + let pr v = Printf.printf "%s\n" (pretty_print_one v) in + List.iter pr vs + let dbg_print_all vs = let pr v = Printf.printf "%s\n" (dbg_print_one v) in List.iter pr vs diff --git a/lib/interpreterStdlib.ml b/lib/interpreterStdlib.ml index 8f88b13..6f00749 100644 --- a/lib/interpreterStdlib.ml +++ b/lib/interpreterStdlib.ml @@ -59,20 +59,28 @@ let cons _ a b = LCons (a, b) let lisp_list _ vs = vs (* builtin function that updates an existing binding *) -let lisp_set env = function - | LCons (LSymbol s, LCons (v, LNil)) -> - Env.update env s v; - v - | _ -> invalid_arg "invalid args to set" - +let lisp_set env sym v = + match sym with + | LSymbol s -> Env.update env s v; v + | _ -> invalid_arg ("cannot set non-symbol " ^ dbg_print_one sym) let lambda env = function | LCons (l, body) -> LLambda (env, l, body) - | _ -> raise (Invalid_argument "invalid args to lambda!") + | args -> invalid_arg ("invalid args to fn! " ^ (dbg_print_one args)) +let defn env = function + | LCons (LSymbol s, LCons (l, body)) -> + let f = LFunction (s, env, l, body) in + Env.set_global env s f; f + | args -> invalid_arg ("cannot define function! " ^ (dbg_print_one args)) let lambda_macro env = function | LCons (l, body) -> LUnnamedMacro (env, l, body) - | _ -> invalid_arg "invalid args to lambda-macro";; + | args -> invalid_arg ("invalid args to fn-macro! " ^ (dbg_print_one args)) +let defmacro env = function + | LCons (LSymbol s, LCons (l, body)) -> + let f = LMacro (s, env, l, body) in + Env.set_global env s f; f + | args -> invalid_arg ("cannot define macro! " ^ (dbg_print_one args)) let lisp_not _ = function @@ -83,7 +91,7 @@ let lisp_not _ = function let bind_local env = function | LCons (LSymbol s, LCons (v, body)) -> let e = Env.new_lexical env in - Env.set_local e s v; + Env.set_local e s (Eval.eval_one env v); Eval.eval_body e body | _ -> invalid_arg "invalid argument to bind-local" @@ -107,7 +115,6 @@ let lisp_if env = function | _ -> invalid_arg "invalid argument list passed to if!" - open Env;; @@ -139,21 +146,24 @@ let sp2 s f = let add_builtins bs = List.iter (fun (s, f) -> set_default s f) bs - -let init_script = " +(* (def defn (fn-macro (name lm . body) (list 'def name (cons 'fn (cons lm body))))) (def defmacro (fn-macro (name lm . body) (list 'def name (cons 'fn-macro (cons lm body))))) + *) +let init_script = +" (defmacro setq (sym val) (list 'set (list 'quote sym) val)) (defmacro letfn (sym fun . body) (cons 'let-one (cons sym (cons '() (cons (list 'setq sym fun) body))))) - +(defn mapcar (f l) + (if l)) (defn filter (f l) (letfn helper (fn (l acc) @@ -162,27 +172,6 @@ let init_script = " ";; let init_default_env () = - (* - add_builtin "+" add; - add_builtin "-" sub; - add_builtin "*" mul; - add_builtin "/" div; - add_builtin "car" car; - add_builtin "cdr" cdr; - add_builtin "rem" rem; - add_builtin "cons" cons; - add_special "def" lisp_define; - add_builtin "set" lisp_set; - add_builtin "list" lisp_list; - add_special "fn" lambda; - add_special "fn-macro" lambda_macro; - add_special "let-one" bind_local; - add_special "quote" (fun _ -> function - | LCons (x, LNil) -> x - | _ -> invalid_arg "hmm"); - add_special "if" lisp_if; - add_builtin "nil?" lisp_not; - add_builtin "not" lisp_not; (* Yes, these are the same thing *) *) add_builtins [ bf "+" add; bf "-" sub; bf "*" mul; bf "/" div; @@ -190,13 +179,15 @@ let init_default_env () = bf1 "cdr" cdr; bf2 "cons" cons; bf "rem" rem; - bf "set" lisp_set; + bf2 "set" lisp_set; bf "list" lisp_list; bf "nil?" lisp_not; bf "not" lisp_not; sp "fn" lambda; + sp "defn" defn; sp "fn-macro" lambda_macro; + sp "defmacro" defmacro; sp "let-one" bind_local; sp "def" lisp_define; sp1 "quote" (fun _ x -> x);