From 5ee33f8cf6cb4597ed51641df1330e983c45a0df Mon Sep 17 00:00:00 2001 From: janis Date: Fri, 12 Jun 2026 00:10:58 +0200 Subject: [PATCH] define, lambda, eval works --- stages/lisp0/lisp.asm | 349 +++++++++++++++++++++++++++--------------- stages/lisp0/lisp.rs | 37 ++++- 2 files changed, 254 insertions(+), 132 deletions(-) diff --git a/stages/lisp0/lisp.asm b/stages/lisp0/lisp.asm index e3ebc0b..453953d 100644 --- a/stages/lisp0/lisp.asm +++ b/stages/lisp0/lisp.asm @@ -3,8 +3,10 @@ section .bss buf resb 0x100 align 8,db 0 - atoms times 3 resb 8 + atoms times 20 resb 8 +global env env resq 1 + env_tail resq 1 ;; section .text @@ -96,7 +98,14 @@ extern alloc ;; fn dealloc(ptr: *mut u8, size: usize, align: usize) extern dealloc - align 8,db 0 +do_panic_abort: + xor rdi, rdi + xor rsi, rsi + call panic_abort + int 3 + +align 8,db 0 + global nil nil dq 1 ; the nil object, with refcount = 1 OBJ_BYTE equ 0 OBJ_CONS equ 1 @@ -119,6 +128,12 @@ extern dealloc ATOM_CAR equ 9 ATOM_CDR equ 10 ATOM_NOT equ 11 + ATOM_LAMBDA equ 12 + ATOM_DEFINE equ 13 + ATOM_EVAL equ 14 + ATOM_IF equ 15 + ATOM_LET equ 16 + ATOM_LET_STAR equ 17 QUOTE_STR db "quote" QUOTE_STR_LEN equ $ - QUOTE_STR @@ -144,6 +159,18 @@ extern dealloc CDR_STR_LEN equ $ - CDR_STR NOT_STR db "not" NOT_STR_LEN equ $ - NOT_STR + LAMBDA_STR db "lambda" + LAMBDA_STR_LEN equ $ - LAMBDA_STR + DEFINE_STR db "define" + DEFINE_STR_LEN equ $ - DEFINE_STR + EVAL_STR db "eval" + EVAL_STR_LEN equ $ - EVAL_STR + IF_STR db "if" + IF_STR_LEN equ $ - IF_STR + LET_STR db "let" + LET_STR_LEN equ $ - LET_STR + LET_STAR_STR db "let*" + LET_STAR_STR_LEN equ $ - LET_STAR_STR ;; folds all elements in the list $rdi using the binary function $rdx in the environment $rsi with an accumulator value of $rcx, returning the result in $rax ;; fn fold_list(List, Env, (U, T, Env) -> U, U) -> U @@ -514,7 +541,7 @@ p_quote: ret p_lambda: - push rsi + push rsi ; save env call get_car push rax ; params call get_cdr @@ -523,6 +550,9 @@ p_lambda: mov rsi, rax ; body pop rdi ; params pop rdx + cmp rdx, qword [rel env] ; if env is global env, then use nil as closure env + lea rcx, [rel nil] + cmove rdx, rcx call clos ret @@ -531,15 +561,23 @@ p_define: push rax ; params call get_cdr mov rdi, rax + call get_car + mov rdi, rax call eval mov rsi, rax ; evaled value mov rdi, qword [rsp] ; name - call cons + call genv_append + pop rax ; name + ret + +p_eval: + push rsi + call eval_list mov rdi, rax - mov rsi, [rel env] - call cons - mov [rel env], rax - pop rax + call get_car + mov rdi, rax + pop rsi + call eval ret ;; (if cond then else) @@ -667,6 +705,32 @@ p_let_star: global init_env + ;; appends var=$rdi bound to val=$rsi to the global environment +genv_append: + call cons + mov rdi, rax + lea rsi, [rel nil] + call cons + mov rsi, rax + mov rdi, qword [rel env_tail] + call set_cdr + mov qword [rel env_tail], rsi + ret + + ;; appends var=atoms[$rdi] bound to val=prim($rsi) to the global environment +genv_append_atom_prim_by_idx: + lea rax, [rel atoms] + mov rdi, [rax + rdi * 8] ; get the atom pointer + call make_prim_pair + mov rdi, rax + lea rsi, [rel nil] + call cons + mov rsi, rax + mov rdi, qword [rel env_tail] + call set_cdr + mov qword [rel env_tail], rsi + ret + init_env: call init_atoms @@ -677,109 +741,78 @@ init_env: mov rdi, rax ; $rdi = (t . t) lea rsi, [rel nil] call cons ; ((t . t) . nil) - push rax + mov qword [rel env], rax ; env = ((t . t) . nil) + mov qword [rel env_tail], rax ; env_tail = ((t . t) . nil) - lea rdi, [rel atoms] - mov rdi, [rdi + ATOM_QUOTE * 8] ; get the "quote" atom + mov rdi, ATOM_QUOTE lea rsi, [rel p_quote] - call make_prim_pair ; ("quote" . p_add) - mov rdi, rax - mov rsi, qword [rsp] - call cons - mov qword [rsp], rax + call genv_append_atom_prim_by_idx - lea rdi, [rel atoms] - mov rdi, [rdi + ATOM_PLUS * 8] ; get the "+" atom + mov rdi, ATOM_PLUS lea rsi, [rel p_add] - call make_prim_pair ; ("+" . p_add) - mov rdi, rax - mov rsi, qword [rsp] - call cons - mov qword [rsp], rax + call genv_append_atom_prim_by_idx - lea rdi, [rel atoms] - mov rdi, [rdi + ATOM_MINUS * 8] ; get the "+" atom + mov rdi, ATOM_MINUS lea rsi, [rel p_sub] - call make_prim_pair ; ("+" . p_add) - mov rdi, rax - mov rsi, qword [rsp] - call cons - mov qword [rsp], rax + call genv_append_atom_prim_by_idx - lea rdi, [rel atoms] - mov rdi, [rdi + ATOM_MUL * 8] ; get the "*" atom + mov rdi, ATOM_MUL lea rsi, [rel p_mul] - call make_prim_pair ; ("*" . p_mul) - mov rdi, rax - mov rsi, qword [rsp] - call cons - mov qword [rsp], rax + call genv_append_atom_prim_by_idx - lea rdi, [rel atoms] - mov rdi, [rdi + ATOM_DIV * 8] ; get the "/" atom + mov rdi, ATOM_DIV lea rsi, [rel p_div] - call make_prim_pair ; ("/" . p_div) - mov rdi, rax - mov rsi, qword [rsp] - call cons - mov qword [rsp], rax + call genv_append_atom_prim_by_idx - lea rdi, [rel atoms] - mov rdi, [rdi + ATOM_REM * 8] ; get the "%" atom + mov rdi, ATOM_REM lea rsi, [rel p_rem] - call make_prim_pair ; ("%" . p_rem) - mov rdi, rax - mov rsi, qword [rsp] - call cons - mov qword [rsp], rax + call genv_append_atom_prim_by_idx - lea rdi, [rel atoms] - mov rdi, [rdi + ATOM_LT * 8] ; get the "<" atom + mov rdi, ATOM_LT lea rsi, [rel p_lt] - call make_prim_pair ; ("<" . p_lt) - mov rdi, rax - mov rsi, qword [rsp] - call cons - mov qword [rsp], rax + call genv_append_atom_prim_by_idx - lea rdi, [rel atoms] - mov rdi, [rdi + ATOM_EQ * 8] ; get the "=" atom + mov rdi, ATOM_EQ lea rsi, [rel p_eq] - call make_prim_pair ; ("=" . p_eq) - mov rdi, rax - mov rsi, qword [rsp] - call cons - mov qword [rsp], rax + call genv_append_atom_prim_by_idx - lea rdi, [rel atoms] - mov rdi, [rdi + ATOM_CAR * 8] ; get the "car" atom + mov rdi, ATOM_CAR lea rsi, [rel p_car] - call make_prim_pair ; ("car" . p_car) - mov rdi, rax - mov rsi, qword [rsp] - call cons - mov qword [rsp], rax + call genv_append_atom_prim_by_idx - lea rdi, [rel atoms] - mov rdi, [rdi + ATOM_CDR * 8] ; get the "cdr" atom + mov rdi, ATOM_CDR lea rsi, [rel p_cdr] - call make_prim_pair ; ("cdr" . p_cdr) - mov rdi, rax - mov rsi, qword [rsp] - call cons - mov qword [rsp], rax + call genv_append_atom_prim_by_idx - lea rdi, [rel atoms] - mov rdi, [rdi + ATOM_NOT * 8] ; get the "not" atom + mov rdi, ATOM_NOT lea rsi, [rel p_not] - call make_prim_pair ; ("not" . p_cdr) - mov rdi, rax - mov rsi, qword [rsp] - call cons - mov qword [rsp], rax + call genv_append_atom_prim_by_idx - pop rax - mov qword [rel env], rax ; env = ((t . t) . nil) + mov rdi, ATOM_LAMBDA + lea rsi, [rel p_lambda] + call genv_append_atom_prim_by_idx + + mov rdi, ATOM_DEFINE + lea rsi, [rel p_define] + call genv_append_atom_prim_by_idx + + mov rdi, ATOM_EVAL + lea rsi, [rel p_eval] + call genv_append_atom_prim_by_idx + + mov rdi, ATOM_IF + lea rsi, [rel p_if] + call genv_append_atom_prim_by_idx + + mov rdi, ATOM_LET + lea rsi, [rel p_let] + call genv_append_atom_prim_by_idx + + mov rdi, ATOM_LET_STAR + lea rsi, [rel p_let_star] + call genv_append_atom_prim_by_idx + + mov rax, qword [rel env] ret global init_atoms @@ -891,6 +924,42 @@ init_atoms: lea rcx, [rel atoms] mov qword [rcx + ATOM_NOT * 8], rax ; atoms[11] = "not" + mov rdi, LAMBDA_STR + mov rsi, LAMBDA_STR_LEN + call make_atom + lea rcx, [rel atoms] + mov qword [rcx + ATOM_LAMBDA * 8], rax ; atoms[12] = "lambda" + + mov rdi, DEFINE_STR + mov rsi, DEFINE_STR_LEN + call make_atom + lea rcx, [rel atoms] + mov qword [rcx + ATOM_DEFINE * 8], rax ; atoms[13] = "define" + + mov rdi, EVAL_STR + mov rsi, EVAL_STR_LEN + call make_atom + lea rcx, [rel atoms] + mov qword [rcx + ATOM_EVAL * 8], rax ; atoms[14] = "eval" + + mov rdi, IF_STR + mov rsi, IF_STR_LEN + call make_atom + lea rcx, [rel atoms] + mov qword [rcx + ATOM_IF * 8], rax ; atoms[15] = "if" + + mov rdi, LET_STR + mov rsi, LET_STR_LEN + call make_atom + lea rcx, [rel atoms] + mov qword [rcx + ATOM_LET * 8], rax ; atoms[16] = "let" + + mov rdi, LET_STAR_STR + mov rsi, LET_STAR_STR_LEN + call make_atom + lea rcx, [rel atoms] + mov qword [rcx + ATOM_LET_STAR * 8], rax ; atoms[17] = "let*" + ret @@ -1088,11 +1157,11 @@ obj_set_tag: ;; construcst a closure object with params $rdi, body $rsi, and env $rdx clos: - push rdx - call cons + push rdx ; env + call cons ; (params . body) mov rdi, rax - pop rsi - call cons + pop rsi ; env + call cons ; ((params . body) . env) mov rdi, rax mov rsi, OBJ_CLOS call obj_set_tag @@ -1148,6 +1217,30 @@ set_cdr: xor rdi, rdi call panic_abort +get_clos_env: + call obj_tag_part + cmp al, OBJ_CLOS + jne do_panic_abort + call obj_addr_part + mov rax, qword [rax + 16] ; return the env + ret +get_clos_params: + call obj_tag_part + cmp al, OBJ_CLOS + jne do_panic_abort + call obj_addr_part + mov rdi, qword [rax + 8] ; return the (params . body) + call get_car + ret +get_clos_body: + call obj_tag_part + cmp al, OBJ_CLOS + jne do_panic_abort + call obj_addr_part + mov rdi, qword [rax + 8] ; return the (params . body) + call get_cdr + ret + ;; returns 1 if the result of `peekc($rdi)` is $sil ;; treats all characters less than ' ' as spaces. is_ch: @@ -1258,7 +1351,8 @@ parse_string: xor r12, r12 .loop: ; scan for closing quote - mov al, byte [rel buf + r12] + lea rax, [rel buf] + mov al, byte [rax + r12] ; cmp al, `\\` ; je .escape cmp al, `"` @@ -1280,7 +1374,7 @@ parse_string: mov rsi, 8 call alloc mov dword [rax], 1 ; refcount = 1 - mov dword [rax + 4], r12w ; length of string + mov dword [rax + 4], r12d ; length of string pop rdi mov qword [rax + 8], rdi ; pointer to string mov rdi, rax @@ -1595,34 +1689,30 @@ apply: call panic_abort ;; recursively binds the symbols in $rdi to the values in $rsi in the environment $rdx and returns the new environment in $rax -bind: - mov rax, rdx +bind_list: + sub rsp, 16 + .tailcall: call is_nil test al, al jnz .done ; if there are no more symbols to bind, return the old environment - sub rsp, 32 - mov qword [rsp], rax ; save the old environment on the stack - mov qword [rsp + 16], rsi ; tmp_values call get_car - mov qword [rsp + 8],rax ; key + mov rcx, rax ; key call get_cdr - mov qword [rsp + 16], rax ; keys - mov rdi, qword [rsp + 16] ; values + mov qword [rsp + 8], rax ; keys + mov rdi, rsi ; values call get_car - mov qword [rsp + 16], rax ; val + mov rsi, rax ; val call get_cdr - mov qword [rsp + 24], rax ; vals - - mov rdi, qword [rsp + 8] ; $rdi = key - mov rsi, qword [rsp + 16] ; $rsi = val - mov rdx, qword [rsp] ; $rdx = old environment + mov qword [rsp], rax ; vals + mov rdi, rcx ; $rdi = key call prepend ; new_env = ((key . val) . old_env) mov rdx, rax - mov rdi, qword [rsp + 16] ; $rdi = keys - mov rsi, qword [rsp + 24] ; $rsi = vals - add rsp, 32 - jmp bind ; recursively bind the rest of the keys and vals in the new environment + mov rdi, qword [rsp + 8] ; $rdi = keys + mov rsi, qword [rsp] ; $rsi = vals + jmp .tailcall ; recursively bind the rest of the keys and vals in the new environment .done: + add rsp, 16 + mov rax, rdx ret ;; applies closure $rdi to arguments $rsi and environment $rdx, returning the result in $rax @@ -1631,20 +1721,29 @@ reduce: sub rsp, 32 mov qword [rsp], rdx ; eval_env mov qword [rsp + 8], rdi ; closure - call get_cdr + call get_clos_env mov rdi, rax call is_nil test al, al - mov rax, qword [rsp] ; eval_env - cmovz rax, rdi ; env = closure_env == nil ? eval_env : closure_env - xchg qword [rsp + 8], rax ; - mov rdi, rax ; restore closure - call get_car - mov rdi, rax ; (params . body) - call get_car - mov qword [rsp + 16], rax ; params - call get_cdr - mov qword [rsp + 24], rax ; body + mov rax, qword [rel env] ; g_env + cmovz rax, rdi ; base_env = closure_env == nil ? g_env : closure_env + mov qword [rsp + 16], rax ; save base env at rsp + 16 + mov rdi, rsi ; $rdi = args + mov rsi, qword [rsp] ; $rsi = eval_env + call eval_list ; evaled_args = eval_list(args, eval_env) + mov rsi, rax ; $rsi = evaled args + mov rdi, qword [rsp + 8] ; $rdi = closure + call get_clos_params + mov rdi, rax ; params + mov rdx, qword [rsp + 16] ; $rdx = base_env + call bind_list ; closure_env = bind_list(params, evaled_args, base_env) + mov rsi, rax ; $rsi = closure_env + mov rdi, qword [rsp + 8] ; $rdi = closure + call get_clos_body + mov rdi, rax ; $rdi = body + call eval ; eval(body, closure_env) + add rsp, 32 + ret @@ -1652,8 +1751,8 @@ reduce: prepend: push rdx call cons - mov rsi, rax - pop rdi + mov rdi, rax + pop rsi call cons ret diff --git a/stages/lisp0/lisp.rs b/stages/lisp0/lisp.rs index 3dff54f..a5aa396 100644 --- a/stages/lisp0/lisp.rs +++ b/stages/lisp0/lisp.rs @@ -4,6 +4,11 @@ unsafe extern "C" { fn init_env() -> Object; fn eval(expr: Object, env: Object) -> Object; fn get_env() -> Object; + + #[link_name = "nil"] + static NIL: (); + #[link_name = "env"] + static mut GENV: (); } struct Source<'a> { @@ -82,8 +87,10 @@ struct Object(*mut ()); use std::fmt; impl fmt::Debug for Object { fn fmt(&self, f: &mut fmt::Formatter<'_>) -> fmt::Result { + if self.0 as *const () == &raw const NIL { + return write!(f, "nil"); + } match self.tag() { - 0 => write!(f, "nil"), 1 => unsafe { let car = self.ptr().byte_add(8).cast::().read(); let cdr = self.ptr().byte_add(16).cast::().read(); @@ -91,8 +98,23 @@ impl fmt::Debug for Object { }, 2 => unsafe { let car = self.ptr().byte_add(8).cast::().read(); - let cdr = self.ptr().byte_add(16).cast::().read(); - write!(f, "(λ {car:?} {cdr:?})") + let env = self.ptr().byte_add(16).cast::().read(); + assert_eq!( + car.tag(), + 1, + "Expected a pair for lambda cdr, got tag {}", + car.tag() + ); + let params = car.ptr().byte_add(8).cast::().read(); + let body = car.ptr().byte_add(16).cast::().read(); + + write!(f, "λ ")?; + if env.0 as *const () == &raw const GENV || env.0 as *const () == &raw const NIL { + write!(f, " # ++ ")?; + } else { + write!(f, " {env:?} ++ ")?; + } + write!(f, "{params:?} {body:?})") }, 3 => unsafe { let str_ptr = self.ptr().byte_add(8).cast::<*const u8>().read(); @@ -130,12 +152,13 @@ impl Object { #[test] fn test_parse_list() { let env = unsafe { *ENV_INIT }; - println!("env: {:?}", env); + println!("env: {:?}\n", env); - let input = b"(not (< 3 2))"; + let input = b"((eval (define succ (lambda (x) (+ x 1)))) 4)"; let mut src = Source::from(&input[..]); let sexp = unsafe { parse_next_token(&raw mut src) }; - println!("{:?}", sexp); + println!("> {:?}", sexp); let result = unsafe { eval(sexp, get_env()) }; - println!("{:?}", result); + println!("{:?}\n", result); + println!("env: {:?}", unsafe { get_env() }); }