define, lambda, eval works
This commit is contained in:
parent
f809090299
commit
5ee33f8cf6
SSH key fingerprint:
SHA256:bB1qbbqmDXZNT0KKD5c2Dfjg53JGhj7B3CFcLIzSqq8
|
|
@ -3,8 +3,10 @@
|
||||||
section .bss
|
section .bss
|
||||||
buf resb 0x100
|
buf resb 0x100
|
||||||
align 8,db 0
|
align 8,db 0
|
||||||
atoms times 3 resb 8
|
atoms times 20 resb 8
|
||||||
|
global env
|
||||||
env resq 1
|
env resq 1
|
||||||
|
env_tail resq 1
|
||||||
;;
|
;;
|
||||||
section .text
|
section .text
|
||||||
|
|
||||||
|
|
@ -96,7 +98,14 @@ extern alloc
|
||||||
;; fn dealloc(ptr: *mut u8, size: usize, align: usize)
|
;; fn dealloc(ptr: *mut u8, size: usize, align: usize)
|
||||||
extern dealloc
|
extern dealloc
|
||||||
|
|
||||||
|
do_panic_abort:
|
||||||
|
xor rdi, rdi
|
||||||
|
xor rsi, rsi
|
||||||
|
call panic_abort
|
||||||
|
int 3
|
||||||
|
|
||||||
align 8,db 0
|
align 8,db 0
|
||||||
|
global nil
|
||||||
nil dq 1 ; the nil object, with refcount = 1
|
nil dq 1 ; the nil object, with refcount = 1
|
||||||
OBJ_BYTE equ 0
|
OBJ_BYTE equ 0
|
||||||
OBJ_CONS equ 1
|
OBJ_CONS equ 1
|
||||||
|
|
@ -119,6 +128,12 @@ extern dealloc
|
||||||
ATOM_CAR equ 9
|
ATOM_CAR equ 9
|
||||||
ATOM_CDR equ 10
|
ATOM_CDR equ 10
|
||||||
ATOM_NOT equ 11
|
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 db "quote"
|
||||||
QUOTE_STR_LEN equ $ - QUOTE_STR
|
QUOTE_STR_LEN equ $ - QUOTE_STR
|
||||||
|
|
@ -144,6 +159,18 @@ extern dealloc
|
||||||
CDR_STR_LEN equ $ - CDR_STR
|
CDR_STR_LEN equ $ - CDR_STR
|
||||||
NOT_STR db "not"
|
NOT_STR db "not"
|
||||||
NOT_STR_LEN equ $ - NOT_STR
|
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
|
;; 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
|
;; fn fold_list(List<T>, Env, (U, T, Env) -> U, U) -> U
|
||||||
|
|
@ -514,7 +541,7 @@ p_quote:
|
||||||
ret
|
ret
|
||||||
|
|
||||||
p_lambda:
|
p_lambda:
|
||||||
push rsi
|
push rsi ; save env
|
||||||
call get_car
|
call get_car
|
||||||
push rax ; params
|
push rax ; params
|
||||||
call get_cdr
|
call get_cdr
|
||||||
|
|
@ -523,6 +550,9 @@ p_lambda:
|
||||||
mov rsi, rax ; body
|
mov rsi, rax ; body
|
||||||
pop rdi ; params
|
pop rdi ; params
|
||||||
pop rdx
|
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
|
call clos
|
||||||
ret
|
ret
|
||||||
|
|
||||||
|
|
@ -531,15 +561,23 @@ p_define:
|
||||||
push rax ; params
|
push rax ; params
|
||||||
call get_cdr
|
call get_cdr
|
||||||
mov rdi, rax
|
mov rdi, rax
|
||||||
|
call get_car
|
||||||
|
mov rdi, rax
|
||||||
call eval
|
call eval
|
||||||
mov rsi, rax ; evaled value
|
mov rsi, rax ; evaled value
|
||||||
mov rdi, qword [rsp] ; name
|
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 rdi, rax
|
||||||
mov rsi, [rel env]
|
call get_car
|
||||||
call cons
|
mov rdi, rax
|
||||||
mov [rel env], rax
|
pop rsi
|
||||||
pop rax
|
call eval
|
||||||
ret
|
ret
|
||||||
|
|
||||||
;; (if cond then else)
|
;; (if cond then else)
|
||||||
|
|
@ -667,6 +705,32 @@ p_let_star:
|
||||||
|
|
||||||
|
|
||||||
global init_env
|
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:
|
init_env:
|
||||||
call init_atoms
|
call init_atoms
|
||||||
|
|
||||||
|
|
@ -677,109 +741,78 @@ init_env:
|
||||||
mov rdi, rax ; $rdi = (t . t)
|
mov rdi, rax ; $rdi = (t . t)
|
||||||
lea rsi, [rel nil]
|
lea rsi, [rel nil]
|
||||||
call cons ; ((t . t) . 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], 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
|
ret
|
||||||
|
|
||||||
global init_atoms
|
global init_atoms
|
||||||
|
|
@ -891,6 +924,42 @@ init_atoms:
|
||||||
lea rcx, [rel atoms]
|
lea rcx, [rel atoms]
|
||||||
mov qword [rcx + ATOM_NOT * 8], rax ; atoms[11] = "not"
|
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
|
ret
|
||||||
|
|
||||||
|
|
||||||
|
|
@ -1088,11 +1157,11 @@ obj_set_tag:
|
||||||
|
|
||||||
;; construcst a closure object with params $rdi, body $rsi, and env $rdx
|
;; construcst a closure object with params $rdi, body $rsi, and env $rdx
|
||||||
clos:
|
clos:
|
||||||
push rdx
|
push rdx ; env
|
||||||
call cons
|
call cons ; (params . body)
|
||||||
mov rdi, rax
|
mov rdi, rax
|
||||||
pop rsi
|
pop rsi ; env
|
||||||
call cons
|
call cons ; ((params . body) . env)
|
||||||
mov rdi, rax
|
mov rdi, rax
|
||||||
mov rsi, OBJ_CLOS
|
mov rsi, OBJ_CLOS
|
||||||
call obj_set_tag
|
call obj_set_tag
|
||||||
|
|
@ -1148,6 +1217,30 @@ set_cdr:
|
||||||
xor rdi, rdi
|
xor rdi, rdi
|
||||||
call panic_abort
|
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
|
;; returns 1 if the result of `peekc($rdi)` is $sil
|
||||||
;; treats all characters less than ' ' as spaces.
|
;; treats all characters less than ' ' as spaces.
|
||||||
is_ch:
|
is_ch:
|
||||||
|
|
@ -1258,7 +1351,8 @@ parse_string:
|
||||||
xor r12, r12
|
xor r12, r12
|
||||||
.loop:
|
.loop:
|
||||||
; scan for closing quote
|
; scan for closing quote
|
||||||
mov al, byte [rel buf + r12]
|
lea rax, [rel buf]
|
||||||
|
mov al, byte [rax + r12]
|
||||||
; cmp al, `\\`
|
; cmp al, `\\`
|
||||||
; je .escape
|
; je .escape
|
||||||
cmp al, `"`
|
cmp al, `"`
|
||||||
|
|
@ -1280,7 +1374,7 @@ parse_string:
|
||||||
mov rsi, 8
|
mov rsi, 8
|
||||||
call alloc
|
call alloc
|
||||||
mov dword [rax], 1 ; refcount = 1
|
mov dword [rax], 1 ; refcount = 1
|
||||||
mov dword [rax + 4], r12w ; length of string
|
mov dword [rax + 4], r12d ; length of string
|
||||||
pop rdi
|
pop rdi
|
||||||
mov qword [rax + 8], rdi ; pointer to string
|
mov qword [rax + 8], rdi ; pointer to string
|
||||||
mov rdi, rax
|
mov rdi, rax
|
||||||
|
|
@ -1595,34 +1689,30 @@ apply:
|
||||||
call panic_abort
|
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
|
;; recursively binds the symbols in $rdi to the values in $rsi in the environment $rdx and returns the new environment in $rax
|
||||||
bind:
|
bind_list:
|
||||||
mov rax, rdx
|
sub rsp, 16
|
||||||
|
.tailcall:
|
||||||
call is_nil
|
call is_nil
|
||||||
test al, al
|
test al, al
|
||||||
jnz .done ; if there are no more symbols to bind, return the old environment
|
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
|
call get_car
|
||||||
mov qword [rsp + 8],rax ; key
|
mov rcx, rax ; key
|
||||||
call get_cdr
|
call get_cdr
|
||||||
mov qword [rsp + 16], rax ; keys
|
mov qword [rsp + 8], rax ; keys
|
||||||
mov rdi, qword [rsp + 16] ; values
|
mov rdi, rsi ; values
|
||||||
call get_car
|
call get_car
|
||||||
mov qword [rsp + 16], rax ; val
|
mov rsi, rax ; val
|
||||||
call get_cdr
|
call get_cdr
|
||||||
mov qword [rsp + 24], rax ; vals
|
mov qword [rsp], rax ; vals
|
||||||
|
mov rdi, rcx ; $rdi = key
|
||||||
mov rdi, qword [rsp + 8] ; $rdi = key
|
|
||||||
mov rsi, qword [rsp + 16] ; $rsi = val
|
|
||||||
mov rdx, qword [rsp] ; $rdx = old environment
|
|
||||||
call prepend ; new_env = ((key . val) . old_env)
|
call prepend ; new_env = ((key . val) . old_env)
|
||||||
mov rdx, rax
|
mov rdx, rax
|
||||||
mov rdi, qword [rsp + 16] ; $rdi = keys
|
mov rdi, qword [rsp + 8] ; $rdi = keys
|
||||||
mov rsi, qword [rsp + 24] ; $rsi = vals
|
mov rsi, qword [rsp] ; $rsi = vals
|
||||||
add rsp, 32
|
jmp .tailcall ; recursively bind the rest of the keys and vals in the new environment
|
||||||
jmp bind ; recursively bind the rest of the keys and vals in the new environment
|
|
||||||
.done:
|
.done:
|
||||||
|
add rsp, 16
|
||||||
|
mov rax, rdx
|
||||||
ret
|
ret
|
||||||
|
|
||||||
;; applies closure $rdi to arguments $rsi and environment $rdx, returning the result in $rax
|
;; applies closure $rdi to arguments $rsi and environment $rdx, returning the result in $rax
|
||||||
|
|
@ -1631,20 +1721,29 @@ reduce:
|
||||||
sub rsp, 32
|
sub rsp, 32
|
||||||
mov qword [rsp], rdx ; eval_env
|
mov qword [rsp], rdx ; eval_env
|
||||||
mov qword [rsp + 8], rdi ; closure
|
mov qword [rsp + 8], rdi ; closure
|
||||||
call get_cdr
|
call get_clos_env
|
||||||
mov rdi, rax
|
mov rdi, rax
|
||||||
call is_nil
|
call is_nil
|
||||||
test al, al
|
test al, al
|
||||||
mov rax, qword [rsp] ; eval_env
|
mov rax, qword [rel env] ; g_env
|
||||||
cmovz rax, rdi ; env = closure_env == nil ? eval_env : closure_env
|
cmovz rax, rdi ; base_env = closure_env == nil ? g_env : closure_env
|
||||||
xchg qword [rsp + 8], rax ;
|
mov qword [rsp + 16], rax ; save base env at rsp + 16
|
||||||
mov rdi, rax ; restore closure
|
mov rdi, rsi ; $rdi = args
|
||||||
call get_car
|
mov rsi, qword [rsp] ; $rsi = eval_env
|
||||||
mov rdi, rax ; (params . body)
|
call eval_list ; evaled_args = eval_list(args, eval_env)
|
||||||
call get_car
|
mov rsi, rax ; $rsi = evaled args
|
||||||
mov qword [rsp + 16], rax ; params
|
mov rdi, qword [rsp + 8] ; $rdi = closure
|
||||||
call get_cdr
|
call get_clos_params
|
||||||
mov qword [rsp + 24], rax ; body
|
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:
|
prepend:
|
||||||
push rdx
|
push rdx
|
||||||
call cons
|
call cons
|
||||||
mov rsi, rax
|
mov rdi, rax
|
||||||
pop rdi
|
pop rsi
|
||||||
call cons
|
call cons
|
||||||
ret
|
ret
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -4,6 +4,11 @@ unsafe extern "C" {
|
||||||
fn init_env() -> Object;
|
fn init_env() -> Object;
|
||||||
fn eval(expr: Object, env: Object) -> Object;
|
fn eval(expr: Object, env: Object) -> Object;
|
||||||
fn get_env() -> Object;
|
fn get_env() -> Object;
|
||||||
|
|
||||||
|
#[link_name = "nil"]
|
||||||
|
static NIL: ();
|
||||||
|
#[link_name = "env"]
|
||||||
|
static mut GENV: ();
|
||||||
}
|
}
|
||||||
|
|
||||||
struct Source<'a> {
|
struct Source<'a> {
|
||||||
|
|
@ -82,8 +87,10 @@ struct Object(*mut ());
|
||||||
use std::fmt;
|
use std::fmt;
|
||||||
impl fmt::Debug for Object {
|
impl fmt::Debug for Object {
|
||||||
fn fmt(&self, f: &mut fmt::Formatter<'_>) -> fmt::Result {
|
fn fmt(&self, f: &mut fmt::Formatter<'_>) -> fmt::Result {
|
||||||
|
if self.0 as *const () == &raw const NIL {
|
||||||
|
return write!(f, "nil");
|
||||||
|
}
|
||||||
match self.tag() {
|
match self.tag() {
|
||||||
0 => write!(f, "nil"),
|
|
||||||
1 => unsafe {
|
1 => unsafe {
|
||||||
let car = self.ptr().byte_add(8).cast::<Object>().read();
|
let car = self.ptr().byte_add(8).cast::<Object>().read();
|
||||||
let cdr = self.ptr().byte_add(16).cast::<Object>().read();
|
let cdr = self.ptr().byte_add(16).cast::<Object>().read();
|
||||||
|
|
@ -91,8 +98,23 @@ impl fmt::Debug for Object {
|
||||||
},
|
},
|
||||||
2 => unsafe {
|
2 => unsafe {
|
||||||
let car = self.ptr().byte_add(8).cast::<Object>().read();
|
let car = self.ptr().byte_add(8).cast::<Object>().read();
|
||||||
let cdr = self.ptr().byte_add(16).cast::<Object>().read();
|
let env = self.ptr().byte_add(16).cast::<Object>().read();
|
||||||
write!(f, "(λ {car:?} {cdr:?})")
|
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 {
|
3 => unsafe {
|
||||||
let str_ptr = self.ptr().byte_add(8).cast::<*const u8>().read();
|
let str_ptr = self.ptr().byte_add(8).cast::<*const u8>().read();
|
||||||
|
|
@ -130,12 +152,13 @@ impl Object {
|
||||||
#[test]
|
#[test]
|
||||||
fn test_parse_list() {
|
fn test_parse_list() {
|
||||||
let env = unsafe { *ENV_INIT };
|
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 mut src = Source::from(&input[..]);
|
||||||
let sexp = unsafe { parse_next_token(&raw mut src) };
|
let sexp = unsafe { parse_next_token(&raw mut src) };
|
||||||
println!("{:?}", sexp);
|
println!("> {:?}", sexp);
|
||||||
let result = unsafe { eval(sexp, get_env()) };
|
let result = unsafe { eval(sexp, get_env()) };
|
||||||
println!("{:?}", result);
|
println!("{:?}\n", result);
|
||||||
|
println!("env: {:?}", unsafe { get_env() });
|
||||||
}
|
}
|
||||||
|
|
|
||||||
Loading…
Reference in a new issue