mirror of
https://github.com/kanaka/mal.git
synced 2024-09-21 10:37:58 +03:00
if and fn* forms working
* Added if and fn* handling in eval
* New Env constructor env_new_bind
which takes a list of binding symbols and expressions
* Macro print_str_mac to shorten raw string printing
* Functions implemented as a list, storing an address to call,
outer environment, bindings and body
* apply_fn handles user-defined functions. Calls env_new_bind,
evaluates the body of the function, and returns the result
Simple tests seem to work:
user> (def! f (fn* (a b) (+ a b)))
#<function>
user> (f 1 2)
3
This commit is contained in:
Ben Dudson
parent
a721b04c24
commit
77872467f6
131
nasm/env.asm
131
nasm/env.asm
@ -1,4 +1,6 @@
|
||||
|
||||
|
||||
%include "macros.mac"
|
||||
|
||||
;; ------------------------------------------------------------
|
||||
;; Environment type
|
||||
;;
|
||||
@ -6,16 +8,17 @@
|
||||
;; current environment, and CDR points to the outer environment
|
||||
;;
|
||||
;; ( {} {} ... )
|
||||
|
||||
|
||||
section .data
|
||||
|
||||
env_symbol: ISTRUC Array
|
||||
AT Array.type, db maltype_symbol
|
||||
AT Array.length, dd 5
|
||||
AT Array.data, db '*env*'
|
||||
IEND
|
||||
section .data
|
||||
|
||||
;; Symbols used for comparison
|
||||
static_symbol env_symbol, '*env*'
|
||||
|
||||
;; Error message strings
|
||||
|
||||
static env_binds_error_string, db "Expecting symbol in binds list",10
|
||||
static env_binds_missing_string, db "Missing expression in bind",10
|
||||
|
||||
section .text
|
||||
|
||||
;; Create a new Environment
|
||||
@ -52,6 +55,116 @@ env_new:
|
||||
mov rax, rbx
|
||||
ret
|
||||
|
||||
;; Create a new environment using a binding list
|
||||
;;
|
||||
;; Input: RSI - Outer environment
|
||||
;; RDI - Binds, a list of symbols
|
||||
;; RCX - Exprs, a list of values to bind each symbol to
|
||||
;;
|
||||
;; Modifies registers
|
||||
;; RBX
|
||||
;; R8
|
||||
;; R9
|
||||
;; R10
|
||||
;; R11
|
||||
;; R12
|
||||
;; R13
|
||||
env_new_bind:
|
||||
mov r11, rdi ; binds list in R11
|
||||
mov r12, rcx ; expr list in R12
|
||||
|
||||
call env_new
|
||||
mov r13, rax ; New environment in R13
|
||||
|
||||
.bind_loop:
|
||||
; Check the type in the bind list
|
||||
mov bl, BYTE [r11]
|
||||
and bl, content_mask
|
||||
cmp bl, content_pointer
|
||||
jne .bind_not_symbol
|
||||
|
||||
mov rdi, [r11 + Cons.car] ; Symbol object?
|
||||
mov bl, BYTE [rdi]
|
||||
cmp bl, maltype_symbol
|
||||
jne .bind_not_symbol
|
||||
|
||||
; RDI now contains a symbol
|
||||
; Check the type in expr
|
||||
|
||||
mov bl, BYTE [r12]
|
||||
mov bh, bl
|
||||
and bh, content_mask
|
||||
cmp bh, content_pointer
|
||||
je .value_pointer
|
||||
|
||||
; A value. Need to remove the container type
|
||||
xchg bl,bh
|
||||
mov [r12], BYTE bl
|
||||
xchg bl,bh
|
||||
mov rcx, r12 ; Value
|
||||
mov rsi, r13 ; Env
|
||||
push rbx
|
||||
call env_set
|
||||
pop rbx
|
||||
; Restore original type
|
||||
mov [r12], BYTE bl
|
||||
jmp .next
|
||||
|
||||
.value_pointer:
|
||||
; A pointer to something, so just pass address to env_set
|
||||
mov rcx, [r12 + Cons.car]
|
||||
mov rsi, r13
|
||||
call env_set
|
||||
; Fall through to next
|
||||
.next:
|
||||
; Check if there is a next
|
||||
mov bl, BYTE [r11 + Cons.typecdr]
|
||||
cmp bl, content_pointer
|
||||
jne .done
|
||||
|
||||
; Got another symbol
|
||||
mov r11, [r11 + Cons.cdr] ; Next symbol
|
||||
|
||||
; Check if there's an expression to bind to
|
||||
mov bl, BYTE [r12 + Cons.typecdr]
|
||||
cmp bl, content_pointer
|
||||
jne .bind_missing_expr
|
||||
|
||||
mov r12, [r12 + Cons.cdr] ; Next expression
|
||||
jmp .bind_loop
|
||||
.done:
|
||||
mov rax, r13 ; Env
|
||||
ret
|
||||
|
||||
.bind_not_symbol: ; Expecting a symbol
|
||||
push r11 ; Binds list
|
||||
|
||||
; Release the environment
|
||||
mov rsi, r13
|
||||
call release_object
|
||||
|
||||
print_str_mac error_string ; print 'Error: '
|
||||
|
||||
print_str_mac env_binds_error_string
|
||||
|
||||
pop rsi ; Throw binds list
|
||||
jmp error_throw
|
||||
|
||||
.bind_missing_expr:
|
||||
push r11 ; Binds list
|
||||
|
||||
; Release the environment
|
||||
mov rsi, r13
|
||||
call release_object
|
||||
|
||||
print_str_mac error_string ; print 'Error: '
|
||||
|
||||
print_str_mac env_binds_missing_string
|
||||
|
||||
pop rsi ; Throw binds list
|
||||
jmp error_throw
|
||||
|
||||
|
||||
;; Environment set
|
||||
;;
|
||||
;; Sets a key-value pair in an environment
|
||||
|
||||
@ -29,6 +29,14 @@
|
||||
AT Array.data, db %2
|
||||
IEND
|
||||
%endmacro
|
||||
|
||||
;; Macro for printing raw string
|
||||
;;
|
||||
%macro print_str_mac 1
|
||||
mov rsi, %1 ; String address
|
||||
mov rdx, %1.len ; Length of string
|
||||
call print_rawstring
|
||||
%endmacro
|
||||
|
||||
%endif
|
||||
|
||||
|
||||
@ -231,19 +231,15 @@ eval_ast:
|
||||
|
||||
; Not found, throw an error
|
||||
push rsi
|
||||
mov rsi, error_string
|
||||
mov rdx, error_string.len
|
||||
call print_rawstring ; print 'Error: '
|
||||
|
||||
print_str_mac error_string ; print 'Error: '
|
||||
|
||||
pop rsi
|
||||
push rsi
|
||||
mov edx, [rsi + Array.length]
|
||||
add rsi, Array.data
|
||||
call print_rawstring ; print symbol
|
||||
|
||||
mov rsi, not_found_string
|
||||
mov rdx, not_found_string.len
|
||||
call print_rawstring ; print ' not found'
|
||||
|
||||
print_str_mac not_found_string ; print ' not found'
|
||||
pop rsi
|
||||
|
||||
jmp error_throw
|
||||
@ -763,9 +759,7 @@ eval:
|
||||
.def_handle_error:
|
||||
push rsi
|
||||
push rdx
|
||||
mov rsi, error_string
|
||||
mov rdx, error_string.len
|
||||
call print_rawstring ; print 'Error: '
|
||||
print_str_mac error_string ; print 'Error: '
|
||||
|
||||
pop rdx
|
||||
pop rsi
|
||||
@ -954,9 +948,8 @@ eval:
|
||||
|
||||
push rsi
|
||||
push rdx
|
||||
mov rsi, error_string
|
||||
mov rdx, error_string.len
|
||||
call print_rawstring ; print 'Error: '
|
||||
|
||||
print_str_mac error_string ; print 'Error: '
|
||||
|
||||
pop rdx
|
||||
pop rsi
|
||||
@ -1045,12 +1038,211 @@ eval:
|
||||
; -----------------------------
|
||||
|
||||
.if_symbol:
|
||||
mov r11, rsi ; if form in R11
|
||||
; Environment in R15
|
||||
|
||||
mov al, BYTE [r11 + Cons.typecdr]
|
||||
cmp al, content_pointer
|
||||
jne .if_no_condition
|
||||
|
||||
mov r11, [r11 + Cons.cdr] ; Should be a condition
|
||||
|
||||
; Check if value or pointer
|
||||
mov al, BYTE [r11]
|
||||
and al, content_mask
|
||||
cmp al, content_pointer
|
||||
jne .if_cond_value
|
||||
|
||||
; A pointer, so evaluate
|
||||
|
||||
push r15
|
||||
push r11
|
||||
mov rsi, [r11 + Cons.car] ; Form
|
||||
mov rdi, r15 ; Env
|
||||
call eval ; Result in RAX
|
||||
pop r11
|
||||
pop r15
|
||||
|
||||
; Get type
|
||||
mov bl, BYTE [rax]
|
||||
|
||||
; release value
|
||||
push rbx
|
||||
mov rsi, rax
|
||||
call release_object
|
||||
pop rbx
|
||||
|
||||
; Check type
|
||||
cmp bl, maltype_nil
|
||||
je .if_false
|
||||
cmp bl, maltype_false
|
||||
je .if_false
|
||||
|
||||
jmp .if_true
|
||||
|
||||
.if_cond_value:
|
||||
|
||||
; A value
|
||||
cmp al, content_nil
|
||||
je .if_false
|
||||
cmp al, content_false
|
||||
je .if_false
|
||||
|
||||
jmp .if_true
|
||||
|
||||
.if_false:
|
||||
; Skip the next item
|
||||
mov al, BYTE [r11 + Cons.typecdr]
|
||||
cmp al, content_pointer
|
||||
jne .if_nil
|
||||
|
||||
mov r11, [r11 + Cons.cdr]
|
||||
|
||||
.if_true:
|
||||
; Get the next item in the list and evaluate it
|
||||
mov al, BYTE [r11 + Cons.typecdr]
|
||||
cmp al, content_pointer
|
||||
jne .if_nil
|
||||
|
||||
mov r11, [r11 + Cons.cdr]
|
||||
|
||||
; Check if value or pointer
|
||||
mov al, BYTE [r11]
|
||||
and al, content_mask
|
||||
cmp al, content_pointer
|
||||
je .if_got_pointer
|
||||
|
||||
.if_got_value:
|
||||
; copy value in r11
|
||||
call alloc_cons
|
||||
mov bl, BYTE [r11]
|
||||
and bl, content_mask
|
||||
mov [rax], BYTE bl
|
||||
mov rbx, [r11 + Cons.car]
|
||||
mov [rax + Cons.car], rbx
|
||||
ret
|
||||
|
||||
.if_got_pointer:
|
||||
mov rsi, [r11 + Cons.car] ; Form
|
||||
mov rdi, r15 ; Env
|
||||
call eval
|
||||
ret
|
||||
|
||||
.if_no_condition: ; just (if) without a condition
|
||||
call alloc_cons
|
||||
mov [rax], BYTE maltype_nil
|
||||
mov [rax + Cons.typecdr], BYTE content_nil
|
||||
ret
|
||||
|
||||
.if_nil:
|
||||
call alloc_cons
|
||||
mov [rax], BYTE maltype_nil
|
||||
mov [rax + Cons.typecdr], BYTE content_nil
|
||||
ret
|
||||
|
||||
; -----------------------------
|
||||
|
||||
.fn_symbol:
|
||||
mov r11, rsi ; fn form in R11
|
||||
; Environment in R15
|
||||
|
||||
; Get the binds and body of the function
|
||||
mov al, BYTE [r11 + Cons.typecdr]
|
||||
cmp al, content_pointer
|
||||
jne .fn_empty
|
||||
|
||||
mov r11, [r11 + Cons.cdr]
|
||||
mov al, BYTE [r11]
|
||||
and al, content_mask
|
||||
cmp al, content_pointer
|
||||
jne .fn_binds_not_list
|
||||
|
||||
mov r12, [r11 + Cons.car] ; Should be binds list
|
||||
mov al, BYTE [r12]
|
||||
and al, (block_mask + container_mask)
|
||||
cmp al, (block_cons + container_list)
|
||||
je .fn_got_binds ; Can be list
|
||||
cmp al, (block_cons + container_vector)
|
||||
je .fn_got_binds ; or vector
|
||||
jmp .fn_binds_not_list
|
||||
|
||||
.fn_got_binds:
|
||||
|
||||
; Next get the body of the function
|
||||
mov al, BYTE [r11 + Cons.typecdr]
|
||||
cmp al, content_pointer
|
||||
jne .fn_no_body
|
||||
|
||||
mov r11, [r11 + Cons.cdr]
|
||||
; Check value or pointer
|
||||
mov al, BYTE [r11]
|
||||
and al, content_mask
|
||||
cmp al, content_pointer
|
||||
jne .fn_got_body ; Body in r11
|
||||
mov r11, [r11 + Cons.car]
|
||||
.fn_got_body:
|
||||
|
||||
; Now put into function type
|
||||
; Addr is "apply_fn", the address to call
|
||||
; Env in R15
|
||||
; Binds in R12
|
||||
; Body in R11
|
||||
|
||||
call alloc_cons
|
||||
mov [rax], BYTE (block_cons + container_function + content_function)
|
||||
mov rbx, apply_fn
|
||||
mov [rax + Cons.car], rbx ; Address of apply function
|
||||
mov [rax + Cons.typecdr], BYTE content_pointer
|
||||
|
||||
mov r13, rax ; Return list in R13
|
||||
|
||||
call alloc_cons
|
||||
mov [rax], BYTE (block_cons + container_function + content_pointer)
|
||||
mov [rax + Cons.car], r15 ; Environment
|
||||
mov [rax + Cons.typecdr], BYTE content_pointer
|
||||
|
||||
mov [r13 + Cons.cdr], rax ; Append to list
|
||||
mov r14, rax
|
||||
|
||||
push rax
|
||||
mov rsi, r15
|
||||
call incref_object
|
||||
pop rax
|
||||
|
||||
call alloc_cons
|
||||
mov [rax], BYTE (block_cons + container_function + content_pointer)
|
||||
mov [rax + Cons.car], r12 ; Binds list
|
||||
mov [rax + Cons.typecdr], BYTE content_pointer
|
||||
|
||||
mov [r14 + Cons.cdr], rax ; Append to list
|
||||
mov r14, rax
|
||||
|
||||
push rax
|
||||
mov rsi, r12
|
||||
call incref_object
|
||||
pop rax
|
||||
|
||||
call alloc_cons
|
||||
mov [rax], BYTE (block_cons + container_function + content_pointer)
|
||||
mov [rax + Cons.car], r11 ; Body of function
|
||||
|
||||
mov [r14 + Cons.cdr], rax
|
||||
|
||||
mov rsi, r11
|
||||
call incref_object
|
||||
|
||||
mov rax, r13
|
||||
ret
|
||||
|
||||
.fn_empty:
|
||||
.fn_binds_not_list:
|
||||
.fn_no_body:
|
||||
|
||||
call alloc_cons
|
||||
mov [rax], BYTE maltype_nil
|
||||
mov [rax + Cons.typecdr], BYTE content_nil
|
||||
ret
|
||||
|
||||
|
||||
; -----------------------------
|
||||
|
||||
@ -1093,6 +1285,38 @@ eval:
|
||||
.empty_list:
|
||||
mov rax, rsi
|
||||
ret
|
||||
|
||||
;; Applies a user-defined function
|
||||
;;
|
||||
;; Input: RSI - Arguments to bind
|
||||
;; RDI - Function object
|
||||
apply_fn:
|
||||
push rsi
|
||||
; Extract values from the list in RDI
|
||||
mov rax, [rdi + Cons.cdr]
|
||||
mov rsi, [rax + Cons.car] ; Env
|
||||
mov rax, [rax + Cons.cdr]
|
||||
mov rdi, [rax + Cons.car] ; Binds
|
||||
pop rcx ; Exprs
|
||||
|
||||
push rax
|
||||
call env_new_bind
|
||||
mov rdi, rax ; New environment in RDI
|
||||
pop rax ; Function object
|
||||
|
||||
mov rax, [rax + Cons.cdr]
|
||||
mov rsi, [rax + Cons.car] ; Body
|
||||
|
||||
push rdi ; Environment
|
||||
call eval
|
||||
pop rsi
|
||||
|
||||
; Release the environment
|
||||
push rax
|
||||
call release_object
|
||||
pop rax
|
||||
|
||||
ret
|
||||
|
||||
;; Prints the result
|
||||
print:
|
||||
@ -1127,9 +1351,7 @@ _start:
|
||||
|
||||
.mainLoop:
|
||||
; print the prompt
|
||||
mov rdx, prompt_string.len ; number of bytes
|
||||
mov rsi, prompt_string ; address of raw string to output
|
||||
call print_rawstring
|
||||
print_str_mac prompt_string
|
||||
|
||||
call read_line
|
||||
|
||||
|
||||
@ -1160,7 +1160,7 @@ map_set:
|
||||
; Here a Cons object
|
||||
mov bh, bl
|
||||
and bh, container_mask
|
||||
cmp bl, container_value
|
||||
cmp bh, container_value
|
||||
jne .set_value_pointer ; Not a simple value, so point to it
|
||||
; A value, so copy
|
||||
mov rcx, [r10 + Cons.car]
|
||||
@ -1357,8 +1357,11 @@ map_keys:
|
||||
;;
|
||||
;; Functions are consist of a list
|
||||
;; - First car is the function address to call
|
||||
;;
|
||||
;; ( addr )
|
||||
;; - Second is the environment
|
||||
;; - Third is the binds list
|
||||
;; - Fourth is the body of the function
|
||||
;;
|
||||
;; ( addr env binds body )
|
||||
;;
|
||||
;;
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user