kinda working fn
This commit is contained in:
IgorCielniak
@@ -19,7 +19,7 @@ _start:
|
||||
mov rax, 60
|
||||
syscall
|
||||
word_puts:
|
||||
; detects string if top is len>=0 and next is a pointer in [data_start, data_end)
|
||||
; detects string if top is len>=0 and next is a pointer in [data_start, data_end]
|
||||
mov rax, [r12] ; len or int value
|
||||
mov rbx, [r12 + 8] ; possible address
|
||||
cmp rax, 0
|
||||
|
||||
382
build/t.asm
Normal file
382
build/t.asm
Normal file
@@ -0,0 +1,382 @@
|
||||
section .text
|
||||
%define DSTK_BYTES 65536
|
||||
%define RSTK_BYTES 65536
|
||||
%define PRINT_BUF_BYTES 128
|
||||
global _start
|
||||
_start:
|
||||
; initialize data/return stack pointers
|
||||
lea r12, [rel dstack_top]
|
||||
mov r15, r12
|
||||
lea r13, [rel rstack_top]
|
||||
call word_main
|
||||
mov rax, 0
|
||||
cmp r12, r15
|
||||
je .no_exit_value
|
||||
mov rax, [r12]
|
||||
add r12, 8
|
||||
.no_exit_value:
|
||||
mov rdi, rax
|
||||
mov rax, 60
|
||||
syscall
|
||||
word_puts:
|
||||
; detects string if top is len>=0 and next is a pointer in [data_start, data_end]
|
||||
mov rax, [r12] ; len or int value
|
||||
mov rbx, [r12 + 8] ; possible address
|
||||
cmp rax, 0
|
||||
jl puts_print_int
|
||||
lea r8, [rel data_start]
|
||||
lea r9, [rel data_end]
|
||||
cmp rbx, r8
|
||||
jl puts_print_int
|
||||
cmp rbx, r9
|
||||
jge puts_print_int
|
||||
; treat as string: (addr below len)
|
||||
mov rdx, rax ; len
|
||||
mov rsi, rbx ; addr
|
||||
add r12, 16 ; pop len + addr
|
||||
test rdx, rdx
|
||||
jz puts_str_newline_only
|
||||
mov rax, 1
|
||||
mov rdi, 1
|
||||
syscall
|
||||
puts_str_newline_only:
|
||||
mov byte [rel print_buf], 10
|
||||
mov rax, 1
|
||||
mov rdi, 1
|
||||
lea rsi, [rel print_buf]
|
||||
mov rdx, 1
|
||||
syscall
|
||||
ret
|
||||
|
||||
puts_print_int:
|
||||
mov rax, [r12]
|
||||
add r12, 8
|
||||
mov rbx, rax
|
||||
mov r8, 0
|
||||
cmp rbx, 0
|
||||
jge puts_abs
|
||||
neg rbx
|
||||
mov r8, 1
|
||||
puts_abs:
|
||||
lea rsi, [rel print_buf_end]
|
||||
mov rcx, 0
|
||||
mov r10, 10
|
||||
cmp rbx, 0
|
||||
jne puts_digits
|
||||
dec rsi
|
||||
mov byte [rsi], '0'
|
||||
inc rcx
|
||||
jmp puts_sign
|
||||
puts_digits:
|
||||
puts_loop:
|
||||
xor rdx, rdx
|
||||
mov rax, rbx
|
||||
div r10
|
||||
add dl, '0'
|
||||
dec rsi
|
||||
mov [rsi], dl
|
||||
inc rcx
|
||||
mov rbx, rax
|
||||
test rbx, rbx
|
||||
jne puts_loop
|
||||
puts_sign:
|
||||
cmp r8, 0
|
||||
je puts_finish_digits
|
||||
dec rsi
|
||||
mov byte [rsi], '-'
|
||||
inc rcx
|
||||
puts_finish_digits:
|
||||
mov byte [rsi + rcx], 10
|
||||
inc rcx
|
||||
mov rax, 1
|
||||
mov rdi, 1
|
||||
mov rdx, rcx
|
||||
mov r9, rsi
|
||||
mov rsi, r9
|
||||
syscall
|
||||
ret
|
||||
word_dup:
|
||||
mov rax, [r12]
|
||||
sub r12, 8
|
||||
mov [r12], rax
|
||||
ret
|
||||
word_drop:
|
||||
add r12, 8
|
||||
ret
|
||||
word_over:
|
||||
mov rax, [r12 + 8]
|
||||
sub r12, 8
|
||||
mov [r12], rax
|
||||
ret
|
||||
word_swap:
|
||||
mov rax, [r12]
|
||||
mov rbx, [r12 + 8]
|
||||
mov [r12], rbx
|
||||
mov [r12 + 8], rax
|
||||
ret
|
||||
word_rot:
|
||||
mov rax, [r12] ; x3
|
||||
mov rbx, [r12 + 8] ; x2
|
||||
mov rcx, [r12 + 16] ; x1
|
||||
mov [r12], rcx ; top = x1
|
||||
mov [r12 + 8], rax ; next = x3
|
||||
mov [r12 + 16], rbx ; third = x2
|
||||
ret
|
||||
word__2drot:
|
||||
mov rax, [r12] ; x3
|
||||
mov rbx, [r12 + 8] ; x2
|
||||
mov rcx, [r12 + 16] ; x1
|
||||
mov [r12], rbx ; top = x2
|
||||
mov [r12 + 8], rcx ; next = x1
|
||||
mov [r12 + 16], rax ; third = x3
|
||||
ret
|
||||
word_nip:
|
||||
mov rax, [r12]
|
||||
add r12, 8 ; drop lower element
|
||||
mov [r12], rax ; keep original top
|
||||
ret
|
||||
word_tuck:
|
||||
mov rax, [r12] ; x2
|
||||
mov rbx, [r12 + 8] ; x1
|
||||
sub r12, 8 ; make room
|
||||
mov [r12], rax ; x2
|
||||
mov [r12 + 8], rbx ; x1
|
||||
mov [r12 + 16], rax ; x2
|
||||
ret
|
||||
word_2dup:
|
||||
mov rax, [r12] ; b
|
||||
mov rbx, [r12 + 8] ; a
|
||||
sub r12, 8
|
||||
mov [r12], rbx ; push a
|
||||
sub r12, 8
|
||||
mov [r12], rax ; push b
|
||||
ret
|
||||
word_2drop:
|
||||
add r12, 16
|
||||
ret
|
||||
word_2swap:
|
||||
mov rax, [r12] ; d
|
||||
mov rbx, [r12 + 8] ; c
|
||||
mov rcx, [r12 + 16] ; b
|
||||
mov rdx, [r12 + 24] ; a
|
||||
mov [r12], rcx ; top = b
|
||||
mov [r12 + 8], rdx ; next = a
|
||||
mov [r12 + 16], rax ; third = d
|
||||
mov [r12 + 24], rbx ; fourth = c
|
||||
ret
|
||||
word_2over:
|
||||
mov rax, [r12 + 16] ; b
|
||||
mov rbx, [r12 + 24] ; a
|
||||
sub r12, 8
|
||||
mov [r12], rbx ; push a
|
||||
sub r12, 8
|
||||
mov [r12], rax ; push b
|
||||
ret
|
||||
word__2b:
|
||||
mov rax, [r12]
|
||||
add r12, 8
|
||||
add qword [r12], rax
|
||||
ret
|
||||
word__2d:
|
||||
mov rax, [r12]
|
||||
add r12, 8
|
||||
sub qword [r12], rax
|
||||
ret
|
||||
word__2a:
|
||||
mov rax, [r12]
|
||||
add r12, 8
|
||||
imul qword [r12]
|
||||
mov [r12], rax
|
||||
ret
|
||||
word__2f:
|
||||
mov rbx, [r12]
|
||||
add r12, 8
|
||||
mov rax, [r12]
|
||||
cqo
|
||||
idiv rbx
|
||||
mov [r12], rax
|
||||
ret
|
||||
word__25:
|
||||
mov rbx, [r12]
|
||||
add r12, 8
|
||||
mov rax, [r12]
|
||||
cqo
|
||||
idiv rbx
|
||||
mov [r12], rdx
|
||||
ret
|
||||
word__3d_3d:
|
||||
mov rax, [r12]
|
||||
add r12, 8
|
||||
mov rbx, [r12]
|
||||
cmp rbx, rax
|
||||
mov rbx, 0
|
||||
sete bl
|
||||
mov [r12], rbx
|
||||
ret
|
||||
word__21_3d:
|
||||
mov rax, [r12]
|
||||
add r12, 8
|
||||
mov rbx, [r12]
|
||||
cmp rbx, rax
|
||||
mov rbx, 0
|
||||
setne bl
|
||||
mov [r12], rbx
|
||||
ret
|
||||
word__3c:
|
||||
mov rax, [r12]
|
||||
add r12, 8
|
||||
mov rbx, [r12]
|
||||
cmp rbx, rax
|
||||
mov rbx, 0
|
||||
setl bl
|
||||
mov [r12], rbx
|
||||
ret
|
||||
word__3e:
|
||||
mov rax, [r12]
|
||||
add r12, 8
|
||||
mov rbx, [r12]
|
||||
cmp rbx, rax
|
||||
mov rbx, 0
|
||||
setg bl
|
||||
mov [r12], rbx
|
||||
ret
|
||||
word__3c_3d:
|
||||
mov rax, [r12]
|
||||
add r12, 8
|
||||
mov rbx, [r12]
|
||||
cmp rbx, rax
|
||||
mov rbx, 0
|
||||
setle bl
|
||||
mov [r12], rbx
|
||||
ret
|
||||
word__3e_3d:
|
||||
mov rax, [r12]
|
||||
add r12, 8
|
||||
mov rbx, [r12]
|
||||
cmp rbx, rax
|
||||
mov rbx, 0
|
||||
setge bl
|
||||
mov [r12], rbx
|
||||
ret
|
||||
word__40:
|
||||
mov rax, [r12]
|
||||
mov rax, [rax]
|
||||
mov [r12], rax
|
||||
ret
|
||||
word__21:
|
||||
mov rax, [r12]
|
||||
add r12, 8
|
||||
mov rbx, [r12]
|
||||
mov [rax], rbx
|
||||
add r12, 8
|
||||
ret
|
||||
word_mmap:
|
||||
mov r9, [r12]
|
||||
add r12, 8
|
||||
mov r8, [r12]
|
||||
add r12, 8
|
||||
mov r10, [r12]
|
||||
add r12, 8
|
||||
mov rdx, [r12]
|
||||
add r12, 8
|
||||
mov rsi, [r12]
|
||||
add r12, 8
|
||||
mov rdi, [r12]
|
||||
mov rax, 9
|
||||
syscall
|
||||
mov [r12], rax
|
||||
ret
|
||||
word_munmap:
|
||||
mov rsi, [r12]
|
||||
add r12, 8
|
||||
mov rdi, [r12]
|
||||
mov rax, 11
|
||||
syscall
|
||||
mov [r12], rax
|
||||
ret
|
||||
word_exit:
|
||||
mov rdi, [r12]
|
||||
add r12, 8
|
||||
mov rax, 60
|
||||
syscall
|
||||
ret
|
||||
word_and:
|
||||
mov rax, [r12]
|
||||
add r12, 8
|
||||
mov rbx, [r12]
|
||||
test rax, rax
|
||||
setz cl
|
||||
test rbx, rbx
|
||||
setz dl
|
||||
movzx rcx, cl
|
||||
movzx rdx, dl
|
||||
and rcx, rdx
|
||||
mov [r12], rcx
|
||||
ret
|
||||
word_or:
|
||||
mov rax, [r12]
|
||||
add r12, 8
|
||||
mov rbx, [r12]
|
||||
test rax, rax
|
||||
setz cl
|
||||
test rbx, rbx
|
||||
setz dl
|
||||
movzx rcx, cl
|
||||
movzx rdx, dl
|
||||
or rcx, rdx
|
||||
mov [r12], rcx
|
||||
ret
|
||||
word_not:
|
||||
mov rax, [r12]
|
||||
test rax, rax
|
||||
setz al
|
||||
movzx rax, al
|
||||
mov [r12], rax
|
||||
ret
|
||||
word__3er:
|
||||
mov rax, [r12]
|
||||
add r12, 8
|
||||
sub r13, 8
|
||||
mov [r13], rax
|
||||
ret
|
||||
word_r_3e:
|
||||
mov rax, [r13]
|
||||
add r13, 8
|
||||
sub r12, 8
|
||||
mov [r12], rax
|
||||
ret
|
||||
word_rdrop:
|
||||
add r13, 8
|
||||
ret
|
||||
word_pick:
|
||||
mov rcx, [r12]
|
||||
add r12, 8
|
||||
mov rax, [r12 + rcx * 8]
|
||||
sub r12, 8
|
||||
mov [r12], rax
|
||||
ret
|
||||
word_rpick:
|
||||
mov rcx, [r12]
|
||||
add r12, 8
|
||||
mov rax, [r13 + rcx * 8]
|
||||
sub r12, 8
|
||||
mov [r12], rax
|
||||
ret
|
||||
word_main:
|
||||
; push 0
|
||||
sub r12, 8
|
||||
mov qword [r12], 0
|
||||
ret
|
||||
section .data
|
||||
data_start:
|
||||
data_end:
|
||||
section .bss
|
||||
align 16
|
||||
dstack: resb DSTK_BYTES
|
||||
dstack_top:
|
||||
align 16
|
||||
rstack: resb RSTK_BYTES
|
||||
rstack_top:
|
||||
align 16
|
||||
print_buf: resb PRINT_BUF_BYTES
|
||||
print_buf_end:
|
||||
@@ -594,18 +594,18 @@ word_test_2dif:
|
||||
mov rax, [r12]
|
||||
add r12, 8
|
||||
test rax, rax
|
||||
jz L_if_false_24
|
||||
jz L_if_false_34
|
||||
; push 111
|
||||
sub r12, 8
|
||||
mov qword [r12], 111
|
||||
call word_puts
|
||||
jmp L_if_end_25
|
||||
L_if_false_24:
|
||||
jmp L_if_end_35
|
||||
L_if_false_34:
|
||||
; push 222
|
||||
sub r12, 8
|
||||
mov qword [r12], 222
|
||||
call word_puts
|
||||
L_if_end_25:
|
||||
L_if_end_35:
|
||||
ret
|
||||
word_test_2delse_2dif:
|
||||
; push 2
|
||||
@@ -619,13 +619,13 @@ word_test_2delse_2dif:
|
||||
mov rax, [r12]
|
||||
add r12, 8
|
||||
test rax, rax
|
||||
jz L_if_false_26
|
||||
jz L_if_false_36
|
||||
; push 50
|
||||
sub r12, 8
|
||||
mov qword [r12], 50
|
||||
call word_puts
|
||||
jmp L_if_end_27
|
||||
L_if_false_26:
|
||||
jmp L_if_end_37
|
||||
L_if_false_36:
|
||||
call word_dup
|
||||
; push 2
|
||||
sub r12, 8
|
||||
@@ -634,19 +634,19 @@ L_if_false_26:
|
||||
mov rax, [r12]
|
||||
add r12, 8
|
||||
test rax, rax
|
||||
jz L_if_false_28
|
||||
jz L_if_false_38
|
||||
; push 60
|
||||
sub r12, 8
|
||||
mov qword [r12], 60
|
||||
call word_puts
|
||||
jmp L_if_end_29
|
||||
L_if_false_28:
|
||||
jmp L_if_end_39
|
||||
L_if_false_38:
|
||||
; push 70
|
||||
sub r12, 8
|
||||
mov qword [r12], 70
|
||||
call word_puts
|
||||
L_if_end_29:
|
||||
L_if_end_27:
|
||||
L_if_end_39:
|
||||
L_if_end_37:
|
||||
call word_drop
|
||||
ret
|
||||
word_test_2dfor:
|
||||
@@ -659,10 +659,10 @@ word_test_2dfor:
|
||||
mov rax, [r12]
|
||||
add r12, 8
|
||||
cmp rax, 0
|
||||
jle L_for_end_31
|
||||
jle L_for_end_41
|
||||
sub r13, 8
|
||||
mov [r13], rax
|
||||
L_for_loop_30:
|
||||
L_for_loop_40:
|
||||
; push 1
|
||||
sub r12, 8
|
||||
mov qword [r12], 1
|
||||
@@ -670,9 +670,9 @@ L_for_loop_30:
|
||||
mov rax, [r13]
|
||||
dec rax
|
||||
mov [r13], rax
|
||||
jg L_for_loop_30
|
||||
jg L_for_loop_40
|
||||
add r13, 8
|
||||
L_for_end_31:
|
||||
L_for_end_41:
|
||||
call word_puts
|
||||
ret
|
||||
word_test_2dfor_2dzero:
|
||||
@@ -685,17 +685,17 @@ word_test_2dfor_2dzero:
|
||||
mov rax, [r12]
|
||||
add r12, 8
|
||||
cmp rax, 0
|
||||
jle L_for_end_33
|
||||
jle L_for_end_43
|
||||
sub r13, 8
|
||||
mov [r13], rax
|
||||
L_for_loop_32:
|
||||
L_for_loop_42:
|
||||
call word_drop
|
||||
mov rax, [r13]
|
||||
dec rax
|
||||
mov [r13], rax
|
||||
jg L_for_loop_32
|
||||
jg L_for_loop_42
|
||||
add r13, 8
|
||||
L_for_end_33:
|
||||
L_for_end_43:
|
||||
call word_puts
|
||||
ret
|
||||
word_test_2dstruct:
|
||||
|
||||
BIN
build/test.o
BIN
build/test.o
Binary file not shown.
176
fn.sl
176
fn.sl
@@ -30,6 +30,7 @@ again
|
||||
immediate
|
||||
compile-only
|
||||
|
||||
|
||||
: extend-syntax
|
||||
"call-syntax-rewrite" set-token-hook
|
||||
;
|
||||
@@ -127,6 +128,181 @@ compile-only
|
||||
;
|
||||
compile-only
|
||||
|
||||
: fn-emit-prologue # params out -- params out
|
||||
over list-length # params out n
|
||||
begin
|
||||
dup 0 > if
|
||||
1 - # params out n-1
|
||||
>r # params out (r: n-1)
|
||||
">r" list-append # params out'
|
||||
r> # params out' n-1
|
||||
continue
|
||||
then
|
||||
drop # params out
|
||||
exit
|
||||
again
|
||||
;
|
||||
compile-only
|
||||
|
||||
: fn-emit-epilogue # params out -- out
|
||||
over list-length >r # params out (r: n)
|
||||
begin
|
||||
r> dup 0 > if
|
||||
1 - >r
|
||||
"rdrop" list-append
|
||||
continue
|
||||
then
|
||||
drop # drop counter
|
||||
swap drop # out
|
||||
exit
|
||||
again
|
||||
;
|
||||
compile-only
|
||||
|
||||
: fn-translate-prologue-loop # count --
|
||||
dup 0 > if
|
||||
1 -
|
||||
0 rpick ">r" list-append drop
|
||||
fn-translate-prologue-loop
|
||||
then
|
||||
drop
|
||||
;
|
||||
compile-only
|
||||
|
||||
: fn-translate-epilogue-loop # count --
|
||||
dup 0 > if
|
||||
1 -
|
||||
0 rpick "rdrop" list-append drop
|
||||
fn-translate-epilogue-loop
|
||||
then
|
||||
drop
|
||||
;
|
||||
compile-only
|
||||
|
||||
: fn-param-index # params name -- params idx flag
|
||||
>r # params (r: name)
|
||||
0 # params idx
|
||||
|
||||
begin
|
||||
over list-length over swap >= if # params idx flag (idx >= len?)
|
||||
drop # params
|
||||
r> drop # drop name
|
||||
-1 0 exit # params -1 0
|
||||
then # params idx
|
||||
over over list-get # params idx elem
|
||||
0 rpick string= # params idx flag
|
||||
if
|
||||
r> drop # drop name
|
||||
1 exit # params idx 1
|
||||
then
|
||||
drop # params idx
|
||||
1 + # params idx+1
|
||||
again
|
||||
;
|
||||
compile-only
|
||||
|
||||
|
||||
: fn-build-param-map # params -- params map
|
||||
map-new # params map
|
||||
0 # params map idx
|
||||
begin
|
||||
2 pick list-length # params map idx len
|
||||
over swap >= if # params map idx flag
|
||||
drop # params map
|
||||
exit
|
||||
then # params map idx
|
||||
2 pick over list-get # params map idx name
|
||||
swap # params map name idx
|
||||
dup >r # params map name idx (r: idx)
|
||||
map-set # params map'
|
||||
r> 1 + # params map' idx'
|
||||
continue
|
||||
again
|
||||
;
|
||||
compile-only
|
||||
|
||||
|
||||
: fn-translate-token # out map tok -- out map
|
||||
# number?
|
||||
dup string>number # out map tok num ok
|
||||
if
|
||||
# drop tok, append num
|
||||
swap drop # out map num
|
||||
swap >r # out num (r: map)
|
||||
list-append # out'
|
||||
r> # out' map
|
||||
exit
|
||||
then
|
||||
drop # out map tok
|
||||
|
||||
# param?
|
||||
dup >r # out map tok (r: tok)
|
||||
map-get # out map idx|nil ok
|
||||
if
|
||||
# append idx
|
||||
swap >r # out idx (r: map tok)
|
||||
list-append # out'
|
||||
r> # out' map
|
||||
# append "rpick"
|
||||
"rpick" # out' map "rpick"
|
||||
swap >r # out' "rpick" (r: map tok)
|
||||
list-append # out''
|
||||
r> # out'' map
|
||||
# drop saved tok
|
||||
r> drop # out'' map
|
||||
exit
|
||||
then
|
||||
# not a param: drop idx|nil, append original tok
|
||||
drop # out map
|
||||
r> # out map tok
|
||||
swap >r # out tok (r: map)
|
||||
list-append # out'
|
||||
r> # out' map
|
||||
;
|
||||
compile-only
|
||||
|
||||
|
||||
: fn-translate-postfix-loop # map out postfix -- map out
|
||||
begin
|
||||
dup list-empty? if
|
||||
drop
|
||||
exit
|
||||
then
|
||||
list-pop-front # map out postfix' tok
|
||||
swap >r # map out tok (r: postfix')
|
||||
>r swap r> # out map tok (r: postfix')
|
||||
fn-translate-token # out map
|
||||
swap # map out
|
||||
r> # map out postfix'
|
||||
continue
|
||||
again
|
||||
;
|
||||
compile-only
|
||||
|
||||
|
||||
: fn-translate-postfix # postfix params -- out
|
||||
swap # params postfix
|
||||
list-new # params postfix out
|
||||
|
||||
# prologue: stash args on return stack (emit ">r")
|
||||
swap >r # params out (r: postfix)
|
||||
fn-emit-prologue # params out
|
||||
r> swap # params postfix out
|
||||
|
||||
# build param map (name -> index)
|
||||
2 pick fn-build-param-map # params postfix out params map
|
||||
>r drop r> # params postfix out map
|
||||
# reorder to: params map out postfix
|
||||
swap >r swap r> swap # params map out postfix
|
||||
|
||||
# translate tokens
|
||||
fn-translate-postfix-loop # params map out
|
||||
# drop map, emit epilogue
|
||||
swap drop # params out
|
||||
fn-emit-epilogue # out
|
||||
;
|
||||
compile-only
|
||||
|
||||
: fn-build-body
|
||||
fn-translate-postfix # words
|
||||
;
|
||||
|
||||
89
main.py
89
main.py
@@ -476,6 +476,7 @@ class Parser:
|
||||
|
||||
def _execute_immediate_word(self, word: Word) -> None:
|
||||
try:
|
||||
print(f"[ct] invoking {word.name}")
|
||||
self.compile_time_vm.invoke(word)
|
||||
except ParseError:
|
||||
raise
|
||||
@@ -1066,6 +1067,7 @@ class CompileTimeVM:
|
||||
word = self.dictionary.lookup(name)
|
||||
if word is None:
|
||||
raise ParseError(f"unknown word '{name}' during compile-time execution")
|
||||
print(f"[ct-call] {name} stack={self.stack}")
|
||||
self._call_word(word)
|
||||
|
||||
def _execute_nodes(self, nodes: Sequence[ASTNode]) -> None:
|
||||
@@ -1741,17 +1743,6 @@ def _ct_nil(vm: CompileTimeVM) -> None:
|
||||
vm.push(None)
|
||||
|
||||
|
||||
def _ct_puts(vm: CompileTimeVM) -> None:
|
||||
value = vm.pop()
|
||||
if isinstance(value, str):
|
||||
print(value)
|
||||
return
|
||||
if isinstance(value, int):
|
||||
print(value)
|
||||
return
|
||||
raise ParseError("puts expects string or integer at compile time")
|
||||
|
||||
|
||||
def _ct_nil_p(vm: CompileTimeVM) -> None:
|
||||
vm.push(1 if vm.pop() is None else 0)
|
||||
|
||||
@@ -1796,6 +1787,27 @@ def _ct_list_pop_front(vm: CompileTimeVM) -> None:
|
||||
vm.push(value)
|
||||
|
||||
|
||||
def _ct_list_peek_front(vm: CompileTimeVM) -> None:
|
||||
lst = _ensure_list(vm.pop())
|
||||
if not lst:
|
||||
raise ParseError("cannot peek from empty list")
|
||||
vm.push(lst)
|
||||
vm.push(lst[0])
|
||||
|
||||
|
||||
def _ct_list_push_front(vm: CompileTimeVM) -> None:
|
||||
value = vm.pop()
|
||||
lst = _ensure_list(vm.pop())
|
||||
lst.insert(0, value)
|
||||
vm.push(lst)
|
||||
|
||||
|
||||
def _ct_list_reverse(vm: CompileTimeVM) -> None:
|
||||
lst = _ensure_list(vm.pop())
|
||||
lst.reverse()
|
||||
vm.push(lst)
|
||||
|
||||
|
||||
def _ct_list_length(vm: CompileTimeVM) -> None:
|
||||
lst = vm.pop_list()
|
||||
vm.push(len(lst))
|
||||
@@ -1886,8 +1898,11 @@ def _ct_map_has(vm: CompileTimeVM) -> None:
|
||||
|
||||
|
||||
def _ct_string_eq(vm: CompileTimeVM) -> None:
|
||||
right = vm.pop_str()
|
||||
left = vm.pop_str()
|
||||
try:
|
||||
right = vm.pop_str()
|
||||
left = vm.pop_str()
|
||||
except ParseError as exc:
|
||||
raise ParseError(f"string= expects strings; stack={vm.stack!r}") from exc
|
||||
vm.push(1 if left == right else 0)
|
||||
|
||||
|
||||
@@ -1947,47 +1962,6 @@ def _ct_add_token_chars(vm: CompileTimeVM) -> None:
|
||||
vm.parser.reader.add_token_chars(chars)
|
||||
|
||||
|
||||
def _ct_fn_param_index(vm: CompileTimeVM) -> None:
|
||||
name = vm.pop_str()
|
||||
params = _ensure_list(vm.pop())
|
||||
try:
|
||||
idx = params.index(name)
|
||||
vm.push(params)
|
||||
vm.push(idx)
|
||||
vm.push(1)
|
||||
except ValueError:
|
||||
vm.push(params)
|
||||
vm.push(-1)
|
||||
vm.push(0)
|
||||
|
||||
|
||||
def _ct_fn_translate_postfix(vm: CompileTimeVM) -> None:
|
||||
params = _ensure_list(vm.pop())
|
||||
postfix = _ensure_list(vm.pop())
|
||||
prologue: List[Any] = [">r"] * len(params)
|
||||
translated: List[Any] = []
|
||||
for tok in postfix:
|
||||
if isinstance(tok, int):
|
||||
translated.append(tok)
|
||||
continue
|
||||
if isinstance(tok, str):
|
||||
try:
|
||||
num_value = int(tok, 0)
|
||||
translated.append(num_value)
|
||||
continue
|
||||
except ValueError:
|
||||
pass
|
||||
if isinstance(tok, str) and tok in params:
|
||||
idx = params.index(tok)
|
||||
translated.append(idx)
|
||||
translated.append("rpick")
|
||||
else:
|
||||
translated.append(tok)
|
||||
epilogue: List[Any] = ["rdrop"] * len(params)
|
||||
out: List[Any] = prologue + translated + epilogue
|
||||
vm.push(out)
|
||||
|
||||
|
||||
def _ct_shunt(vm: CompileTimeVM) -> None:
|
||||
"""Convert an infix token list (strings) to postfix using +,-,*,/,%."""
|
||||
ops: List[str] = []
|
||||
@@ -2026,8 +2000,6 @@ def _ct_int_to_string(vm: CompileTimeVM) -> None:
|
||||
vm.push(str(value))
|
||||
|
||||
|
||||
|
||||
|
||||
def _ct_identifier_p(vm: CompileTimeVM) -> None:
|
||||
value = vm._resolve_handle(vm.pop())
|
||||
if isinstance(value, Token):
|
||||
@@ -2161,6 +2133,9 @@ def _register_compile_time_primitives(dictionary: Dictionary) -> None:
|
||||
register("drop", _ct_drop)
|
||||
register("list-pop", _ct_list_pop, compile_only=True)
|
||||
register("list-pop-front", _ct_list_pop_front, compile_only=True)
|
||||
register("list-peek-front", _ct_list_peek_front, compile_only=True)
|
||||
register("list-push-front", _ct_list_push_front, compile_only=True)
|
||||
register("list-reverse", _ct_list_reverse, compile_only=True)
|
||||
register("list-length", _ct_list_length, compile_only=True)
|
||||
register("list-empty?", _ct_list_empty, compile_only=True)
|
||||
register("list-get", _ct_list_get, compile_only=True)
|
||||
@@ -2179,8 +2154,6 @@ def _register_compile_time_primitives(dictionary: Dictionary) -> None:
|
||||
register("string-length", _ct_string_length, compile_only=True)
|
||||
register("string-append", _ct_string_append, compile_only=True)
|
||||
register("string>number", _ct_string_to_number, compile_only=True)
|
||||
register("fn-param-index", _ct_fn_param_index, compile_only=True)
|
||||
register("fn-translate-postfix", _ct_fn_translate_postfix, compile_only=True)
|
||||
register("int>string", _ct_int_to_string, compile_only=True)
|
||||
register("identifier?", _ct_identifier_p, compile_only=True)
|
||||
register("shunt", _ct_shunt, compile_only=True)
|
||||
|
||||
Reference in New Issue
Block a user