blob: ad1f110deb953a1920cea486b948c8aae1a01987 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
|
(.require
[library
[lux (.except Scope)
[abstract
["[0]" monad (.only do)]]
[data
["[0]" product]
[text
["%" \\format (.only format)]]
[collection
["[0]" list (.use "[1]#[0]" functor)]]]
[math
[number
["n" nat]]]
[meta
[target
["_" common_lisp (.only Expression)]]]]]
["[0]" //
[runtime (.only Operation Phase Generator)]
["[1][0]" case]
["/[1]" //
["[1][0]" reference]
["/[1]" //
[synthesis
["[0]" case]]
["/[1]" //
["[0]"synthesis (.only Scope Synthesis)]
["[1][0]" generation]
["//[1]" ///
["[1][0]" phase]
[meta
[archive (.only Archive)]]
[reference
[variable (.only Register)]]]]]]])
(def .public (scope expression archive [start initsS+ bodyS])
(Generator (Scope Synthesis))
(case initsS+
... function/false/non-independent loop
{.#End}
(expression archive bodyS)
... true loop
_
(do [! ///////phase.monad]
[@scope (at ! each (|>> %.nat (format "loop_scope") _.tag) /////generation.next)
@output (at ! each (|>> %.nat (format "loop_output") _.var) /////generation.next)
initsG+ (monad.each ! (expression archive) initsS+)
bodyG (/////generation.with_anchor [@scope start]
(expression archive bodyS))]
... TODO: There is a bug in the way the variables are updated. Do a _.multiple_value_setq instead.
(in (_.let (|> initsG+
list.enumeration
(list#each (function (_ [idx init])
[(|> idx (n.+ start) //case.register)
init]))
(list.partial [@output _.nil]))
(list (_.tagbody (list @scope
(_.setq @output bodyG)))
@output))))))
(def .public (again expression archive argsS+)
(Generator (List Synthesis))
(do [! ///////phase.monad]
[[tag offset] /////generation.anchor
argsO+ (monad.each ! (expression archive) argsS+)
.let [bindings (|> argsO+
list.enumeration
(list#each (|>> product.left (n.+ offset) //case.register))
_.args)]]
(in (_.progn (list (_.multiple_value_setq bindings (_.values/* argsO+))
(_.go tag))))))
|
