From 45828a8dd45795d8c1c45fb63cb1b165fbd8b8be Mon Sep 17 00:00:00 2001
From: haxala1r <me@emin.engineer>
Date: Thu, 30 Oct 2025 21:01:40 +0300
Subject: [PATCH] reorganized a bit, separated bind-symbol into two operators
 that have different uses, def and set

---
 lib/ast.ml               | 10 +++++++++-
 lib/eval.ml              | 28 +++++++++++++++++-----------
 lib/interpreterStdlib.ml | 21 +++++----------------
 3 files changed, 31 insertions(+), 28 deletions(-)

diff --git a/lib/ast.ml b/lib/ast.ml
index f2a0c2a..7861d88 100644
--- a/lib/ast.ml
+++ b/lib/ast.ml
@@ -27,7 +27,15 @@ and environment = (string, lisp_val) Hashtbl.t list
 let env_set_local env s v =
   match env with
   | [] -> ()
-  | e1 :: _ ->  Hashtbl.replace e1 s v
+  | e1 :: _ -> Hashtbl.replace e1 s v
+
+let rec env_update env s v =
+  match env with
+  | [] -> ()
+  | e1 :: erest ->
+     match Hashtbl.find_opt e1 s with
+     | None -> env_update erest s v
+     | Some _ -> Hashtbl.replace e1 s v
 
 let env_new_lexical env = 
   let h = Hashtbl.create 16 in
diff --git a/lib/eval.ml b/lib/eval.ml
index 251cd29..219faa0 100644
--- a/lib/eval.ml
+++ b/lib/eval.ml
@@ -91,13 +91,21 @@ and eval_call env func args =
                   (Printf.sprintf "eval_apply: cannot call non-function object %s" (dbg_print_one v)))
 
 and (* This only creates a *local* binding, contained to the body given. *)
-  bind_local env =
-  function
+  bind_local env = function
   | LCons (LSymbol s, LCons (v, body)) ->
     let e = env_new_lexical env in
     env_set_local e s v;
     eval_body e body
   | _ -> invalid_arg "invalid argument to bind-local"
+
+(* special form that creates a global binding *)
+and lisp_define env = function
+  | LCons (LSymbol s, LCons (v, LNil)) ->
+     let evaluated = eval_one env v in
+     env_set_global env s evaluated;
+     evaluated
+  | _ -> invalid_arg "invalid args to def"
+
 and lisp_if env = function
   | LCons (cond, LCons (if_true, LNil)) ->
     (match eval_one env cond with
@@ -118,7 +126,8 @@ let () = add_builtin "-" sub
 let () = add_builtin "car" car
 let () = add_builtin "cdr" cdr
 let () = add_builtin "cons" cons
-let () = add_builtin "bind-symbol" bind_symbol 
+let () = add_special "def" lisp_define
+let () = add_builtin "set" lisp_set
 let () = add_builtin "list" lisp_list
 let () = add_special "fn" lambda
 let () = add_special "fn-macro" lambda_macro
@@ -131,14 +140,11 @@ let () = add_special "if" lisp_if
 
 (* I know this looks insane. please trust me. *)
 let _ = eval_all default_env (Read.parse_str "
-(bind-symbol 'defn
+(def defn
   (fn-macro (name lm . body)
-    (list 'bind-symbol (list 'quote name) (cons 'fn (cons lm body)))))
-(bind-symbol 'defmacro
+    (list 'def name (cons 'fn (cons lm body)))))
+(def defmacro
   (fn-macro (name lm . body)
-    (list 'bind-symbol (list 'quote name) (cons 'fn-macro (cons lm body)))))
-(defmacro def
-  (var val)
-  (list 'bind-symbol (list 'quote var) val))
-()")
+    (list 'def name (cons 'fn-macro (cons lm body)))))
+")
 
diff --git a/lib/interpreterStdlib.ml b/lib/interpreterStdlib.ml
index 53c62c0..a490ec5 100644
--- a/lib/interpreterStdlib.ml
+++ b/lib/interpreterStdlib.ml
@@ -47,23 +47,12 @@ let cons _ vs =
 
 let lisp_list _ vs = vs
 
-(* Binds any value to a symbol, in the *global environment*. *)
-let bind_symbol env =
-  function
-  (* Special case for setting a function to a symbol, if the function
-     is a lambda then we turn it into a real "function" by giving it this
-     new name *)
-  | LCons (LQuoted (LSymbol s), LCons (LLambda (e, l, b), LNil))
-  | LCons (LSymbol s, LCons (LLambda (e, l, b), LNil)) ->
-    let f = LFunction (s, e, l, b) in
-    env_set_global env s f;
-    f
-  | LCons (LQuoted (LSymbol s), LCons (v, LNil))
+(* builtin function that updates an existing binding *)
+let lisp_set env = function
   | LCons (LSymbol s, LCons (v, LNil)) ->
-    env_set_global env s v;
-    v
-  | _ -> raise (Invalid_argument "invalid args to set!")
-           
+     env_update env s v;
+     v
+  | _ -> invalid_arg "invalid args to set"
 
 let lambda env = function
   | LCons (l, body) ->