7857 - shell: first function call
This commit is contained in:
Kartik K. Agaram
parent
e4fc67ee44
commit
bcde6be528
156
shell/eval.mu
156
shell/eval.mu
|
|
@ -29,9 +29,108 @@ fn evaluate _in: (addr handle cell), out: (addr handle cell), env: (addr cell),
|
|||
trace-higher trace
|
||||
return
|
||||
}
|
||||
# TODO: pairs
|
||||
copy-object _in, out
|
||||
trace-higher trace
|
||||
# in-addr is a pair
|
||||
# TODO: special forms
|
||||
trace-text trace, "eval", "function call"
|
||||
trace-text trace, "eval", "evaluating list elements"
|
||||
var evaluated-list-storage: (handle cell)
|
||||
var evaluated-list-ah/esi: (addr handle cell) <- address evaluated-list-storage
|
||||
var curr-out-ah/edx: (addr handle cell) <- copy evaluated-list-ah
|
||||
var curr/ecx: (addr cell) <- copy in-addr
|
||||
$evaluate-list:loop: {
|
||||
allocate-pair curr-out-ah
|
||||
var is-nil?/eax: boolean <- is-nil? curr
|
||||
compare is-nil?, 0/false
|
||||
break-if-!=
|
||||
# eval left
|
||||
var curr-out/eax: (addr cell) <- lookup *curr-out-ah
|
||||
var left-out-ah/edi: (addr handle cell) <- get curr-out, left
|
||||
var left-ah/esi: (addr handle cell) <- get curr, left
|
||||
evaluate left-ah, left-out-ah, env, trace
|
||||
#
|
||||
curr-out-ah <- get curr-out, right
|
||||
var right-ah/eax: (addr handle cell) <- get curr, right
|
||||
var right/eax: (addr cell) <- lookup *right-ah
|
||||
curr <- copy right
|
||||
loop
|
||||
}
|
||||
trace-text trace, "eval", "apply"
|
||||
var evaluated-list/eax: (addr cell) <- lookup *evaluated-list-ah
|
||||
var function-ah/ecx: (addr handle cell) <- get evaluated-list, left
|
||||
var args-ah/edx: (addr handle cell) <- get evaluated-list, right
|
||||
#? dump-cell args-ah
|
||||
#? abort "aaa"
|
||||
apply function-ah, args-ah, out, env, trace
|
||||
}
|
||||
|
||||
fn apply _f-ah: (addr handle cell), args-ah: (addr handle cell), out: (addr handle cell), env: (addr cell), trace: (addr trace) {
|
||||
var f-ah/eax: (addr handle cell) <- copy _f-ah
|
||||
var f/eax: (addr cell) <- lookup *f-ah
|
||||
{
|
||||
var f-type/ecx: (addr int) <- get f, type
|
||||
compare *f-type, 4/primitive-function
|
||||
break-if-!=
|
||||
apply-primitive f, args-ah, out, env, trace
|
||||
return
|
||||
}
|
||||
abort "unknown function"
|
||||
}
|
||||
|
||||
fn apply-primitive _f: (addr cell), args-ah: (addr handle cell), out: (addr handle cell), env: (addr cell), trace: (addr trace) {
|
||||
var f/esi: (addr cell) <- copy _f
|
||||
var f-index/eax: (addr int) <- get f, index-data
|
||||
{
|
||||
compare *f-index, 1/add
|
||||
break-if-!=
|
||||
apply-add args-ah, out, env, trace
|
||||
return
|
||||
}
|
||||
abort "unknown primitive function"
|
||||
}
|
||||
|
||||
fn apply-add _args-ah: (addr handle cell), out: (addr handle cell), env: (addr cell), trace: (addr trace) {
|
||||
var args-ah/eax: (addr handle cell) <- copy _args-ah
|
||||
var _args/eax: (addr cell) <- lookup *args-ah
|
||||
var args/esi: (addr cell) <- copy _args
|
||||
# TODO: check that args is a pair
|
||||
var empty-args?/eax: boolean <- is-nil? args
|
||||
compare empty-args?, 0/false
|
||||
{
|
||||
break-if-=
|
||||
error trace, "+ needs 2 args but got 0"
|
||||
return
|
||||
}
|
||||
# args->left->value
|
||||
var first-ah/eax: (addr handle cell) <- get args, left
|
||||
var first/eax: (addr cell) <- lookup *first-ah
|
||||
var first-type/ecx: (addr int) <- get first, type
|
||||
compare *first-type, 1/number
|
||||
{
|
||||
break-if-=
|
||||
error trace, "first arg for + is not a number"
|
||||
return
|
||||
}
|
||||
var first-value/ecx: (addr float) <- get first, number-data
|
||||
# args->right->left->value
|
||||
var right-ah/eax: (addr handle cell) <- get args, right
|
||||
#? dump-cell right-ah
|
||||
#? abort "aaa"
|
||||
var right/eax: (addr cell) <- lookup *right-ah
|
||||
# TODO: check that right is a pair
|
||||
var second-ah/eax: (addr handle cell) <- get right, left
|
||||
var second/eax: (addr cell) <- lookup *second-ah
|
||||
var second-type/edx: (addr int) <- get second, type
|
||||
compare *second-type, 1/number
|
||||
{
|
||||
break-if-=
|
||||
error trace, "second arg for + is not a number"
|
||||
return
|
||||
}
|
||||
var second-value/edx: (addr float) <- get second, number-data
|
||||
# add
|
||||
var result/xmm0: float <- copy *first-value
|
||||
result <- add *second-value
|
||||
new-float out, result
|
||||
}
|
||||
|
||||
fn lookup-symbol sym: (addr cell), out: (addr handle cell), _env: (addr cell), trace: (addr trace) {
|
||||
|
|
@ -120,10 +219,10 @@ fn lookup-symbol-in-hardcoded-globals _sym: (addr cell), out: (addr handle cell)
|
|||
var _sym-data/eax: (addr stream byte) <- lookup *sym-data-ah
|
||||
var sym-data/esi: (addr stream byte) <- copy _sym-data
|
||||
{
|
||||
var is-plus?/eax: boolean <- stream-data-equal? sym-data, "+"
|
||||
compare is-plus?, 0/false
|
||||
var is-add?/eax: boolean <- stream-data-equal? sym-data, "+"
|
||||
compare is-add?, 0/false
|
||||
break-if-=
|
||||
new-primitive-function out, 1/plus
|
||||
new-primitive-function out, 1/add
|
||||
trace-text trace, "eval", "global +"
|
||||
return
|
||||
}
|
||||
|
|
@ -183,7 +282,7 @@ fn test-lookup-symbol-in-hardcoded-globals {
|
|||
var result-type/edx: (addr int) <- get result, type
|
||||
check-ints-equal *result-type, 4/primitive-function, "F - test-lookup-symbol-in-hardcoded-globals/0"
|
||||
var result-value/eax: (addr int) <- get result, index-data
|
||||
check-ints-equal *result-value, 1/plus, "F - test-lookup-symbol-in-hardcoded-globals/1"
|
||||
check-ints-equal *result-value, 1/add, "F - test-lookup-symbol-in-hardcoded-globals/1"
|
||||
}
|
||||
|
||||
fn car _in: (addr cell), out: (addr handle cell), trace: (addr trace) {
|
||||
|
|
@ -419,18 +518,51 @@ fn test-evaluate-primitive-function {
|
|||
var nil-storage: (handle cell)
|
||||
var nil-ah/ecx: (addr handle cell) <- address nil-storage
|
||||
allocate-pair nil-ah
|
||||
var plus-storage: (handle cell)
|
||||
var plus-ah/ebx: (addr handle cell) <- address plus-storage
|
||||
new-symbol plus-ah, "+"
|
||||
var add-storage: (handle cell)
|
||||
var add-ah/ebx: (addr handle cell) <- address add-storage
|
||||
new-symbol add-ah, "+"
|
||||
# eval +, nil env
|
||||
var tmp-storage: (handle cell)
|
||||
var tmp-ah/esi: (addr handle cell) <- address tmp-storage
|
||||
var env/eax: (addr cell) <- lookup *nil-ah
|
||||
evaluate plus-ah, tmp-ah, env, 0/no-trace
|
||||
evaluate add-ah, tmp-ah, env, 0/no-trace
|
||||
#
|
||||
var result/eax: (addr cell) <- lookup *tmp-ah
|
||||
var result-type/edx: (addr int) <- get result, type
|
||||
check-ints-equal *result-type, 4/primitive-function, "F - test-evaluate-primitive-function/0"
|
||||
var result-value/eax: (addr int) <- get result, index-data
|
||||
check-ints-equal *result-value, 1/plus, "F - test-evaluate-primitive-function/1"
|
||||
check-ints-equal *result-value, 1/add, "F - test-evaluate-primitive-function/1"
|
||||
}
|
||||
|
||||
fn test-evaluate-primitive-function-call {
|
||||
var t-storage: trace
|
||||
var t/edi: (addr trace) <- address t-storage
|
||||
initialize-trace t, 0x100, 0/visible # we don't use trace UI
|
||||
#
|
||||
var nil-storage: (handle cell)
|
||||
var nil-ah/ecx: (addr handle cell) <- address nil-storage
|
||||
allocate-pair nil-ah
|
||||
var one-storage: (handle cell)
|
||||
var one-ah/edx: (addr handle cell) <- address one-storage
|
||||
new-integer one-ah, 1
|
||||
var add-storage: (handle cell)
|
||||
var add-ah/ebx: (addr handle cell) <- address add-storage
|
||||
new-symbol add-ah, "+"
|
||||
# eval (+ 1 1), nil env
|
||||
var tmp-storage: (handle cell)
|
||||
var tmp-ah/esi: (addr handle cell) <- address tmp-storage
|
||||
new-pair tmp-ah, *one-ah, *nil-ah
|
||||
new-pair tmp-ah, *one-ah, *tmp-ah
|
||||
new-pair tmp-ah, *add-ah, *tmp-ah
|
||||
#? dump-cell tmp-ah
|
||||
var env/eax: (addr cell) <- lookup *nil-ah
|
||||
evaluate tmp-ah, tmp-ah, env, t
|
||||
#? dump-trace t
|
||||
#
|
||||
var result/eax: (addr cell) <- lookup *tmp-ah
|
||||
var result-type/edx: (addr int) <- get result, type
|
||||
check-ints-equal *result-type, 1/number, "F - test-evaluate-primitive-function-call/0"
|
||||
var result-value-addr/eax: (addr float) <- get result, number-data
|
||||
var result-value/eax: int <- convert *result-value-addr
|
||||
check-ints-equal result-value, 2, "F - test-evaluate-primitive-function-call/1"
|
||||
}
|
||||
|
|
|
|||
|
|
@ -35,6 +35,16 @@ fn print-cell _in: (addr handle cell), out: (addr stream byte), trace: (addr tra
|
|||
}
|
||||
}
|
||||
|
||||
# debug helper
|
||||
fn dump-cell in-ah: (addr handle cell) {
|
||||
var stream-storage: (stream byte 0x40)
|
||||
var stream/edx: (addr stream byte) <- address stream-storage
|
||||
print-cell in-ah, stream, 0/no-trace
|
||||
var d1/eax: int <- copy 0
|
||||
var d2/ecx: int <- copy 0
|
||||
d1, d2 <- draw-stream-wrapping-right-then-down 0/screen, stream, 0/xmin, 0/ymin, 0x80/xmax, 0x30/ymax, 0/x, 0/y, 7/fg, 0/bg
|
||||
}
|
||||
|
||||
fn print-symbol _in: (addr cell), out: (addr stream byte), trace: (addr trace) {
|
||||
trace-text trace, "print", "symbol"
|
||||
var in/esi: (addr cell) <- copy _in
|
||||
|
|
|
|||
|
|
@ -73,6 +73,14 @@ fn next-token in: (addr gap-buffer), _out-cell: (addr cell), trace: (addr trace)
|
|||
next-bracket-token g, out, trace
|
||||
break $next-token:body
|
||||
}
|
||||
# non-symbol operators
|
||||
{
|
||||
var operator?/eax: boolean <- is-operator-grapheme? g
|
||||
compare operator?, 0/false
|
||||
break-if-=
|
||||
next-operator-token in, out, trace
|
||||
break $next-token:body
|
||||
}
|
||||
}
|
||||
trace-higher trace
|
||||
var stream-storage: (stream byte 0x40)
|
||||
|
|
@ -120,6 +128,43 @@ fn next-symbol-token in: (addr gap-buffer), out: (addr stream byte), trace: (add
|
|||
trace trace, "read", stream
|
||||
}
|
||||
|
||||
fn next-operator-token in: (addr gap-buffer), out: (addr stream byte), trace: (addr trace) {
|
||||
trace-text trace, "read", "looking for a operator"
|
||||
trace-lower trace
|
||||
$next-operator-token:loop: {
|
||||
var done?/eax: boolean <- gap-buffer-scan-done? in
|
||||
compare done?, 0/false
|
||||
break-if-!=
|
||||
var g/eax: grapheme <- peek-from-gap-buffer in
|
||||
{
|
||||
var stream-storage: (stream byte 0x40)
|
||||
var stream/esi: (addr stream byte) <- address stream-storage
|
||||
write stream, "next: "
|
||||
var gval/eax: int <- copy g
|
||||
write-int32-hex stream, gval
|
||||
trace trace, "read", stream
|
||||
}
|
||||
# if non-operator, return
|
||||
{
|
||||
var operator-grapheme?/eax: boolean <- is-operator-grapheme? g
|
||||
compare operator-grapheme?, 0/false
|
||||
break-if-!=
|
||||
trace-text trace, "read", "stop"
|
||||
break $next-operator-token:loop
|
||||
}
|
||||
var g/eax: grapheme <- read-from-gap-buffer in
|
||||
write-grapheme out, g
|
||||
loop
|
||||
}
|
||||
trace-higher trace
|
||||
var stream-storage: (stream byte 0x40)
|
||||
var stream/esi: (addr stream byte) <- address stream-storage
|
||||
write stream, "=> "
|
||||
rewind-stream out
|
||||
write-stream stream, out
|
||||
trace trace, "read", stream
|
||||
}
|
||||
|
||||
fn next-number-token in: (addr gap-buffer), out: (addr stream byte), trace: (addr trace) {
|
||||
trace-text trace, "read", "looking for a number"
|
||||
trace-lower trace
|
||||
|
|
@ -194,11 +239,6 @@ fn is-symbol-grapheme? g: grapheme -> _/eax: boolean {
|
|||
break-if-!=
|
||||
return 0/false
|
||||
}
|
||||
compare g, 0x27/single-quote
|
||||
{
|
||||
break-if-!=
|
||||
return 0/false
|
||||
}
|
||||
compare g, 0x60/backquote
|
||||
{
|
||||
break-if-!=
|
||||
|
|
@ -253,6 +293,11 @@ fn is-symbol-grapheme? g: grapheme -> _/eax: boolean {
|
|||
break-if-!=
|
||||
return 0/false
|
||||
}
|
||||
compare g, 0x27/single-quote
|
||||
{
|
||||
break-if-!=
|
||||
return 0/false
|
||||
}
|
||||
compare g, 0x2a/asterisk
|
||||
{
|
||||
break-if-!=
|
||||
|
|
@ -268,13 +313,12 @@ fn is-symbol-grapheme? g: grapheme -> _/eax: boolean {
|
|||
break-if-!=
|
||||
return 0/false
|
||||
}
|
||||
# '-' is a symbol char
|
||||
compare g, 0x2e/period
|
||||
compare g, 0x2d/dash # '-' not allowed in symbols
|
||||
{
|
||||
break-if-!=
|
||||
return 0/false
|
||||
}
|
||||
compare g, 0x2f/slash
|
||||
compare g, 0x2e/period
|
||||
{
|
||||
break-if-!=
|
||||
return 0/false
|
||||
|
|
@ -373,6 +417,108 @@ fn is-bracket-grapheme? g: grapheme -> _/eax: boolean {
|
|||
return 0/false
|
||||
}
|
||||
|
||||
fn is-operator-grapheme? g: grapheme -> _/eax: boolean {
|
||||
# '$' is a symbol char
|
||||
compare g, 0x25/percent
|
||||
{
|
||||
break-if-!=
|
||||
return 1/false
|
||||
}
|
||||
compare g, 0x26/ampersand
|
||||
{
|
||||
break-if-!=
|
||||
return 1/true
|
||||
}
|
||||
compare g, 0x27/single-quote
|
||||
{
|
||||
break-if-!=
|
||||
return 1/true
|
||||
}
|
||||
compare g, 0x2a/asterisk
|
||||
{
|
||||
break-if-!=
|
||||
return 1/true
|
||||
}
|
||||
compare g, 0x2b/plus
|
||||
{
|
||||
break-if-!=
|
||||
return 1/true
|
||||
}
|
||||
compare g, 0x2c/comma
|
||||
{
|
||||
break-if-!=
|
||||
return 1/true
|
||||
}
|
||||
compare g, 0x2d/dash # '-' not allowed in symbols
|
||||
{
|
||||
break-if-!=
|
||||
return 1/true
|
||||
}
|
||||
compare g, 0x2e/period
|
||||
{
|
||||
break-if-!=
|
||||
return 1/true
|
||||
}
|
||||
compare g, 0x2f/slash
|
||||
{
|
||||
break-if-!=
|
||||
return 1/true
|
||||
}
|
||||
compare g, 0x3a/colon
|
||||
{
|
||||
break-if-!=
|
||||
return 1/true
|
||||
}
|
||||
compare g, 0x3b/semi-colon
|
||||
{
|
||||
break-if-!=
|
||||
return 1/true
|
||||
}
|
||||
compare g, 0x3c/less-than
|
||||
{
|
||||
break-if-!=
|
||||
return 1/true
|
||||
}
|
||||
compare g, 0x3d/equal
|
||||
{
|
||||
break-if-!=
|
||||
return 1/true
|
||||
}
|
||||
compare g, 0x3e/greater-than
|
||||
{
|
||||
break-if-!=
|
||||
return 1/true
|
||||
}
|
||||
# '?' is a symbol char
|
||||
compare g, 0x40/at-sign
|
||||
{
|
||||
break-if-!=
|
||||
return 1/true
|
||||
}
|
||||
compare g, 0x5c/backslash
|
||||
{
|
||||
break-if-!=
|
||||
return 1/true
|
||||
}
|
||||
compare g, 0x5e/caret
|
||||
{
|
||||
break-if-!=
|
||||
return 1/true
|
||||
}
|
||||
# '_' is a symbol char
|
||||
compare g, 0x7c/vertical-line
|
||||
{
|
||||
break-if-!=
|
||||
return 1/true
|
||||
}
|
||||
compare g, 0x7e/tilde
|
||||
{
|
||||
break-if-!=
|
||||
return 1/true
|
||||
}
|
||||
return 0/false
|
||||
}
|
||||
|
||||
fn is-number-token? _in: (addr cell) -> _/eax: boolean {
|
||||
var in/eax: (addr cell) <- copy _in
|
||||
var in-data-ah/eax: (addr handle stream byte) <- get in, text-data
|
||||
|
|
|
|||
|
|
@ -255,6 +255,36 @@ fn trace-lines-equal? _a: (addr trace-line), _b: (addr trace-line) -> _/eax: boo
|
|||
return data-match?
|
||||
}
|
||||
|
||||
fn dump-trace _self: (addr trace) {
|
||||
var already-hiding-lines?: boolean
|
||||
var y/ecx: int <- copy 0
|
||||
var self/esi: (addr trace) <- copy _self
|
||||
compare self, 0
|
||||
{
|
||||
break-if-!=
|
||||
return
|
||||
}
|
||||
var trace-ah/eax: (addr handle array trace-line) <- get self, data
|
||||
var _trace/eax: (addr array trace-line) <- lookup *trace-ah
|
||||
var trace/edi: (addr array trace-line) <- copy _trace
|
||||
var i/edx: int <- copy 0
|
||||
var max-addr/ebx: (addr int) <- get self, first-free
|
||||
var max/ebx: int <- copy *max-addr
|
||||
$dump-trace:loop: {
|
||||
compare i, max
|
||||
break-if->=
|
||||
$dump-trace:iter: {
|
||||
var offset/ebx: (offset trace-line) <- compute-offset trace, i
|
||||
var curr/ebx: (addr trace-line) <- index trace, offset
|
||||
var curr-label-ah/eax: (addr handle array byte) <- get curr, label
|
||||
var curr-label/eax: (addr array byte) <- lookup *curr-label-ah
|
||||
y <- render-trace-line 0/screen, curr, 0, y, 0x80/width, 0x30/height, 7/fg, 0/bg
|
||||
}
|
||||
i <- increment
|
||||
loop
|
||||
}
|
||||
}
|
||||
|
||||
## UI stuff
|
||||
|
||||
fn mark-lines-dirty _self: (addr trace) {
|
||||
|
|
|
|||
Loading…
Reference in New Issue