7857 - shell: first function call

4 files changed, 338 insertions, 20 deletions

diff --git a/shell/eval.mu b/shell/eval.mu
index da5dda19..9ca8d4bc 100644
--- a/shell/eval.mu
+++ b/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"
 }
diff --git a/shell/print.mu b/shell/print.mu
index 32f5e725..46782705 100644
--- a/shell/print.mu
+++ b/shell/print.mu
@@ -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
diff --git a/shell/tokenize.mu b/shell/tokenize.mu
index 7beedf23..b6ca1ffd 100644
--- a/shell/tokenize.mu
+++ b/shell/tokenize.mu
@@ -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
diff --git a/shell/trace.mu b/shell/trace.mu
index 34303f43..218e35d5 100644
--- a/shell/trace.mu
+++ b/shell/trace.mu
@@ -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) {