fix typeof, progn, eq, debug printing recursing genv

stages/lisp0/lisp1.asm

@@ -1593,6 +1593,9 @@ align 8, db 0
 
 section .text
 
+;; append variable $rdi pointing to itself to the global env.
+genv_append_identity:
+    mov rsi, rdi
 ;; append variable $rdi with value $rsi to the global env.
 genv_append:
     call cons
@@ -1627,23 +1630,53 @@ cons_atom_prim:
 
 global init_env
 init_env:
-    lea rdi, [rel ATOM_T]
-    mov esi, OBJ_ATOM
-    call obj_set_tag_in_place
-    mov rsi, rdi
-    call cons                   ; (t . t)
+    lea rdi, [rel p_quote]
+    call make_prim
+    mov rsi, rax
+    lea rdi, [rel ATOM_QUOTE]
+    or rdi, OBJ_ATOM
+    call cons
     mov rdi, rax
     lea rsi, [rel nil]
-    call cons                   ; ((t . t) . nil)
+    call cons                   ; (('quote . #p_quote) . nil)
     mov qword [rel env], rax
     mov qword [rel env_tail], rax
 
-    lea rdi, [rel p_quote]
-    call make_prim
-    lea rdi, [rel ATOM_QUOTE]
+    lea rdi, [rel ATOM_T]
     or rdi, OBJ_ATOM
-    mov rsi, rax
-    call genv_append
+    call genv_append_identity   ; env => (('quote . #p_quote) . (('t . 't) . nil))
+
+    lea rdi, [rel ATOM_NIL]
+    or rdi, OBJ_ATOM
+    call genv_append_identity
+
+    lea rdi, [rel ATOM_BYTE]
+    or rdi, OBJ_ATOM
+    call genv_append_identity
+
+    lea rdi, [rel ATOM_NUM]
+    or rdi, OBJ_ATOM
+    call genv_append_identity
+
+    lea rdi, [rel ATOM_PRIM]
+    or rdi, OBJ_ATOM
+    call genv_append_identity
+
+    lea rdi, [rel ATOM_CONS]
+    or rdi, OBJ_ATOM
+    call genv_append_identity
+
+    lea rdi, [rel ATOM_CLOSURE]
+    or rdi, OBJ_ATOM
+    call genv_append_identity
+
+    lea rdi, [rel ATOM_ATOM]
+    or rdi, OBJ_ATOM
+    call genv_append_identity
+
+    lea rdi, [rel ATOM_ARRAY]
+    or rdi, OBJ_ATOM
+    call genv_append_identity
 
     mov rdi, PLUS_STR
     mov esi, PLUS_STR_LEN
@@ -2403,7 +2436,6 @@ p_let_star_inner:
 p_eq:
     sub rsp, 8
     mov qword [rsp], rsi        ; env
-    push rsi
     call eval_list
     mov rsi, qword [rsp]        ; env
     mov qword [rsp], rax        ; evaled_list
@@ -3136,35 +3168,31 @@ p_cons:
     ret
 
 p_progn:
-    sub rsp, 32
-    mov qword [rsp + 8], rsi    ; env
-    call eval_list
-    mov qword [rsp], rax        ; evaled list
-    mov qword [rsp + 16], rax   ; rest
-    lea rdi, [rel nil]
-    mov qword [rsp + 24], rdi   ; init result
-    mov rdi, rax
+    sub rsp, 24
+    mov qword [rsp], rsi        ; env
+    mov qword [rsp + 8], rdi    ; rest
+    lea rax, [rel nil]
+    mov qword [rsp + 16], rax   ; init result
 
 .loop:
+    mov rdi, qword [rsp + 8]    ; rest
     call obj_is_nil
     je .done
 
-    mov rdi, qword [rsp + 24]   ; result
+    mov rdi, qword [rsp + 16]   ; result
     call obj_dec_ref
 
-    mov rdi, qword [rsp + 16]   ; rest
+    mov rdi, qword [rsp + 8]    ; rest
     call car_cdr
-    mov qword [rsp + 16], rdx   ; rest
+    mov qword [rsp + 8], rdx    ; rest
     mov rdi, rax                ; car
-    mov rsi, qword [rsp + 8]    ; env
+    mov rsi, qword [rsp]        ; env
     call eval
-    mov qword [rsp + 24], rax   ; result
+    mov qword [rsp + 16], rax   ; result
     jmp .loop
 .done:
-    mov rdi, qword [rsp]        ; evaled list
-    call obj_dec_ref
-    mov rax, qword [rsp + 24]   ; result
-    add rsp, 32
+    mov rax, qword [rsp + 16]   ; result
+    add rsp, 24
     ret
 
     ;; returns a list of the evaluated arguments
@@ -3242,8 +3270,9 @@ p_typeof:
     lea rdx, [rel ATOM_ARRAY]
     cmp al, OBJ_ARR
     je .done
-    lea rdx, [rel nil]
+    jmp panic_abort
 .done:
+    inc qword [rdx]
     or rdx, OBJ_ATOM
     mov rdi, qword [rsp]        ; evaled list
     mov qword [rsp], rdx        ; result
@@ -3251,6 +3280,3 @@ p_typeof:
     mov rax, qword [rsp]        ; result
     add rsp, 8
     ret
-    
-    
-

stages/lisp0/test.rs

@@ -41,14 +41,59 @@ impl Object {
     fn is_nil(&self) -> bool {
         self.0 as *const () == &raw const NIL
     }
+    fn tag(&self) -> u8 {
+        self.0.addr() as u8 & 0b111
+    }
+    fn bits(&self) -> usize {
+        self.0.addr()
+    }
+    fn ptr(&self) -> *mut () {
+        self.0.map_addr(|addr| addr & !0b111)
+    }
+    fn is_g_env(&self) -> bool {
+        self.0 as *const () == unsafe { *ENV_INIT }.0 as *const ()
+    }
+}
+
+#[derive(Copy, Clone)]
+struct DebugObjectExplicitGenv(Object);
+
+impl std::fmt::Debug for DebugObjectExplicitGenv {
+    fn fmt(&self, f: &mut std::fmt::Formatter<'_>) -> std::fmt::Result {
+        #[repr(C)]
+        struct Cons {
+            refc: u64,
+            car: Object,
+            cdr: Object,
+        }
+
+        if self.0.is_g_env() {
+            let mut proxy = unsafe {
+                Cons {
+                    refc: 1,
+                    car: self.0.ptr().byte_add(8).cast::<Object>().read(),
+                    cdr: self.0.ptr().byte_add(16).cast::<Object>().read(),
+                }
+            };
+            let obj =
+                Object((&raw const proxy as *mut ()).map_addr(|addr| addr | Object::CONS as usize));
+            write!(f, "{:?}", obj)
+        } else {
+            return write!(f, "{:?}", self.0);
+        }
+    }
 }
 
 impl std::fmt::Debug for Object {
     fn fmt(&self, f: &mut std::fmt::Formatter<'_>) -> std::fmt::Result {
-        if self.0 as *const () == &raw const NIL {
+        if self.is_nil() {
             return write!(f, "nil");
         }
 
+        if self.is_g_env() {
+            return write!(f, "#<g_env>");
+        }
+
         fn fmt_byte(byte: *const (), f: &mut std::fmt::Formatter<'_>) -> std::fmt::Result {
             let c = unsafe { byte.cast::<u8>().read() };
             if c.is_ascii_graphic() || c == b' ' {
@@ -95,7 +140,7 @@ impl std::fmt::Debug for Object {
             let (car, env) = unsafe { clos.cast::<(Object, Object)>().read() };
             assert_eq!(
                 car.tag(),
-                1,
+                Object::CONS,
                 "Expected a pair for lambda cdr, got tag {}",
                 car.tag()
             );
@@ -188,18 +233,6 @@ impl std::fmt::Debug for Object {
     }
 }
 
-impl Object {
-    fn tag(&self) -> u8 {
-        self.0.addr() as u8 & 0b111
-    }
-    fn bits(&self) -> usize {
-        self.0.addr()
-    }
-    fn ptr(&self) -> *mut () {
-        self.0.map_addr(|addr| addr & !0b111)
-    }
-}
-
 #[repr(C)]
 struct Source {
     fd: i32,
@@ -249,6 +282,9 @@ unsafe impl std::alloc::Allocator for HeapAlloc {
     }
 }
 
+static mut ENV_INIT: std::cell::LazyCell<Object> =
+    std::cell::LazyCell::new(|| unsafe { init_env() });
+
 #[cfg(test)]
 mod tests {
     use super::*;
@@ -352,14 +388,11 @@ mod tests {
         }
     }
 
-    static mut ENV_INIT: std::cell::LazyCell<Object> =
-        std::cell::LazyCell::new(|| unsafe { init_env() });
-
     #[test]
     fn global_env() {
         unsafe {
             let env = unsafe { *ENV_INIT };
-            println!("{env:?}");
+            println!("{:?}", DebugObjectExplicitGenv(env));
         }
     }
 

stages/lisp0/tests/define.l

@@ -0,0 +1,6 @@
+(progn
+  (define gt (lambda (a b)
+               (if (< b a)
+                   't ())))
+  (gt 1 2)
+  )

stages/lisp0/tests/eval.l

@@ -0,0 +1,3 @@
+(let ((x 10)
+      (y 20))
+  (eval '(cons x y)))

stages/lisp0/tests/typeof.l

@@ -0,0 +1,12 @@
+(progn
+  (define exit (lambda (code)
+                 (syscall 60 code)))
+  (define assert (lambda (cond)
+                 (if (nil? cond)
+                     (exit 1) ())))
+  (assert (= (typeof 1) 'number))
+  (assert (= (typeof 'symbol) 'atom))
+  (assert (= (typeof '()) 'nil))
+  (assert (= (typeof '(1 2 3)) 'cons))
+  (assert (= (typeof exit) 'closure))
+  )