https://github.com/akkartik/mu/blob/main/shell/eval.mu

      1 # env is an alist of ((sym . val) (sym . val) ...)
      2 # we never modify `in` or `env`
      3 fn evaluate _in: (addr handle cell), out: (addr handle cell), env-h: (handle cell), trace: (addr trace) {
      4   var in/esi: (addr handle cell) <- copy _in
      5 +-- 12 lines: # trace "evaluate " in " in environment " env -----------------------------------------------------------------------------------------------------------------------------
     17   trace-lower trace
     18   var in-addr/eax: (addr cell) <- lookup *in
     19   {
     20     var nil?/eax: boolean <- nil? in-addr
     21     compare nil?, 0/false
     22     break-if-=
     23     # nil is a literal
     24     trace-text trace, "eval", "nil"
     25     copy-object _in, out
     26     trace-higher trace
     27     return
     28   }
     29   var in-type/ecx: (addr int) <- get in-addr, type
     30   compare *in-type, 1/number
     31   {
     32     break-if-!=
     33     # numbers are literals
     34     trace-text trace, "eval", "number"
     35     copy-object _in, out
     36     trace-higher trace
     37     return
     38   }
     39   compare *in-type, 2/symbol
     40   {
     41     break-if-!=
     42     trace-text trace, "eval", "symbol"
     43     lookup-symbol in-addr, out, env-h, trace
     44     trace-higher trace
     45     return
     46   }
     47   # in-addr is a syntax tree
     48   $evaluate:anonymous-function: {
     49     # trees starting with "fn" are anonymous functions and therefore literals
     50     var expr/esi: (addr cell) <- copy in-addr
     51     # if its first elem is not "fn", break
     52     var first-ah/ecx: (addr handle cell) <- get in-addr, left
     53     var first/eax: (addr cell) <- lookup *first-ah
     54     var fn?/eax: boolean <- fn? first
     55     compare fn?, 0/false
     56     break-if-=
     57     #
     58     trace-text trace, "eval", "anonymous function"
     59     copy-object _in, out
     60     trace-higher trace
     61     return
     62   }
     63   trace-text trace, "eval", "function call"
     64   trace-text trace, "eval", "evaluating list elements"
     65   var evaluated-list-storage: (handle cell)
     66   var evaluated-list-ah/esi: (addr handle cell) <- address evaluated-list-storage
     67   var curr-out-ah/edx: (addr handle cell) <- copy evaluated-list-ah
     68   var curr/ecx: (addr cell) <- copy in-addr
     69   $evaluate-list:loop: {
     70     allocate-pair curr-out-ah
     71     var nil?/eax: boolean <- nil? curr
     72     compare nil?, 0/false
     73     break-if-!=
     74     # eval left
     75     var curr-out/eax: (addr cell) <- lookup *curr-out-ah
     76     var left-out-ah/edi: (addr handle cell) <- get curr-out, left
     77     var left-ah/esi: (addr handle cell) <- get curr, left
     78     evaluate left-ah, left-out-ah, env-h, trace
     79     #
     80     curr-out-ah <- get curr-out, right
     81     var right-ah/eax: (addr handle cell) <- get curr, right
     82     var right/eax: (addr cell) <- lookup *right-ah
     83     curr <- copy right
     84     loop
     85   }
     86   var evaluated-list/eax: (addr cell) <- lookup *evaluated-list-ah
     87   var function-ah/ecx: (addr handle cell) <- get evaluated-list, left
     88   var args-ah/edx: (addr handle cell) <- get evaluated-list, right
     89 #?   dump-cell args-ah
     90 #?   abort "aaa"
     91   apply function-ah, args-ah, out, env-h, trace
     92   trace-higher trace
     93 +--  9 lines: # trace "=> " out ---------------------------------------------------------------------------------------------------------------------------------------------------------
    102 }
    103
    104 fn apply _f-ah: (addr handle cell), args-ah: (addr handle cell), out: (addr handle cell), env-h: (handle cell), trace: (addr trace) {
    105   var f-ah/eax: (addr handle cell) <- copy _f-ah
    106   var _f/eax: (addr cell) <- lookup *f-ah
    107   var f/esi: (addr cell) <- copy _f
    108   # call primitive functions
    109   {
    110     var f-type/eax: (addr int) <- get f, type
    111     compare *f-type, 4/primitive-function
    112     break-if-!=
    113     apply-primitive f, args-ah, out, env-h, trace
    114     return
    115   }
    116   # if it's not a primitive function it must be an anonymous function
    117 +-- 12 lines: # trace "apply anonymous function " f " in environment " env --------------------------------------------------------------------------------------------------------------
    129   trace-lower trace
    130   {
    131     var f-type/ecx: (addr int) <- get f, type
    132     compare *f-type, 0/pair
    133     break-if-!=
    134     var first-ah/eax: (addr handle cell) <- get f, left
    135     var first/eax: (addr cell) <- lookup *first-ah
    136     var fn?/eax: boolean <- fn? first
    137     compare fn?, 0/false
    138     break-if-=
    139     var rest-ah/esi: (addr handle cell) <- get f, right
    140     var rest/eax: (addr cell) <- lookup *rest-ah
    141     var params-ah/ecx: (addr handle cell) <- get rest, left
    142     var body-ah/eax: (addr handle cell) <- get rest, right
    143     apply-function params-ah, args-ah, body-ah, out, env-h, trace
    144     trace-higher trace
    145     return
    146   }
    147   error trace, "unknown function"
    148 }
    149
    150 fn apply-function params-ah: (addr handle cell), args-ah: (addr handle cell), _body-ah: (addr handle cell), out: (addr handle cell), env-h: (handle cell), trace: (addr trace) {
    151   # push bindings for params to env
    152   var new-env-storage: (handle cell)
    153   var new-env-ah/esi: (addr handle cell) <- address new-env-storage
    154   push-bindings params-ah, args-ah, env-h, new-env-ah, trace
    155   # eval all expressions in body, writing result to `out` each time
    156   var body-ah/ecx: (addr handle cell) <- copy _body-ah
    157   $apply-function:body: {
    158     var body/eax: (addr cell) <- lookup *body-ah
    159     # stop when body is nil
    160     {
    161       var body-nil?/eax: boolean <- nil? body
    162       compare body-nil?, 0/false
    163       break-if-!= $apply-function:body
    164     }
    165     # evaluate each expression, writing result to `out`
    166     {
    167       var curr-ah/eax: (addr handle cell) <- get body, left
    168       evaluate curr-ah, out, *new-env-ah, trace
    169     }
    170     #
    171     body-ah <- get body, right
    172     loop
    173   }
    174   # `out` contains result of evaluating final expression
    175 }
    176
    177 # Bind params to corresponding args and add the bindings to old-env. Return
    178 # the result in env-ah.
    179 #
    180 # We never modify old-env, but we point to it. This way other parts of the
    181 # interpreter can continue using old-env, and everything works harmoniously
    182 # even though no cells are copied around.
    183 #
    184 # env should always be a DAG (ignoring internals of values). It doesn't have
    185 # to be a tree (some values may be shared), but there are also no cycles.
    186 #
    187 # Learn more: https://en.wikipedia.org/wiki/Persistent_data_structure
    188 fn push-bindings _params-ah: (addr handle cell), _args-ah: (addr handle cell), old-env-h: (handle cell), env-ah: (addr handle cell), trace: (addr trace) {
    189   var params-ah/edx: (addr handle cell) <- copy _params-ah
    190   var args-ah/ebx: (addr handle cell) <- copy _args-ah
    191   var _params/eax: (addr cell) <- lookup *params-ah
    192   var params/esi: (addr cell) <- copy _params
    193   {
    194     var params-nil?/eax: boolean <- nil? params
    195     compare params-nil?, 0/false
    196     break-if-=
    197     # nil is a literal
    198     trace-text trace, "eval", "done with push-bindings"
    199     copy-handle old-env-h, env-ah
    200     return
    201   }
    202   # Params can only be symbols or pairs. Args can be anything.
    203 +-- 14 lines: # trace "pushing bindings from " params " to " args -----------------------------------------------------------------------------------------------------------------------
    217   trace-lower trace
    218   var params-type/eax: (addr int) <- get params, type
    219   compare *params-type, 2/symbol
    220   {
    221     break-if-!=
    222     trace-text trace, "eval", "symbol; binding to all remaining args"
    223     # create a new binding
    224     var new-binding-storage: (handle cell)
    225     var new-binding-ah/eax: (addr handle cell) <- address new-binding-storage
    226     new-pair new-binding-ah, *params-ah, *args-ah
    227     # push it to env
    228     new-pair env-ah, *new-binding-ah, old-env-h
    229     trace-higher trace
    230     return
    231   }
    232   compare *params-type, 0/pair
    233   {
    234     break-if-=
    235     error trace, "cannot bind a non-symbol"
    236     trace-higher trace
    237     return
    238   }
    239   var _args/eax: (addr cell) <- lookup *args-ah
    240   var args/edi: (addr cell) <- copy _args
    241   # params is now a pair, so args must be also
    242   var args-type/eax: (addr int) <- get args, type
    243   compare *args-type, 0/pair
    244   {
    245     break-if-=
    246     error trace, "args not in a proper list"
    247     trace-higher trace
    248     return
    249   }
    250   var intermediate-env-storage: (handle cell)
    251   var intermediate-env-ah/edx: (addr handle cell) <- address intermediate-env-storage
    252   var first-param-ah/eax: (addr handle cell) <- get params, left
    253   var first-arg-ah/ecx: (addr handle cell) <- get args, left
    254   push-bindings first-param-ah, first-arg-ah, old-env-h, intermediate-env-ah, trace
    255   var remaining-params-ah/eax: (addr handle cell) <- get params, right
    256   var remaining-args-ah/ecx: (addr handle cell) <- get args, right
    257   push-bindings remaining-params-ah, remaining-args-ah, *intermediate-env-ah, env-ah, trace
    258   trace-higher trace
    259 }
    260
    261 fn apply-primitive _f: (addr cell), args-ah: (addr handle cell), out: (addr handle cell), env-h: (handle cell), trace: (addr trace) {
    262   var f/esi: (addr cell) <- copy _f
    263   var f-index/eax: (addr int) <- get f, index-data
    264   {
    265     compare *f-index, 1/add
    266     break-if-!=
    267     apply-add args-ah, out, env-h, trace
    268     return
    269   }
    270   abort "unknown primitive function"
    271 }
    272
    273 fn apply-add _args-ah: (addr handle cell), out: (addr handle cell), env-h: (handle cell), trace: (addr trace) {
    274   trace-text trace, "eval", "apply +"
    275   var args-ah/eax: (addr handle cell) <- copy _args-ah
    276   var _args/eax: (addr cell) <- lookup *args-ah
    277   var args/esi: (addr cell) <- copy _args
    278   var _env/eax: (addr cell) <- lookup env-h
    279   var env/edi: (addr cell) <- copy _env
    280   # TODO: check that args is a pair
    281   var empty-args?/eax: boolean <- nil? args
    282   compare empty-args?, 0/false
    283   {
    284     break-if-=
    285     error trace, "+ needs 2 args but got 0"
    286     return
    287   }
    288   # args->left->value
    289   var first-ah/eax: (addr handle cell) <- get args, left
    290   var first/eax: (addr cell) <- lookup *first-ah
    291   var first-type/ecx: (addr int) <- get first, type
    292   compare *first-type, 1/number
    293   {
    294     break-if-=
    295     error trace, "first arg for + is not a number"
    296     return
    297   }
    298   var first-value/ecx: (addr float) <- get first, number-data
    299   # args->right->left->value
    300   var right-ah/eax: (addr handle cell) <- get args, right
    301 #?   dump-cell right-ah
    302 #?   abort "aaa"
    303   var right/eax: (addr cell) <- lookup *right-ah
    304   # TODO: check that right is a pair
    305   var second-ah/eax: (addr handle cell) <- get right, left
    306   var second/eax: (addr cell) <- lookup *second-ah
    307   var second-type/edx: (addr int) <- get second, type
    308   compare *second-type, 1/number
    309   {
    310     break-if-=
    311     error trace, "second arg for + is not a number"
    312     return
    313   }
    314   var second-value/edx: (addr float) <- get second, number-data
    315   # add
    316   var result/xmm0: float <- copy *first-value
    317   result <- add *second-value
    318   new-float out, result
    319 }
    320
    321 fn lookup-symbol sym: (addr cell), out: (addr handle cell), env-h: (handle cell), trace: (addr trace) {
    322   # trace sym
    323   {
    324     var stream-storage: (stream byte 0x40)
    325     var stream/ecx: (addr stream byte) <- address stream-storage
    326     write stream, "look up "
    327     var sym2/eax: (addr cell) <- copy sym
    328     var sym-data-ah/eax: (addr handle stream byte) <- get sym2, text-data
    329     var sym-data/eax: (addr stream byte) <- lookup *sym-data-ah
    330     rewind-stream sym-data
    331     write-stream stream, sym-data
    332     write stream, " in "
    333     var env-ah/eax: (addr handle cell) <- address env-h
    334     print-cell env-ah, stream, 0/no-trace
    335     trace trace, "eval", stream
    336   }
    337   trace-lower trace
    338   var _env/eax: (addr cell) <- lookup env-h
    339   var env/ebx: (addr cell) <- copy _env
    340   # if env is not a list, abort
    341   {
    342     var env-type/ecx: (addr int) <- get env, type
    343     compare *env-type, 0/pair
    344     break-if-=
    345     error trace, "eval found a non-list environment"
    346     trace-higher trace
    347     return
    348   }
    349   # if env is nil, look up in globals
    350   {
    351     var env-nil?/eax: boolean <- nil? env
    352     compare env-nil?, 0/false
    353     break-if-=
    354     lookup-symbol-in-hardcoded-globals sym, out, trace
    355     trace-higher trace
    356 +-- 13 lines: # trace "=> " out " (global)" ---------------------------------------------------------------------------------------------------------------------------------------------
    369     return
    370   }
    371   # check car
    372   var env-head-storage: (handle cell)
    373   var env-head-ah/eax: (addr handle cell) <- address env-head-storage
    374   car env, env-head-ah, 0/no-trace
    375   var _env-head/eax: (addr cell) <- lookup *env-head-ah
    376   var env-head/ecx: (addr cell) <- copy _env-head
    377   # if car is not a list, abort
    378   {
    379     var env-head-type/eax: (addr int) <- get env-head, type
    380     compare *env-head-type, 0/pair
    381     break-if-=
    382     error trace, "environment is not a list of (key . value) pairs"
    383     trace-higher trace
    384     return
    385   }
    386   # check key
    387   var curr-key-storage: (handle cell)
    388   var curr-key-ah/eax: (addr handle cell) <- address curr-key-storage
    389   car env-head, curr-key-ah, trace
    390   var curr-key/eax: (addr cell) <- lookup *curr-key-ah
    391   # if key is not a symbol, abort
    392   {
    393     var curr-key-type/eax: (addr int) <- get curr-key, type
    394     compare *curr-key-type, 2/symbol
    395     break-if-=
    396     error trace, "environment contains a binding for a non-symbol"
    397     trace-higher trace
    398     return
    399   }
    400   # if key matches sym, return val
    401   var match?/eax: boolean <- cell-isomorphic? curr-key, sym, trace
    402   compare match?, 0/false
    403   {
    404     break-if-=
    405     cdr env-head, out, 0/no-trace
    406 +-- 13 lines: # trace "=> " out " (match)" ----------------------------------------------------------------------------------------------------------------------------------------------
    419     trace-higher trace
    420     return
    421   }
    422   # otherwise recurse
    423   var env-tail-storage: (handle cell)
    424   var env-tail-ah/eax: (addr handle cell) <- address env-tail-storage
    425   cdr env, env-tail-ah, trace
    426   lookup-symbol sym, out, *env-tail-ah, trace
    427   trace-higher trace
    428 +-- 13 lines: # trace "=> " out " (recurse)" --------------------------------------------------------------------------------------------------------------------------------------------
    441 }
    442
    443 fn lookup-symbol-in-hardcoded-globals _sym: (addr cell), out: (addr handle cell), trace: (addr trace) {
    444   var sym/eax: (addr cell) <- copy _sym
    445   var sym-data-ah/eax: (addr handle stream byte) <- get sym, text-data
    446   var _sym-data/eax: (addr stream byte) <- lookup *sym-data-ah
    447   var sym-data/esi: (addr stream byte) <- copy _sym-data
    448   {
    449     var add?/eax: boolean <- stream-data-equal? sym-data, "+"
    450     compare add?, 0/false
    451     break-if-=
    452     new-primitive-function out, 1/add
    453     trace-text trace, "eval", "global +"
    454     return
    455   }
    456   # otherwise error "unbound symbol: ", sym
    457   var stream-storage: (stream byte 0x40)
    458   var stream/ecx: (addr stream byte) <- address stream-storage
    459   write stream, "unbound symbol: "
    460   rewind-stream sym-data
    461   write-stream stream, sym-data
    462   trace trace, "error", stream
    463 }
    464
    465 fn test-lookup-symbol-in-env {
    466   # tmp = (a . 3)
    467   var val-storage: (handle cell)
    468   var val-ah/ecx: (addr handle cell) <- address val-storage
    469   new-integer val-ah, 3
    470   var key-storage: (handle cell)
    471   var key-ah/edx: (addr handle cell) <- address key-storage
    472   new-symbol key-ah, "a"
    473   var env-storage: (handle cell)
    474   var env-ah/ebx: (addr handle cell) <- address env-storage
    475   new-pair env-ah, *key-ah, *val-ah
    476   # env = ((a . 3))
    477   var nil-storage: (handle cell)
    478   var nil-ah/ecx: (addr handle cell) <- address nil-storage
    479   allocate-pair nil-ah
    480   new-pair env-ah, *env-ah, *nil-ah
    481   # lookup sym(a) in env tmp
    482   var tmp-storage: (handle cell)
    483   var tmp-ah/edx: (addr handle cell) <- address tmp-storage
    484   new-symbol tmp-ah, "a"
    485   var in/eax: (addr cell) <- lookup *tmp-ah
    486   lookup-symbol in, tmp-ah, *env-ah, 0/no-trace
    487   var result/eax: (addr cell) <- lookup *tmp-ah
    488   var result-type/edx: (addr int) <- get result, type
    489   check-ints-equal *result-type, 1/number, "F - test-lookup-symbol-in-env/0"
    490   var result-value-addr/eax: (addr float) <- get result, number-data
    491   var result-value/eax: int <- convert *result-value-addr
    492   check-ints-equal result-value, 3, "F - test-lookup-symbol-in-env/1"
    493 }
    494
    495 fn test-lookup-symbol-in-hardcoded-globals {
    496   # env = nil
    497   var nil-storage: (handle cell)
    498   var nil-ah/ecx: (addr handle cell) <- address nil-storage
    499   allocate-pair nil-ah
    500   # lookup sym(a), env
    501   var tmp-storage: (handle cell)
    502   var tmp-ah/ebx: (addr handle cell) <- address tmp-storage
    503   new-symbol tmp-ah, "+"
    504   var in/eax: (addr cell) <- lookup *tmp-ah
    505   lookup-symbol in, tmp-ah, *nil-ah, 0/no-trace
    506   var result/eax: (addr cell) <- lookup *tmp-ah
    507   var result-type/edx: (addr int) <- get result, type
    508   check-ints-equal *result-type, 4/primitive-function, "F - test-lookup-symbol-in-hardcoded-globals/0"
    509   var result-value/eax: (addr int) <- get result, index-data
    510   check-ints-equal *result-value, 1/add, "F - test-lookup-symbol-in-hardcoded-globals/1"
    511 }
    512
    513 fn car _in: (addr cell), out: (addr handle cell), trace: (addr trace) {
    514   trace-text trace, "eval", "car"
    515   trace-lower trace
    516   var in/eax: (addr cell) <- copy _in
    517   # if in is not a list, abort
    518   {
    519     var in-type/ecx: (addr int) <- get in, type
    520     compare *in-type, 0/pair
    521     break-if-=
    522     error trace, "car on a non-list"
    523     trace-higher trace
    524     return
    525   }
    526   # if in is nil, abort
    527   {
    528     var in-nil?/eax: boolean <- nil? in
    529     compare in-nil?, 0/false
    530     break-if-=
    531     error trace, "car on nil"
    532     trace-higher trace
    533     return
    534   }
    535   var in-left/eax: (addr handle cell) <- get in, left
    536   copy-object in-left, out
    537   trace-higher trace
    538   return
    539 }
    540
    541 fn cdr _in: (addr cell), out: (addr handle cell), trace: (addr trace) {
    542   trace-text trace, "eval", "cdr"
    543   trace-lower trace
    544   var in/eax: (addr cell) <- copy _in
    545   # if in is not a list, abort
    546   {
    547     var in-type/ecx: (addr int) <- get in, type
    548     compare *in-type, 0/pair
    549     break-if-=
    550     error trace, "car on a non-list"
    551     trace-higher trace
    552     return
    553   }
    554   # if in is nil, abort
    555   {
    556     var in-nil?/eax: boolean <- nil? in
    557     compare in-nil?, 0/false
    558     break-if-=
    559     error trace, "car on nil"
    560     trace-higher trace
    561     return
    562   }
    563   var in-right/eax: (addr handle cell) <- get in, right
    564   copy-object in-right, out
    565   trace-higher trace
    566   return
    567 }
    568
    569 fn cell-isomorphic? _a: (addr cell), _b: (addr cell), trace: (addr trace) -> _/eax: boolean {
    570   trace-text trace, "eval", "cell-isomorphic?"
    571   trace-lower trace
    572   var a/esi: (addr cell) <- copy _a
    573   var b/edi: (addr cell) <- copy _b
    574   # if types don't match, return false
    575   var a-type-addr/eax: (addr int) <- get a, type
    576   var b-type-addr/ecx: (addr int) <- get b, type
    577   var b-type/ecx: int <- copy *b-type-addr
    578   compare b-type, *a-type-addr
    579   {
    580     break-if-=
    581     trace-higher trace
    582     trace-text trace, "eval", "=> false (type)"
    583     return 0/false
    584   }
    585   # if types are number, compare number-data
    586   # TODO: exactly comparing floats is a bad idea
    587   compare b-type, 1/number
    588   {
    589     break-if-!=
    590     var a-val-addr/eax: (addr float) <- get a, number-data
    591     var b-val-addr/ecx: (addr float) <- get b, number-data
    592     var a-val/xmm0: float <- copy *a-val-addr
    593     compare a-val, *b-val-addr
    594     {
    595       break-if-=
    596       trace-higher trace
    597       trace-text trace, "eval", "=> false (numbers)"
    598       return 0/false
    599     }
    600     trace-higher trace
    601     trace-text trace, "eval", "=> true (numbers)"
    602     return 1/true
    603   }
    604   compare b-type, 2/symbol
    605   {
    606     break-if-!=
    607     var b-val-ah/eax: (addr handle stream byte) <- get b, text-data
    608     var _b-val/eax: (addr stream byte) <- lookup *b-val-ah
    609     var b-val/ecx: (addr stream byte) <- copy _b-val
    610     var a-val-ah/eax: (addr handle stream byte) <- get a, text-data
    611     var a-val/eax: (addr stream byte) <- lookup *a-val-ah
    612     var tmp-array: (handle array byte)
    613     var tmp-ah/edx: (addr handle array byte) <- address tmp-array
    614     rewind-stream a-val
    615     stream-to-array a-val, tmp-ah
    616     var tmp/eax: (addr array byte) <- lookup *tmp-ah
    617     var match?/eax: boolean <- stream-data-equal? b-val, tmp
    618     trace-higher trace
    619     {
    620       compare match?, 0/false
    621       break-if-=
    622       trace-text trace, "eval", "=> true (symbols)"
    623     }
    624     {
    625       compare match?, 0/false
    626       break-if-!=
    627       trace-text trace, "eval", "=> false (symbols)"
    628     }
    629     return match?
    630   }
    631   # if a is nil, b should be nil
    632   {
    633     # (assumes nil? returns 0 or 1)
    634     var _b-nil?/eax: boolean <- nil? b
    635     var b-nil?/ecx: boolean <- copy _b-nil?
    636     var a-nil?/eax: boolean <- nil? a
    637     # a == nil and b == nil => return true
    638     {
    639       compare a-nil?, 0/false
    640       break-if-=
    641       compare b-nil?, 0/false
    642       break-if-=
    643       trace-higher trace
    644       trace-text trace, "eval", "=> true (nils)"
    645       return 1/true
    646     }
    647     # a == nil => return false
    648     {
    649       compare a-nil?, 0/false
    650       break-if-=
    651       trace-higher trace
    652       trace-text trace, "eval", "=> false (b != nil)"
    653       return 0/false
    654     }
    655     # b == nil => return false
    656     {
    657       compare b-nil?, 0/false
    658       break-if-=
    659       trace-higher trace
    660       trace-text trace, "eval", "=> false (a != nil)"
    661       return 0/false
    662     }
    663   }
    664   # a and b are pairs
    665   var a-tmp-storage: (handle cell)
    666   var a-tmp-ah/edx: (addr handle cell) <- address a-tmp-storage
    667   var b-tmp-storage: (handle cell)
    668   var b-tmp-ah/ebx: (addr handle cell) <- address b-tmp-storage
    669   # if cars aren't equal, return false
    670   car a, a-tmp-ah, trace
    671   car b, b-tmp-ah, trace
    672   {
    673     var _a-tmp/eax: (addr cell) <- lookup *a-tmp-ah
    674     var a-tmp/ecx: (addr cell) <- copy _a-tmp
    675     var b-tmp/eax: (addr cell) <- lookup *b-tmp-ah
    676     var result/eax: boolean <- cell-isomorphic? a-tmp, b-tmp, trace
    677     compare result, 0/false
    678     break-if-!=
    679     trace-higher trace
    680     trace-text trace, "eval", "=> false (car mismatch)"
    681     return 0/false
    682   }
    683   # recurse on cdrs
    684   cdr a, a-tmp-ah, trace
    685   cdr b, b-tmp-ah, trace
    686   var _a-tmp/eax: (addr cell) <- lookup *a-tmp-ah
    687   var a-tmp/ecx: (addr cell) <- copy _a-tmp
    688   var b-tmp/eax: (addr cell) <- lookup *b-tmp-ah
    689   var result/eax: boolean <- cell-isomorphic? a-tmp, b-tmp, trace
    690   trace-higher trace
    691   return result
    692 }
    693
    694 fn fn? _x: (addr cell) -> _/eax: boolean {
    695   var x/esi: (addr cell) <- copy _x
    696   var type/eax: (addr int) <- get x, type
    697   compare *type, 2/symbol
    698   {
    699     break-if-=
    700     return 0/false
    701   }
    702   var contents-ah/eax: (addr handle stream byte) <- get x, text-data
    703   var contents/eax: (addr stream byte) <- lookup *contents-ah
    704   var result/eax: boolean <- stream-data-equal? contents, "fn"
    705   return result
    706 }
    707
    708 fn test-evaluate-is-well-behaved {
    709   var t-storage: trace
    710   var t/esi: (addr trace) <- address t-storage
    711   initialize-trace t, 0x10, 0/visible  # we don't use trace UI
    712   # env = nil
    713   var env-storage: (handle cell)
    714   var env-ah/ecx: (addr handle cell) <- address env-storage
    715   allocate-pair env-ah
    716   # eval sym(a), nil env
    717   var tmp-storage: (handle cell)
    718   var tmp-ah/edx: (addr handle cell) <- address tmp-storage
    719   new-symbol tmp-ah, "a"
    720   evaluate tmp-ah, tmp-ah, *env-ah, t
    721   # doesn't die
    722   check-trace-contains t, "error", "unbound symbol: a", "F - test-evaluate-is-well-behaved"
    723 }
    724
    725 fn test-evaluate-number {
    726   # env = nil
    727   var env-storage: (handle cell)
    728   var env-ah/ecx: (addr handle cell) <- address env-storage
    729   allocate-pair env-ah
    730   # tmp = 3
    731   var tmp-storage: (handle cell)
    732   var tmp-ah/edx: (addr handle cell) <- address tmp-storage
    733   new-integer tmp-ah, 3
    734   evaluate tmp-ah, tmp-ah, *env-ah, 0/no-trace
    735   #
    736   var result/eax: (addr cell) <- lookup *tmp-ah
    737   var result-type/edx: (addr int) <- get result, type
    738   check-ints-equal *result-type, 1/number, "F - test-evaluate-number/0"
    739   var result-value-addr/eax: (addr float) <- get result, number-data
    740   var result-value/eax: int <- convert *result-value-addr
    741   check-ints-equal result-value, 3, "F - test-evaluate-number/1"
    742 }
    743
    744 fn test-evaluate-symbol {
    745   # tmp = (a . 3)
    746   var val-storage: (handle cell)
    747   var val-ah/ecx: (addr handle cell) <- address val-storage
    748   new-integer val-ah, 3
    749   var key-storage: (handle cell)
    750   var key-ah/edx: (addr handle cell) <- address key-storage
    751   new-symbol key-ah, "a"
    752   var env-storage: (handle cell)
    753   var env-ah/ebx: (addr handle cell) <- address env-storage
    754   new-pair env-ah, *key-ah, *val-ah
    755   # env = ((a . 3))
    756   var nil-storage: (handle cell)
    757   var nil-ah/ecx: (addr handle cell) <- address nil-storage
    758   allocate-pair nil-ah
    759   new-pair env-ah, *env-ah, *nil-ah
    760   # eval sym(a), env
    761   var tmp-storage: (handle cell)
    762   var tmp-ah/edx: (addr handle cell) <- address tmp-storage
    763   new-symbol tmp-ah, "a"
    764   evaluate tmp-ah, tmp-ah, *env-ah, 0/no-trace
    765   var result/eax: (addr cell) <- lookup *tmp-ah
    766   var result-type/edx: (addr int) <- get result, type
    767   check-ints-equal *result-type, 1/number, "F - test-evaluate-symbol/0"
    768   var result-value-addr/eax: (addr float) <- get result, number-data
    769   var result-value/eax: int <- convert *result-value-addr
    770   check-ints-equal result-value, 3, "F - test-evaluate-symbol/1"
    771 }
    772
    773 fn test-evaluate-primitive-function {
    774   var nil-storage: (handle cell)
    775   var nil-ah/ecx: (addr handle cell) <- address nil-storage
    776   allocate-pair nil-ah
    777   var add-storage: (handle cell)
    778   var add-ah/ebx: (addr handle cell) <- address add-storage
    779   new-symbol add-ah, "+"
    780   # eval +, nil env
    781   var tmp-storage: (handle cell)
    782   var tmp-ah/esi: (addr handle cell) <- address tmp-storage
    783   evaluate add-ah, tmp-ah, *nil-ah, 0/no-trace
    784   #
    785   var result/eax: (addr cell) <- lookup *tmp-ah
    786   var result-type/edx: (addr int) <- get result, type
    787   check-ints-equal *result-type, 4/primitive-function, "F - test-evaluate-primitive-function/0"
    788   var result-value/eax: (addr int) <- get result, index-data
    789   check-ints-equal *result-value, 1/add, "F - test-evaluate-primitive-function/1"
    790 }
    791
    792 fn test-evaluate-primitive-function-call {
    793   var t-storage: trace
    794   var t/edi: (addr trace) <- address t-storage
    795   initialize-trace t, 0x100, 0/visible  # we don't use trace UI
    796   #
    797   var nil-storage: (handle cell)
    798   var nil-ah/ecx: (addr handle cell) <- address nil-storage
    799   allocate-pair nil-ah
    800   var one-storage: (handle cell)
    801   var one-ah/edx: (addr handle cell) <- address one-storage
    802   new-integer one-ah, 1
    803   var add-storage: (handle cell)
    804   var add-ah/ebx: (addr handle cell) <- address add-storage
    805   new-symbol add-ah, "+"
    806   # eval (+ 1 1), nil env
    807   var tmp-storage: (handle cell)
    808   var tmp-ah/esi: (addr handle cell) <- address tmp-storage
    809   new-pair tmp-ah, *one-ah, *nil-ah
    810   new-pair tmp-ah, *one-ah, *tmp-ah
    811   new-pair tmp-ah, *add-ah, *tmp-ah
    812 #?   dump-cell tmp-ah
    813   evaluate tmp-ah, tmp-ah, *nil-ah, t
    814 #?   dump-trace t
    815   #
    816   var result/eax: (addr cell) <- lookup *tmp-ah
    817   var result-type/edx: (addr int) <- get result, type
    818   check-ints-equal *result-type, 1/number, "F - test-evaluate-primitive-function-call/0"
    819   var result-value-addr/eax: (addr float) <- get result, number-data
    820   var result-value/eax: int <- convert *result-value-addr
    821   check-ints-equal result-value, 2, "F - test-evaluate-primitive-function-call/1"
    822 }