aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--new-luxc/source/luxc/lang/synthesis/case.lux99
-rw-r--r--stdlib/source/lux/lang/analysis.lux157
-rw-r--r--stdlib/source/lux/lang/analysis/reference.lux4
-rw-r--r--stdlib/source/lux/lang/analysis/structure.lux2
-rw-r--r--stdlib/source/lux/lang/synthesis.lux137
-rw-r--r--stdlib/source/lux/lang/synthesis/case.lux170
-rw-r--r--stdlib/source/lux/lang/synthesis/expression.lux225
-rw-r--r--stdlib/source/lux/lang/synthesis/function.lux103
-rw-r--r--stdlib/source/lux/lang/synthesis/loop.lux56
-rw-r--r--stdlib/test/test/lux/lang/analysis/reference.lux4
-rw-r--r--stdlib/test/test/lux/lang/synthesis/case.lux89
-rw-r--r--stdlib/test/test/lux/lang/synthesis/function.lux37
12 files changed, 661 insertions, 422 deletions
diff --git a/new-luxc/source/luxc/lang/synthesis/case.lux b/new-luxc/source/luxc/lang/synthesis/case.lux
deleted file mode 100644
index 968c35561..000000000
--- a/new-luxc/source/luxc/lang/synthesis/case.lux
+++ /dev/null
@@ -1,99 +0,0 @@
-(.module:
- lux
- (lux (data [bool "bool/" Eq<Bool>]
- [text "text/" Eq<Text>]
- text/format
- [number]
- (coll [list "list/" Fold<List> Monoid<List>]))
- (macro [code "code/" Eq<Code>]))
- (luxc (lang [".L" variable #+ Variable]
- ["la" analysis]
- ["ls" synthesis]
- (synthesis [".S" function]))))
-
-(def: popPS ls.Path (' ("lux case pop")))
-
-(def: (path' arity num-locals pattern)
- (-> ls.Arity Nat la.Pattern [Nat (List ls.Path)])
- (case pattern
- (^code ("lux case tuple" [(~+ membersP)]))
- (case membersP
- #.Nil
- [num-locals
- (list popPS)]
-
- (#.Cons singletonP #.Nil)
- (path' arity num-locals singletonP)
-
- (#.Cons _)
- (let [last-idx (n/dec (list.size membersP))
- [_ output] (list/fold (: (-> la.Pattern [Nat [Nat (List ls.Path)]] [Nat [Nat (List ls.Path)]])
- (function (_ current-pattern [current-idx num-locals' next])
- (let [[num-locals'' current-path] (path' arity num-locals' current-pattern)]
- [(n/dec current-idx)
- num-locals''
- (|> (list (if (n/= last-idx current-idx)
- (` ("lux case tuple right" (~ (code.nat current-idx))))
- (` ("lux case tuple left" (~ (code.nat current-idx))))))
- (list/compose current-path)
- (list/compose next))])))
- [last-idx num-locals (list popPS)]
- (list.reverse membersP))]
- output))
-
- (^code ("lux case variant" (~ [_ (#.Nat tag)]) (~ [_ (#.Nat num-tags)]) (~ memberP)))
- (let [[num-locals' member-path] (path' arity num-locals memberP)]
- [num-locals' (|> (list (if (n/= (n/dec num-tags) tag)
- (` ("lux case variant right" (~ (code.nat tag))))
- (` ("lux case variant left" (~ (code.nat tag))))))
- (list/compose member-path)
- (list& popPS))])
-
- (^code ("lux case bind" (~ [_ (#.Nat register)])))
- [(n/inc num-locals)
- (list popPS
- (` ("lux case bind" (~ (code.nat (if (functionS.nested? arity)
- (n/+ (n/dec arity) register)
- register))))))]
-
- _
- [num-locals
- (list popPS pattern)]))
-
-(def: (clean-unnecessary-pops paths)
- (-> (List ls.Path) (List ls.Path))
- (case paths
- (#.Cons path paths')
- (if (is? popPS path)
- (clean-unnecessary-pops paths')
- paths)
-
- #.Nil
- paths))
-
-(def: #export (path arity num-locals synthesize pattern bodyA)
- (-> ls.Arity Nat (-> Nat la.Analysis ls.Synthesis) la.Pattern la.Analysis ls.Path)
- (let [[num-locals' pieces] (path' arity num-locals pattern)]
- (|> pieces
- clean-unnecessary-pops
- (list/fold (function (_ pre post)
- (` ("lux case seq" (~ pre) (~ post))))
- (` ("lux case exec" (~ (synthesize num-locals' bodyA))))))))
-
-(def: #export (weave leftP rightP)
- (-> ls.Path ls.Path ls.Path)
- (with-expansions [<default> (as-is (` ("lux case alt" (~ leftP) (~ rightP))))]
- (case [leftP rightP]
- (^ [(^code ("lux case seq" (~ preL) (~ postL)))
- (^code ("lux case seq" (~ preR) (~ postR)))])
- (case (weave preL preR)
- (^code ("lux case alt" (~ thenP) (~ elseP)))
- <default>
-
- weavedP
- (` ("lux case seq" (~ weavedP) (~ (weave postL postR)))))
-
- _
- (if (code/= leftP rightP)
- rightP
- <default>))))
diff --git a/stdlib/source/lux/lang/analysis.lux b/stdlib/source/lux/lang/analysis.lux
index 3cac8d7b2..87cd99120 100644
--- a/stdlib/source/lux/lang/analysis.lux
+++ b/stdlib/source/lux/lang/analysis.lux
@@ -1,6 +1,7 @@
(.module:
[lux #- nat int deg]
- (lux (control [equality #+ Eq])
+ (lux (control [equality #+ Equality]
+ [hash #+ Hash])
[function]
(data (coll [list "list/" Fold<List>]))))
@@ -26,11 +27,19 @@
(#Complex (Composite Pattern))
(#Bind Register))
+(type: #export (Branch' e)
+ {#when Pattern
+ #then e})
+
(type: #export Variable
(#Local Register)
(#Foreign Register))
-(struct: #export _ (Eq Variable)
+(type: #export Reference
+ (#Variable Variable)
+ (#Constant Ident))
+
+(struct: #export _ (Equality Variable)
(def: (= reference sample)
(case [reference sample]
(^template [<tag>]
@@ -41,8 +50,18 @@
_
false)))
-(type: #export (Match p e)
- [[p e] (List [p e])])
+(struct: #export _ (Hash Variable)
+ (def: eq Equality<Variable>)
+ (def: (hash var)
+ (case var
+ (#Local register)
+ (n/* +1 register)
+
+ (#Foreign register)
+ (n/* +2 register))))
+
+(type: #export (Match' e)
+ [(Branch' e) (List (Branch' e))])
(type: #export Environment
(List Variable))
@@ -54,13 +73,46 @@
(type: #export #rec Analysis
(#Primitive Primitive)
(#Structure (Composite Analysis))
- (#Variable Variable)
- (#Constant Ident)
- (#Case Analysis (Match Pattern Analysis))
+ (#Reference Reference)
+ (#Case Analysis (Match' Analysis))
(#Function Environment Analysis)
(#Apply Analysis Analysis)
(#Special (Special Analysis)))
+(type: #export Branch
+ (Branch' Analysis))
+
+(type: #export Match
+ (Match' Analysis))
+
+(do-template [<name> <tag>]
+ [(template: #export (<name> content)
+ (<tag> content))]
+
+ [control/case #Case]
+ )
+
+(do-template [<name> <family> <tag>]
+ [(template: #export (<name> content)
+ (<| #Reference
+ <family>
+ <tag>
+ content))]
+
+ [variable/local #..Variable #..Local]
+ [variable/foreign #..Variable #..Foreign]
+ )
+
+(do-template [<name> <tag>]
+ [(template: #export (<name> content)
+ (<| #Reference
+ <tag>
+ content))]
+
+ [reference/variable #..Variable]
+ [reference/constant #..Constant]
+ )
+
(do-template [<name> <type> <tag>]
[(def: #export <name>
(-> <type> Analysis)
@@ -87,15 +139,13 @@
(-> Nat Tag Bool)
(n/= (dec size) tag))
-(def: #export (no-op value)
- (-> Analysis Analysis)
- (let [identity (#Function (list) (#Variable (#Local +1)))]
- (#Apply value identity)))
+(template: #export (no-op value)
+ (#Apply value (#Function (list) (#Reference (#Variable (#Local +1))))))
(do-template [<name> <type> <structure> <prep-value>]
[(def: #export (<name> size tag value)
(-> Nat Tag <type> <type>)
- (let [left (function.const (|>> #.Left #Sum <structure>))
+ (let [left (function.constant (|>> #.Left #Sum <structure>))
right (|>> #.Right #Sum <structure>)]
(if (last? size tag)
(if (n/= +1 tag)
@@ -141,37 +191,47 @@
(type: #export Analyser
(-> Code (Meta Analysis)))
-(def: #export (tuple analysis)
- (-> Analysis (Tuple Analysis))
- (case analysis
- (#Structure (#Product left right))
- (#.Cons left (tuple right))
+(do-template [<name> <type> <tag>]
+ [(def: #export (<name> value)
+ (-> <type> (Tuple <type>))
+ (case value
+ (<tag> (#Product left right))
+ (#.Cons left (<name> right))
- _
- (list analysis)))
-
-(def: #export (variant analysis)
- (-> Analysis (Maybe (Variant Analysis)))
- (loop [lefts +0
- variantA analysis]
- (case variantA
- (#Structure (#Sum (#.Left valueA)))
- (case valueA
- (#Structure (#Sum _))
- (recur (inc lefts) valueA)
-
- _
- (#.Some {#lefts lefts
- #right? false
- #value valueA}))
-
- (#Structure (#Sum (#.Right valueA)))
- (#.Some {#lefts lefts
- #right? true
- #value valueA})
+ _
+ (list value)))]
- _
- #.None)))
+ [tuple Analysis #Structure]
+ [tuple-pattern Pattern #Complex]
+ )
+
+(do-template [<name> <type> <tag>]
+ [(def: #export (<name> value)
+ (-> <type> (Maybe (Variant <type>)))
+ (loop [lefts +0
+ variantA value]
+ (case variantA
+ (<tag> (#Sum (#.Left valueA)))
+ (case valueA
+ (<tag> (#Sum _))
+ (recur (inc lefts) valueA)
+
+ _
+ (#.Some {#lefts lefts
+ #right? false
+ #value valueA}))
+
+ (<tag> (#Sum (#.Right valueA)))
+ (#.Some {#lefts lefts
+ #right? true
+ #value valueA})
+
+ _
+ #.None)))]
+
+ [variant Analysis #Structure]
+ [variant-pattern Pattern #Complex]
+ )
(def: #export (application analysis)
(-> Analysis Application)
@@ -191,3 +251,18 @@
_
false))
+
+(template: #export (pattern/unit)
+ (#..Simple #..Unit))
+
+(do-template [<name> <tag>]
+ [(template: #export (<name> content)
+ (#..Simple (<tag> content)))]
+
+ [pattern/bool #..Bool]
+ [pattern/nat #..Nat]
+ [pattern/int #..Int]
+ [pattern/deg #..Deg]
+ [pattern/frac #..Frac]
+ [pattern/text #..Text]
+ )
diff --git a/stdlib/source/lux/lang/analysis/reference.lux b/stdlib/source/lux/lang/analysis/reference.lux
index 4192ed118..e00edc178 100644
--- a/stdlib/source/lux/lang/analysis/reference.lux
+++ b/stdlib/source/lux/lang/analysis/reference.lux
@@ -21,7 +21,7 @@
_
(do @
[_ (typeA.infer actualT)]
- (:: @ map (|>> #analysisL.Constant)
+ (:: @ map (|>> analysisL.reference/constant)
(macro.normalize def-name))))))
(def: (variable var-name)
@@ -32,7 +32,7 @@
(#.Some [actualT ref])
(do @
[_ (typeA.infer actualT)]
- (wrap (#.Some (#analysisL.Variable ref))))
+ (wrap (#.Some (analysisL.reference/variable ref))))
#.None
(wrap #.None))))
diff --git a/stdlib/source/lux/lang/analysis/structure.lux b/stdlib/source/lux/lang/analysis/structure.lux
index 4e91baad7..bc527cd49 100644
--- a/stdlib/source/lux/lang/analysis/structure.lux
+++ b/stdlib/source/lux/lang/analysis/structure.lux
@@ -185,7 +185,7 @@
code.tuple
analyse
(typeA.with-type tailT)
- (:: @ map analysis.no-op))))))
+ (:: @ map (|>> analysis.no-op)))))))
(def: #export (product analyse membersC)
(-> Analyser (List Code) (Meta Analysis))
diff --git a/stdlib/source/lux/lang/synthesis.lux b/stdlib/source/lux/lang/synthesis.lux
index 4bb83ac5e..c26564001 100644
--- a/stdlib/source/lux/lang/synthesis.lux
+++ b/stdlib/source/lux/lang/synthesis.lux
@@ -1,16 +1,18 @@
(.module:
[lux #- Scope]
(lux (control [state]
- ["ex" exception #+ Exception exception:])
+ ["ex" exception #+ Exception exception:]
+ [monad #+ do])
(data [product]
[error #+ Error]
[number]
- (coll (dictionary ["dict" unordered #+ Dict]))))
- [//analysis #+ Register Variable Environment Special Analysis])
+ (coll (dictionary ["dict" unordered #+ Dict])))
+ [function])
+ [//analysis #+ Register Variable Reference Environment Special Analysis])
(type: #export Arity Nat)
-(type: #export Resolver (Dict Register Variable))
+(type: #export Resolver (Dict Variable Variable))
(type: #export State
{#scope-arity Arity
@@ -18,10 +20,14 @@
#direct? Bool
#locals Nat})
+(def: #export fresh-resolver
+ Resolver
+ (dict.new //analysis.Hash<Variable>))
+
(def: #export init
State
{#scope-arity +0
- #resolver (dict.new number.Hash<Nat>)
+ #resolver fresh-resolver
#direct? false
#locals +0})
@@ -41,11 +47,24 @@
(#Variant (//analysis.Variant a))
(#Tuple (//analysis.Tuple a)))
+(type: #export Side
+ (Either Nat Nat))
+
+(type: #export Member
+ (Either Nat Nat))
+
+(type: #export Access
+ (#Side Side)
+ (#Member Member))
+
(type: #export (Path' s)
+ #Pop
+ (#Test Primitive)
+ (#Access Access)
(#Bind Register)
(#Alt (Path' s) (Path' s))
(#Seq (Path' s) (Path' s))
- (#Exec s))
+ (#Then s))
(type: #export (Abstraction' s)
{#environment Environment
@@ -55,7 +74,8 @@
(type: #export (Branch s)
(#Case s (Path' s))
(#Let s Register s)
- (#If s s s))
+ (#If s s s)
+ (#Exec s))
(type: #export (Scope s)
{#start Register
@@ -78,13 +98,36 @@
(type: #export #rec Synthesis
(#Primitive Primitive)
(#Structure (Structure Synthesis))
- (#Variable Variable)
+ (#Reference Reference)
(#Control (Control Synthesis))
(#Special (Special Synthesis)))
(type: #export Path
(Path' Synthesis))
+(def: #export path/pop
+ Path
+ #Pop)
+
+(do-template [<name> <tag>]
+ [(template: #export (<name> content)
+ (#..Test (<tag> content)))]
+
+ [path/bool #..Bool]
+ [path/i64 #..I64]
+ [path/f64 #..F64]
+ [path/text #..Text]
+ )
+
+(do-template [<name> <tag>]
+ [(template: #export (<name> content)
+ (<tag> content))]
+
+ [path/alt #..Alt]
+ [path/seq #..Seq]
+ [path/then #..Then]
+ )
+
(type: #export Abstraction
(Abstraction' Synthesis))
@@ -106,21 +149,62 @@
(:: error.Monad<Error> map product.right
(synthesizer analysis ..init)))
-(def: (localized transform)
+(def: (localized' transform)
(-> (-> State State)
- (-> Synthesizer Synthesizer))
- (function (scope synthesizer)
- (function (synthesize analysis state)
- (case (synthesize analysis (transform state))
+ (All [a] (-> (Operation a) (Operation a))))
+ (function (_ operation)
+ (function (_ state)
+ (case (operation (transform state))
(#error.Error error)
(#error.Error error)
(#error.Success [state' output])
(#error.Success [state output])))))
-(def: #export indirectly
- (-> Synthesizer Synthesizer)
- (localized (set@ #direct? false)))
+(def: (localized transform)
+ (-> (-> State State)
+ (-> Synthesizer Synthesizer))
+ (function (_ synthesize)
+ (function (_ analysis)
+ (localized' transform (synthesize analysis)))))
+
+(do-template [<operation> <synthesizer> <value>]
+ [(def: #export <operation>
+ (All [a] (-> (Operation a) (Operation a)))
+ (localized' (set@ #direct? <value>)))
+
+ (def: #export <synthesizer>
+ (-> Synthesizer Synthesizer)
+ (localized (set@ #direct? <value>)))]
+
+ [indirectly' indirectly false]
+ [directly' directly true]
+ )
+
+(do-template [<operation> <synthesizer> <type> <tag>]
+ [(def: #export (<operation> value)
+ (-> <type> (All [a] (-> (Operation a) (Operation a))))
+ (localized' (set@ <tag> value)))
+
+ (def: #export (<synthesizer> value)
+ (-> <type> (-> Synthesizer Synthesizer))
+ (localized (set@ <tag> value)))]
+
+ [with-scope-arity' with-scope-arity Arity #scope-arity]
+ [with-resolver' with-resolver Resolver #resolver]
+ [with-locals' with-locals Nat #locals]
+ )
+
+(def: #export (with-state value)
+ (-> ..State (-> Synthesizer Synthesizer))
+ (localized (function.constant value)))
+
+(def: #export (with-abstraction-state arity resolver)
+ (-> Arity Resolver (-> Synthesizer Synthesizer))
+ (with-state {#scope-arity arity
+ #resolver resolver
+ #direct? true
+ #locals arity}))
(do-template [<name> <tag> <type>]
[(def: #export <name>
@@ -129,10 +213,30 @@
(#error.Success [state (get@ <tag> state)])))]
[scope-arity #scope-arity Arity]
+ [resolver #resolver Resolver]
[direct? #direct? Bool]
[locals #locals Nat]
)
+(def: #export Operation@Monad (state.Monad<State'> error.Monad<Error>))
+
+(def: #export with-new-local'
+ (All [a] (-> (Operation a) (Operation a)))
+ (<<| (do Operation@Monad
+ [locals ..locals])
+ (..with-locals' (inc locals))))
+
+(do-template [<name> <tag>]
+ [(template: #export (<name> content)
+ (<| #..Reference
+ #//analysis.Variable
+ <tag>
+ content))]
+
+ [variable/local #//analysis.Local]
+ [variable/foreign #//analysis.Foreign]
+ )
+
(do-template [<name> <family> <tag>]
[(template: #export (<name> content)
(<| #..Control
@@ -143,6 +247,7 @@
[branch/case #..Branch #..Case]
[branch/let #..Branch #..Let]
[branch/if #..Branch #..If]
+ [branch/exec #..Branch #..Exec]
[loop/scope #..Loop #..Scope]
[loop/recur #..Loop #..Recur]
diff --git a/stdlib/source/lux/lang/synthesis/case.lux b/stdlib/source/lux/lang/synthesis/case.lux
new file mode 100644
index 000000000..ca7524072
--- /dev/null
+++ b/stdlib/source/lux/lang/synthesis/case.lux
@@ -0,0 +1,170 @@
+(.module:
+ lux
+ (lux (control [equality #+ Eq]
+ pipe
+ [monad #+ do])
+ (data [product]
+ [bool "bool/" Eq<Bool>]
+ [text "text/" Eq<Text>]
+ text/format
+ [number "frac/" Eq<Frac>]
+ (coll [list "list/" Fold<List> Monoid<List>])))
+ [///analysis #+ Pattern Match Analysis]
+ [// #+ Path Synthesis Operation]
+ [//function])
+
+(def: (path' pattern bodyC)
+ (-> Pattern (Operation Path) (Operation Path))
+ (case pattern
+ (#///analysis.Simple simple)
+ (case simple
+ #///analysis.Unit
+ bodyC
+
+ (^template [<from> <to>]
+ (<from> value)
+ (:: //.Operation@Monad map
+ (|>> (#//.Seq (#//.Test (|> value <to>))))
+ bodyC))
+ ([#///analysis.Bool #//.Bool]
+ [#///analysis.Nat (<| #//.I64 .i64)]
+ [#///analysis.Int (<| #//.I64 .i64)]
+ [#///analysis.Deg (<| #//.I64 .i64)]
+ [#///analysis.Frac #//.F64]
+ [#///analysis.Text #//.Text]))
+
+ (#///analysis.Bind register)
+ (do //.Operation@Monad
+ [arity //.scope-arity]
+ (:: @ map (|>> (#//.Seq (#//.Bind (if (//function.nested? arity)
+ (n/+ (dec arity) register)
+ register))))
+ (//.with-new-local' bodyC)))
+
+ (#///analysis.Complex _)
+ (case (///analysis.variant-pattern pattern)
+ (#.Some [lefts right? value-pattern])
+ (:: //.Operation@Monad map
+ (|>> (#//.Seq (#//.Access (#//.Side (if right?
+ (#.Right lefts)
+ (#.Left lefts))))))
+ (path' value-pattern bodyC))
+
+ #.None
+ (let [tuple (///analysis.tuple-pattern pattern)
+ tuple/last (dec (list.size tuple))]
+ (list/fold (function (_ [tuple/idx tuple/member] thenC)
+ (case tuple/member
+ (#///analysis.Simple #///analysis.Unit)
+ thenC
+
+ _
+ (let [last? (n/= tuple/last tuple/idx)]
+ (|> (if (or last?
+ (is? bodyC thenC))
+ thenC
+ (:: //.Operation@Monad map (|>> (#//.Seq #//.Pop)) thenC))
+ (path' tuple/member)
+ (:: //.Operation@Monad map
+ (|>> (#//.Seq (#//.Access (#//.Member (if last?
+ (#.Right (dec tuple/idx))
+ (#.Left tuple/idx)))))))))))
+ bodyC
+ (list.reverse (list.enumerate tuple)))))))
+
+(def: #export (path synthesize pattern bodyA)
+ (-> //.Synthesizer Pattern Analysis (Operation Path))
+ (path' pattern (:: //.Operation@Monad map (|>> #//.Then) (synthesize bodyA))))
+
+(def: #export (weave leftP rightP)
+ (-> Path Path Path)
+ (with-expansions [<default> (as-is (#//.Alt leftP rightP))]
+ (case [leftP rightP]
+ [(#//.Seq preL postL)
+ (#//.Seq preR postR)]
+ (case (weave preL preR)
+ (#//.Alt _)
+ <default>
+
+ weavedP
+ (#//.Seq weavedP (weave postL postR)))
+
+ [#//.Pop #//.Pop]
+ rightP
+
+ (^template [<tag> <eq>]
+ [(#//.Test (<tag> leftV))
+ (#//.Test (<tag> rightV))]
+ (if (<eq> leftV rightV)
+ rightP
+ <default>))
+ ([#//.Bool bool/=]
+ [#//.I64 (:! (Eq I64) i/=)]
+ [#//.F64 frac/=]
+ [#//.Text text/=])
+
+ (^template [<access> <side>]
+ [(#//.Access (<access> (<side> leftL)))
+ (#//.Access (<access> (<side> rightL)))]
+ (if (n/= leftL rightL)
+ rightP
+ <default>))
+ ([#//.Side #.Left]
+ [#//.Side #.Right]
+ [#//.Member #.Left]
+ [#//.Member #.Right])
+
+ [(#//.Bind leftR) (#//.Bind rightR)]
+ (if (n/= leftR rightR)
+ rightP
+ <default>)
+
+ _
+ <default>)))
+
+(def: #export (synthesize synthesize^ inputA [headB tailB+])
+ (-> //.Synthesizer Analysis Match (Operation Synthesis))
+ (do //.Operation@Monad
+ [inputS (synthesize^ inputA)]
+ (case [headB tailB+]
+ [[(#///analysis.Bind inputR) headB/bodyA]
+ #.Nil]
+ (case headB/bodyA
+ (^ (///analysis.variable/local outputR))
+ (wrap (if (n/= inputR outputR)
+ inputS
+ (//.branch/exec inputS)))
+
+ _
+ (do @
+ [arity //.scope-arity
+ headB/bodyS (//.with-new-local'
+ (synthesize^ headB/bodyA))]
+ (wrap (//.branch/let [inputS
+ (if (//function.nested? arity)
+ (n/+ (dec arity) inputR)
+ inputR)
+ headB/bodyS]))))
+
+ (^or (^ [[(///analysis.pattern/bool true) thenA]
+ (list [(///analysis.pattern/bool false) elseA])])
+ (^ [[(///analysis.pattern/bool false) elseA]
+ (list [(///analysis.pattern/bool true) thenA])]))
+ (do @
+ [thenS (synthesize^ thenA)
+ elseS (synthesize^ elseA)]
+ (wrap (//.branch/if [inputS thenS elseS])))
+
+ _
+ (let [[[lastP lastA] prevsPA] (|> (#.Cons headB tailB+)
+ list.reverse
+ (case> (#.Cons [lastP lastA] prevsPA)
+ [[lastP lastA] prevsPA]
+
+ _
+ (undefined)))]
+ (do @
+ [lastSP (path synthesize^ lastP lastA)
+ prevsSP+ (monad.map @ (product.uncurry (path synthesize^)) prevsPA)]
+ (wrap (//.branch/case [inputS (list/fold weave lastSP prevsSP+)]))))
+ )))
diff --git a/stdlib/source/lux/lang/synthesis/expression.lux b/stdlib/source/lux/lang/synthesis/expression.lux
index 1167e975a..d556048b3 100644
--- a/stdlib/source/lux/lang/synthesis/expression.lux
+++ b/stdlib/source/lux/lang/synthesis/expression.lux
@@ -1,147 +1,67 @@
(.module:
[lux #- primitive]
(lux (control [monad #+ do]
- ["ex" exception #+ exception:]
- [state])
+ ["ex" exception #+ exception:])
(data [maybe]
- [error]
- [number]
- [product]
- text/format
- (coll [list "list/" Functor<List> Fold<List> Monoid<List>]
- (dictionary ["dict" unordered #+ Dict])))
- (macro [code]
- ["s" syntax])
- [lang]
- (lang [".L" analysis #+ Analysis]
- [".L" extension #+ Extension]))
+ (coll [list "list/" Functor<List>]
+ (dictionary ["dict" unordered #+ Dict]))))
+ [///analysis #+ Analysis]
+ [///extension #+ Extension]
[// #+ Synthesis]
[//function]
- ## (luxc (lang (synthesis [".S" case]
- ## [".S" loop])
- ## [".L" variable #+ Variable])
- ## )
- )
+ [//case])
(exception: #export (unknown-synthesis-extension {name Text})
name)
-## (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 Synthesis Synthesis)
-## (if (//function.nested? inner-arity)
-## body
-## (loopS.reify-recursion arity body)))
-
-## (def: (let$ register inputS bodyS)
-## (-> Nat Synthesis Synthesis Synthesis)
-## (` ("lux let" (~ (code.nat register)) (~ inputS) (~ bodyS))))
-
-## (def: (if$ testS thenS elseS)
-## (-> Synthesis Synthesis Synthesis Synthesis)
-## (` ("lux if" (~ testS)
-## (~ thenS)
-## (~ elseS))))
-
-## (def: (variant$ tag last? valueS)
-## (-> Nat Bool Synthesis Synthesis)
-## (` ((~ (code.nat tag)) (~ (code.bool last?)) (~ valueS))))
-
-## (def: (var$ var)
-## (-> Variable Synthesis)
-## (` ((~ (code.int var)))))
-
-## (def: (procedure$ name argsS)
-## (-> Text (List Synthesis) Synthesis)
-## (` ((~ (code.text name)) (~+ argsS))))
-
-## (def: (call$ funcS argsS)
-## (-> Synthesis (List Synthesis) Synthesis)
-## (` ("lux call" (~ funcS) (~+ argsS))))
-
-## (def: (synthesize-case arity num-locals synthesize inputA branchesA)
-## (-> ls.Arity Nat (-> Nat Analysis Synthesis)
-## Analysis (List [la.Pattern Analysis])
-## 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 (//function.nested? arity)
-## (n/+ (dec arity) register)
-## register)
-## inputS
-## (synthesize (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 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: (primitive analysis)
- (-> analysisL.Primitive //.Primitive)
+ (-> ///analysis.Primitive //.Primitive)
(case analysis
- #analysisL.Unit
+ #///analysis.Unit
(#//.Text //.unit)
(^template [<analysis> <synthesis>]
(<analysis> value)
(<synthesis> value))
- ([#analysisL.Bool #//.Bool]
- [#analysisL.Frac #//.F64]
- [#analysisL.Text #//.Text])
+ ([#///analysis.Bool #//.Bool]
+ [#///analysis.Frac #//.F64]
+ [#///analysis.Text #//.Text])
(^template [<analysis> <synthesis>]
(<analysis> value)
(<synthesis> (.i64 value)))
- ([#analysisL.Nat #//.I64]
- [#analysisL.Int #//.I64]
- [#analysisL.Deg #//.I64])))
+ ([#///analysis.Nat #//.I64]
+ [#///analysis.Int #//.I64]
+ [#///analysis.Deg #//.I64])))
-(def: Compiler@Monad (state.Monad<State'> error.Monad<Error>))
-(open: "compiler/" Compiler@Monad)
+(open: "operation/" //.Operation@Monad)
(def: #export (synthesizer extensions)
- (-> (Extension extensionL.Synthesis) //.Synthesizer)
+ (-> (Extension ///extension.Synthesis) //.Synthesizer)
(function (synthesize analysis)
(case analysis
- (#analysisL.Primitive analysis')
- (compiler/wrap (#//.Primitive (..primitive analysis')))
+ (#///analysis.Primitive analysis')
+ (operation/wrap (#//.Primitive (..primitive analysis')))
- (#analysisL.Structure composite)
- (case (analysisL.variant analysis)
+ (#///analysis.Structure composite)
+ (case (///analysis.variant analysis)
(#.Some variant)
- (do Compiler@Monad
- [valueS (synthesize (get@ #analysisL.value variant))]
- (wrap (#//.Structure (#//.Variant (set@ #analysisL.value valueS variant)))))
+ (do //.Operation@Monad
+ [valueS (synthesize (get@ #///analysis.value variant))]
+ (wrap (#//.Structure (#//.Variant (set@ #///analysis.value valueS variant)))))
_
- (do Compiler@Monad
- [tupleS (monad.map @ synthesize (analysisL.tuple analysis))]
+ (do //.Operation@Monad
+ [tupleS (monad.map @ synthesize (///analysis.tuple analysis))]
(wrap (#//.Structure (#//.Tuple tupleS)))))
- (#analysisL.Apply _)
+ (#///analysis.Apply _)
(//function.apply (//.indirectly synthesize) analysis)
- (#analysisL.Special name args)
+ (#///analysis.Function environmentA bodyA)
+ (//function.function synthesize environmentA bodyA)
+
+ (#///analysis.Special name args)
(case (dict.get name extensions)
#.None
(//.throw unknown-synthesis-extension name)
@@ -149,62 +69,31 @@
(#.Some extension)
(extension (//.indirectly synthesize) args))
- _
- (undefined)
-
- ## (^code ((~ [_ (#.Int var)])))
- ## (if (variableL.local? var)
- ## (if (//function.nested? arity)
- ## (if (variableL.self? var)
- ## (call$ (var$ 0) (|> (list.n/range +1 (dec arity))
- ## (list/map (|>> variableL.local code.int (~) () (`)))))
- ## (var$ (//function.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 (//.indirectly synthesize) inputA branchesA)
-
- ## (^multi (^code ("lux function" [(~+ scope)] (~ bodyA)))
- ## [(s.run scope (p.some s.int)) (#error.Success raw-env)])
- ## (let [function-arity (if direct?
- ## (inc arity)
- ## +1)
- ## env (list/map (function (_ closure)
- ## (case (dict.get closure resolver)
- ## (#.Some resolved)
- ## (if (and (variableL.local? resolved)
- ## (//function.nested? arity)
- ## (|> resolved variableL.local-register (n/>= arity)))
- ## (//function.adjust-var arity resolved)
- ## resolved)
-
- ## #.None
- ## (if (and (variableL.local? closure)
- ## (//function.nested? arity))
- ## (//function.adjust-var arity closure)
- ## closure)))
- ## raw-env)
- ## env-vars (: (List Variable)
- ## (case raw-env
- ## #.Nil (list)
- ## _ (|> (list.size raw-env) dec (list.n/range +0) (list/map variableL.captured))))
- ## resolver' (if (and (//function.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 (inc unmerged-arity)]
- ## (function$ merged-arity env
- ## (prepare-body function-arity merged-arity bodyS')))
-
- ## bodyS
- ## (function$ +1 env (prepare-body function-arity +1 bodyS))))
+ (#///analysis.Reference reference)
+ (case reference
+ (#///analysis.Constant constant)
+ (operation/wrap (#//.Reference reference))
+
+ (#///analysis.Variable var)
+ (do //.Operation@Monad
+ [resolver //.resolver]
+ (case var
+ (#///analysis.Local register)
+ (do @
+ [arity //.scope-arity]
+ (wrap (if (//function.nested? arity)
+ (if (n/= +0 register)
+ (|> (dec arity)
+ (list.n/range +1)
+ (list/map (|>> //.variable/local))
+ [(//.variable/local +0)]
+ //.function/apply)
+ (#//.Reference (#///analysis.Variable (//function.adjust arity false var))))
+ (#//.Reference (#///analysis.Variable var)))))
+
+ (#///analysis.Foreign register)
+ (wrap (|> resolver (dict.get var) (maybe.default var) #///analysis.Variable #//.Reference)))))
+
+ (#///analysis.Case inputA branchesAB+)
+ (//case.synthesize (//.indirectly synthesize) inputA branchesAB+)
)))
diff --git a/stdlib/source/lux/lang/synthesis/function.lux b/stdlib/source/lux/lang/synthesis/function.lux
index 7b989d975..4bd6846e2 100644
--- a/stdlib/source/lux/lang/synthesis/function.lux
+++ b/stdlib/source/lux/lang/synthesis/function.lux
@@ -1,21 +1,33 @@
(.module:
- lux
+ [lux #- function]
(lux (control [monad #+ do]
- [state])
- (data [maybe]
+ [state]
+ pipe
+ ["ex" exception #+ exception:])
+ (data [maybe "maybe/" Monad<Maybe>]
[error]
- (coll [list "list/" Monoid<List>]))
- (lang [".L" analysis #+ Variable Analysis]))
- [// #+ Arity Synthesizer]
+ (coll [list "list/" Functor<List> Monoid<List> Fold<List>]
+ (dictionary ["dict" unordered #+ Dict])))
+ (lang [".L" analysis #+ Variable Environment Analysis]))
+ [// #+ Arity Synthesis Synthesizer]
[//loop])
-(def: nested?
+(def: Operation@Monad (state.Monad<State'> error.Monad<Error>))
+
+(def: #export nested?
(-> Arity Bool)
(n/> +1))
-## (def: (adjust-var outer var)
-## (-> Arity Variable Variable)
-## (|> outer dec .int (i/+ var)))
+(def: #export (adjust up-arity after? var)
+ (-> Arity Bool Variable Variable)
+ (case var
+ (#analysisL.Local register)
+ (if (and after? (n/>= up-arity register))
+ (#analysisL.Local (n/+ (dec up-arity) register))
+ var)
+
+ _
+ var))
(def: (unfold apply)
(-> Analysis [Analysis (List Analysis)])
@@ -30,7 +42,7 @@
(def: #export (apply synthesize)
(-> Synthesizer Synthesizer)
- (function (_ exprA)
+ (.function (_ exprA)
(let [[funcA argsA] (unfold exprA)]
(do (state.Monad<State'> error.Monad<Error>)
[funcS (synthesize funcA)
@@ -47,3 +59,72 @@
_
(wrap (//.function/apply [funcS argsS])))))))
+
+(def: (prepare up down)
+ (-> Arity Arity (//loop.Transform Synthesis))
+ (.function (_ body)
+ (if (nested? up)
+ (#.Some body)
+ (//loop.recursion down body))))
+
+(exception: #export (cannot-prepare-function-body {_ []})
+ "")
+
+(def: return
+ (All [a] (-> (Maybe a) (//.Operation a)))
+ (|>> (case> (#.Some output)
+ (:: Operation@Monad wrap output)
+
+ #.None
+ (//.throw cannot-prepare-function-body []))))
+
+(def: #export (function synthesize environment body)
+ (-> Synthesizer Environment Analysis (//.Operation Synthesis))
+ (do Operation@Monad
+ [direct? //.direct?
+ arity //.scope-arity
+ resolver //.resolver
+ #let [function-arity (if direct?
+ (inc arity)
+ +1)
+ up-environment (if (nested? arity)
+ (list/map (.function (_ closure)
+ (case (dict.get closure resolver)
+ (#.Some resolved)
+ (adjust arity true resolved)
+
+ #.None
+ (adjust arity false closure)))
+ environment)
+ environment)
+ down-environment (: (List Variable)
+ (case environment
+ #.Nil
+ (list)
+
+ _
+ (|> (list.size environment) dec (list.n/range +0)
+ (list/map (|>> #analysisL.Foreign)))))
+ resolver' (if (and (nested? function-arity)
+ direct?)
+ (list/fold (.function (_ [from to] resolver')
+ (dict.put from to resolver'))
+ //.fresh-resolver
+ (list.zip2 down-environment up-environment))
+ (list/fold (.function (_ var resolver')
+ (dict.put var var resolver'))
+ //.fresh-resolver
+ down-environment))
+ synthesize' (//.with-abstraction-state function-arity resolver' synthesize)]
+ bodyS (synthesize' body)]
+ (case bodyS
+ (^ (//.function/abstraction [env' down-arity' bodyS']))
+ (let [arity' (inc down-arity')]
+ (|> (prepare function-arity arity' bodyS')
+ (maybe/map (|>> [up-environment arity'] //.function/abstraction))
+ ..return))
+
+ _
+ (|> (prepare function-arity +1 bodyS)
+ (maybe/map (|>> [up-environment +1] //.function/abstraction))
+ ..return))))
diff --git a/stdlib/source/lux/lang/synthesis/loop.lux b/stdlib/source/lux/lang/synthesis/loop.lux
index 476cf27b4..4dcc25873 100644
--- a/stdlib/source/lux/lang/synthesis/loop.lux
+++ b/stdlib/source/lux/lang/synthesis/loop.lux
@@ -9,7 +9,7 @@
[///analysis #+ Register Variable Environment]
[// #+ Path Abstraction Synthesis])
-(type: (Transform a)
+(type: #export (Transform a)
(-> a (Maybe a)))
(def: (some? maybe)
@@ -18,11 +18,21 @@
(#.Some _) true
#.None false))
+(template: #export (self-reference)
+ (#//.Reference (#///analysis.Variable (#///analysis.Local +0))))
+
+(template: (recursive-apply args)
+ (#//.Apply (self-reference) args))
+
(def: proper Bool true)
+(def: improper Bool false)
(def: (proper? exprS)
(-> Synthesis Bool)
(case exprS
+ (^ (self-reference))
+ improper
+
(#//.Structure structure)
(case structure
(#//.Variant variantS)
@@ -31,9 +41,6 @@
(#//.Tuple membersS+)
(list.every? proper? membersS+))
- (#//.Variable var)
- (not (///analysis.self? var))
-
(#//.Control controlS)
(case controlS
(#//.Branch branchS)
@@ -45,12 +52,15 @@
(^or (#//.Alt leftS rightS) (#//.Seq leftS rightS))
(and (recur leftS) (recur rightS))
- (#//.Exec bodyS)
+ (#//.Then bodyS)
(proper? bodyS)
_
proper)))
+ (#//.Exec bodyS)
+ (proper? bodyS)
+
(#//.Let inputS register bodyS)
(and (proper? inputS)
(proper? bodyS))
@@ -100,16 +110,12 @@
(#//.Seq leftS rightS)
(maybe/map (|>> (#//.Seq leftS)) (recur rightS))
- (#//.Exec bodyS)
- (maybe/map (|>> #//.Exec) (synthesis-recursion bodyS))
+ (#//.Then bodyS)
+ (maybe/map (|>> #//.Then) (synthesis-recursion bodyS))
_
#.None)))
-(template: (recursive-apply args)
- (#//.Apply (#//.Variable (#///analysis.Local +0))
- args))
-
(def: #export (recursion arity)
(-> Nat (Transform Synthesis))
(function (recur exprS)
@@ -123,6 +129,9 @@
(path-recursion recur)
(maybe/map (|>> (#//.Case inputS) #//.Branch #//.Control)))
+ (#//.Exec bodyS)
+ (maybe/map (|>> //.branch/exec) (recur bodyS))
+
(#//.Let inputS register bodyS)
(maybe/map (|>> (#//.Let inputS register) #//.Branch #//.Control)
(recur bodyS))
@@ -174,8 +183,8 @@
(wrap (<tag> leftS' rightS'))))
([#//.Alt] [#//.Seq])
- (#//.Exec bodyS)
- (|> bodyS adjust-synthesis (maybe/map (|>> #//.Exec)))
+ (#//.Then bodyS)
+ (|> bodyS adjust-synthesis (maybe/map (|>> #//.Then)))
_
(#.Some pathS))))
@@ -199,15 +208,20 @@
(monad.map maybe.Monad<Maybe> recur)
(maybe/map (|>> #//.Tuple #//.Structure))))
- (#//.Variable variable)
- (case variable
- (#///analysis.Local register)
- (#.Some (#//.Variable (#///analysis.Local (n/+ offset register))))
+ (#//.Reference reference)
+ (case reference
+ (#///analysis.Constant constant)
+ (#.Some exprS)
- (#///analysis.Foreign register)
- (|> scope-environment
- (list.nth register)
- (maybe/map (|>> #//.Variable))))
+ (#///analysis.Variable variable)
+ (case variable
+ (#///analysis.Local register)
+ (#.Some (#//.Reference (#///analysis.Variable (#///analysis.Local (n/+ offset register)))))
+
+ (#///analysis.Foreign register)
+ (|> scope-environment
+ (list.nth register)
+ (maybe/map (|>> #///analysis.Variable #//.Reference)))))
(^ (//.branch/case [inputS pathS]))
(do maybe.Monad<Maybe>
diff --git a/stdlib/test/test/lux/lang/analysis/reference.lux b/stdlib/test/test/lux/lang/analysis/reference.lux
index 00689f3e0..e67756d55 100644
--- a/stdlib/test/test/lux/lang/analysis/reference.lux
+++ b/stdlib/test/test/lux/lang/analysis/reference.lux
@@ -36,7 +36,7 @@
(typeA.with-inference
(..analyse (code.symbol ["" var-name])))))
(macro.run (initL.compiler []))
- (case> (^ (#e.Success [inferredT (#analysisL.Variable (#analysisL.Local var))]))
+ (case> (^ (#e.Success [inferredT (analysisL.variable/local var)]))
(and (type/= expectedT inferredT)
(n/= +0 var))
@@ -49,7 +49,7 @@
(..analyse (code.symbol def-name))))
(moduleL.with-module +0 module-name)
(macro.run (initL.compiler []))
- (case> (#e.Success [_ inferredT (#analysisL.Constant constant-name)])
+ (case> (^ (#e.Success [_ inferredT (analysisL.reference/constant constant-name)]))
(and (type/= expectedT inferredT)
(ident/= def-name constant-name))
diff --git a/stdlib/test/test/lux/lang/synthesis/case.lux b/stdlib/test/test/lux/lang/synthesis/case.lux
index 3ae62badc..23ed6726c 100644
--- a/stdlib/test/test/lux/lang/synthesis/case.lux
+++ b/stdlib/test/test/lux/lang/synthesis/case.lux
@@ -1,47 +1,50 @@
(.module:
lux
- (lux [io]
- (control [monad #+ do]
+ (lux (control [monad #+ do]
pipe)
- (macro [code])
+ (data [error "error/" Functor<Error>])
+ (lang [".L" analysis #+ Branch Analysis]
+ ["//" synthesis #+ Synthesis]
+ (synthesis [".S" expression])
+ [".L" extension])
["r" math/random "r/" Monad<Random>]
test)
- (luxc (lang ["la" analysis]
- ["//" synthesis #+ Synthesis]
- (synthesis [".S" expression])
- [".L" extension]
- [".L" variable #+ Variable]))
- (/// common))
+ [//primitive])
(context: "Dummy variables."
(<| (times +100)
(do @
- [maskedA gen-primitive
+ [maskedA //primitive.primitive
temp (|> r.nat (:: @ map (n/% +100)))
- #let [maskA (` ("lux case" (~ maskedA)
- {("lux case bind" (~ (code.nat temp)))
- (~ (la.var (variableL.local temp)))}))]]
+ #let [maskA (analysisL.control/case
+ [maskedA
+ [[(#analysisL.Bind temp)
+ (analysisL.variable/local temp)]
+ (list)]])]]
(test "Dummy variables created to mask expressions get eliminated during synthesis."
- (|> (//.run (expressionS.synthesizer extensionL.no-syntheses
- maskA))
- (corresponds? maskedA))))))
+ (|> maskA
+ (//.run (expressionS.synthesizer extensionL.empty))
+ (error/map (//primitive.corresponds? maskedA))
+ (error.default false))))))
(context: "Let expressions."
(<| (times +100)
(do @
[registerA r.nat
- inputA gen-primitive
- outputA gen-primitive
- #let [letA (` ("lux case" (~ inputA)
- {("lux case bind" (~ (code.nat registerA)))
- (~ outputA)}))]]
+ inputA //primitive.primitive
+ outputA //primitive.primitive
+ #let [letA (analysisL.control/case
+ [inputA
+ [[(#analysisL.Bind registerA)
+ outputA]
+ (list)]])]]
(test "Can detect and reify simple 'let' expressions."
- (|> (//.run (expressionS.synthesizer extensionL.no-syntheses
- letA))
- (case> (^ [_ (#.Form (list [_ (#.Text "lux let")] [_ (#.Nat registerS)] inputS outputS))])
+ (|> letA
+ (//.run (expressionS.synthesizer extensionL.empty))
+ (case> (^ (#error.Success (//.branch/let [inputS registerS outputS])))
(and (n/= registerA registerS)
- (corresponds? inputA inputS)
- (corresponds? outputA outputS))
+ (//primitive.corresponds? inputA inputS)
+ (//primitive.corresponds? outputA outputS))
_
false))))))
@@ -50,23 +53,25 @@
(<| (times +100)
(do @
[then|else r.bool
- inputA gen-primitive
- thenA gen-primitive
- elseA gen-primitive
- #let [ifA (if then|else
- (` ("lux case" (~ inputA)
- {true (~ thenA)
- false (~ elseA)}))
- (` ("lux case" (~ inputA)
- {false (~ elseA)
- true (~ thenA)})))]]
+ inputA //primitive.primitive
+ thenA //primitive.primitive
+ elseA //primitive.primitive
+ #let [thenB (: Branch
+ [(#analysisL.Simple (#analysisL.Bool true))
+ thenA])
+ elseB (: Branch
+ [(#analysisL.Simple (#analysisL.Bool false))
+ elseA])
+ ifA (if then|else
+ (analysisL.control/case [inputA [thenB (list elseB)]])
+ (analysisL.control/case [inputA [elseB (list thenB)]]))]]
(test "Can detect and reify simple 'if' expressions."
- (|> (//.run (expressionS.synthesizer extensionL.no-syntheses
- ifA))
- (case> (^ [_ (#.Form (list [_ (#.Text "lux if")] inputS thenS elseS))])
- (and (corresponds? inputA inputS)
- (corresponds? thenA thenS)
- (corresponds? elseA elseS))
+ (|> ifA
+ (//.run (expressionS.synthesizer extensionL.empty))
+ (case> (^ (#error.Success (//.branch/if [inputS thenS elseS])))
+ (and (//primitive.corresponds? inputA inputS)
+ (//primitive.corresponds? thenA thenS)
+ (//primitive.corresponds? elseA elseS))
_
false))))))
diff --git a/stdlib/test/test/lux/lang/synthesis/function.lux b/stdlib/test/test/lux/lang/synthesis/function.lux
index c469d8665..93ca5d40d 100644
--- a/stdlib/test/test/lux/lang/synthesis/function.lux
+++ b/stdlib/test/test/lux/lang/synthesis/function.lux
@@ -11,7 +11,7 @@
(coll [list "list/" Functor<List> Fold<List>]
(dictionary ["dict" unordered #+ Dict])
(set ["set" unordered])))
- (lang [".L" analysis #+ Variable Analysis "variable/" Eq<Variable>]
+ (lang [".L" analysis #+ Variable Analysis "variable/" Equality<Variable>]
["//" synthesis #+ Arity Synthesis]
(synthesis [".S" expression])
[".L" extension])
@@ -44,40 +44,39 @@
(do r.Monad<Random>
[num-locals (|> r.nat (:: @ map (|>> (n/% +100) (n/max +10))))
#let [indices (list.n/range +0 (dec num-locals))
- absolute-env (list/map (|>> #analysisL.Local) indices)
- relative-env (list/map (|>> #analysisL.Foreign) indices)]
+ local-env (list/map (|>> #analysisL.Local) indices)
+ foreign-env (list/map (|>> #analysisL.Foreign) indices)]
[arity bodyA predictionA] (: (r.Random [Arity Analysis Variable])
(loop [arity +1
- global-env relative-env]
- (let [env-size (list.size global-env)
+ current-env foreign-env]
+ (let [current-env/size (list.size current-env)
resolver (list/fold (function (_ [idx var] resolver)
(dict.put idx var resolver))
(: (Dict Nat Variable)
(dict.new number.Hash<Nat>))
- (list.zip2 (list.n/range +0 (dec env-size))
- global-env))]
+ (list.enumerate current-env))]
(do @
[nest? r.bool]
(if nest?
(do @
- [num-picks (:: @ map (n/max +1) (pick (inc env-size)))
- picks (|> (r.set number.Hash<Nat> num-picks (pick env-size))
+ [num-picks (:: @ map (n/max +1) (pick (inc current-env/size)))
+ picks (|> (r.set number.Hash<Nat> num-picks (pick current-env/size))
(:: @ map set.to-list))
[arity bodyA predictionA] (recur (inc arity)
(list/map (function (_ pick)
- (maybe.assume (list.nth pick global-env)))
- picks))]
+ (maybe.assume (list.nth pick current-env)))
+ picks))
+ #let [picked-env (list/map (|>> #analysisL.Foreign) picks)]]
(wrap [arity
- (#analysisL.Function (list/map (|>> #analysisL.Foreign) picks)
- bodyA)
+ (#analysisL.Function picked-env bodyA)
predictionA]))
(do @
- [chosen (pick (list.size global-env))]
+ [chosen (pick (list.size current-env))]
(wrap [arity
- (#analysisL.Variable (#analysisL.Foreign chosen))
+ (analysisL.variable/foreign chosen)
(maybe.assume (dict.get chosen resolver))])))))))]
(wrap [arity
- (#analysisL.Function absolute-env bodyA)
+ (#analysisL.Function local-env bodyA)
predictionA])))
(def: local-function
@@ -94,7 +93,7 @@
(do r.Monad<Random>
[chosen (|> r.nat (:: @ map (|>> (n/% +100) (n/max +2))))]
(wrap [arity
- (#analysisL.Variable (#analysisL.Local chosen))
+ (analysisL.variable/local chosen)
(|> chosen (n/+ (dec arity)) #analysisL.Local)])))))
(context: "Function definition."
@@ -116,7 +115,7 @@
(test "Folded functions provide direct access to environment variables."
(|> function//environment
(//.run (expressionS.synthesizer extensionL.empty))
- (case> (^ (#error.Success (//.function/abstraction [environment arity (#//.Variable output)])))
+ (case> (^ (#error.Success (//.function/abstraction [environment arity (analysisL.reference/variable output)])))
(and (n/= arity//environment arity)
(variable/= prediction//environment output))
@@ -125,7 +124,7 @@
(test "Folded functions properly offset local variables."
(|> function//local
(//.run (expressionS.synthesizer extensionL.empty))
- (case> (^ (#error.Success (//.function/abstraction [environment arity (#//.Variable output)])))
+ (case> (^ (#error.Success (//.function/abstraction [environment arity (analysisL.reference/variable output)])))
(and (n/= arity//local arity)
(variable/= prediction//local output))