aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/synthesizer/loop.lux
diff options
context:
space:
mode:
authorEduardo Julian2017-11-01 00:04:43 -0400
committerEduardo Julian2017-11-01 00:04:43 -0400
commit71d7a4c7206155e09f3e1e1d8699561ea6967382 (patch)
tree866b104d1552fe71ff52b0241f7e2fd260ff77bf /new-luxc/source/luxc/synthesizer/loop.lux
parent7cc935bd3d2e716bfeb006badeeaa8bb05927d11 (diff)
- Re-organized synthesis.
Diffstat (limited to 'new-luxc/source/luxc/synthesizer/loop.lux')
-rw-r--r--new-luxc/source/luxc/synthesizer/loop.lux185
1 files changed, 0 insertions, 185 deletions
diff --git a/new-luxc/source/luxc/synthesizer/loop.lux b/new-luxc/source/luxc/synthesizer/loop.lux
deleted file mode 100644
index 0070fcd5d..000000000
--- a/new-luxc/source/luxc/synthesizer/loop.lux
+++ /dev/null
@@ -1,185 +0,0 @@
-(;module:
- lux
- (lux (control [monad #+ do]
- ["p" parser])
- (data [maybe]
- (coll [list "list/" Functor<List>]))
- (meta [code]
- [syntax]))
- (luxc (lang ["ls" synthesis]
- [";L" variable #+ Variable Register])))
-
-(def: #export (contains-self-reference? exprS)
- (-> ls;Synthesis Bool)
- (case exprS
- (^ [_ (#;Form (list [_ (#;Nat tag)] [_ (#;Bool last?)] memberS))])
- (contains-self-reference? memberS)
-
- [_ (#;Tuple membersS)]
- (list;any? contains-self-reference? membersS)
-
- (^ [_ (#;Form (list [_ (#;Int var)]))])
- (variableL;self? var)
-
- (^ [_ (#;Form (list [_ (#;Text "lux case")] inputS pathS))])
- (or (contains-self-reference? inputS)
- (loop [pathS pathS]
- (case pathS
- (^or (^ [_ (#;Form (list [_ (#;Text "lux case alt")] leftS rightS))])
- (^ [_ (#;Form (list [_ (#;Text "lux case seq")] leftS rightS))]))
- (or (recur leftS)
- (recur rightS))
-
- (^ [_ (#;Form (list [_ (#;Text "lux case exec")] bodyS))])
- (contains-self-reference? bodyS)
-
- _
- false)))
-
- (^ [_ (#;Form (list [_ (#;Text "lux function")] arity [_ (#;Tuple environment)] bodyS))])
- (list;any? (function [captured]
- (case captured
- (^ [_ (#;Form (list [_ (#;Int var)]))])
- (variableL;self? var)
-
- _
- false))
- environment)
-
- (^ [_ (#;Form (list& [_ (#;Text "lux call")] funcS argsS))])
- (or (contains-self-reference? funcS)
- (list;any? contains-self-reference? argsS))
-
- (^ [_ (#;Form (list [_ (#;Text "lux let")] register inputS bodyS))])
- (or (contains-self-reference? inputS)
- (contains-self-reference? bodyS))
-
- (^ [_ (#;Form (list [_ (#;Text "lux if")] inputS thenS elseS))])
- (or (contains-self-reference? inputS)
- (contains-self-reference? thenS)
- (contains-self-reference? elseS))
-
- (^ [_ (#;Form (list [_ (#;Text "lux loop")] offset [_ (#;Tuple initsS)] bodyS))])
- (or (list;any? contains-self-reference? initsS)
- (contains-self-reference? bodyS))
-
- (^or (^ [_ (#;Form (list& [_ (#;Text "lux recur")] argsS))])
- (^ [_ (#;Form (list& [_ (#;Text procedure)] argsS))]))
- (list;any? contains-self-reference? argsS)
-
- _
- false
- ))
-
-(def: #export (reify-recursion arity exprS)
- (-> Nat ls;Synthesis ls;Synthesis)
- (loop [exprS exprS]
- (case exprS
- (^ [_ (#;Form (list [_ (#;Text "lux case")] inputS pathS))])
- (` ("lux case" (~ inputS)
- (~ (let [reify-recursion' recur]
- (loop [pathS pathS]
- (case pathS
- (^ [_ (#;Form (list [_ (#;Text "lux case alt")] leftS rightS))])
- (` ("lux case alt" (~ (recur leftS)) (~ (recur rightS))))
-
- (^ [_ (#;Form (list [_ (#;Text "lux case seq")] leftS rightS))])
- (` ("lux case seq" (~ leftS) (~ (recur rightS))))
-
- (^ [_ (#;Form (list [_ (#;Text "lux case exec")] bodyS))])
- (` ("lux case exec" (~ (reify-recursion' bodyS))))
-
- _
- pathS))))))
-
- (^multi (^ [_ (#;Form (list& [_ (#;Text "lux call")]
- [_ (#;Form (list [_ (#;Int 0)]))]
- argsS))])
- (n.= arity (list;size argsS)))
- (` ("lux recur" (~@ argsS)))
-
- (^ [_ (#;Form (list [_ (#;Text "lux let")] register inputS bodyS))])
- (` ("lux let" (~ register) (~ inputS) (~ (recur bodyS))))
-
- (^ [_ (#;Form (list [_ (#;Text "lux if")] inputS thenS elseS))])
- (` ("lux if" (~ inputS) (~ (recur thenS)) (~ (recur elseS))))
-
- _
- exprS
- )))
-
-(def: #export (adjust env outer-offset exprS)
- (-> (List Variable) Register ls;Synthesis ls;Synthesis)
- (let [resolve-captured (: (-> Variable Variable)
- (function [var]
- (let [idx (|> var (i.* -1) int-to-nat n.dec)]
- (|> env (list;nth idx) maybe;assume))))]
- (loop [exprS exprS]
- (case exprS
- (^ [_ (#;Form (list [_ (#;Nat tag)] last? valueS))])
- (` ((~ (code;nat tag)) (~ last?) (~ (recur valueS))))
-
- [_ (#;Tuple members)]
- [_ (#;Tuple (list/map recur members))]
-
- (^ [_ (#;Form (list [_ (#;Text "lux case")] inputS pathS))])
- (` ("lux case" (~ (recur inputS))
- (~ (let [adjust' recur]
- (loop [pathS pathS]
- (case pathS
- (^template [<pattern>]
- (^ [_ (#;Form (list [_ (#;Text <pattern>)] leftS rightS))])
- (` (<pattern> (~ (recur leftS)) (~ (recur rightS)))))
- (["lux case alt"]
- ["lux case seq"])
-
- (^ [_ (#;Form (list [_ (#;Text "lux case exec")] bodyS))])
- (` ("lux case exec" (~ (adjust' bodyS))))
-
- _
- pathS))))))
-
- (^ [_ (#;Form (list [_ (#;Text "lux function")] arity [_ (#;Tuple environment)] bodyS))])
- (` ("lux function" (~ arity)
- (~ [_ (#;Tuple (list/map (function [_var]
- (case _var
- (^ [_ (#;Form (list [_ (#;Int var)]))])
- (` ((~ (code;int (resolve-captured var)))))
-
- _
- _var))
- environment))])
- (~ (recur bodyS))))
-
- (^ [_ (#;Form (list& [_ (#;Text "lux call")] funcS argsS))])
- (` ("lux call" (~ (recur funcS)) (~@ (list/map recur argsS))))
-
- (^ [_ (#;Form (list& [_ (#;Text "lux recur")] argsS))])
- (` ("lux recur" (~@ (list/map recur argsS))))
-
- (^ [_ (#;Form (list& [_ (#;Text procedure)] argsS))])
- (` ((~ (code;text procedure)) (~@ (list/map recur argsS))))
-
- (^ [_ (#;Form (list [_ (#;Int var)]))])
- (if (variableL;captured? var)
- (` ((~ (code;int (resolve-captured var)))))
- (` ((~ (code;int (|> outer-offset nat-to-int (i.+ var)))))))
-
- (^ [_ (#;Form (list [_ (#;Text "lux let")] [_ (#;Nat register)] inputS bodyS))])
- (` ("lux let" (~ (code;nat (n.+ outer-offset register)))
- (~ (recur inputS))
- (~ (recur bodyS))))
-
- (^ [_ (#;Form (list [_ (#;Text "lux if")] inputS thenS elseS))])
- (` ("lux if" (~ (recur inputS))
- (~ (recur thenS))
- (~ (recur elseS))))
-
- (^ [_ (#;Form (list [_ (#;Text "lux loop")] [_ (#;Nat inner-offset)] [_ (#;Tuple initsS)] bodyS))])
- (` ("lux loop" (~ (code;nat (n.+ outer-offset inner-offset)))
- [(~@ (list/map recur initsS))]
- (~ (recur bodyS))))
-
- _
- exprS
- ))))