aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/synthesizer
diff options
context:
space:
mode:
Diffstat (limited to 'new-luxc/source/luxc/synthesizer')
-rw-r--r--new-luxc/source/luxc/synthesizer/case.lux70
-rw-r--r--new-luxc/source/luxc/synthesizer/function.lux29
-rw-r--r--new-luxc/source/luxc/synthesizer/loop.lux185
-rw-r--r--new-luxc/source/luxc/synthesizer/variable.lux98
4 files changed, 0 insertions, 382 deletions
diff --git a/new-luxc/source/luxc/synthesizer/case.lux b/new-luxc/source/luxc/synthesizer/case.lux
deleted file mode 100644
index 15cb6eca3..000000000
--- a/new-luxc/source/luxc/synthesizer/case.lux
+++ /dev/null
@@ -1,70 +0,0 @@
-(;module:
- lux
- (lux (data [bool "bool/" Eq<Bool>]
- [text "text/" Eq<Text>]
- [number]
- (coll [list "list/" Fold<List>]))
- (meta [code "code/" Eq<Code>]))
- (luxc (lang ["la" analysis]
- ["ls" synthesis])))
-
-(def: #export (path pattern)
- (-> la;Pattern ls;Path)
- (case pattern
- (^code [(~@ membersP)])
- (case (list;reverse membersP)
- #;Nil
- (' ("lux case pop"))
-
- (#;Cons singletonP #;Nil)
- (path singletonP)
-
- (#;Cons lastP prevsP)
- (let [length (list;size membersP)
- last-idx (n.dec length)
- [_ tuple-path] (list/fold (function [current-pattern [current-idx next-path]]
- [(n.dec current-idx)
- (` ("lux case seq"
- ("lux case tuple left" (~ (code;nat current-idx)) (~ (path current-pattern)))
- (~ next-path)))])
- [(n.dec last-idx)
- (` ("lux case tuple right" (~ (code;nat last-idx)) (~ (path lastP))))]
- prevsP)]
- tuple-path))
-
- (^code ((~ [_ (#;Nat tag)]) (~ [_ (#;Nat num-tags)]) (~ memberP)))
- (if (n.= (n.dec num-tags) tag)
- (` ("lux case variant right" (~ (code;nat tag)) (~ (path memberP))))
- (` ("lux case variant left" (~ (code;nat tag)) (~ (path memberP)))))
-
- _
- pattern))
-
-(def: #export (weave leftP rightP)
- (-> ls;Path ls;Path ls;Path)
- (with-expansions [<default> (as-is (` ("lux case alt" (~ leftP) (~ rightP))))]
- (case [leftP rightP]
- (^template [<special>]
- (^ [[_ (#;Form (list [_ (#;Text <special>)] [_ (#;Nat left-idx)] left-then))]
- [_ (#;Form (list [_ (#;Text <special>)] [_ (#;Nat right-idx)] right-then))]])
- (if (n.= left-idx right-idx)
- (` (<special> (~ (code;nat left-idx)) (~ (weave left-then right-then))))
- <default>))
- (["lux case tuple left"]
- ["lux case tuple right"]
- ["lux case variant left"]
- ["lux case variant right"])
-
- (^ [[_ (#;Form (list [_ (#;Text "lux case seq")] left-pre left-post))]
- [_ (#;Form (list [_ (#;Text "lux case seq")] right-pre right-post))]])
- (case (weave left-pre right-pre)
- (^ [_ (#;Form (list [_ (#;Text "lux case alt")] _ _))])
- <default>
-
- weavedP
- (` ("lux case seq" (~ weavedP) (~ (weave left-post right-post)))))
-
- _
- (if (code/= leftP rightP)
- leftP
- <default>))))
diff --git a/new-luxc/source/luxc/synthesizer/function.lux b/new-luxc/source/luxc/synthesizer/function.lux
deleted file mode 100644
index 52aee9a49..000000000
--- a/new-luxc/source/luxc/synthesizer/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/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
- ))))
diff --git a/new-luxc/source/luxc/synthesizer/variable.lux b/new-luxc/source/luxc/synthesizer/variable.lux
deleted file mode 100644
index 3ce9f2678..000000000
--- a/new-luxc/source/luxc/synthesizer/variable.lux
+++ /dev/null
@@ -1,98 +0,0 @@
-(;module:
- lux
- (lux (data [number]
- (coll [list "list/" Fold<List> Monoid<List>]
- ["s" set])))
- (luxc (lang ["la" analysis]
- ["ls" synthesis]
- [";L" variable #+ Variable])))
-
-(def: (bound-vars path)
- (-> ls;Path (List Variable))
- (case path
- (#ls;BindP register)
- (list (nat-to-int register))
-
- (^or (#ls;SeqP pre post) (#ls;AltP pre post))
- (list/compose (bound-vars pre) (bound-vars post))
-
- _
- (list)))
-
-(def: (path-bodies path)
- (-> ls;Path (List ls;Synthesis))
- (case path
- (#ls;ExecP body)
- (list body)
-
- (#ls;SeqP pre post)
- (path-bodies post)
-
- (#ls;AltP pre post)
- (list/compose (path-bodies pre) (path-bodies post))
-
- _
- (list)))
-
-(def: (non-arg? arity var)
- (-> ls;Arity Variable Bool)
- (and (variableL;local? var)
- (n.> arity (int-to-nat var))))
-
-(type: Tracker (s;Set Variable))
-
-(def: init-tracker Tracker (s;new number;Hash<Int>))
-
-(def: (unused-vars current-arity bound exprS)
- (-> ls;Arity (List Variable) ls;Synthesis (List Variable))
- (let [tracker (loop [exprS exprS
- tracker (list/fold s;add init-tracker bound)]
- (case exprS
- (#ls;Variable var)
- (if (non-arg? current-arity var)
- (s;remove var tracker)
- tracker)
-
- (#ls;Variant tag last? memberS)
- (recur memberS tracker)
-
- (#ls;Tuple membersS)
- (list/fold recur tracker membersS)
-
- (#ls;Call funcS argsS)
- (list/fold recur (recur funcS tracker) argsS)
-
- (^or (#ls;Recur argsS)
- (#ls;Procedure name argsS))
- (list/fold recur tracker argsS)
-
- (#ls;Let offset inputS outputS)
- (|> tracker (recur inputS) (recur outputS))
-
- (#ls;If testS thenS elseS)
- (|> tracker (recur testS) (recur thenS) (recur elseS))
-
- (#ls;Loop offset initsS bodyS)
- (recur bodyS (list/fold recur tracker initsS))
-
- (#ls;Case inputS outputPS)
- (let [tracker' (list/fold s;add
- (recur inputS tracker)
- (bound-vars outputPS))]
- (list/fold recur tracker' (path-bodies outputPS)))
-
- (#ls;Function arity env bodyS)
- (list/fold s;remove tracker env)
-
- _
- tracker
- ))]
- (s;to-list tracker)))
-
-## (def: (optimize-register-use current-arity [pathS bodyS])
-## (-> ls;Arity [ls;Path ls;Synthesis] [ls;Path ls;Synthesis])
-## (let [bound (bound-vars pathS)
-## unused (unused-vars current-arity bound bodyS)
-## adjusted (adjust-vars unused bound)]
-## [(|> pathS (clean-pattern adjusted) simplify-pattern)
-## (clean-expression adjusted bodyS)]))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-25 19:03:23 +0000