archive/1.vm/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 ]