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

lambda, define, if, eval, let, let*

Browse source
This commit is contained in:
janis 2026-06-11 17:31:05 +02:00
parent 13f4e2bfe4
commit f809090299
Signed by: janis
SSH key fingerprint: SHA256:bB1qbbqmDXZNT0KKD5c2Dfjg53JGhj7B3CFcLIzSqq8
1 changed files with 152 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

153
stages/lisp0/lisp.asm
View file

@ -513,6 +513,158 @@ p_quote:
call get_car call get_car
ret ret
p_lambda:
push rsi
call get_car
push rax ; params
call get_cdr
mov rdi, rax
call get_car
mov rsi, rax ; body
pop rdi ; params
pop rdx
call clos
ret
p_define:
call get_car
push rax ; params
call get_cdr
mov rdi, rax
call eval
mov rsi, rax ; evaled value
mov rdi, qword [rsp] ; name
call cons
mov rdi, rax
mov rsi, [rel env]
call cons
mov [rel env], rax
pop rax
ret
;; (if cond then else)
;; cond = car($rdi)
;; then = car(cdr($rdi))
;; else = car(cdr(cdr($rdi)))
;; result = eval(cond) ? eval(then) : eval(else)
p_if:
; eval(car(cdr(not(eval(car($rdi), $rsi)) ? cdr(rdi) : $rdi)) $rsi)
sub rsp, 16
mov qword [rsp], rdi ; save $rdi = arg
mov qword [rsp + 8], rsi ; save $rsi = env
call get_car
mov rdi, rax
call eval
mov rdi, rax
call is_nil
mov cl, al
mov rdi, qword [rsp] ; restore $rdi = arg
call get_cdr
mov rdi, rax
call get_car
mov rsi, rax
call get_cdr
test cl, cl
cmovnz rsi, rax
mov rdi, rsi
call get_car
mov rdi, rax
mov rsi, qword [rsp + 8] ; restore $rsi = env
call eval
add rsp, 16
ret
;; (Env, (var val), Env) -> Env
;; $rdi = acc-env, $rsi = (var val), $rdx = genv
p_let_inner:
sub rsp, 24
mov qword [rsp], rdi ; acc-env
mov qword [rsp + 8], rsi ; (var val)
mov qword [rsp + 16], rdx ; genv
call get_cdr
mov rdi, rax
call get_car
mov rdi, rax
mov rsi, qword [rsp + 16] ; genv
call eval
mov rsi, rax ; val
mov rdi, qword [rsp + 8] ; (var val)
call get_car
mov rdi, rax ; var
call cons
mov rdi, rax
mov rsi, qword [rsp] ; acc-env
call cons
add rsp, 24
ret
;; (Env, (var val), Env) -> Env
;; $rdi = acc-env, $rsi = (var val), $rdx = genv
p_let_star_inner:
sub rsp, 24
mov qword [rsp], rdi ; acc-env
mov qword [rsp + 8], rsi ; (var val)
call get_cdr
mov rdi, rax
call get_car
mov rdi, rax
mov rsi, qword [rsp] ; genv
call eval
mov rsi, rax ; val
mov rdi, qword [rsp + 8] ; (var val)
call get_car
mov rdi, rax ; var
call cons
mov rdi, rax
mov rsi, qword [rsp] ; acc-env
call cons
add rsp, 24
ret
;; (let ((var1 val1) (var2 val2) ...) body)
;; $rdi = (bindings expr) where bindings = ((var1 val1) (var2 val2) ...)
p_let:
sub rsp, 24
call get_car
mov qword [rsp], rax ; bindings
call get_cdr
mov rdi, rax
call get_car
mov qword [rsp + 8], rax ; body
mov qword [rsp + 16], rsi ; in_env
mov rdi, qword [rsp] ; $rdi = bindings
mov rsi, qword [rsp + 16] ; $rsi = in_env
mov rcx, rsi
lea rdx, [rel p_let_inner]
call fold_list
mov rsi, rax ; body_env = fold_list(...)
mov rdi, qword [rsp + 8] ; $rdi =
call eval
add rsp, 24
ret
p_let_star:
sub rsp, 24
call get_car
mov qword [rsp], rax ; bindings
call get_cdr
mov rdi, rax
call get_car
mov qword [rsp + 8], rax ; body
mov qword [rsp + 16], rsi ; in_env
mov rdi, qword [rsp] ; $rdi = bindings
mov rsi, qword [rsp + 16] ; $rsi = in_env
mov rcx, rsi
lea rdx, [rel p_let_star_inner]
call fold_list
mov rsi, rax ; body_env = fold_list(...)
mov rdi, qword [rsp + 8] ; $rdi =
call eval
add rsp, 24
ret
; p_let_rec:
global init_env global init_env
init_env: init_env:
@ -963,7 +1115,6 @@ cons:
call obj_set_tag call obj_set_tag
ret ret
get_car: get_car:
call obj_tag_part call obj_tag_part
cmp al, OBJ_CONS cmp al, OBJ_CONS