From 71d7a4c7206155e09f3e1e1d8699561ea6967382 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Wed, 1 Nov 2017 00:04:43 -0400
Subject: - Re-organized synthesis.
---
new-luxc/source/luxc/eval.lux | 8 +-
new-luxc/source/luxc/generator.lux | 10 +-
new-luxc/source/luxc/generator/eval.jvm.lux | 1 -
new-luxc/source/luxc/generator/expression.jvm.lux | 1 -
new-luxc/source/luxc/generator/function.jvm.lux | 1 -
new-luxc/source/luxc/generator/primitive.jvm.lux | 1 -
.../source/luxc/generator/procedure/common.jvm.lux | 1 -
.../source/luxc/generator/procedure/host.jvm.lux | 1 -
new-luxc/source/luxc/generator/runtime.jvm.lux | 1 -
new-luxc/source/luxc/generator/structure.jvm.lux | 1 -
new-luxc/source/luxc/lang/synthesis/case.lux | 70 ++++++++
new-luxc/source/luxc/lang/synthesis/expression.lux | 184 ++++++++++++++++++++
new-luxc/source/luxc/lang/synthesis/function.lux | 29 ++++
new-luxc/source/luxc/lang/synthesis/loop.lux | 185 +++++++++++++++++++++
new-luxc/source/luxc/lang/synthesis/variable.lux | 98 +++++++++++
new-luxc/source/luxc/synthesizer.lux | 184 --------------------
new-luxc/source/luxc/synthesizer/case.lux | 70 --------
new-luxc/source/luxc/synthesizer/function.lux | 29 ----
new-luxc/source/luxc/synthesizer/loop.lux | 185 ---------------------
new-luxc/source/luxc/synthesizer/variable.lux | 98 -----------
20 files changed, 575 insertions(+), 583 deletions(-)
create mode 100644 new-luxc/source/luxc/lang/synthesis/case.lux
create mode 100644 new-luxc/source/luxc/lang/synthesis/expression.lux
create mode 100644 new-luxc/source/luxc/lang/synthesis/function.lux
create mode 100644 new-luxc/source/luxc/lang/synthesis/loop.lux
create mode 100644 new-luxc/source/luxc/lang/synthesis/variable.lux
delete mode 100644 new-luxc/source/luxc/synthesizer.lux
delete mode 100644 new-luxc/source/luxc/synthesizer/case.lux
delete mode 100644 new-luxc/source/luxc/synthesizer/function.lux
delete mode 100644 new-luxc/source/luxc/synthesizer/loop.lux
delete mode 100644 new-luxc/source/luxc/synthesizer/variable.lux
(limited to 'new-luxc/source')
diff --git a/new-luxc/source/luxc/eval.lux b/new-luxc/source/luxc/eval.lux
index fdbf8e781..baac56c64 100644
--- a/new-luxc/source/luxc/eval.lux
+++ b/new-luxc/source/luxc/eval.lux
@@ -2,10 +2,10 @@
lux
(lux (control [monad #+ do])
[meta])
- (luxc (lang (analysis [";A" expression])))
+ (luxc (lang (analysis [";A" expression])
+ (synthesis [";S" expression])))
[../base]
- (.. [synthesizer]
- (generator [";G" expression]
+ (.. (generator [";G" expression]
[eval])))
(def: #export (eval type exprC)
@@ -13,6 +13,6 @@
(do meta;Monad
[exprA (../base;with-expected-type type
(expressionA;analyser eval exprC))
- #let [exprS (synthesizer;synthesize exprA)]
+ #let [exprS (expressionS;synthesize exprA)]
exprI (expressionG;generate exprS)]
(eval;eval exprI)))
diff --git a/new-luxc/source/luxc/generator.lux b/new-luxc/source/luxc/generator.lux
index e4d4317fe..e9b6c4d3f 100644
--- a/new-luxc/source/luxc/generator.lux
+++ b/new-luxc/source/luxc/generator.lux
@@ -14,11 +14,11 @@
[";L" host]
["&;" io]
["&;" module]
- ["&;" synthesizer]
["&;" eval]
(lang ["&;" syntax]
(analysis [";A" expression]
- [";A" common]))
+ [";A" common])
+ (synthesis [";S" expression]))
(generator ["&&;" runtime]
["&&;" statement]
["&&;" common]
@@ -41,7 +41,7 @@
[[_ metaA] (&;with-scope
(&;with-expected-type Code
(analyse metaC)))
- metaI (expressionG;generate (&synthesizer;synthesize metaA))
+ metaI (expressionG;generate (expressionS;synthesize metaA))
metaV (&&eval;eval metaI)
[_ valueT valueA] (&;with-scope
(if (meta;type? (:! Code metaV))
@@ -51,7 +51,7 @@
(wrap [Type valueA])))
(commonA;with-unknown-type
(analyse valueC))))
- valueI (expressionG;generate (&synthesizer;synthesize valueA))
+ valueI (expressionG;generate (expressionS;synthesize valueA))
_ (&;with-scope
(&&statement;generate-def def-name valueT valueI metaI (:! Code metaV)))]
(wrap []))
@@ -63,7 +63,7 @@
[[_ programA] (&;with-scope
(&;with-expected-type (type (io;IO Unit))
(analyse programC)))
- programI (expressionG;generate (&synthesizer;synthesize programA))]
+ programI (expressionG;generate (expressionS;synthesize programA))]
(&&statement;generate-program program-args programI))
_
diff --git a/new-luxc/source/luxc/generator/eval.jvm.lux b/new-luxc/source/luxc/generator/eval.jvm.lux
index 86bede8cd..2f0ce1c24 100644
--- a/new-luxc/source/luxc/generator/eval.jvm.lux
+++ b/new-luxc/source/luxc/generator/eval.jvm.lux
@@ -12,7 +12,6 @@
["$i" inst]))
(lang ["la" analysis]
["ls" synthesis])
- ["&;" synthesizer]
(generator ["&;" common])
))
diff --git a/new-luxc/source/luxc/generator/expression.jvm.lux b/new-luxc/source/luxc/generator/expression.jvm.lux
index e0f95b48b..798998510 100644
--- a/new-luxc/source/luxc/generator/expression.jvm.lux
+++ b/new-luxc/source/luxc/generator/expression.jvm.lux
@@ -11,7 +11,6 @@
(host ["$" jvm])
(lang ["ls" synthesis]
[";L" variable #+ Variable Register])
- ["&;" synthesizer]
(generator ["&;" common]
["&;" primitive]
["&;" structure]
diff --git a/new-luxc/source/luxc/generator/function.jvm.lux b/new-luxc/source/luxc/generator/function.jvm.lux
index 70b892d41..310f4d7a0 100644
--- a/new-luxc/source/luxc/generator/function.jvm.lux
+++ b/new-luxc/source/luxc/generator/function.jvm.lux
@@ -13,7 +13,6 @@
(lang ["la" analysis]
["ls" synthesis]
[";L" variable #+ Variable])
- ["&;" synthesizer]
(generator ["&;" common]
["&;" runtime])))
diff --git a/new-luxc/source/luxc/generator/primitive.jvm.lux b/new-luxc/source/luxc/generator/primitive.jvm.lux
index f772383d1..637f46a85 100644
--- a/new-luxc/source/luxc/generator/primitive.jvm.lux
+++ b/new-luxc/source/luxc/generator/primitive.jvm.lux
@@ -10,7 +10,6 @@
["$t" type]))
(lang ["la" analysis]
["ls" synthesis])
- ["&;" synthesizer]
(generator ["&;" common]))
[../runtime])
diff --git a/new-luxc/source/luxc/generator/procedure/common.jvm.lux b/new-luxc/source/luxc/generator/procedure/common.jvm.lux
index a8fa81f81..dffbcb64e 100644
--- a/new-luxc/source/luxc/generator/procedure/common.jvm.lux
+++ b/new-luxc/source/luxc/generator/procedure/common.jvm.lux
@@ -17,7 +17,6 @@
["$i" inst]))
(lang ["la" analysis]
["ls" synthesis])
- ["&;" synthesizer]
(generator ["&;" common]
["&;" runtime])))
diff --git a/new-luxc/source/luxc/generator/procedure/host.jvm.lux b/new-luxc/source/luxc/generator/procedure/host.jvm.lux
index 97c8fb87e..9222b2e4a 100644
--- a/new-luxc/source/luxc/generator/procedure/host.jvm.lux
+++ b/new-luxc/source/luxc/generator/procedure/host.jvm.lux
@@ -23,7 +23,6 @@
(lang ["la" analysis]
(analysis (procedure ["&;" host]))
["ls" synthesis])
- ["&;" synthesizer]
(generator ["&;" common]
["&;" runtime]))
["@" ../common])
diff --git a/new-luxc/source/luxc/generator/runtime.jvm.lux b/new-luxc/source/luxc/generator/runtime.jvm.lux
index fd8fbf74a..4b57e802e 100644
--- a/new-luxc/source/luxc/generator/runtime.jvm.lux
+++ b/new-luxc/source/luxc/generator/runtime.jvm.lux
@@ -14,7 +14,6 @@
["$i" inst]))
(lang ["la" analysis]
["ls" synthesis])
- ["&;" synthesizer]
(generator ["&;" common])))
(host;import java.lang.Object)
diff --git a/new-luxc/source/luxc/generator/structure.jvm.lux b/new-luxc/source/luxc/generator/structure.jvm.lux
index b9dced077..96d5767c6 100644
--- a/new-luxc/source/luxc/generator/structure.jvm.lux
+++ b/new-luxc/source/luxc/generator/structure.jvm.lux
@@ -13,7 +13,6 @@
["$i" inst]))
(lang ["la" analysis]
["ls" synthesis])
- ["&;" synthesizer]
(generator ["&;" common]))
[../runtime])
diff --git a/new-luxc/source/luxc/lang/synthesis/case.lux b/new-luxc/source/luxc/lang/synthesis/case.lux
new file mode 100644
index 000000000..15cb6eca3
--- /dev/null
+++ b/new-luxc/source/luxc/lang/synthesis/case.lux
@@ -0,0 +1,70 @@
+(;module:
+ lux
+ (lux (data [bool "bool/" Eq]
+ [text "text/" Eq]
+ [number]
+ (coll [list "list/" Fold]))
+ (meta [code "code/" Eq]))
+ (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 [ (as-is (` ("lux case alt" (~ leftP) (~ rightP))))]
+ (case [leftP rightP]
+ (^template []
+ (^ [[_ (#;Form (list [_ (#;Text )] [_ (#;Nat left-idx)] left-then))]
+ [_ (#;Form (list [_ (#;Text )] [_ (#;Nat right-idx)] right-then))]])
+ (if (n.= left-idx right-idx)
+ (` ( (~ (code;nat left-idx)) (~ (weave left-then right-then))))
+ ))
+ (["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")] _ _))])
+
+
+ weavedP
+ (` ("lux case seq" (~ weavedP) (~ (weave left-post right-post)))))
+
+ _
+ (if (code/= leftP rightP)
+ leftP
+ ))))
diff --git a/new-luxc/source/luxc/lang/synthesis/expression.lux b/new-luxc/source/luxc/lang/synthesis/expression.lux
new file mode 100644
index 000000000..05b99923b
--- /dev/null
+++ b/new-luxc/source/luxc/lang/synthesis/expression.lux
@@ -0,0 +1,184 @@
+(;module:
+ lux
+ (lux (control ["p" parser])
+ (data [maybe]
+ ["e" error]
+ [number]
+ [product]
+ text/format
+ (coll [list "list/" Functor Fold Monoid]
+ [dict #+ Dict]))
+ (meta [code]
+ ["s" syntax]))
+ (luxc ["&" base]
+ (lang ["la" analysis]
+ ["ls" synthesis]
+ (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))
+
+(def: (prepare-body inner-arity arity body)
+ (-> Nat Nat 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 synthesize inputA branchesA)
+ (-> (-> la;Analysis ls;Synthesis)
+ la;Analysis (List [la;Pattern la;Analysis])
+ ls;Synthesis)
+ (let [inputS (synthesize inputA)]
+ (case (list;reverse branchesA)
+ (^multi (^ (list [(^code ("lux case bind" (~ [_ (#;Nat input-register)])))
+ (^code ((~ [_ (#;Int var)])))]))
+ (not (variableL;captured? var))
+ (n.= input-register (int-to-nat var)))
+ inputS
+
+ (^ (list [(^code ("lux case bind" (~ [_ (#;Nat register)]))) bodyA]))
+ (let$ register inputS (synthesize bodyA))
+
+ (^or (^ (list [(^code true) thenA] [(^code false) elseA]))
+ (^ (list [(^code false) elseA] [(^code true) thenA])))
+ (if$ inputS (synthesize thenA) (synthesize elseA))
+
+ (#;Cons [lastP lastA] prevsPA)
+ (let [transform-branch (: (-> la;Pattern la;Analysis ls;Path)
+ (function [pattern expr]
+ (|> (synthesize expr)
+ (~) ("lux case exec")
+ ("lux case seq" (~ (caseS;path pattern)))
+ (`))))]
+ (` ("lux case" (~ inputS)
+ (~ (list/fold caseS;weave
+ (transform-branch lastP lastA)
+ (list/map (product;uncurry transform-branch) prevsPA))))))
+
+ _
+ (undefined)
+ )))
+
+(def: (synthesize-apply synthesize outer-arity num-locals exprA)
+ (-> (-> la;Analysis ls;Synthesis) ls;Arity Nat la;Analysis ls;Synthesis)
+ (let [[funcA argsA] (functionS;unfold-apply exprA)
+ funcS (synthesize funcA)
+ argsS (list/map synthesize argsA)]
+ (case funcS
+ (^multi (^ [_ (#;Form (list [_ (#;Text "lux function")] [_ (#;Nat _arity)] [_ (#;Tuple _env)] _bodyS))])
+ (and (n.= _arity (list;size argsS))
+ (not (loopS;contains-self-reference? _bodyS)))
+ [(s;run _env (p;some s;int)) (#e;Success _env)])
+ (let [register-offset (if (functionS;top? outer-arity)
+ num-locals
+ (|> outer-arity n.inc (n.+ num-locals)))]
+ (` ("lux loop" (~ (code;nat register-offset)) [(~@ argsS)]
+ (~ (loopS;adjust _env register-offset _bodyS)))))
+
+ (^ [_ (#;Form (list& [_ (#;Text "lux call")] funcS' argsS'))])
+ (call$ funcS' (list/compose argsS' argsS))
+
+ _
+ (call$ funcS argsS))))
+
+(def: #export (synthesize analysis)
+ (-> la;Analysis ls;Synthesis)
+ (loop [outer-arity +0
+ resolver init-resolver
+ num-locals +0
+ exprA analysis]
+ (case exprA
+ (^code [(~ _left) (~ _right)])
+ (` [(~@ (list/map (recur +0 resolver num-locals) (la;unfold-tuple exprA)))])
+
+ (^or (^code ("lux sum left" (~ _)))
+ (^code ("lux sum right" (~ _))))
+ (let [[tag last? value] (maybe;assume (la;unfold-variant exprA))]
+ (variant$ tag last? (recur +0 resolver num-locals value)))
+
+ (^code ((~ [_ (#;Int var)])))
+ (if (variableL;local? var)
+ (let [register (variableL;local-register var)]
+ (if (functionS;nested? outer-arity)
+ (if (n.= +0 register)
+ (call$ (var$ 0) (|> (list;n.range +1 (n.dec outer-arity))
+ (list/map (|>. variableL;local code;int (~) () (`)))))
+ (var$ (functionS;adjust-var outer-arity (variableL;local register))))
+ (var$ (variableL;local register))))
+ (let [register (variableL;captured-register var)]
+ (var$ (let [var (variableL;captured register)]
+ (maybe;default var (dict;get var resolver))))))
+
+ (^code ("lux case" (~ inputA) (~ [_ (#;Record branchesA)])))
+ (synthesize-case (recur +0 resolver num-locals) inputA branchesA)
+
+ (^multi (^code ("lux function" [(~@ scope)] (~ bodyA)))
+ [(s;run scope (p;some s;int)) (#e;Success raw-env)])
+ (let [inner-arity (n.inc outer-arity)
+ env (list/map (function [var] (maybe;default var (dict;get var resolver))) raw-env)
+ env-vars (let [env-size (list;size raw-env)]
+ (: (List Variable)
+ (case env-size
+ +0 (list)
+ _ (list/map variableL;captured (list;n.range +0 (n.dec env-size))))))
+ resolver' (if (functionS;nested? inner-arity)
+ (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 inner-arity resolver' +0 bodyA)
+ (^ [_ (#;Form (list [_ (#;Text "lux function")] [_ (#;Nat arity')] env' bodyS'))])
+ (let [arity (n.inc arity')]
+ (function$ arity env (prepare-body inner-arity arity bodyS')))
+
+ bodyS
+ (function$ +1 env (prepare-body inner-arity +1 bodyS))))
+
+ (^code ("lux apply" (~@ _)))
+ (synthesize-apply synthesize outer-arity num-locals exprA)
+
+ (^code ((~ [_ (#;Text name)]) (~@ args)))
+ (procedure$ name (list/map (recur +0 resolver num-locals) args))
+
+ _
+ exprA)))
diff --git a/new-luxc/source/luxc/lang/synthesis/function.lux b/new-luxc/source/luxc/lang/synthesis/function.lux
new file mode 100644
index 000000000..52aee9a49
--- /dev/null
+++ b/new-luxc/source/luxc/lang/synthesis/function.lux
@@ -0,0 +1,29 @@
+(;module:
+ lux
+ (luxc (lang ["la" analysis]
+ ["ls" synthesis]
+ [";L" variable #+ Variable])))
+
+(do-template [ []
+ [(def: #export ( arity)
+ (-> ls;Arity Bool)
+ ( ][ 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
new file mode 100644
index 000000000..0070fcd5d
--- /dev/null
+++ b/new-luxc/source/luxc/lang/synthesis/loop.lux
@@ -0,0 +1,185 @@
+(;module:
+ lux
+ (lux (control [monad #+ do]
+ ["p" parser])
+ (data [maybe]
+ (coll [list "list/" Functor]]))
+ (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 []
+ (^ [_ (#;Form (list [_ (#;Text )] leftS rightS))])
+ (` ( (~ (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/lang/synthesis/variable.lux b/new-luxc/source/luxc/lang/synthesis/variable.lux
new file mode 100644
index 000000000..3ce9f2678
--- /dev/null
+++ b/new-luxc/source/luxc/lang/synthesis/variable.lux
@@ -0,0 +1,98 @@
+(;module:
+ lux
+ (lux (data [number]
+ (coll [list "list/" Fold Monoid]
+ ["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))
+
+(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)]))
diff --git a/new-luxc/source/luxc/synthesizer.lux b/new-luxc/source/luxc/synthesizer.lux
deleted file mode 100644
index c43958890..000000000
--- a/new-luxc/source/luxc/synthesizer.lux
+++ /dev/null
@@ -1,184 +0,0 @@
-(;module:
- lux
- (lux (control ["p" parser])
- (data [maybe]
- ["e" error]
- [number]
- [product]
- text/format
- (coll [list "list/" Functor Fold Monoid]
- [dict #+ Dict]))
- (meta [code]
- ["s" syntax]))
- (luxc ["&" base]
- (lang ["la" analysis]
- ["ls" synthesis]
- [";L" variable #+ Variable])
- (synthesizer ["&&;" case]
- ["&&;" function]
- ["&&;" loop])
- ))
-
-(def: init-env (List Variable) (list))
-(def: init-resolver (Dict Int Int) (dict;new number;Hash))
-
-(def: (prepare-body inner-arity arity body)
- (-> Nat Nat ls;Synthesis ls;Synthesis)
- (if (&&function;nested? inner-arity)
- body
- (&&loop;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 synthesize inputA branchesA)
- (-> (-> la;Analysis ls;Synthesis)
- la;Analysis (List [la;Pattern la;Analysis])
- ls;Synthesis)
- (let [inputS (synthesize inputA)]
- (case (list;reverse branchesA)
- (^multi (^ (list [(^code ("lux case bind" (~ [_ (#;Nat input-register)])))
- (^code ((~ [_ (#;Int var)])))]))
- (not (variableL;captured? var))
- (n.= input-register (int-to-nat var)))
- inputS
-
- (^ (list [(^code ("lux case bind" (~ [_ (#;Nat register)]))) bodyA]))
- (let$ register inputS (synthesize bodyA))
-
- (^or (^ (list [(^code true) thenA] [(^code false) elseA]))
- (^ (list [(^code false) elseA] [(^code true) thenA])))
- (if$ inputS (synthesize thenA) (synthesize elseA))
-
- (#;Cons [lastP lastA] prevsPA)
- (let [transform-branch (: (-> la;Pattern la;Analysis ls;Path)
- (function [pattern expr]
- (|> (synthesize expr)
- (~) ("lux case exec")
- ("lux case seq" (~ (&&case;path pattern)))
- (`))))]
- (` ("lux case" (~ inputS)
- (~ (list/fold &&case;weave
- (transform-branch lastP lastA)
- (list/map (product;uncurry transform-branch) prevsPA))))))
-
- _
- (undefined)
- )))
-
-(def: (synthesize-apply synthesize outer-arity num-locals exprA)
- (-> (-> la;Analysis ls;Synthesis) ls;Arity Nat la;Analysis ls;Synthesis)
- (let [[funcA argsA] (&&function;unfold-apply exprA)
- funcS (synthesize funcA)
- argsS (list/map synthesize argsA)]
- (case funcS
- (^multi (^ [_ (#;Form (list [_ (#;Text "lux function")] [_ (#;Nat _arity)] [_ (#;Tuple _env)] _bodyS))])
- (and (n.= _arity (list;size argsS))
- (not (&&loop;contains-self-reference? _bodyS)))
- [(s;run _env (p;some s;int)) (#e;Success _env)])
- (let [register-offset (if (&&function;top? outer-arity)
- num-locals
- (|> outer-arity n.inc (n.+ num-locals)))]
- (` ("lux loop" (~ (code;nat register-offset)) [(~@ argsS)]
- (~ (&&loop;adjust _env register-offset _bodyS)))))
-
- (^ [_ (#;Form (list& [_ (#;Text "lux call")] funcS' argsS'))])
- (call$ funcS' (list/compose argsS' argsS))
-
- _
- (call$ funcS argsS))))
-
-(def: #export (synthesize analysis)
- (-> la;Analysis ls;Synthesis)
- (loop [outer-arity +0
- resolver init-resolver
- num-locals +0
- exprA analysis]
- (case exprA
- (^code [(~ _left) (~ _right)])
- (` [(~@ (list/map (recur +0 resolver num-locals) (la;unfold-tuple exprA)))])
-
- (^or (^code ("lux sum left" (~ _)))
- (^code ("lux sum right" (~ _))))
- (let [[tag last? value] (maybe;assume (la;unfold-variant exprA))]
- (variant$ tag last? (recur +0 resolver num-locals value)))
-
- (^code ((~ [_ (#;Int var)])))
- (if (variableL;local? var)
- (let [register (variableL;local-register var)]
- (if (&&function;nested? outer-arity)
- (if (n.= +0 register)
- (call$ (var$ 0) (|> (list;n.range +1 (n.dec outer-arity))
- (list/map (|>. variableL;local code;int (~) () (`)))))
- (var$ (&&function;adjust-var outer-arity (variableL;local register))))
- (var$ (variableL;local register))))
- (let [register (variableL;captured-register var)]
- (var$ (let [var (variableL;captured register)]
- (maybe;default var (dict;get var resolver))))))
-
- (^code ("lux case" (~ inputA) (~ [_ (#;Record branchesA)])))
- (synthesize-case (recur +0 resolver num-locals) inputA branchesA)
-
- (^multi (^code ("lux function" [(~@ scope)] (~ bodyA)))
- [(s;run scope (p;some s;int)) (#e;Success raw-env)])
- (let [inner-arity (n.inc outer-arity)
- env (list/map (function [var] (maybe;default var (dict;get var resolver))) raw-env)
- env-vars (let [env-size (list;size raw-env)]
- (: (List Variable)
- (case env-size
- +0 (list)
- _ (list/map variableL;captured (list;n.range +0 (n.dec env-size))))))
- resolver' (if (&&function;nested? inner-arity)
- (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 inner-arity resolver' +0 bodyA)
- (^ [_ (#;Form (list [_ (#;Text "lux function")] [_ (#;Nat arity')] env' bodyS'))])
- (let [arity (n.inc arity')]
- (function$ arity env (prepare-body inner-arity arity bodyS')))
-
- bodyS
- (function$ +1 env (prepare-body inner-arity +1 bodyS))))
-
- (^code ("lux apply" (~@ _)))
- (synthesize-apply synthesize outer-arity num-locals exprA)
-
- (^code ((~ [_ (#;Text name)]) (~@ args)))
- (procedure$ name (list/map (recur +0 resolver num-locals) args))
-
- _
- exprA)))
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]
- [text "text/" Eq]
- [number]
- (coll [list "list/" Fold]))
- (meta [code "code/" Eq]))
- (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 [ (as-is (` ("lux case alt" (~ leftP) (~ rightP))))]
- (case [leftP rightP]
- (^template []
- (^ [[_ (#;Form (list [_ (#;Text )] [_ (#;Nat left-idx)] left-then))]
- [_ (#;Form (list [_ (#;Text )] [_ (#;Nat right-idx)] right-then))]])
- (if (n.= left-idx right-idx)
- (` ( (~ (code;nat left-idx)) (~ (weave left-then right-then))))
- ))
- (["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")] _ _))])
-
-
- weavedP
- (` ("lux case seq" (~ weavedP) (~ (weave left-post right-post)))))
-
- _
- (if (code/= leftP rightP)
- leftP
- ))))
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 [ []
- [(def: #export ( arity)
- (-> ls;Arity Bool)
- ( ][ 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]]))
- (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 []
- (^ [_ (#;Form (list [_ (#;Text )] leftS rightS))])
- (` ( (~ (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 Monoid]
- ["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))
-
-(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)]))
--
cgit v1.2.3