aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc
diff options
context:
space:
mode:
Diffstat (limited to 'new-luxc/source/luxc')
-rw-r--r--new-luxc/source/luxc/lang/synthesis/expression.lux202
-rw-r--r--new-luxc/source/luxc/lang/synthesis/function.lux29
-rw-r--r--new-luxc/source/luxc/lang/synthesis/loop.lux188
3 files changed, 0 insertions, 419 deletions
diff --git a/new-luxc/source/luxc/lang/synthesis/expression.lux b/new-luxc/source/luxc/lang/synthesis/expression.lux
deleted file mode 100644
index 3fa594086..000000000
--- a/new-luxc/source/luxc/lang/synthesis/expression.lux
+++ /dev/null
@@ -1,202 +0,0 @@
-(.module:
- lux
- (lux (control ["p" parser])
- (data [maybe]
- ["e" error]
- [number]
- [product]
- text/format
- (coll [list "list/" Functor<List> Fold<List> Monoid<List>]
- (dictionary ["dict" unordered #+ Dict])))
- (macro [code]
- ["s" syntax]))
- (luxc (lang ["la" analysis]
- ["ls" synthesis]
- [".L" extension #+ Syntheses]
- (synthesis [".S" case]
- [".S" function]
- [".S" loop])
- [".L" variable #+ Variable])
- ))
-
-(def: init-env (List Variable) (list))
-(def: init-resolver (Dict Int Int) (dict.new number.Hash<Int>))
-
-(def: (prepare-body inner-arity arity body)
- (-> ls.Arity ls.Arity ls.Synthesis ls.Synthesis)
- (if (functionS.nested? inner-arity)
- body
- (loopS.reify-recursion arity body)))
-
-(def: (let$ register inputS bodyS)
- (-> Nat ls.Synthesis ls.Synthesis ls.Synthesis)
- (` ("lux let" (~ (code.nat register)) (~ inputS) (~ bodyS))))
-
-(def: (if$ testS thenS elseS)
- (-> ls.Synthesis ls.Synthesis ls.Synthesis ls.Synthesis)
- (` ("lux if" (~ testS)
- (~ thenS)
- (~ elseS))))
-
-(def: (function$ arity environment body)
- (-> ls.Arity (List Variable) ls.Synthesis ls.Synthesis)
- (` ("lux function" (~ (code.nat arity))
- [(~+ (list/map code.int environment))]
- (~ body))))
-
-(def: (variant$ tag last? valueS)
- (-> Nat Bool ls.Synthesis ls.Synthesis)
- (` ((~ (code.nat tag)) (~ (code.bool last?)) (~ valueS))))
-
-(def: (var$ var)
- (-> Variable ls.Synthesis)
- (` ((~ (code.int var)))))
-
-(def: (procedure$ name argsS)
- (-> Text (List ls.Synthesis) ls.Synthesis)
- (` ((~ (code.text name)) (~+ argsS))))
-
-(def: (call$ funcS argsS)
- (-> ls.Synthesis (List ls.Synthesis) ls.Synthesis)
- (` ("lux call" (~ funcS) (~+ argsS))))
-
-(def: (synthesize-case arity num-locals synthesize inputA branchesA)
- (-> ls.Arity Nat (-> Nat la.Analysis ls.Synthesis)
- la.Analysis (List [la.Pattern la.Analysis])
- ls.Synthesis)
- (let [inputS (synthesize num-locals inputA)]
- (case (list.reverse branchesA)
- (^multi (^ (list [(^code ("lux case bind" (~ [_ (#.Nat input-register)])))
- (^code ((~ [_ (#.Int var)])))]))
- (not (variableL.captured? var))
- (n/= input-register (variableL.local-register var)))
- inputS
-
- (^ (list [(^code ("lux case bind" (~ [_ (#.Nat register)]))) bodyA]))
- (let$ (if (functionS.nested? arity)
- (n/+ (n/dec arity) register)
- register)
- inputS
- (synthesize (n/inc num-locals) bodyA))
-
- (^or (^ (list [(^code true) thenA] [(^code false) elseA]))
- (^ (list [(^code false) elseA] [(^code true) thenA])))
- (if$ inputS (synthesize num-locals thenA) (synthesize num-locals elseA))
-
- (#.Cons [lastP lastA] prevsPA)
- (let [transform-branch (: (-> la.Pattern la.Analysis ls.Path)
- (caseS.path arity num-locals synthesize))
- pathS (list/fold caseS.weave
- (transform-branch lastP lastA)
- (list/map (product.uncurry transform-branch) prevsPA))]
- (` ("lux case" (~ inputS) (~ pathS))))
-
- _
- (undefined)
- )))
-
-(def: (synthesize-apply synthesize num-locals exprA)
- (-> (-> la.Analysis ls.Synthesis) Nat la.Analysis ls.Synthesis)
- (let [[funcA argsA] (functionS.unfold-apply exprA)
- funcS (synthesize funcA)
- argsS (list/map synthesize argsA)]
- (case funcS
- (^multi (^code ("lux function" (~ [_ (#.Nat _arity)]) [(~+ _env)] (~ _bodyS)))
- (and (n/= _arity (list.size argsS))
- (not (loopS.contains-self-reference? _bodyS)))
- [(s.run _env (p.some s.int)) (#e.Success _env)])
- (` ("lux loop" (~ (code.nat (n/inc num-locals))) [(~+ argsS)]
- (~ (loopS.adjust _env num-locals _bodyS))))
-
- (^code ("lux call" (~ funcS') (~+ argsS')))
- (call$ funcS' (list/compose argsS' argsS))
-
- _
- (call$ funcS argsS))))
-
-(def: #export (synthesize extensions expressionA)
- (-> Syntheses la.Analysis ls.Synthesis)
- (loop [arity +0
- resolver init-resolver
- direct? false
- num-locals +0
- expressionA expressionA]
- (case expressionA
- (^code [(~ _left) (~ _right)])
- (` [(~+ (list/map (recur arity resolver false num-locals)
- (la.unfold-tuple expressionA)))])
-
- (^or (^code ("lux sum left" (~ _)))
- (^code ("lux sum right" (~ _))))
- (let [[tag last? value] (maybe.assume (la.unfold-variant expressionA))]
- (variant$ tag last? (recur arity resolver false num-locals value)))
-
- (^code ((~ [_ (#.Int var)])))
- (if (variableL.local? var)
- (if (functionS.nested? arity)
- (if (variableL.self? var)
- (call$ (var$ 0) (|> (list.n/range +1 (n/dec arity))
- (list/map (|>> variableL.local code.int (~) () (`)))))
- (var$ (functionS.adjust-var arity var)))
- (var$ var))
- (var$ (maybe.default var (dict.get var resolver))))
-
- (^code ("lux case" (~ inputA) (~ [_ (#.Record branchesA)])))
- (synthesize-case arity num-locals (recur arity resolver false) inputA branchesA)
-
- (^multi (^code ("lux function" [(~+ scope)] (~ bodyA)))
- [(s.run scope (p.some s.int)) (#e.Success raw-env)])
- (let [function-arity (if direct?
- (n/inc arity)
- +1)
- env (list/map (function (_ closure)
- (case (dict.get closure resolver)
- (#.Some resolved)
- (if (and (variableL.local? resolved)
- (functionS.nested? arity)
- (|> resolved variableL.local-register (n/>= arity)))
- (functionS.adjust-var arity resolved)
- resolved)
-
- #.None
- (if (and (variableL.local? closure)
- (functionS.nested? arity))
- (functionS.adjust-var arity closure)
- closure)))
- raw-env)
- env-vars (: (List Variable)
- (case raw-env
- #.Nil (list)
- _ (|> (list.size raw-env) n/dec (list.n/range +0) (list/map variableL.captured))))
- resolver' (if (and (functionS.nested? function-arity)
- direct?)
- (list/fold (function (_ [from to] resolver')
- (dict.put from to resolver'))
- init-resolver
- (list.zip2 env-vars env))
- (list/fold (function (_ var resolver')
- (dict.put var var resolver'))
- init-resolver
- env-vars))]
- (case (recur function-arity resolver' true function-arity bodyA)
- (^ [_ (#.Form (list [_ (#.Text "lux function")] [_ (#.Nat unmerged-arity)] env' bodyS'))])
- (let [merged-arity (n/inc unmerged-arity)]
- (function$ merged-arity env
- (prepare-body function-arity merged-arity bodyS')))
-
- bodyS
- (function$ +1 env (prepare-body function-arity +1 bodyS))))
-
- (^code ("lux apply" (~+ _)))
- (synthesize-apply (recur arity resolver false num-locals) num-locals expressionA)
-
- (^code ((~ [_ (#.Text name)]) (~+ args)))
- (case (dict.get name extensions)
- #.None
- (procedure$ name (list/map (recur arity resolver false num-locals) args))
-
- (#.Some extension)
- (extension (recur arity resolver false num-locals) args))
-
- _
- expressionA)))
diff --git a/new-luxc/source/luxc/lang/synthesis/function.lux b/new-luxc/source/luxc/lang/synthesis/function.lux
deleted file mode 100644
index 25dd75aff..000000000
--- a/new-luxc/source/luxc/lang/synthesis/function.lux
+++ /dev/null
@@ -1,29 +0,0 @@
-(.module:
- lux
- (luxc (lang ["la" analysis]
- ["ls" synthesis]
- [".L" variable #+ Variable])))
-
-(do-template [<name> <comp> <ref>]
- [(def: #export (<name> arity)
- (-> ls.Arity Bool)
- (<comp> <ref> arity))]
-
- [nested? n/> +1]
- [top? n/= +0]
- )
-
-(def: #export (adjust-var outer var)
- (-> ls.Arity Variable Variable)
- (|> outer n/dec nat-to-int (i/+ var)))
-
-(def: #export (unfold-apply apply)
- (-> la.Analysis [la.Analysis (List la.Analysis)])
- (loop [apply apply
- args (list)]
- (case apply
- (^code ("lux apply" (~ arg) (~ func)))
- (recur func (#.Cons arg args))
-
- _
- [apply args])))
diff --git a/new-luxc/source/luxc/lang/synthesis/loop.lux b/new-luxc/source/luxc/lang/synthesis/loop.lux
deleted file mode 100644
index c00d5626b..000000000
--- a/new-luxc/source/luxc/lang/synthesis/loop.lux
+++ /dev/null
@@ -1,188 +0,0 @@
-(.module:
- lux
- (lux (control [monad #+ do]
- ["p" parser])
- (data [maybe]
- (coll [list "list/" Functor<List>]))
- (macro [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 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
- (^code ((~ [_ (#.Nat tag)]) (~ last?) (~ valueS)))
- (` ((~ (code.nat tag)) (~ last?) (~ (recur valueS))))
-
- (^code [(~+ members)])
- (` [(~+ (list/map recur members))])
-
- (^code ("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"])
-
- (^code ("lux case bind" (~ [_ (#.Nat register)])))
- (` ("lux case bind" (~ (code.nat (n/+ offset register)))))
-
- (^ [_ (#.Form (list [_ (#.Text "lux case exec")] bodyS))])
- (` ("lux case exec" (~ (adjust' bodyS))))
-
- _
- pathS))))))
-
- (^code ("lux function" (~ arity) [(~+ environment)] (~ bodyS)))
- (` ("lux function" (~ arity)
- [(~+ (list/map (function (_ _var)
- (case _var
- (^ [_ (#.Form (list [_ (#.Int var)]))])
- (` ((~ (code.int (resolve-captured var)))))
-
- _
- _var))
- environment))]
- (~ 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))))
-
- (^code ("lux let" (~ [_ (#.Nat register)]) (~ inputS) (~ bodyS)))
- (` ("lux let" (~ (code.nat (n/+ 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 loop-offset)] [_ (#.Tuple initsS)] bodyS))])
- (` ("lux loop" (~ (code.nat (n/+ offset loop-offset)))
- [(~+ (list/map recur initsS))]
- (~ (recur bodyS))))
-
- (^ [_ (#.Form (list [_ (#.Int var)]))])
- (if (variableL.captured? var)
- (` ((~ (code.int (resolve-captured var)))))
- (` ((~ (code.int (|> offset nat-to-int (i/+ var)))))))
-
- (^ [_ (#.Form (list& [_ (#.Text procedure)] argsS))])
- (` ((~ (code.text procedure)) (~+ (list/map recur argsS))))
-
- _
- exprS
- ))))