https://github.com/akkartik/mu/blob/master/lambda-to-mu.mu

      1 ## experimental compiler to translate programs written in a generic
      2 ## expression-oriented language called 'lambda' into Mu
      3
      4 # incomplete; code generator not done
      5 # potential enhancements:
      6 #   symbol table
      7 #   poor man's macros
      8 #     substitute one instruction with multiple, parameterized by inputs and products
      9
     10 scenario convert-lambda [
     11   run [
     12     local-scope
     13     1:text/raw <- lambda-to-mu [(add a (multiply b c))]
     14     2:@:char/raw <- copy *1:text/raw
     15   ]
     16   memory-should-contain [
     17     2:array:character <- [t1 <- multiply b c
     18 result <- add a t1]
     19   ]
     20 ]
     21
     22 def lambda-to-mu in:text -> out:text [
     23   local-scope
     24   load-inputs
     25   out <- copy null
     26   cells:&:cell <- parse in
     27   out <- to-mu cells
     28 ]
     29
     30 # 'parse' will turn lambda expressions into trees made of cells
     31 exclusive-container cell [
     32   atom:text
     33   pair:pair
     34 ]
     35
     36 # printed below as < first | rest >
     37 container pair [
     38   first:&:cell
     39   rest:&:cell
     40 ]
     41
     42 def new-atom name:text -> result:&:cell [
     43   local-scope
     44   load-inputs
     45   result <- new cell:type
     46   *result <- merge 0/tag:atom, name
     47 ]
     48
     49 def new-pair a:&:cell, b:&:cell -> result:&:cell [
     50   local-scope
     51   load-inputs
     52   result <- new cell:type
     53   *result <- merge 1/tag:pair, a/first, b/rest
     54 ]
     55
     56 def is-atom? x:&:cell -> result:bool [
     57   local-scope
     58   load-inputs
     59   return-unless x, false
     60   _, result <- maybe-convert *x, atom:variant
     61 ]
     62
     63 def is-pair? x:&:cell -> result:bool [
     64   local-scope
     65   load-inputs
     66   return-unless x, false
     67   _, result <- maybe-convert *x, pair:variant
     68 ]
     69
     70 scenario atom-is-not-pair [
     71   local-scope
     72   s:text <- new [a]
     73   x:&:cell <- new-atom s
     74   10:bool/raw <- is-atom? x
     75   11:bool/raw <- is-pair? x
     76   memory-should-contain [
     77     10 <- 1
     78     11 <- 0
     79   ]
     80 ]
     81
     82 scenario pair-is-not-atom [
     83   local-scope
     84   # construct (a . nil)
     85   s:text <- new [a]
     86   x:&:cell <- new-atom s
     87   y:&:cell <- new-pair x, null
     88   10:bool/raw <- is-atom? y
     89   11:bool/raw <- is-pair? y
     90   memory-should-contain [
     91     10 <- 0
     92     11 <- 1
     93   ]
     94 ]
     95
     96 def atom-match? x:&:cell, pat:text -> result:bool [
     97   local-scope
     98   load-inputs
     99   s:text, is-atom?:bool <- maybe-convert *x, atom:variant
    100   return-unless is-atom?, false
    101   result <- equal pat, s
    102 ]
    103
    104 scenario atom-match [
    105   local-scope
    106   x:&:cell <- new-atom [abc]
    107   10:bool/raw <- atom-match? x, [abc]
    108   memory-should-contain [
    109     10 <- 1
    110   ]
    111 ]
    112
    113 def first x:&:cell -> result:&:cell [
    114   local-scope
    115   load-inputs
    116   pair:pair, pair?:bool <- maybe-convert *x, pair:variant
    117   return-unless pair?, null
    118   result <- get pair, first:offset
    119 ]
    120
    121 def rest x:&:cell -> result:&:cell [
    122   local-scope
    123   load-inputs
    124   pair:pair, pair?:bool <- maybe-convert *x, pair:variant
    125   return-unless pair?, null
    126   result <- get pair, rest:offset
    127 ]
    128
    129 def set-first base:&:cell, new-first:&:cell -> base:&:cell [
    130   local-scope
    131   load-inputs
    132   pair:pair, is-pair?:bool <- maybe-convert *base, pair:variant
    133   return-unless is-pair?
    134   pair <- put pair, first:offset, new-first
    135   *base <- merge 1/pair, pair
    136 ]
    137
    138 def set-rest base:&:cell, new-rest:&:cell -> base:&:cell [
    139   local-scope
    140   load-inputs
    141   pair:pair, is-pair?:bool <- maybe-convert *base, pair:variant
    142   return-unless is-pair?
    143   pair <- put pair, rest:offset, new-rest
    144   *base <- merge 1/pair, pair
    145 ]
    146
    147 scenario cell-operations-on-atom [
    148   local-scope
    149   s:text <- new [a]
    150   x:&:cell <- new-atom s
    151   10:&:cell/raw <- first x
    152   11:&:cell/raw <- rest x
    153   memory-should-contain [
    154     10 <- 0  # first is nil
    155     11 <- 0  # rest is nil
    156   ]
    157 ]
    158
    159 scenario cell-operations-on-pair [
    160   local-scope
    161   # construct (a . nil)
    162   s:text <- new [a]
    163   x:&:cell <- new-atom s
    164   y:&:cell <- new-pair x, null
    165   x2:&:cell <- first y
    166   10:bool/raw <- equal x, x2
    167   11:&:cell/raw <- rest y
    168   memory-should-contain [
    169     10 <- 1  # first is correct
    170     11 <- 0  # rest is nil
    171   ]
    172 ]
    173
    174 ## convert lambda text to a tree of cells
    175
    176 def parse in:text -> out:&:cell [
    177   local-scope
    178   load-inputs
    179   s:&:stream:char <- new-stream in
    180   out, s <- parse s
    181   trace 2, [app/parse], out
    182 ]
    183
    184 def parse in:&:stream:char -> out:&:cell, in:&:stream:char [
    185   local-scope
    186   load-inputs
    187   # skip whitespace
    188   in <- skip-whitespace in
    189   c:char, eof?:bool <- peek in
    190   return-if eof?, null
    191   pair?:bool <- equal c, 40/open-paren
    192   {
    193     break-if pair?
    194     # atom
    195     buf:&:buffer:char <- new-buffer 30
    196     {
    197       done?:bool <- end-of-stream? in
    198       break-if done?
    199       # stop before close paren or space
    200       c:char <- peek in
    201       done? <- equal c, 41/close-paren
    202       break-if done?
    203       done? <- space? c
    204       break-if done?
    205       c <- read in
    206       buf <- append buf, c
    207       loop
    208     }
    209     s:text <- buffer-to-array buf
    210     out <- new-atom s
    211   }
    212   {
    213     break-unless pair?
    214     # pair
    215     read in  # skip the open-paren
    216     out <- new cell:type  # start out with nil
    217     # read in first element of pair
    218     {
    219       end?:bool <- end-of-stream? in
    220       not-end?:bool <- not end?
    221       assert not-end?, [unbalanced '(' in expression]
    222       c <- peek in
    223       close-paren?:bool <- equal c, 41/close-paren
    224       break-if close-paren?
    225       first:&:cell, in <- parse in
    226       *out <- merge 1/pair, first, null
    227     }
    228     # read in any remaining elements
    229     curr:&:cell <- copy out
    230     {
    231       in <- skip-whitespace in
    232       end?:bool <- end-of-stream? in
    233       not-end?:bool <- not end?
    234       assert not-end?, [unbalanced '(' in expression]
    235       # termination check: ')'
    236       c <- peek in
    237       {
    238         close-paren?:bool <- equal c, 41/close-paren
    239         break-unless close-paren?
    240         read in  # skip ')'
    241         break +end-pair
    242       }
    243       # still here? read next element of pair
    244       next:&:cell, in <- parse in
    245       is-dot?:bool <- atom-match? next, [.]
    246       {
    247         break-if is-dot?
    248         next-curr:&:cell <- new-pair next, null
    249         curr <- set-rest curr, next-curr
    250         curr <- rest curr
    251       }
    252       {
    253         break-unless is-dot?
    254         # deal with dotted pair
    255         in <- skip-whitespace in
    256         c <- peek in
    257         not-close-paren?:bool <- not-equal c, 41/close-paren
    258         assert not-close-paren?, [')' cannot immediately follow '.']
    259         final:&:cell <- parse in
    260         curr <- set-rest curr, final
    261         # we're not gonna update curr, so better make sure the next iteration
    262         # is going to end the pair
    263         in <- skip-whitespace in
    264         c <- peek in
    265         close-paren?:bool <- equal c, 41/close-paren
    266         assert close-paren?, ['.' must be followed by exactly one expression before ')']
    267       }
    268       loop
    269     }
    270     +end-pair
    271   }
    272 ]
    273
    274 def skip-whitespace in:&:stream:char -> in:&:stream:char [
    275   local-scope
    276   load-inputs
    277   {
    278     done?:bool <- end-of-stream? in
    279     return-if done?, null
    280     c:char <- peek in
    281     space?:bool <- space? c
    282     break-unless space?
    283     read in  # skip
    284     loop
    285   }
    286 ]
    287
    288 def to-text x:&:cell -> out:text [
    289   local-scope
    290   load-inputs
    291   buf:&:buffer:char <- new-buffer 30
    292   buf <- to-buffer x, buf
    293   out <- buffer-to-array buf
    294 ]
    295
    296 def to-buffer x:&:cell, buf:&:buffer:char -> buf:&:buffer:char [
    297   local-scope
    298   load-inputs
    299   # base case: empty cell
    300   {
    301     break-if x
    302     buf <- append buf, [<>]
    303     return
    304   }
    305   # base case: atom
    306   {
    307     s:text, atom?:bool <- maybe-convert *x, atom:variant
    308     break-unless atom?
    309     buf <- append buf, s
    310     return
    311   }
    312   # recursive case: pair
    313   buf <- append buf, [< ]
    314   first:&:cell <- first x
    315   buf <- to-buffer first, buf
    316   buf <- append buf, [ | ]
    317   rest:&:cell <- rest x
    318   buf <- to-buffer rest, buf
    319   buf <- append buf, [ >]
    320 ]
    321
    322 scenario parse-single-letter-atom [
    323   local-scope
    324   s:text <- new [a]
    325   x:&:cell <- parse s
    326   s2:text, 10:bool/raw <- maybe-convert *x, atom:variant
    327   11:@:char/raw <- copy *s2
    328   memory-should-contain [
    329     10 <- 1  # parse result is an atom
    330     11:array:character <- [a]
    331   ]
    332 ]
    333
    334 scenario parse-atom [
    335   local-scope
    336   s:text <- new [abc]
    337   x:&:cell <- parse s
    338   s2:text, 10:bool/raw <- maybe-convert *x, atom:variant
    339   11:@:char/raw <- copy *s2
    340   memory-should-contain [
    341     10 <- 1  # parse result is an atom
    342     11:array:character <- [abc]
    343   ]
    344 ]
    345
    346 scenario parse-list-of-two-atoms [
    347   local-scope
    348   s:text <- new [(abc def)]
    349   x:&:cell <- parse s
    350   trace-should-contain [
    351     app/parse: < abc | < def | <> > >
    352   ]
    353   10:bool/raw <- is-pair? x
    354   x1:&:cell <- first x
    355   x2:&:cell <- rest x
    356   s1:text, 11:bool/raw <- maybe-convert *x1, atom:variant
    357   12:bool/raw <- is-pair? x2
    358   x3:&:cell <- first x2
    359   s2:text, 13:bool/raw <- maybe-convert *x3, atom:variant
    360   14:&:cell/raw <- rest x2
    361   20:@:char/raw <- copy *s1
    362   30:@:char/raw <- copy *s2
    363   memory-should-contain [
    364     10 <- 1  # parse result is a pair
    365     11 <- 1  # result.first is an atom
    366     12 <- 1  # result.rest is a pair
    367     13 <- 1  # result.rest.first is an atom
    368     14 <- 0  # result.rest.rest is nil
    369     20:array:character <- [abc]  # result.first
    370     30:array:character <- [def]  # result.rest.first
    371   ]
    372 ]
    373
    374 scenario parse-list-with-extra-spaces [
    375   local-scope
    376   s:text <- new [ ( abc  def ) ]  # extra spaces
    377   x:&:cell <- parse s
    378   trace-should-contain [
    379     app/parse: < abc | < def | <> > >
    380   ]
    381   10:bool/raw <- is-pair? x
    382   x1:&:cell <- first x
    383   x2:&:cell <- rest x
    384   s1:text, 11:bool/raw <- maybe-convert *x1, atom:variant
    385   12:bool/raw <- is-pair? x2
    386   x3:&:cell <- first x2
    387   s2:text, 13:bool/raw <- maybe-convert *x3, atom:variant
    388   14:&:cell/raw <- rest x2
    389   20:@:char/raw <- copy *s1
    390   30:@:char/raw <- copy *s2
    391   memory-should-contain [
    392     10 <- 1  # parse result is a pair
    393     11 <- 1  # result.first is an atom
    394     12 <- 1  # result.rest is a pair
    395     13 <- 1  # result.rest.first is an atom
    396     14 <- 0  # result.rest.rest is nil
    397     20:array:character <- [abc]  # result.first
    398     30:array:character <- [def]  # result.rest.first
    399   ]
    400 ]
    401
    402 scenario parse-list-of-more-than-two-atoms [
    403   local-scope
    404   s:text <- new [(abc def ghi)]
    405   x:&:cell <- parse s
    406   trace-should-contain [
    407     app/parse: < abc | < def | < ghi | <> > > >
    408   ]
    409   10:bool/raw <- is-pair? x
    410   x1:&:cell <- first x
    411   x2:&:cell <- rest x
    412   s1:text, 11:bool/raw <- maybe-convert *x1, atom:variant
    413   12:bool/raw <- is-pair? x2
    414   x3:&:cell <- first x2
    415   s2:text, 13:bool/raw <- maybe-convert *x3, atom:variant
    416   x4:&:cell <- rest x2
    417   14:bool/raw <- is-pair? x4
    418   x5:&:cell <- first x4
    419   s3:text, 15:bool/raw <- maybe-convert *x5, atom:variant
    420   16:&:cell/raw <- rest x4
    421   20:@:char/raw <- copy *s1
    422   30:@:char/raw <- copy *s2
    423   40:@:char/raw <- copy *s3
    424   memory-should-contain [
    425     10 <- 1  # parse result is a pair
    426     11 <- 1  # result.first is an atom
    427     12 <- 1  # result.rest is a pair
    428     13 <- 1  # result.rest.first is an atom
    429     14 <- 1  # result.rest.rest is a pair
    430     15 <- 1  # result.rest.rest.first is an atom
    431     16 <- 0  # result.rest.rest.rest is nil
    432     20:array:character <- [abc]  # result.first
    433     30:array:character <- [def]  # result.rest.first
    434     40:array:character <- [ghi]  # result.rest.rest
    435   ]
    436 ]
    437
    438 scenario parse-nested-list [
    439   local-scope
    440   s:text <- new [((abc))]
    441   x:&:cell <- parse s
    442   trace-should-contain [
    443     app/parse: < < abc | <> > | <> >
    444   ]
    445   10:bool/raw <- is-pair? x
    446   x1:&:cell <- first x
    447   11:bool/raw <- is-pair? x
    448   x2:&:cell <- first x1
    449   s1:text, 12:bool/raw <- maybe-convert *x2, atom:variant
    450   13:&:cell/raw <- rest x1
    451   14:&:cell/raw <- rest x
    452   20:@:char/raw <- copy *s1
    453   memory-should-contain [
    454     10 <- 1  # parse result is a pair
    455     11 <- 1  # result.first is a pair
    456     12 <- 1  # result.first.first is an atom
    457     13 <- 0  # result.first.rest is nil
    458     14 <- 0  # result.rest is nil
    459     20:array:character <- [abc]  # result.first.first
    460   ]
    461 ]
    462
    463 scenario parse-nested-list-2 [
    464   local-scope
    465   s:text <- new [((abc) def)]
    466   x:&:cell <- parse s
    467   trace-should-contain [
    468     app/parse: < < abc | <> > | < def | <> > >
    469   ]
    470   10:bool/raw <- is-pair? x
    471   x1:&:cell <- first x
    472   11:bool/raw <- is-pair? x
    473   x2:&:cell <- first x1
    474   s1:text, 12:bool/raw <- maybe-convert *x2, atom:variant
    475   13:&:cell/raw <- rest x1
    476   x3:&:cell <- rest x
    477   x4:&:cell <- first x3
    478   s2:text, 14:bool/raw <- maybe-convert *x4, atom:variant
    479   15:&:cell/raw <- rest x3
    480   20:@:char/raw <- copy *s1
    481   30:@:char/raw <- copy *s2
    482   memory-should-contain [
    483     10 <- 1  # parse result is a pair
    484     11 <- 1  # result.first is a pair
    485     12 <- 1  # result.first.first is an atom
    486     13 <- 0  # result.first.rest is nil
    487     14 <- 1  # result.rest.first is an atom
    488     15 <- 0  # result.rest.rest is nil
    489     20:array:character <- [abc]  # result.first.first
    490     30:array:character <- [def]  # result.rest.first
    491   ]
    492 ]
    493
    494 # todo: uncomment these tests after we figure out how to continue tests after
    495 # assertion failures
    496 #? scenario parse-error [
    497 #?   local-scope
    498 #?   s:text <- new [(]
    499 #? #?   hide-errors
    500 #?   x:&:cell <- parse s
    501 #? #?   show-errors
    502 #?   trace-should-contain [
    503 #?     error: unbalanced '(' in expression
    504 #?   ]
    505 #? ]
    506 #?
    507 #? scenario parse-error-after-element [
    508 #?   local-scope
    509 #?   s:text <- new [(abc]
    510 #? #?   hide-errors
    511 #?   x:&:cell <- parse s
    512 #? #?   show-errors
    513 #?   trace-should-contain [
    514 #?     error: unbalanced '(' in expression
    515 #?   ]
    516 #? ]
    517
    518 scenario parse-dotted-list-of-two-atoms [
    519   local-scope
    520   s:text <- new [(abc . def)]
    521   x:&:cell <- parse s
    522   trace-should-contain [
    523     app/parse: < abc | def >
    524   ]
    525   10:bool/raw <- is-pair? x
    526   x1:&:cell <- first x
    527   x2:&:cell <- rest x
    528   s1:text, 11:bool/raw <- maybe-convert *x1, atom:variant
    529   s2:text, 12:bool/raw <- maybe-convert *x2, atom:variant
    530   20:@:char/raw <- copy *s1
    531   30:@:char/raw <- copy *s2
    532   memory-should-contain [
    533     # parses to < abc | def >
    534     10 <- 1  # parse result is a pair
    535     11 <- 1  # result.first is an atom
    536     12 <- 1  # result.rest is an atom
    537     20:array:character <- [abc]  # result.first
    538     30:array:character <- [def]  # result.rest
    539   ]
    540 ]
    541
    542 scenario parse-dotted-list-of-more-than-two-atoms [
    543   local-scope
    544   s:text <- new [(abc def . ghi)]
    545   x:&:cell <- parse s
    546   trace-should-contain [
    547     app/parse: < abc | < def | ghi > >
    548   ]
    549   10:bool/raw <- is-pair? x
    550   x1:&:cell <- first x
    551   x2:&:cell <- rest x
    552   s1:text, 11:bool/raw <- maybe-convert *x1, atom:variant
    553   12:bool/raw <- is-pair? x2
    554   x3:&:cell <- first x2
    555   s2:text, 13:bool/raw <- maybe-convert *x3, atom:variant
    556   x4:&:cell <- rest x2
    557   s3:text, 14:bool/raw <- maybe-convert *x4, atom:variant
    558   20:@:char/raw <- copy *s1
    559   30:@:char/raw <- copy *s2
    560   40:@:char/raw <- copy *s3
    561   memory-should-contain [
    562     10 <- 1  # parse result is a pair
    563     11 <- 1  # result.first is an atom
    564     12 <- 1  # result.rest is a pair
    565     13 <- 1  # result.rest.first is an atom
    566     14 <- 1  # result.rest.rest is an atom
    567     20:array:character <- [abc]  # result.first
    568     30:array:character <- [def]  # result.rest.first
    569     40:array:character <- [ghi]  # result.rest.rest
    570   ]
    571 ]
    572
    573 ## convert tree of cells to Mu text
    574
    575 def to-mu in:&:cell -> out:text [
    576   local-scope
    577   load-inputs
    578   buf:&:buffer:char <- new-buffer 30
    579   buf <- to-mu in, buf
    580   out <- buffer-to-array buf
    581 ]
    582
    583 def to-mu in:&:cell, buf:&:buffer:char -> buf:&:buffer:char, result-name:text [
    584   local-scope
    585   load-inputs
    586   # null cell? no change.
    587   # pair with all atoms? gensym a new variable
    588   # pair containing other pairs? recurse
    589   result-name <- copy null
    590 ]