7851 - shell snapshot: symbol lookup

2 files changed, 287 insertions, 2 deletions

diff --git a/shell/eval.mu b/shell/eval.mu
index b8284426..1774f8a2 100644
--- a/shell/eval.mu
+++ b/shell/eval.mu
@@ -1,4 +1,5 @@
-fn evaluate _in: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+# env is an alist of ((sym . val) (sym . val) ...)
+fn evaluate _in: (addr handle cell), out: (addr handle cell), env: (addr cell), trace: (addr trace) {
   trace-text trace, "eval", "evaluate"
   trace-lower trace
   var in/eax: (addr handle cell) <- copy _in
@@ -21,6 +22,271 @@ fn evaluate _in: (addr handle cell), out: (addr handle cell), trace: (addr trace
     trace-higher trace
     return
   }
+  compare *in-type, 2/symbol
+  {
+    break-if-!=
+    lookup-symbol in-addr, out, env, trace
+    trace-higher trace
+    return
+  }
+  # TODO: pairs
   copy-object _in, out
   trace-higher trace
 }
+
+fn lookup-symbol sym: (addr cell), out: (addr handle cell), _env: (addr cell), trace: (addr trace) {
+  # trace sym
+  {
+    var stream-storage: (stream byte 0x40)
+    var stream/ecx: (addr stream byte) <- address stream-storage
+    write stream, "lookup "
+    var sym2/eax: (addr cell) <- copy sym
+    var sym-data-ah/eax: (addr handle stream byte) <- get sym2, text-data
+    var sym-data/eax: (addr stream byte) <- lookup *sym-data-ah
+    rewind-stream sym-data
+    write-stream stream, sym-data
+    trace trace, "eval", stream
+  }
+  trace-lower trace
+  var env/ebx: (addr cell) <- copy _env
+  # if env is not a list, abort
+  {
+    var env-type/ecx: (addr int) <- get env, type
+    compare *env-type, 0/pair
+    break-if-=
+    error trace, "eval found a non-list environment"
+    trace-higher trace
+    return
+  }
+  # if env is nil, abort
+  {
+    var env-is-nil?/eax: boolean <- is-nil? env
+    compare env-is-nil?, 0/false
+    break-if-=
+    # error "unbound symbol: ", sym
+    var stream-storage: (stream byte 0x40)
+    var stream/ecx: (addr stream byte) <- address stream-storage
+    write stream, "unbound symbol: "
+    var sym2/eax: (addr cell) <- copy sym
+    var sym-data-ah/eax: (addr handle stream byte) <- get sym2, text-data
+    var sym-data/eax: (addr stream byte) <- lookup *sym-data-ah
+    rewind-stream sym-data
+    write-stream stream, sym-data
+    trace trace, "error", stream
+    trace-higher trace
+    return
+  }
+  # check car
+  var env-head-storage: (handle cell)
+  var env-head-ah/eax: (addr handle cell) <- address env-head-storage
+  car env, env-head-ah, trace
+  var _env-head/eax: (addr cell) <- lookup *env-head-ah
+  var env-head/ecx: (addr cell) <- copy _env-head
+  # if car is not a list, abort
+  {
+    var env-head-type/eax: (addr int) <- get env-head, type
+    compare *env-head-type, 0/pair
+    break-if-=
+    error trace, "environment is not a list of (key . value) pairs"
+    trace-higher trace
+    return
+  }
+  # check key
+  var curr-key-storage: (handle cell)
+  var curr-key-ah/eax: (addr handle cell) <- address curr-key-storage
+  car env-head, curr-key-ah, trace
+  var curr-key/eax: (addr cell) <- lookup *curr-key-ah
+  # if key is not a symbol, abort
+  {
+    var curr-key-type/eax: (addr int) <- get curr-key, type
+    compare *curr-key-type, 2/symbol
+    break-if-=
+    error trace, "environment contains a binding for a non-symbol"
+    trace-higher trace
+    return
+  }
+  # if key matches sym, return val
+  var match?/eax: boolean <- cell-isomorphic? curr-key, sym, trace
+  compare match?, 0/false
+  {
+    break-if-=
+    cdr env-head, out, trace
+    trace-higher trace
+    return
+  }
+  # otherwise recurse
+  var env-tail-storage: (handle cell)
+  var env-tail-ah/eax: (addr handle cell) <- address env-tail-storage
+  cdr env, env-tail-ah, trace
+  var env-tail/eax: (addr cell) <- lookup *env-tail-ah
+  lookup-symbol sym, out, env-tail, trace
+  trace-higher trace
+}
+
+fn car _in: (addr cell), out: (addr handle cell), trace: (addr trace) {
+  trace-text trace, "eval", "car"
+  trace-lower trace
+  var in/eax: (addr cell) <- copy _in
+  # if in is not a list, abort
+  {
+    var in-type/ecx: (addr int) <- get in, type
+    compare *in-type, 0/pair
+    break-if-=
+    error trace, "car on a non-list"
+    trace-higher trace
+    return
+  }
+  # if in is nil, abort
+  {
+    var in-is-nil?/eax: boolean <- is-nil? in
+    compare in-is-nil?, 0/false
+    break-if-=
+    error trace, "car on nil"
+    trace-higher trace
+    return
+  }
+  var in-left/eax: (addr handle cell) <- get in, left
+  copy-object in-left, out
+  trace-higher trace
+  return
+}
+
+fn cdr _in: (addr cell), out: (addr handle cell), trace: (addr trace) {
+  trace-text trace, "eval", "cdr"
+  trace-lower trace
+  var in/eax: (addr cell) <- copy _in
+  # if in is not a list, abort
+  {
+    var in-type/ecx: (addr int) <- get in, type
+    compare *in-type, 0/pair
+    break-if-=
+    error trace, "car on a non-list"
+    trace-higher trace
+    return
+  }
+  # if in is nil, abort
+  {
+    var in-is-nil?/eax: boolean <- is-nil? in
+    compare in-is-nil?, 0/false
+    break-if-=
+    error trace, "car on nil"
+    trace-higher trace
+    return
+  }
+  var in-right/eax: (addr handle cell) <- get in, right
+  copy-object in-right, out
+  trace-higher trace
+  return
+}
+
+fn cell-isomorphic? _a: (addr cell), _b: (addr cell), trace: (addr trace) -> _/eax: boolean {
+  trace-text trace, "eval", "cell-isomorphic?"
+  trace-lower trace
+  var a/esi: (addr cell) <- copy _a
+  var b/edi: (addr cell) <- copy _b
+  # if types don't match, return false
+  var a-type-addr/eax: (addr int) <- get a, type
+  var b-type-addr/ecx: (addr int) <- get b, type
+  var b-type/ecx: int <- copy *b-type-addr
+  compare b-type, *a-type-addr
+  {
+    break-if-=
+    trace-text trace, "eval", "=> false (type)"
+    trace-higher trace
+    return 0/false
+  }
+  # if types are number, compare number-data
+  # TODO: exactly comparing floats is a bad idea
+  compare b-type, 1/number
+  {
+    break-if-!=
+    var a-val-addr/eax: (addr float) <- get a, number-data
+    var b-val-addr/ecx: (addr float) <- get b, number-data
+    var a-val/xmm0: float <- copy *a-val-addr
+    compare a-val, *b-val-addr
+    {
+      break-if-=
+      trace-text trace, "eval", "=> false (numbers)"
+      trace-higher trace
+      return 0/false
+    }
+    trace-text trace, "eval", "=> true (numbers)"
+    trace-higher trace
+    return 1/true
+  }
+  compare b-type, 2/symbol
+  {
+    break-if-!=
+    var b-val-ah/eax: (addr handle stream byte) <- get b, text-data
+    var _b-val/eax: (addr stream byte) <- lookup *b-val-ah
+    var b-val/ecx: (addr stream byte) <- copy _b-val
+    var a-val-ah/eax: (addr handle stream byte) <- get a, text-data
+    var a-val/eax: (addr stream byte) <- lookup *a-val-ah
+    var tmp-array: (handle array byte)
+    var tmp-ah/edx: (addr handle array byte) <- address tmp-array
+    stream-to-array a-val, tmp-ah
+    var tmp/eax: (addr array byte) <- lookup *tmp-ah
+    var match?/eax: boolean <- stream-data-equal? b-val, tmp
+    trace-text trace, "eval", "=> ? (symbols)"
+    trace-higher trace
+    return match?
+  }
+  # if a is nil, b should be nil
+  {
+    # (assumes is-nil? returns 0 or 1)
+    var _b-is-nil?/eax: boolean <- is-nil? b
+    var b-is-nil?/ecx: boolean <- copy _b-is-nil?
+    var a-is-nil?/eax: boolean <- is-nil? a
+    # a == nil and b == nil => return true
+    {
+      compare a-is-nil?, 0/false
+      break-if-=
+      compare b-is-nil?, 0/false
+      break-if-=
+      trace-text trace, "eval", "=> true (nils)"
+      trace-higher trace
+      return 1/true
+    }
+    # a == nil => return false
+    {
+      compare a-is-nil?, 0/false
+      break-if-=
+      trace-text trace, "eval", "=> false (b != nil)"
+      trace-higher trace
+      return 0/false
+    }
+    # b == nil => return false
+    {
+      compare b-is-nil?, 0/false
+      break-if-=
+      trace-text trace, "eval", "=> false (a != nil)"
+      trace-higher trace
+      return 0/false
+    }
+  }
+  # a and b are pairs
+  var a-tmp-storage: (handle cell)
+  var a-tmp-ah/edx: (addr handle cell) <- address a-tmp-storage
+  var b-tmp-storage: (handle cell)
+  var b-tmp-ah/ebx: (addr handle cell) <- address b-tmp-storage
+  # if cars aren't equal, return false
+  car a, a-tmp-ah, trace
+  car b, b-tmp-ah, trace
+  {
+    var _a-tmp/eax: (addr cell) <- lookup *a-tmp-ah
+    var a-tmp/ecx: (addr cell) <- copy _a-tmp
+    var b-tmp/eax: (addr cell) <- lookup *b-tmp-ah
+    var result/eax: boolean <- cell-isomorphic? a-tmp, b-tmp, trace
+    compare result, 0/false
+    break-if-!=
+    return 0/false
+  }
+  # recurse on cdrs
+  cdr a, a-tmp-ah, trace
+  cdr b, b-tmp-ah, trace
+  var _a-tmp/eax: (addr cell) <- lookup *a-tmp-ah
+  var a-tmp/ecx: (addr cell) <- copy _a-tmp
+  var b-tmp/eax: (addr cell) <- lookup *b-tmp-ah
+  var result/eax: boolean <- cell-isomorphic? a-tmp, b-tmp, trace
+  return result
+}
diff --git a/shell/sandbox.mu b/shell/sandbox.mu
index 6f25474a..fbed3cff 100644
--- a/shell/sandbox.mu
+++ b/shell/sandbox.mu
@@ -174,9 +174,28 @@ fn run in: (addr gap-buffer), out: (addr stream byte), trace: (addr trace) {
     break-if-=
     return
   }
+  var nil-storage: (handle cell)
+  var nil-ah/ecx: (addr handle cell) <- address nil-storage
+  allocate-pair nil-ah
+  # HERE
+  var tmp-storage: (handle cell)
+  var tmp-ah/edx: (addr handle cell) <- address tmp-storage
+  # tmp = a
+  new-symbol tmp-ah, "a"
+  # tmp = (a)
+  new-pair tmp-ah, *tmp-ah, *nil-ah
+  # tmp = (a . (a)) = (a a)
+  var tmp/eax: (addr cell) <- lookup *tmp-ah
+  {
+    var new-ah/ecx: (addr handle cell) <- get tmp, left
+    new-pair tmp-ah, *new-ah, *tmp-ah
+  }
+  # env = tmp = ((a a))
+  new-pair tmp-ah, *tmp-ah, *nil-ah
+  var env/eax: (addr cell) <- lookup *tmp-ah
   var eval-result-storage: (handle cell)
   var eval-result/edi: (addr handle cell) <- address eval-result-storage
-  evaluate read-result, eval-result, trace
+  evaluate read-result, eval-result, env, trace
   var error?/eax: boolean <- has-errors? trace
   {
     compare error?, 0/false