aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/lang/analysis.lux72
-rw-r--r--stdlib/source/lux/lang/analysis/reference.lux20
-rw-r--r--stdlib/source/lux/lang/reference.lux66
-rw-r--r--stdlib/source/lux/lang/scope.lux14
-rw-r--r--stdlib/source/lux/lang/synthesis.lux10
-rw-r--r--stdlib/source/lux/lang/synthesis/case.lux3
-rw-r--r--stdlib/source/lux/lang/synthesis/expression.lux15
-rw-r--r--stdlib/source/lux/lang/synthesis/function.lux13
-rw-r--r--stdlib/source/lux/lang/synthesis/loop.lux35
-rw-r--r--stdlib/test/test/lux/lang/analysis/function.lux3
-rw-r--r--stdlib/test/test/lux/lang/analysis/reference.lux7
-rw-r--r--stdlib/test/test/lux/lang/synthesis/case.lux5
-rw-r--r--stdlib/test/test/lux/lang/synthesis/function.lux19
13 files changed, 147 insertions, 135 deletions
diff --git a/stdlib/source/lux/lang/analysis.lux b/stdlib/source/lux/lang/analysis.lux
index 87cd99120..d5a25cad3 100644
--- a/stdlib/source/lux/lang/analysis.lux
+++ b/stdlib/source/lux/lang/analysis.lux
@@ -1,9 +1,8 @@
(.module:
[lux #- nat int deg]
- (lux (control [equality #+ Equality]
- [hash #+ Hash])
- [function]
- (data (coll [list "list/" Fold<List>]))))
+ (lux [function]
+ (data (coll [list "list/" Fold<List>])))
+ [//reference #+ Register Variable Reference])
(type: #export #rec Primitive
#Unit
@@ -20,8 +19,6 @@
(#Sum (Either a a))
(#Product [a a]))
-(type: #export Register Nat)
-
(type: #export #rec Pattern
(#Simple Primitive)
(#Complex (Composite Pattern))
@@ -31,35 +28,6 @@
{#when Pattern
#then e})
-(type: #export Variable
- (#Local Register)
- (#Foreign Register))
-
-(type: #export Reference
- (#Variable Variable)
- (#Constant Ident))
-
-(struct: #export _ (Equality Variable)
- (def: (= reference sample)
- (case [reference sample]
- (^template [<tag>]
- [(<tag> reference') (<tag> sample')]
- (n/= reference' sample'))
- ([#Local] [#Foreign])
-
- _
- false)))
-
-(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))])
@@ -92,27 +60,6 @@
[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)
@@ -140,7 +87,9 @@
(n/= (dec size) tag))
(template: #export (no-op value)
- (#Apply value (#Function (list) (#Reference (#Variable (#Local +1))))))
+ (|> +1 #//reference.Local #//reference.Variable #..Reference
+ (#..Function (list))
+ (#..Apply value)))
(do-template [<name> <type> <structure> <prep-value>]
[(def: #export (<name> size tag value)
@@ -243,15 +192,6 @@
_
[analysis (list)]))
-(def: #export (self? var)
- (-> Variable Bool)
- (case var
- (#Local +0)
- true
-
- _
- false))
-
(template: #export (pattern/unit)
(#..Simple #..Unit))
diff --git a/stdlib/source/lux/lang/analysis/reference.lux b/stdlib/source/lux/lang/analysis/reference.lux
index e00edc178..cceb4db7d 100644
--- a/stdlib/source/lux/lang/analysis/reference.lux
+++ b/stdlib/source/lux/lang/analysis/reference.lux
@@ -3,11 +3,11 @@
(lux (control monad)
[macro]
(macro [code])
- [lang]
- (lang (type ["tc" check])
- [".L" scope]
- [".L" analysis #+ Analysis]
- (analysis [".A" type]))))
+ (lang (type ["tc" check])))
+ [// #+ Analysis]
+ [//type]
+ [///reference]
+ [///scope])
## [Analysers]
(def: (definition def-name)
@@ -20,19 +20,19 @@
_
(do @
- [_ (typeA.infer actualT)]
- (:: @ map (|>> analysisL.reference/constant)
+ [_ (//type.infer actualT)]
+ (:: @ map (|>> ///reference.constant #//.Reference)
(macro.normalize def-name))))))
(def: (variable var-name)
(-> Text (Meta (Maybe Analysis)))
(do macro.Monad<Meta>
- [?var (scopeL.find var-name)]
+ [?var (///scope.find var-name)]
(case ?var
(#.Some [actualT ref])
(do @
- [_ (typeA.infer actualT)]
- (wrap (#.Some (analysisL.reference/variable ref))))
+ [_ (//type.infer actualT)]
+ (wrap (#.Some (|> ref ///reference.variable #//.Reference))))
#.None
(wrap #.None))))
diff --git a/stdlib/source/lux/lang/reference.lux b/stdlib/source/lux/lang/reference.lux
new file mode 100644
index 000000000..98756aa08
--- /dev/null
+++ b/stdlib/source/lux/lang/reference.lux
@@ -0,0 +1,66 @@
+(.module:
+ lux
+ (lux (control [equality #+ Equality]
+ [hash #+ Hash]
+ pipe)))
+
+(type: #export Register Nat)
+
+(type: #export Variable
+ (#Local Register)
+ (#Foreign Register))
+
+(type: #export Reference
+ (#Variable Variable)
+ (#Constant Ident))
+
+(struct: #export _ (Equality Variable)
+ (def: (= reference sample)
+ (case [reference sample]
+ (^template [<tag>]
+ [(<tag> reference') (<tag> sample')]
+ (n/= reference' sample'))
+ ([#Local] [#Foreign])
+
+ _
+ false)))
+
+(struct: #export _ (Hash Variable)
+ (def: eq Equality<Variable>)
+ (def: (hash var)
+ (case var
+ (#Local register)
+ (n/* +1 register)
+
+ (#Foreign register)
+ (n/* +2 register))))
+
+(do-template [<name> <family> <tag>]
+ [(template: #export (<name> content)
+ (<| <family>
+ <tag>
+ content))]
+
+ [local #..Variable #..Local]
+ [foreign #..Variable #..Foreign]
+ )
+
+(do-template [<name> <tag>]
+ [(template: #export (<name> content)
+ (<| <tag>
+ content))]
+
+ [variable #..Variable]
+ [constant #..Constant]
+ )
+
+(def: #export self Reference (..local +0))
+
+(def: #export self?
+ (-> Variable Bool)
+ (|>> ..variable
+ (case> (^ (..local +0))
+ true
+
+ _
+ false)))
diff --git a/stdlib/source/lux/lang/scope.lux b/stdlib/source/lux/lang/scope.lux
index 1995338f4..217b7fcb3 100644
--- a/stdlib/source/lux/lang/scope.lux
+++ b/stdlib/source/lux/lang/scope.lux
@@ -9,9 +9,9 @@
(coll [list "list/" Functor<List> Fold<List> Monoid<List>]
(dictionary [plist])))
[macro])
- (// [analysis #+ Variable Register]))
+ [//reference #+ Register Variable])
-(type: Locals (Bindings Text [Type Nat]))
+(type: Locals (Bindings Text [Type Register]))
(type: Foreign (Bindings Text [Type Variable]))
(def: (is-local? name scope)
@@ -26,7 +26,7 @@
(get@ [#.locals #.mappings])
(plist.get name)
(maybe/map (function (_ [type value])
- [type (#analysis.Local value)]))))
+ [type (#//reference.Local value)]))))
(def: (is-captured? name scope)
(-> Text Scope Bool)
@@ -44,7 +44,7 @@
(#.Cons [_name [_source-type _source-ref]] mappings')
(if (text/= name _name)
- (#.Some [_source-type (#analysis.Foreign idx)])
+ (#.Some [_source-type (#//reference.Foreign idx)])
(recur (inc idx) mappings')))))
(def: (is-ref? name scope)
@@ -76,7 +76,7 @@
(get-ref name top-outer))
[ref inner'] (list/fold (: (-> Scope [Variable (List Scope)] [Variable (List Scope)])
(function (_ scope ref+inner)
- [(#analysis.Foreign (get@ [#.captured #.counter] scope))
+ [(#//reference.Foreign (get@ [#.captured #.counter] scope))
(#.Cons (update@ #.captured
(: (-> Foreign Foreign)
(|>> (update@ #.counter inc)
@@ -176,10 +176,10 @@
(-> Ref Variable)
(case ref
(#.Local register)
- (#analysis.Local register)
+ (#//reference.Local register)
(#.Captured register)
- (#analysis.Foreign register)))
+ (#//reference.Foreign register)))
(def: #export (environment scope)
(-> Scope (List Variable))
diff --git a/stdlib/source/lux/lang/synthesis.lux b/stdlib/source/lux/lang/synthesis.lux
index c26564001..d68b535dc 100644
--- a/stdlib/source/lux/lang/synthesis.lux
+++ b/stdlib/source/lux/lang/synthesis.lux
@@ -8,7 +8,8 @@
[number]
(coll (dictionary ["dict" unordered #+ Dict])))
[function])
- [//analysis #+ Register Variable Reference Environment Special Analysis])
+ [//reference #+ Register Variable Reference]
+ [//analysis #+ Environment Special Analysis])
(type: #export Arity Nat)
@@ -22,7 +23,7 @@
(def: #export fresh-resolver
Resolver
- (dict.new //analysis.Hash<Variable>))
+ (dict.new //reference.Hash<Variable>))
(def: #export init
State
@@ -229,12 +230,11 @@
(do-template [<name> <tag>]
[(template: #export (<name> content)
(<| #..Reference
- #//analysis.Variable
<tag>
content))]
- [variable/local #//analysis.Local]
- [variable/foreign #//analysis.Foreign]
+ [variable/local //reference.local]
+ [variable/foreign //reference.foreign]
)
(do-template [<name> <family> <tag>]
diff --git a/stdlib/source/lux/lang/synthesis/case.lux b/stdlib/source/lux/lang/synthesis/case.lux
index ca7524072..5fe32e62d 100644
--- a/stdlib/source/lux/lang/synthesis/case.lux
+++ b/stdlib/source/lux/lang/synthesis/case.lux
@@ -9,6 +9,7 @@
text/format
[number "frac/" Eq<Frac>]
(coll [list "list/" Fold<List> Monoid<List>])))
+ [///reference]
[///analysis #+ Pattern Match Analysis]
[// #+ Path Synthesis Operation]
[//function])
@@ -130,7 +131,7 @@
[[(#///analysis.Bind inputR) headB/bodyA]
#.Nil]
(case headB/bodyA
- (^ (///analysis.variable/local outputR))
+ (^ (#///analysis.Reference (///reference.local outputR)))
(wrap (if (n/= inputR outputR)
inputS
(//.branch/exec inputS)))
diff --git a/stdlib/source/lux/lang/synthesis/expression.lux b/stdlib/source/lux/lang/synthesis/expression.lux
index d556048b3..aab092777 100644
--- a/stdlib/source/lux/lang/synthesis/expression.lux
+++ b/stdlib/source/lux/lang/synthesis/expression.lux
@@ -5,6 +5,7 @@
(data [maybe]
(coll [list "list/" Functor<List>]
(dictionary ["dict" unordered #+ Dict]))))
+ [///reference]
[///analysis #+ Analysis]
[///extension #+ Extension]
[// #+ Synthesis]
@@ -71,14 +72,14 @@
(#///analysis.Reference reference)
(case reference
- (#///analysis.Constant constant)
+ (#///reference.Constant constant)
(operation/wrap (#//.Reference reference))
- (#///analysis.Variable var)
+ (#///reference.Variable var)
(do //.Operation@Monad
[resolver //.resolver]
(case var
- (#///analysis.Local register)
+ (#///reference.Local register)
(do @
[arity //.scope-arity]
(wrap (if (//function.nested? arity)
@@ -88,11 +89,11 @@
(list/map (|>> //.variable/local))
[(//.variable/local +0)]
//.function/apply)
- (#//.Reference (#///analysis.Variable (//function.adjust arity false var))))
- (#//.Reference (#///analysis.Variable var)))))
+ (#//.Reference (#///reference.Variable (//function.adjust arity false var))))
+ (#//.Reference (#///reference.Variable var)))))
- (#///analysis.Foreign register)
- (wrap (|> resolver (dict.get var) (maybe.default var) #///analysis.Variable #//.Reference)))))
+ (#///reference.Foreign register)
+ (wrap (|> resolver (dict.get var) (maybe.default var) #///reference.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 4bd6846e2..8014c3b4a 100644
--- a/stdlib/source/lux/lang/synthesis/function.lux
+++ b/stdlib/source/lux/lang/synthesis/function.lux
@@ -7,8 +7,9 @@
(data [maybe "maybe/" Monad<Maybe>]
[error]
(coll [list "list/" Functor<List> Monoid<List> Fold<List>]
- (dictionary ["dict" unordered #+ Dict])))
- (lang [".L" analysis #+ Variable Environment Analysis]))
+ (dictionary ["dict" unordered #+ Dict]))))
+ [///reference #+ Variable]
+ [///analysis #+ Environment Analysis]
[// #+ Arity Synthesis Synthesizer]
[//loop])
@@ -21,9 +22,9 @@
(def: #export (adjust up-arity after? var)
(-> Arity Bool Variable Variable)
(case var
- (#analysisL.Local register)
+ (#///reference.Local register)
(if (and after? (n/>= up-arity register))
- (#analysisL.Local (n/+ (dec up-arity) register))
+ (#///reference.Local (n/+ (dec up-arity) register))
var)
_
@@ -34,7 +35,7 @@
(loop [apply apply
args (list)]
(case apply
- (#analysisL.Apply arg func)
+ (#///analysis.Apply arg func)
(recur func (#.Cons arg args))
_
@@ -104,7 +105,7 @@
_
(|> (list.size environment) dec (list.n/range +0)
- (list/map (|>> #analysisL.Foreign)))))
+ (list/map (|>> #///reference.Foreign)))))
resolver' (if (and (nested? function-arity)
direct?)
(list/fold (.function (_ [from to] resolver')
diff --git a/stdlib/source/lux/lang/synthesis/loop.lux b/stdlib/source/lux/lang/synthesis/loop.lux
index 4dcc25873..1b5d3401c 100644
--- a/stdlib/source/lux/lang/synthesis/loop.lux
+++ b/stdlib/source/lux/lang/synthesis/loop.lux
@@ -6,7 +6,8 @@
(coll [list "list/" Functor<List>]))
(macro [code]
[syntax]))
- [///analysis #+ Register Variable Environment]
+ [///reference #+ Register Variable]
+ [///analysis #+ Environment]
[// #+ Path Abstraction Synthesis])
(type: #export (Transform a)
@@ -18,11 +19,11 @@
(#.Some _) true
#.None false))
-(template: #export (self-reference)
- (#//.Reference (#///analysis.Variable (#///analysis.Local +0))))
+(template: #export (self)
+ (#//.Reference (///reference.local +0)))
(template: (recursive-apply args)
- (#//.Apply (self-reference) args))
+ (#//.Apply (self) args))
(def: proper Bool true)
(def: improper Bool false)
@@ -30,7 +31,7 @@
(def: (proper? exprS)
(-> Synthesis Bool)
(case exprS
- (^ (self-reference))
+ (^ (self))
improper
(#//.Structure structure)
@@ -82,7 +83,7 @@
(#//.Function functionS)
(case functionS
(#//.Abstraction environment arity bodyS)
- (list.every? ///analysis.self? environment)
+ (list.every? ///reference.self? environment)
(#//.Apply funcS argsS)
(and (proper? funcS)
@@ -162,7 +163,7 @@
(-> Environment (Transform Variable))
(function (_ variable)
(case variable
- (#///analysis.Foreign register)
+ (#///reference.Foreign register)
(list.nth register environment)
_
@@ -210,18 +211,16 @@
(#//.Reference reference)
(case reference
- (#///analysis.Constant constant)
+ (^ (///reference.constant constant))
(#.Some exprS)
-
- (#///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)))))
+
+ (^ (///reference.local register))
+ (#.Some (#//.Reference (///reference.local (n/+ offset register))))
+
+ (^ (///reference.foreign register))
+ (|> scope-environment
+ (list.nth register)
+ (maybe/map (|>> #///reference.Variable #//.Reference))))
(^ (//.branch/case [inputS pathS]))
(do maybe.Monad<Maybe>
diff --git a/stdlib/test/test/lux/lang/analysis/function.lux b/stdlib/test/test/lux/lang/analysis/function.lux
index 97ab808a0..a99504045 100644
--- a/stdlib/test/test/lux/lang/analysis/function.lux
+++ b/stdlib/test/test/lux/lang/analysis/function.lux
@@ -15,6 +15,7 @@
[lang]
(lang [type "type/" Eq<Type>]
[".L" init]
+ [".L" reference]
[".L" analysis #+ Analysis]
(analysis [".A" type]
[".A" expression]
@@ -91,7 +92,7 @@
partial-polyT2 (<| (type.univ-q +1)
(type.function (#.Cons varT partial-poly-inputsT))
varT)
- dummy-function (#analysisL.Function (list) (#analysisL.Variable (#analysisL.Local +1)))]]
+ dummy-function (#analysisL.Function (list) (#analysisL.Reference (referenceL.local +1)))]]
($_ seq
(test "Can analyse monomorphic type application."
(|> (/.apply ..analyse funcT dummy-function inputsC)
diff --git a/stdlib/test/test/lux/lang/analysis/reference.lux b/stdlib/test/test/lux/lang/analysis/reference.lux
index e67756d55..6551e3cba 100644
--- a/stdlib/test/test/lux/lang/analysis/reference.lux
+++ b/stdlib/test/test/lux/lang/analysis/reference.lux
@@ -13,6 +13,7 @@
[".L" scope]
[".L" module]
[".L" init]
+ [".L" reference]
[".L" analysis]
(analysis [".A" type]
[".A" expression]))
@@ -34,9 +35,9 @@
(|> (scopeL.with-scope scope-name
(scopeL.with-local [var-name expectedT]
(typeA.with-inference
- (..analyse (code.symbol ["" var-name])))))
+ (..analyse (code.local-symbol var-name)))))
(macro.run (initL.compiler []))
- (case> (^ (#e.Success [inferredT (analysisL.variable/local var)]))
+ (case> (^ (#e.Success [inferredT (#analysisL.Reference (referenceL.local var))]))
(and (type/= expectedT inferredT)
(n/= +0 var))
@@ -49,7 +50,7 @@
(..analyse (code.symbol def-name))))
(moduleL.with-module +0 module-name)
(macro.run (initL.compiler []))
- (case> (^ (#e.Success [_ inferredT (analysisL.reference/constant constant-name)]))
+ (case> (^ (#e.Success [_ inferredT (#analysisL.Reference (referenceL.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 23ed6726c..f2541ee0e 100644
--- a/stdlib/test/test/lux/lang/synthesis/case.lux
+++ b/stdlib/test/test/lux/lang/synthesis/case.lux
@@ -3,7 +3,8 @@
(lux (control [monad #+ do]
pipe)
(data [error "error/" Functor<Error>])
- (lang [".L" analysis #+ Branch Analysis]
+ (lang ["///." reference]
+ [".L" analysis #+ Branch Analysis]
["//" synthesis #+ Synthesis]
(synthesis [".S" expression])
[".L" extension])
@@ -19,7 +20,7 @@
#let [maskA (analysisL.control/case
[maskedA
[[(#analysisL.Bind temp)
- (analysisL.variable/local temp)]
+ (#analysisL.Reference (///reference.local temp))]
(list)]])]]
(test "Dummy variables created to mask expressions get eliminated during synthesis."
(|> maskA
diff --git a/stdlib/test/test/lux/lang/synthesis/function.lux b/stdlib/test/test/lux/lang/synthesis/function.lux
index 93ca5d40d..c0cfc5587 100644
--- a/stdlib/test/test/lux/lang/synthesis/function.lux
+++ b/stdlib/test/test/lux/lang/synthesis/function.lux
@@ -11,7 +11,8 @@
(coll [list "list/" Functor<List> Fold<List>]
(dictionary ["dict" unordered #+ Dict])
(set ["set" unordered])))
- (lang [".L" analysis #+ Variable Analysis "variable/" Equality<Variable>]
+ (lang ["///." reference #+ Variable "variable/" Equality<Variable>]
+ [".L" analysis #+ Analysis]
["//" synthesis #+ Arity Synthesis]
(synthesis [".S" expression])
[".L" extension])
@@ -44,8 +45,8 @@
(do r.Monad<Random>
[num-locals (|> r.nat (:: @ map (|>> (n/% +100) (n/max +10))))
#let [indices (list.n/range +0 (dec num-locals))
- local-env (list/map (|>> #analysisL.Local) indices)
- foreign-env (list/map (|>> #analysisL.Foreign) indices)]
+ local-env (list/map (|>> #///reference.Local) indices)
+ foreign-env (list/map (|>> #///reference.Foreign) indices)]
[arity bodyA predictionA] (: (r.Random [Arity Analysis Variable])
(loop [arity +1
current-env foreign-env]
@@ -66,14 +67,14 @@
(list/map (function (_ pick)
(maybe.assume (list.nth pick current-env)))
picks))
- #let [picked-env (list/map (|>> #analysisL.Foreign) picks)]]
+ #let [picked-env (list/map (|>> #///reference.Foreign) picks)]]
(wrap [arity
(#analysisL.Function picked-env bodyA)
predictionA]))
(do @
[chosen (pick (list.size current-env))]
(wrap [arity
- (analysisL.variable/foreign chosen)
+ (#analysisL.Reference (///reference.foreign chosen))
(maybe.assume (dict.get chosen resolver))])))))))]
(wrap [arity
(#analysisL.Function local-env bodyA)
@@ -93,8 +94,8 @@
(do r.Monad<Random>
[chosen (|> r.nat (:: @ map (|>> (n/% +100) (n/max +2))))]
(wrap [arity
- (analysisL.variable/local chosen)
- (|> chosen (n/+ (dec arity)) #analysisL.Local)])))))
+ (#analysisL.Reference (///reference.local chosen))
+ (|> chosen (n/+ (dec arity)) #///reference.Local)])))))
(context: "Function definition."
(<| (times +100)
@@ -115,7 +116,7 @@
(test "Folded functions provide direct access to environment variables."
(|> function//environment
(//.run (expressionS.synthesizer extensionL.empty))
- (case> (^ (#error.Success (//.function/abstraction [environment arity (analysisL.reference/variable output)])))
+ (case> (^ (#error.Success (//.function/abstraction [environment arity (#//.Reference (///reference.variable output))])))
(and (n/= arity//environment arity)
(variable/= prediction//environment output))
@@ -124,7 +125,7 @@
(test "Folded functions properly offset local variables."
(|> function//local
(//.run (expressionS.synthesizer extensionL.empty))
- (case> (^ (#error.Success (//.function/abstraction [environment arity (analysisL.reference/variable output)])))
+ (case> (^ (#error.Success (//.function/abstraction [environment arity (#//.Reference (///reference.variable output))])))
(and (n/= arity//local arity)
(variable/= prediction//local output))