add loop/recur
s-ol
2 years ago
| 470 | 470 | val = val[key] |
| 471 | 471 | @out\set val |
| 472 | 472 | |
| 473 | loop = Constant.meta | |
| 474 | meta: | |
| 475 | name: 'loop' | |
| 476 | summary: "Loop on arbitrary data via recursion." | |
| 477 | examples: { '(loop (k1 v1 [k2 v2…]) body)' } | |
| 478 | description: " | |
| 479 | Defines a recursive loop function `*recur*` with parameters `k1`, `k2`, … and | |
| 480 | function body `body`, then invokes it immediately with arguments `v1`, `v2`, … | |
| 481 | ||
| 482 | Inside the `body`, `(recur)` is used to recursively restart loop evaluation | |
| 483 | with a different set of arguments, e.g. to sum the first `5` integers: | |
| 484 | ||
| 485 | (loop (n 5) | |
| 486 | (if (= n 0) | |
| 487 | 0 | |
| 488 | (+ n (recur (n - 1)))))" | |
| 489 | ||
| 490 | value: class extends Builtin | |
| 491 | eval: (scope, tail) => | |
| 492 | L\trace "evaling #{@}" | |
| 493 | assert #tail == 2, "'loop' takes exactly two arguments" | |
| 494 | { binds, body } = tail | |
| 495 | ||
| 496 | assert binds.__class == Cell, "loops bindings have to be an cell" | |
| 497 | assert #binds.children % 2 == 0, "key without binding in loop binding" | |
| 498 | ||
| 499 | names = {} | |
| 500 | inner = { Constant.sym '*recur*' } | |
| 501 | for i=1,#binds.children,2 | |
| 502 | table.insert names, binds.children[i] | |
| 503 | table.insert inner, binds.children[i+1] | |
| 504 | ||
| 505 | loop_fn = FnDef names, body, scope | |
| 506 | ||
| 507 | def_scope = Scope scope | |
| 508 | def_scope\set '*recur*', RTNode result: Constant.wrap loop_fn | |
| 509 | ||
| 510 | tag = @tag\clone Tag.parse '-1' | |
| 511 | inner = Cell tag, inner | |
| 512 | inner\eval def_scope | |
| 513 | ||
| 514 | recur = Constant.meta | |
| 515 | meta: | |
| 516 | name: 'recur' | |
| 517 | summary: "Reenter the innermost loop." | |
| 518 | examples: { '(recur nv1 [nv2…])' } | |
| 519 | description: " | |
| 520 | Reenters the innermost `(loop)` from the top, with `k1` bound to `nv1`, `k2` | |
| 521 | bound to `nv2`… | |
| 522 | ||
| 523 | `(recur nv1 [nv2…])` is equivalent to `(*recur* nv1 [nv2…])`." | |
| 524 | ||
| 525 | value: class extends Builtin | |
| 526 | eval: (caller_scope, tail) => | |
| 527 | L\trace "evaling #{@}" | |
| 528 | recur_fn = assert caller_scope\get '*recur*', "not currently in any loop" | |
| 529 | fndef = recur_fn.result\unwrap T.fndef, "*recur* has to be a fndef" | |
| 530 | ||
| 531 | { :params, :body } = fndef | |
| 532 | if #params != #tail | |
| 533 | err = Error 'argument', "expected #{#params} loop arguments, found #{#tail}" | |
| 534 | error err | |
| 535 | ||
| 536 | fn_scope = Scope fndef.scope, caller_scope | |
| 537 | ||
| 538 | children = for i=1,#params | |
| 539 | name = params[i]\unwrap T.sym | |
| 540 | with L\push tail[i]\eval, caller_scope | |
| 541 | fn_scope\set name, \make_ref! | |
| 542 | ||
| 543 | clone = body\clone @tag | |
| 544 | node = clone\eval fn_scope | |
| 545 | ||
| 546 | table.insert children, node | |
| 547 | RTNode :children, result: node.result | |
| 548 | ||
| 549 | ||
| 473 | 550 | Scope.from_table { |
| 474 | 551 | :doc |
| 475 | 552 | :trace, 'trace=': trace_, print: print_ |
| 487 | 564 | |
| 488 | 565 | :array, :struct, :get |
| 489 | 566 | |
| 567 | :loop, :recur | |
| 568 | ||
| 490 | 569 | true: Constant.meta |
| 491 | 570 | meta: |
| 492 | 571 | name: 'true' |