janis/from-scratch
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

define, lambda, eval works

Browse source
This commit is contained in:
janis 2026-06-12 00:10:58 +02:00
parent f809090299
commit 5ee33f8cf6
Signed by: janis
SSH key fingerprint: SHA256:bB1qbbqmDXZNT0KKD5c2Dfjg53JGhj7B3CFcLIzSqq8
2 changed files with 254 additions and 132 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

391
stages/lisp0/lisp.asm
View file

@ -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
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<T>, 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
lea rdi, [rel atoms]
mov rdi, [rdi + ATOM_QUOTE * 8] ; get the "quote" atom
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
lea rdi, [rel atoms]
mov rdi, [rdi + ATOM_PLUS * 8] ; get the "+" atom
lea rsi, [rel p_add]
call make_prim_pair ; ("+" . p_add)
mov rdi, rax
mov rsi, qword [rsp]
call cons
mov qword [rsp], rax
lea rdi, [rel atoms]
mov rdi, [rdi + ATOM_MINUS * 8] ; get the "+" atom
lea rsi, [rel p_sub]
call make_prim_pair ; ("+" . p_add)
mov rdi, rax
mov rsi, qword [rsp]
call cons
mov qword [rsp], rax
lea rdi, [rel atoms]
mov rdi, [rdi + ATOM_MUL * 8] ; get the "*" atom
lea rsi, [rel p_mul]
call make_prim_pair ; ("*" . p_mul)
mov rdi, rax
mov rsi, qword [rsp]
call cons
mov qword [rsp], rax
lea rdi, [rel atoms]
mov rdi, [rdi + ATOM_DIV * 8] ; get the "/" atom
lea rsi, [rel p_div]
call make_prim_pair ; ("/" . p_div)
mov rdi, rax
mov rsi, qword [rsp]
call cons
mov qword [rsp], rax
lea rdi, [rel atoms]
mov rdi, [rdi + ATOM_REM * 8] ; get the "%" atom
lea rsi, [rel p_rem]
call make_prim_pair ; ("%" . p_rem)
mov rdi, rax
mov rsi, qword [rsp]
call cons
mov qword [rsp], rax
lea rdi, [rel atoms]
mov rdi, [rdi + ATOM_LT * 8] ; get the "<" atom
lea rsi, [rel p_lt]
call make_prim_pair ; ("<" . p_lt)
mov rdi, rax
mov rsi, qword [rsp]
call cons
mov qword [rsp], rax
lea rdi, [rel atoms]
mov rdi, [rdi + ATOM_EQ * 8] ; get the "=" atom
lea rsi, [rel p_eq]
call make_prim_pair ; ("=" . p_eq)
mov rdi, rax
mov rsi, qword [rsp]
call cons
mov qword [rsp], rax
lea rdi, [rel atoms]
mov rdi, [rdi + ATOM_CAR * 8] ; get the "car" atom
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
lea rdi, [rel atoms]
mov rdi, [rdi + ATOM_CDR * 8] ; get the "cdr" atom
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
lea rdi, [rel atoms]
mov rdi, [rdi + ATOM_NOT * 8] ; get the "not" atom
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
pop rax
mov qword [rel env], rax ; env = ((t . t) . nil)
mov qword [rel env_tail], rax ; env_tail = ((t . t) . nil)
mov rdi, ATOM_QUOTE
lea rsi, [rel p_quote]
call genv_append_atom_prim_by_idx
mov rdi, ATOM_PLUS
lea rsi, [rel p_add]
call genv_append_atom_prim_by_idx
mov rdi, ATOM_MINUS
lea rsi, [rel p_sub]
call genv_append_atom_prim_by_idx
mov rdi, ATOM_MUL
lea rsi, [rel p_mul]
call genv_append_atom_prim_by_idx
mov rdi, ATOM_DIV
lea rsi, [rel p_div]
call genv_append_atom_prim_by_idx
mov rdi, ATOM_REM
lea rsi, [rel p_rem]
call genv_append_atom_prim_by_idx
mov rdi, ATOM_LT
lea rsi, [rel p_lt]
call genv_append_atom_prim_by_idx
mov rdi, ATOM_EQ
lea rsi, [rel p_eq]
call genv_append_atom_prim_by_idx
mov rdi, ATOM_CAR
lea rsi, [rel p_car]
call genv_append_atom_prim_by_idx
mov rdi, ATOM_CDR
lea rsi, [rel p_cdr]
call genv_append_atom_prim_by_idx
mov rdi, ATOM_NOT
lea rsi, [rel p_not]
call genv_append_atom_prim_by_idx
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

37
stages/lisp0/lisp.rs
View file

@ -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::<Object>().read();
let cdr = self.ptr().byte_add(16).cast::<Object>().read();
@ -91,8 +98,23 @@ impl fmt::Debug for Object {
},
2 => unsafe {
let car = self.ptr().byte_add(8).cast::<Object>().read();
let cdr = self.ptr().byte_add(16).cast::<Object>().read();
write!(f, "(λ {car:?} {cdr:?})")
let env = self.ptr().byte_add(16).cast::<Object>().read();
assert_eq!(
car.tag(),
1,
"Expected a pair for lambda cdr, got tag {}",
car.tag()
);
let params = car.ptr().byte_add(8).cast::<Object>().read();
let body = car.ptr().byte_add(16).cast::<Object>().read();
write!(f, "λ ")?;
if env.0 as *const () == &raw const GENV || env.0 as *const () == &raw const NIL {
write!(f, " #<g_env> ++ ")?;
} 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() });
}