diff options
-rw-r--r-- | stdlib/source/lux/lang/analysis.lux | 72 | ||||
-rw-r--r-- | stdlib/source/lux/lang/analysis/reference.lux | 20 | ||||
-rw-r--r-- | stdlib/source/lux/lang/reference.lux | 66 | ||||
-rw-r--r-- | stdlib/source/lux/lang/scope.lux | 14 | ||||
-rw-r--r-- | stdlib/source/lux/lang/synthesis.lux | 10 | ||||
-rw-r--r-- | stdlib/source/lux/lang/synthesis/case.lux | 3 | ||||
-rw-r--r-- | stdlib/source/lux/lang/synthesis/expression.lux | 15 | ||||
-rw-r--r-- | stdlib/source/lux/lang/synthesis/function.lux | 13 | ||||
-rw-r--r-- | stdlib/source/lux/lang/synthesis/loop.lux | 35 | ||||
-rw-r--r-- | stdlib/test/test/lux/lang/analysis/function.lux | 3 | ||||
-rw-r--r-- | stdlib/test/test/lux/lang/analysis/reference.lux | 7 | ||||
-rw-r--r-- | stdlib/test/test/lux/lang/synthesis/case.lux | 5 | ||||
-rw-r--r-- | stdlib/test/test/lux/lang/synthesis/function.lux | 19 |
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)) |