eval
This commit is contained in:
parent
a78d06a216
commit
45ce196938
SSH key fingerprint:
SHA256:bB1qbbqmDXZNT0KKD5c2Dfjg53JGhj7B3CFcLIzSqq8
|
|
@ -41,6 +41,27 @@ strlen:
|
|||
.strlen_done:
|
||||
ret
|
||||
|
||||
;; @param lhs: (rdi, rsi)
|
||||
;; @param rhs: (rdx, rcx)
|
||||
;; @return al
|
||||
strcmp:
|
||||
cmp rcx, rsi
|
||||
cmovb rsi, rcx ; if rhs is shorter, use its length for the loop
|
||||
xor eax, eax
|
||||
.strcmp_loop:
|
||||
cmp rsi, rax
|
||||
je .strcmp_equal
|
||||
movzx ecx, byte [rdx + rax]
|
||||
cmp byte [rdi + rax], cl
|
||||
lea rax, [rax + 1]
|
||||
je .strcmp_loop
|
||||
seta al ; al = lhs > rhs
|
||||
sbb al, 0 ; al = al - CF
|
||||
ret
|
||||
.strcmp_equal:
|
||||
xor eax, eax
|
||||
ret
|
||||
|
||||
;; rdi: src
|
||||
;; rsi: dst
|
||||
;; rdx: len
|
||||
|
|
@ -131,7 +152,107 @@ init_atoms:
|
|||
mov qword [rcx + 8], rax ; atoms[1] = "t"
|
||||
ret
|
||||
|
||||
|
||||
|
||||
|
||||
;; returns 0 if the objects pointed at by $rdi and $rsi are equal, and 1 otherwise.
|
||||
obj_eq:
|
||||
sub rsp, 24
|
||||
mov qword [rsp], rdi ; save obj1
|
||||
mov qword [rsp + 8], rsi ; save obj2
|
||||
call obj_tag_part
|
||||
mov byte [rsp + 16], al ; save tag1
|
||||
mov rdi, qword [rsp + 8] ; restore obj2
|
||||
call obj_tag_part
|
||||
cmp al, byte [rsp + 16] ; compare tag2 with tag1
|
||||
jne .not_equal
|
||||
cmp al, OBJ_ATOM
|
||||
je .compare_atoms
|
||||
cmp al, OBJ_STR
|
||||
je .compare_strs
|
||||
cmp al, OBJ_NUM
|
||||
je .compare_nums
|
||||
cmp al, OBJ_CONS
|
||||
je .compare_cons
|
||||
cmp al, OBJ_CLOS
|
||||
je .compare_clos
|
||||
cmp al, OBJ_PRIM
|
||||
je .compare_prims
|
||||
jmp .equal
|
||||
.compare_atoms:
|
||||
.compare_strs:
|
||||
call obj_addr_part
|
||||
mov qword [rsp + 8], rax
|
||||
mov rdi, qword [rsp] ; restore obj1
|
||||
call obj_addr_part
|
||||
mov rdx, dword [rax + 4] ; len1
|
||||
mov rcx, qword [rsp + 8] ; ptr2
|
||||
mov rbx, dword [rcx + 4] ; len2
|
||||
cmp rdx, rbx
|
||||
jne .not_equal
|
||||
mov rdx, qword [rax + 8] ; ptr1
|
||||
mov rsi, qword [rcx + 8] ; ptr2
|
||||
cmp rdx, rsi
|
||||
je .equal
|
||||
mov rdi, rdx ; $rdi = ptr1
|
||||
mov rsi, rsi ; $rsi = ptr2
|
||||
mov rdx, rbx ; $rdx = len1 = len2
|
||||
call strcmp
|
||||
test al, al
|
||||
je .equal
|
||||
jmp .not_equal
|
||||
.compare_nums:
|
||||
call obj_addr_part
|
||||
mov qword [rsp + 8], rax
|
||||
mov rdi, qword [rsp] ; restore obj1
|
||||
call obj_addr_part
|
||||
mov rdx, qword [rax + 8] ; num1
|
||||
mov rcx, qword [rsp + 8]
|
||||
mov rcx, qword [rcx + 8] ; num2
|
||||
cmp rdx, rcx
|
||||
je .equal
|
||||
jmp .not_equal
|
||||
.compare_cons:
|
||||
.compare_clos:
|
||||
mov rdi, qword [rsp] ; restore obj1
|
||||
call get_cdr
|
||||
mov qword [rsp + 8], rax ; save cdr1
|
||||
call get_car
|
||||
mov rcx, rax ; $rcx = car1
|
||||
mov rdi, qword [rsp + 16] ; $rdi = obj2
|
||||
call get_cdr
|
||||
mov qword [rsp + 16], rax ; save cdr2
|
||||
call get_car
|
||||
mov rdi, rcx ; $rdi = car1
|
||||
mov rsi, rax ; $rsi = car2
|
||||
call obj_eq
|
||||
test al, al
|
||||
jne .not_equal
|
||||
mov rdi, qword [rsp + 8] ; $rdi = cdr1
|
||||
mov rsi, qword [rsp + 16] ; $rsi = cdr2
|
||||
call obj_eq
|
||||
test al, al
|
||||
jne .not_equal
|
||||
jmp .equal
|
||||
.compare_prims:
|
||||
call obj_addr_part
|
||||
mov rax, qword [rax + 8] ; prim1
|
||||
mov qword [rsp + 16], rax
|
||||
mov rdi, qword [rsp] ; restore obj1
|
||||
call obj_addr_part
|
||||
mov rdx, qword [rax + 8] ; prim1
|
||||
mov rcx, qword [rsp + 16] ; prim2
|
||||
cmp rdx, rcx
|
||||
je .equal
|
||||
jmp .not_equal
|
||||
.equal:
|
||||
xor eax, eax
|
||||
add rsp, 24
|
||||
ret
|
||||
.not_equal:
|
||||
mov eax, 1
|
||||
add rsp, 24
|
||||
ret
|
||||
|
||||
|
||||
dtor_table:
|
||||
dd dtor_table - dtor_nil
|
||||
|
|
@ -150,13 +271,9 @@ dtor_cons:
|
|||
dtor_clos:
|
||||
push rdi
|
||||
mov rdi, qword [rdi + 8] ; car
|
||||
call obj_addr_part
|
||||
mov rdi, rax
|
||||
call obj_dec_ref
|
||||
mov rdi, qword [rsp]
|
||||
mov rdi, qword [rdi + 16] ; cdr
|
||||
call obj_addr_part
|
||||
mov rdi, rax
|
||||
call obj_dec_ref
|
||||
pop rdi
|
||||
mov rsi, 24
|
||||
|
|
@ -470,7 +587,6 @@ parse_quote:
|
|||
lea rdi, [rel atoms]
|
||||
mov rdi, [rdi + ATOM_QUOTE * 8] ; get the "quote" atom
|
||||
push rdi
|
||||
call obj_addr_part
|
||||
call obj_inc_ref
|
||||
pop rdi ; $rdi = "quote" atom
|
||||
pop rsi ; $rsi = (t . nil)
|
||||
|
|
@ -534,3 +650,215 @@ parse_next_token:
|
|||
pop rdi
|
||||
call parse_cur_token
|
||||
ret
|
||||
|
||||
global eval
|
||||
;; evaluates the expression in $rdi in the environment $rsi and returns the result in $rax
|
||||
eval:
|
||||
call obj_tag_part
|
||||
cmp al, OBJ_ATOM
|
||||
je .eval_atom
|
||||
cmp al, OBJ_CONS
|
||||
jne .uneval
|
||||
; eval_list($rdi, $rsi)
|
||||
sub rsp, 16
|
||||
mov qword [rsp], rsi ; env
|
||||
call get_cdr
|
||||
mov qword [rsp + 8], rax ; cdr($rdi)
|
||||
call get_car
|
||||
mov rdi, rax ; $rdi = car($rdi)
|
||||
mov rsi, qword [rsp] ; $rsi = env
|
||||
call eval ; $rax = eval(car($rdi), $rsi)
|
||||
mov rdi, rax ; $rdi = eval(car($rdi),
|
||||
mov rsi, qword [rsp + 8] ; $rsi = cdr($rdi)
|
||||
mov rdx, qword [rsp] ; $rdx = env
|
||||
call apply
|
||||
add rsp, 16
|
||||
ret
|
||||
.eval_atom:
|
||||
call assoc
|
||||
ret
|
||||
.uneval:
|
||||
mov rax, rdi
|
||||
ret
|
||||
|
||||
;; returns a list of the evaluated elements in the list in $rdi in the environment $rsi
|
||||
eval_list:
|
||||
sub rsp, 32
|
||||
mov qword [rsp], rsi ; save the environment on the stack
|
||||
lea rax, [rel nil]
|
||||
mov qword [rsp + 8], rax ; tail = nil
|
||||
mov qword [rsp + 16], rax ; head = nil
|
||||
.tailcall:
|
||||
call obj_tag_part
|
||||
cmp al, OBJ_CONS
|
||||
jne .not_cons
|
||||
; cons(eval(car($rdi), $rsi), eval_list(cdr($rdi), $rsi))
|
||||
call get_car
|
||||
mov rcx, rax
|
||||
call get_cdr
|
||||
mov qword [rsp + 24], rax ; cdr($rdi)
|
||||
mov rdi, rcx ; $rdi = car($rdi)
|
||||
mov rsi, qword [rsp] ; $rsi = environment
|
||||
call eval
|
||||
mov rdi, rax ; $rdi = eval(car($rdi), $rsi)
|
||||
lea rsi, [rel nil] ; nil
|
||||
call cons ; $rax = cons(eval(car($rdi), $rsi), 'nil)
|
||||
xchg rax, qword [rsp + 8] ; replace(&mut tail, new_tail)
|
||||
lea rsi, [rel nil]
|
||||
cmp rax, rsi
|
||||
jne .has_init_head
|
||||
mov rax, qword [rsp + 8] ; $rax = new tail
|
||||
mov qword [rsp + 16], rax ; head = new tail
|
||||
mov rdi, qword [rsp + 24] ; $rdi = cdr($rdi)
|
||||
jmp .tailcall
|
||||
.has_init_head:
|
||||
mov rdi, rax
|
||||
mov rsi, qword [rsp + 8]
|
||||
call set_cdr
|
||||
mov rdi, qword [rsp + 24] ; $rdi = cdr($rdi)
|
||||
jmp .tailcall
|
||||
.not_cons:
|
||||
cmp al, OBJ_NIL
|
||||
je .nil
|
||||
mov rsi, qword [rsp] ; $rsi = environment
|
||||
call eval
|
||||
mov rsi, rax
|
||||
mov rdi, qword [rsp + 8] ; $rdi = tail
|
||||
; cdr of tail starts as nil, in the case of a cons cell as a list, we want to update it to be the eval of the cdr of the list
|
||||
call set_cdr ; set_cdr(tail, eval($rdi, $rsi))
|
||||
.nil:
|
||||
; the tail starts as nil
|
||||
mov rax, qword [rsp + 16] ; $rax = head
|
||||
add rsp, 32
|
||||
ret
|
||||
|
||||
;; returns the value associated with the symbol in $rdi in the environment $rsi, or nil if not found
|
||||
assoc:
|
||||
sub rsp, 16
|
||||
mov qword [rsp], rsi ; save the environment on the
|
||||
mov qword [rsp + 8], rdi ; save the symbol on the stack
|
||||
.assoc_loop:
|
||||
mov rdi, qword [rsp] ; $rdi = environment
|
||||
call is_nil
|
||||
test al, al
|
||||
jnz .not_found ; if we've reached the end of the environment, return nil
|
||||
call obj_tag_part
|
||||
cmp al, OBJ_CONS
|
||||
jne .invalid_env
|
||||
call get_car
|
||||
mov rdi, rax
|
||||
call get_car
|
||||
mov rdi, rax ; $rdi = key
|
||||
mov rsi, qword [rsp + 8] ; $rsi = sym
|
||||
call obj_eq
|
||||
test al, al
|
||||
je .found
|
||||
mov rdi, qword [rsp] ; $rdi = environment
|
||||
call get_cdr
|
||||
mov qword [rsp], rax ; environment = cdr(environment)
|
||||
jmp .assoc_loop
|
||||
.found:
|
||||
mov rdi, qword [rsp] ; $rdi = environment
|
||||
call get_car
|
||||
mov rdi, rax
|
||||
call get_cdr
|
||||
add rsp, 16
|
||||
ret
|
||||
.invalid_env:
|
||||
.not_found:
|
||||
lea rax, [rel nil]
|
||||
add rsp, 16
|
||||
ret
|
||||
|
||||
|
||||
;; applies the function in $rdi to the argument list in $rsi in the environment $rdx and returns the result in $rax
|
||||
apply:
|
||||
call obj_tag_part
|
||||
cmp al, OBJ_PRIM
|
||||
je .apply_prim
|
||||
cmp al, OBJ_CLOS
|
||||
jne .invalid_func
|
||||
; closure application:
|
||||
call reduce
|
||||
ret
|
||||
.apply_prim:
|
||||
call obj_addr_part
|
||||
mov rax, qword [rax + 8] ; get the function pointer
|
||||
jmp rax
|
||||
.invalid_func:
|
||||
xor rdi, rdi
|
||||
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
|
||||
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
|
||||
call get_cdr
|
||||
mov qword [rsp + 16], rax ; keys
|
||||
mov rdi, qword [rsp + 16] ; values
|
||||
call get_car
|
||||
mov qword [rsp + 16], 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
|
||||
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
|
||||
.done:
|
||||
ret
|
||||
|
||||
;; applies closure $rdi to arguments $rsi and environment $rdx, returning the result in $rax
|
||||
reduce:
|
||||
; a closure has the following form: ((params . body) . env)
|
||||
sub rsp, 32
|
||||
mov qword [rsp], rdx ; eval_env
|
||||
mov qword [rsp + 8], rdi ; closure
|
||||
call get_cdr
|
||||
mov rdi, rax
|
||||
call is_nil
|
||||
test al, al
|
||||
mov rax, qword [rsp] ; eval_env
|
||||
xchg qword [rsp + 8], rax ;
|
||||
cmovz qword [rsp + 8], rdi ; env = closure_env == nil ? eval_env : closure_env
|
||||
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
|
||||
|
||||
|
||||
|
||||
;; k: $rdi, v: $rsi, e: $rdx -> ((k . v) . e)
|
||||
prepend:
|
||||
push rdx
|
||||
call cons
|
||||
mov rsi, rax
|
||||
pop rdi
|
||||
call cons
|
||||
ret
|
||||
|
||||
|
||||
|
||||
;; PRIMITIVES
|
||||
|
||||
;; returns 1 if the object in $rdi is nil, 0 otherwise
|
||||
is_nil:
|
||||
call obj_tag_part
|
||||
cmp al, OBJ_NIL
|
||||
setz al
|
||||
ret
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
unsafe extern "C" {
|
||||
fn init_atoms();
|
||||
fn parse_next_token(src: *mut Source<'_>) -> Object;
|
||||
fn init_env();
|
||||
fn init_env() -> Object;
|
||||
}
|
||||
|
||||
struct Source<'a> {
|
||||
|
|
@ -53,11 +53,11 @@ extern "C" fn panic_abort(cstr: *const u8) -> ! {
|
|||
}
|
||||
}
|
||||
|
||||
static mut ENV_INIT: std::cell::LazyCell<()> = std::cell::LazyCell::new(|| unsafe {
|
||||
init_env();
|
||||
});
|
||||
static mut ENV_INIT: std::cell::LazyCell<Object> =
|
||||
std::cell::LazyCell::new(|| unsafe { init_env() });
|
||||
|
||||
#[repr(C)]
|
||||
#[derive(Copy, Clone)]
|
||||
struct Object(*mut ());
|
||||
|
||||
// impl Clone for Object {
|
||||
|
|
@ -127,9 +127,8 @@ impl Object {
|
|||
|
||||
#[test]
|
||||
fn test_parse_list() {
|
||||
unsafe {
|
||||
*ENV_INIT;
|
||||
}
|
||||
let env = unsafe { *ENV_INIT };
|
||||
println!("env: {:?}", env);
|
||||
|
||||
let input = b"('a 3 4 5)";
|
||||
let mut src = Source::from(&input[..]);
|
||||
|
|
|
|||
Loading…
Reference in a new issue