diff options
author | Eduardo Julian | 2017-06-12 21:14:55 -0400 |
---|---|---|
committer | Eduardo Julian | 2017-06-12 21:14:55 -0400 |
commit | 9cd2927a4f6175784e081d6b512d3e900c8069e7 (patch) | |
tree | d1fe512bc84ea1e3a50ad86eeb3265771edd23c6 /new-luxc/test | |
parent | c50667a431a5ca67328a230f0c59956dc6ff43fa (diff) |
- Renamed the "compilation" phase as the "generation" phase.
- Implemented compilation of primitives.
- Implemented compilation of structures.
Diffstat (limited to 'new-luxc/test')
-rw-r--r-- | new-luxc/test/test/luxc/analyser/case.lux | 3 | ||||
-rw-r--r-- | new-luxc/test/test/luxc/analyser/common.lux | 31 | ||||
-rw-r--r-- | new-luxc/test/test/luxc/analyser/function.lux | 19 | ||||
-rw-r--r-- | new-luxc/test/test/luxc/analyser/primitive.lux | 5 | ||||
-rw-r--r-- | new-luxc/test/test/luxc/analyser/procedure/common.lux | 17 | ||||
-rw-r--r-- | new-luxc/test/test/luxc/analyser/reference.lux | 7 | ||||
-rw-r--r-- | new-luxc/test/test/luxc/analyser/structure.lux | 33 | ||||
-rw-r--r-- | new-luxc/test/test/luxc/common.lux | 34 | ||||
-rw-r--r-- | new-luxc/test/test/luxc/generator/primitive.lux | 58 | ||||
-rw-r--r-- | new-luxc/test/test/luxc/generator/structure.lux | 105 | ||||
-rw-r--r-- | new-luxc/test/tests.lux | 6 |
11 files changed, 250 insertions, 68 deletions
diff --git a/new-luxc/test/test/luxc/analyser/case.lux b/new-luxc/test/test/luxc/analyser/case.lux index 218ebc0cd..3fe67b7a3 100644 --- a/new-luxc/test/test/luxc/analyser/case.lux +++ b/new-luxc/test/test/luxc/analyser/case.lux @@ -22,7 +22,8 @@ (analyser ["@" case] ["@;" common]) ["@;" module]) - (.. common)) + (.. common) + (test/luxc common)) (def: (total-weaving branchings) (-> (List (List Code)) (List (List Code))) diff --git a/new-luxc/test/test/luxc/analyser/common.lux b/new-luxc/test/test/luxc/analyser/common.lux index 5e8f73fd1..9a17fbb45 100644 --- a/new-luxc/test/test/luxc/analyser/common.lux +++ b/new-luxc/test/test/luxc/analyser/common.lux @@ -6,33 +6,8 @@ [macro] (macro [code])) (luxc ["&" base] - [analyser])) - -(def: compiler-version Text "0.6.0") - -(def: init-compiler-info - Compiler-Info - {#;compiler-version compiler-version - #;compiler-mode #;Build}) - -(def: init-type-context - Type-Context - {#;ex-counter +0 - #;var-counter +0 - #;var-bindings (list)}) - -(def: #export init-compiler - Compiler - {#;info init-compiler-info - #;source [dummy-cursor ""] - #;cursor dummy-cursor - #;modules (list) - #;scopes (list) - #;type-context init-type-context - #;expected #;None - #;seed +0 - #;scope-type-vars (list) - #;host (:! Void [])}) + [analyser]) + (test/luxc common)) (def: gen-unit (r;Random Code) @@ -65,7 +40,7 @@ [(def: #export (<name> analysis) (All [a] (-> (Lux a) Bool)) (|> analysis - (macro;run init-compiler) + (macro;run (init-compiler [])) (case> (#R;Success _) <on-success> diff --git a/new-luxc/test/test/luxc/analyser/function.lux b/new-luxc/test/test/luxc/analyser/function.lux index fe435ebf9..4957bfe06 100644 --- a/new-luxc/test/test/luxc/analyser/function.lux +++ b/new-luxc/test/test/luxc/analyser/function.lux @@ -21,7 +21,8 @@ (analyser ["@" function] ["@;" common]) ["@;" module]) - (.. common)) + (.. common) + (test/luxc common)) (def: (check-type expectedT result) (-> Type (R;Result [Type la;Analysis]) Bool) @@ -54,7 +55,7 @@ (def: (check-apply expectedT num-args analysis) (-> Type Nat (Lux [Type la;Analysis]) Bool) (|> analysis - (macro;run init-compiler) + (macro;run (init-compiler [])) (case> (#R;Success [applyT applyA]) (let [[funcA argsA] (flatten-apply applyA)] (and (Type/= expectedT applyT) @@ -72,36 +73,36 @@ (assert "Can analyse function." (|> (&;with-expected-type (type (All [a] (-> a outputT))) (@;analyse-function analyse func-name arg-name outputC)) - (macro;run init-compiler) + (macro;run (init-compiler [])) succeeds?)) (assert "Generic functions can always be specialized." (and (|> (&;with-expected-type (-> inputT outputT) (@;analyse-function analyse func-name arg-name outputC)) - (macro;run init-compiler) + (macro;run (init-compiler [])) succeeds?) (|> (&;with-expected-type (-> inputT inputT) (@;analyse-function analyse func-name arg-name (code;symbol ["" arg-name]))) - (macro;run init-compiler) + (macro;run (init-compiler [])) succeeds?))) (assert "Can infer function (constant output and unused input)." (|> (@common;with-unknown-type (@;analyse-function analyse func-name arg-name outputC)) - (macro;run init-compiler) + (macro;run (init-compiler [])) (check-type (type (All [a] (-> a outputT)))))) (assert "Can infer function (output = input)." (|> (@common;with-unknown-type (@;analyse-function analyse func-name arg-name (code;symbol ["" arg-name]))) - (macro;run init-compiler) + (macro;run (init-compiler [])) (check-type (type (All [a] (-> a a)))))) (assert "The function's name is bound to the function's type." (|> (&;with-expected-type (type (Rec self (-> inputT self))) (@;analyse-function analyse func-name arg-name (code;symbol ["" func-name]))) - (macro;run init-compiler) + (macro;run (init-compiler [])) succeeds?)) (assert "Can infer recursive types for functions." (|> (@common;with-unknown-type (@;analyse-function analyse func-name arg-name (code;symbol ["" func-name]))) - (macro;run init-compiler) + (macro;run (init-compiler [])) (check-type (type (Rec self (All [a] (-> a self))))))) )) diff --git a/new-luxc/test/test/luxc/analyser/primitive.lux b/new-luxc/test/test/luxc/analyser/primitive.lux index 11a10088b..5e4e318a5 100644 --- a/new-luxc/test/test/luxc/analyser/primitive.lux +++ b/new-luxc/test/test/luxc/analyser/primitive.lux @@ -24,7 +24,8 @@ [analyser] (analyser ["@" primitive] ["@;" common])) - (.. common)) + (.. common) + (test/luxc common)) (test: "Primitives" [%bool% r;bool @@ -39,7 +40,7 @@ [(assert (format "Can analyse " <desc> ".") (|> (@common;with-unknown-type (<analyser> <value>)) - (macro;run init-compiler) + (macro;run (init-compiler [])) (case> (#R;Success [_type (<tag> value)]) (and (Type/= <type> _type) (is <value> value)) diff --git a/new-luxc/test/test/luxc/analyser/procedure/common.lux b/new-luxc/test/test/luxc/analyser/procedure/common.lux index dc4459734..9ebcf6880 100644 --- a/new-luxc/test/test/luxc/analyser/procedure/common.lux +++ b/new-luxc/test/test/luxc/analyser/procedure/common.lux @@ -20,14 +20,15 @@ [analyser] (analyser ["@" procedure] ["@;" common])) - (../.. common)) + (../.. common) + (test/luxc common)) (do-template [<name> <success> <failure>] [(def: (<name> procedure params output-type) (-> Text (List Code) Type Bool) (|> (&;with-expected-type output-type (@;analyse-procedure analyse procedure params)) - (macro;run init-compiler) + (macro;run (init-compiler [])) (case> (#R;Success _) <success> @@ -247,7 +248,7 @@ (@;analyse-procedure analyse "array get" (list idxC (code;symbol ["" var-name])))))) - (macro;run init-compiler) + (macro;run (init-compiler [])) (case> (#R;Success _) true @@ -261,7 +262,7 @@ (list idxC elemC (code;symbol ["" var-name])))))) - (macro;run init-compiler) + (macro;run (init-compiler [])) (case> (#R;Success _) true @@ -274,7 +275,7 @@ (@;analyse-procedure analyse "array remove" (list idxC (code;symbol ["" var-name])))))) - (macro;run init-compiler) + (macro;run (init-compiler [])) (case> (#R;Success _) true @@ -286,7 +287,7 @@ (&;with-expected-type Nat (@;analyse-procedure analyse "array size" (list (code;symbol ["" var-name])))))) - (macro;run init-compiler) + (macro;run (init-compiler [])) (case> (#R;Success _) true @@ -342,7 +343,7 @@ (&;with-expected-type elemT (@;analyse-procedure analyse "atom read" (list (code;symbol ["" var-name])))))) - (macro;run init-compiler) + (macro;run (init-compiler [])) (case> (#R;Success _) true @@ -356,7 +357,7 @@ (list elemC elemC (code;symbol ["" var-name])))))) - (macro;run init-compiler) + (macro;run (init-compiler [])) (case> (#R;Success _) true diff --git a/new-luxc/test/test/luxc/analyser/reference.lux b/new-luxc/test/test/luxc/analyser/reference.lux index 2acec2cad..5e277b2a6 100644 --- a/new-luxc/test/test/luxc/analyser/reference.lux +++ b/new-luxc/test/test/luxc/analyser/reference.lux @@ -14,7 +14,8 @@ [analyser] (analyser ["@" reference] ["@;" common])) - (.. common)) + (.. common) + (test/luxc common)) (test: "References" [[ref-type _] gen-primitive @@ -27,7 +28,7 @@ (&env;with-local [var-name ref-type] (@common;with-unknown-type (@;analyse-reference ["" var-name])))) - (macro;run init-compiler) + (macro;run (init-compiler [])) (case> (#R;Success [_type (#~;Relative idx)]) (Type/= ref-type _type) @@ -40,7 +41,7 @@ [ref-type (list) (:! Void [])])] (@common;with-unknown-type (@;analyse-reference [module-name var-name]))) - (macro;run init-compiler) + (macro;run (init-compiler [])) (case> (#R;Success [_type (#~;Absolute idx)]) (Type/= ref-type _type) diff --git a/new-luxc/test/test/luxc/analyser/structure.lux b/new-luxc/test/test/luxc/analyser/structure.lux index 801f61616..597388aa2 100644 --- a/new-luxc/test/test/luxc/analyser/structure.lux +++ b/new-luxc/test/test/luxc/analyser/structure.lux @@ -22,7 +22,8 @@ (analyser ["@" structure] ["@;" common]) ["@;" module]) - (.. common)) + (.. common) + (test/luxc common)) (def: (flatten-tuple analysis) (-> la;Analysis (List la;Analysis)) @@ -73,7 +74,7 @@ (|> (&;with-scope (&;with-expected-type variantT (@;analyse-sum analyse choice valueC))) - (macro;run init-compiler) + (macro;run (init-compiler [])) (case> (^multi (#R;Success [_ sumA]) [(flatten-variant sumA) (#;Some [tag last? valueA])]) @@ -91,7 +92,7 @@ (TC;check varT variantT))] (&;with-expected-type varT (@;analyse-sum analyse choice valueC)))))) - (macro;run init-compiler) + (macro;run (init-compiler [])) (case> (^multi (#R;Success [_ sumA]) [(flatten-variant sumA) (#;Some [tag last? valueA])]) @@ -106,7 +107,7 @@ (function [[var-id varT]] (&;with-expected-type varT (@;analyse-sum analyse choice valueC))))) - (macro;run init-compiler) + (macro;run (init-compiler [])) (case> (#R;Success _) false @@ -116,7 +117,7 @@ (|> (&;with-scope (&;with-expected-type (type;ex-q +1 +variantT) (@;analyse-sum analyse +choice +valueC))) - (macro;run init-compiler) + (macro;run (init-compiler [])) (case> (#R;Success _) true @@ -126,7 +127,7 @@ (|> (&;with-scope (&;with-expected-type (type;univ-q +1 +variantT) (@;analyse-sum analyse +choice +valueC))) - (macro;run init-compiler) + (macro;run (init-compiler [])) (case> (#R;Success _) (not (n.= choice +choice)) @@ -148,7 +149,7 @@ (assert "Can analyse product." (|> (&;with-expected-type (type;tuple (L/map product;left primitives)) (@;analyse-product analyse (L/map product;right primitives))) - (macro;run init-compiler) + (macro;run (init-compiler [])) (case> (#R;Success tupleA) (n.= size (list;size (flatten-tuple tupleA))) @@ -157,7 +158,7 @@ (assert "Can infer product." (|> (@common;with-unknown-type (@;analyse-product analyse (L/map product;right primitives))) - (macro;run init-compiler) + (macro;run (init-compiler [])) (case> (#R;Success [_type tupleA]) (and (Type/= (type;tuple (L/map product;left primitives)) _type) @@ -168,7 +169,7 @@ (assert "Can analyse pseudo-product (singleton tuple)" (|> (&;with-expected-type singletonT (analyse (` [(~ singletonC)]))) - (macro;run init-compiler) + (macro;run (init-compiler [])) (case> (#R;Success singletonA) true @@ -183,7 +184,7 @@ (TC;check varT (type;tuple (L/map product;left primitives))))] (&;with-expected-type varT (@;analyse-product analyse (L/map product;right primitives))))))) - (macro;run init-compiler) + (macro;run (init-compiler [])) (case> (#R;Success [_ tupleA]) (n.= size (list;size (flatten-tuple tupleA))) @@ -193,7 +194,7 @@ (|> (&;with-scope (&;with-expected-type (type;ex-q +1 +tupleT) (@;analyse-product analyse (L/map product;right +primitives)))) - (macro;run init-compiler) + (macro;run (init-compiler [])) (case> (#R;Success _) true @@ -203,7 +204,7 @@ (|> (&;with-scope (&;with-expected-type (type;univ-q +1 +tupleT) (@;analyse-product analyse (L/map product;right +primitives)))) - (macro;run init-compiler) + (macro;run (init-compiler [])) (case> (#R;Success _) false @@ -214,7 +215,7 @@ (def: (check-variant-inference variantT choice size analysis) (-> Type Nat Nat (Lux [Module Scope Type la;Analysis]) Bool) (|> analysis - (macro;run init-compiler) + (macro;run (init-compiler [])) (case> (^multi (#R;Success [_ _ sumT sumA]) [(flatten-variant sumA) (#;Some [tag last? valueA])]) @@ -228,7 +229,7 @@ (def: (check-record-inference tupleT size analysis) (-> Type Nat (Lux [Module Scope Type la;Analysis]) Bool) (|> analysis - (macro;run init-compiler) + (macro;run (init-compiler [])) (case> (^multi (#R;Success [_ _ productT productA]) [(flatten-tuple productA) membersA]) @@ -291,7 +292,7 @@ (&;with-scope (&;with-expected-type variantT (@;analyse-tagged-sum analyse [module-name other-choice-tag] other-choiceC))))) - (macro;run init-compiler) + (macro;run (init-compiler [])) (case> (^multi (#R;Success [_ _ sumA]) [(flatten-variant sumA) (#;Some [tag last? valueA])]) @@ -345,7 +346,7 @@ (&;with-scope (&;with-expected-type tupleT (@;analyse-record analyse recordC))))) - (macro;run init-compiler) + (macro;run (init-compiler [])) (case> (^multi (#R;Success [_ _ productA]) [(flatten-tuple productA) membersA]) diff --git a/new-luxc/test/test/luxc/common.lux b/new-luxc/test/test/luxc/common.lux new file mode 100644 index 000000000..6892274e4 --- /dev/null +++ b/new-luxc/test/test/luxc/common.lux @@ -0,0 +1,34 @@ +(;module: + lux + (lux (control pipe) + ["r" math/random "r/" Monad<Random>] + (data ["R" result]) + [macro] + (macro [code])) + (luxc ["&" base] + [analyser] + ["&;" host])) + +(def: init-compiler-info + Compiler-Info + {#;compiler-version &;compiler-version + #;compiler-mode #;Build}) + +(def: init-type-context + Type-Context + {#;ex-counter +0 + #;var-counter +0 + #;var-bindings (list)}) + +(def: #export (init-compiler _) + (-> Top Compiler) + {#;info init-compiler-info + #;source [dummy-cursor ""] + #;cursor dummy-cursor + #;modules (list) + #;scopes (list) + #;type-context init-type-context + #;expected #;None + #;seed +0 + #;scope-type-vars (list) + #;host (:! Void (&host;init-host []))}) diff --git a/new-luxc/test/test/luxc/generator/primitive.lux b/new-luxc/test/test/luxc/generator/primitive.lux new file mode 100644 index 000000000..a64712e86 --- /dev/null +++ b/new-luxc/test/test/luxc/generator/primitive.lux @@ -0,0 +1,58 @@ +(;module: + lux + (lux [io] + (control monad + pipe) + (data text/format + ["R" result] + [bool "B/" Eq<Bool>] + [char "C/" Eq<Char>] + [text "T/" Eq<Text>]) + ["r" math/random "R/" Monad<Random>] + [macro] + test) + (luxc (lang ["ls" synthesis]) + [analyser] + [synthesizer] + (generator ["@" expr] + ["@;" eval] + ["@;" common])) + (test/luxc common)) + +(test: "Primitives." + [%bool% r;bool + %nat% r;nat + %int% r;int + %deg% r;deg + %real% r;real + %char% r;char + %text% (r;text +5)] + (with-expansions + [<tests> (do-template [<desc> <type> <synthesis> <sample> <test>] + [(assert (format "Can generate " <desc> ".") + (|> (@eval;eval (@;generate (<synthesis> <sample>))) + (macro;run (init-compiler [])) + (case> (#R;Success valueG) + (<test> <sample> (:! <type> valueG)) + + _ + false)))] + + ["bool" Bool #ls;Bool %bool% B/=] + ["nat" Nat #ls;Nat %nat% n.=] + ["int" Int #ls;Int %int% i.=] + ["deg" Deg #ls;Deg %deg% d.=] + ["real" Real #ls;Real %real% r.=] + ["char" Char #ls;Char %char% C/=] + ["text" Text #ls;Text %text% T/=])] + ($_ seq + (assert "Can generate unit." + (|> (@eval;eval (@;generate #ls;Unit)) + (macro;run (init-compiler [])) + (case> (#R;Success valueG) + (is @common;unit (:! Text valueG)) + + _ + false))) + <tests> + ))) diff --git a/new-luxc/test/test/luxc/generator/structure.lux b/new-luxc/test/test/luxc/generator/structure.lux new file mode 100644 index 000000000..ddf4f0afc --- /dev/null +++ b/new-luxc/test/test/luxc/generator/structure.lux @@ -0,0 +1,105 @@ +(;module: + lux + (lux [io] + (control monad + pipe) + (data text/format + ["R" result] + [bool "B/" Eq<Bool>] + [char "C/" Eq<Char>] + [text "T/" Eq<Text>] + (coll ["a" array] + [list])) + ["r" math/random "r/" Monad<Random>] + [macro #+ Monad<Lux>] + [host #+ jvm-import] + test) + (luxc (lang ["ls" synthesis]) + [analyser] + [synthesizer] + (generator ["@" expr] + ["@;" eval] + ["@;" runtime] + ["@;" common])) + (test/luxc common)) + +(jvm-import java.lang.Integer) + +(def: gen-primitive + (r;Random ls;Synthesis) + (r;either (r;either (r;either (r/wrap #ls;Unit) + (r/map (|>. #ls;Bool) r;bool)) + (r;either (r/map (|>. #ls;Nat) r;nat) + (r/map (|>. #ls;Int) r;int))) + (r;either (r;either (r/map (|>. #ls;Deg) r;deg) + (r/map (|>. #ls;Real) r;real)) + (r;either (r/map (|>. #ls;Char) r;char) + (r/map (|>. #ls;Text) (r;text +5)))))) + +(def: (corresponds? [prediction sample]) + (-> [ls;Synthesis Top] Bool) + (case prediction + #ls;Unit + (is @common;unit (:! Text sample)) + + (^template [<tag> <type> <test>] + (<tag> prediction') + (case (host;try (<test> prediction' (:! <type> sample))) + (#R;Success result) + result + + (#R;Error error) + false)) + ([#ls;Bool Bool B/=] + [#ls;Nat Nat n.=] + [#ls;Int Int i.=] + [#ls;Deg Deg d.=] + [#ls;Real Real r.=] + [#ls;Char Char C/=] + [#ls;Text Text T/=]) + + _ + false + )) + +(test: "Tuples." + [size (|> r;nat (:: @ map (|>. (n.% +10) (n.max +2)))) + members (r;list size gen-primitive)] + (assert "Can generate tuple." + (|> (@eval;eval (@;generate (#ls;Tuple members))) + (macro;run (init-compiler [])) + (case> (#R;Success valueG) + (let [valueG (:! (a;Array Top) valueG)] + (and (n.= size (a;size valueG)) + (list;every? corresponds? (list;zip2 members (a;to-list valueG))))) + + _ + false)))) + +(test: "Variants." + [num-tags (|> r;nat (:: @ map (|>. (n.% +10) (n.max +2)))) + tag (|> r;nat (:: @ map (n.% num-tags))) + #let [last? (n.= (n.dec num-tags) tag)] + member gen-primitive] + (assert "Can generate variant." + (|> (do Monad<Lux> + [runtime-bytecode @runtime;generate] + (@eval;eval (@;generate (#ls;Variant tag last? member)))) + (macro;run (init-compiler [])) + (case> (#R;Success valueG) + (let [valueG (:! (a;Array Top) valueG)] + (and (n.= +3 (a;size valueG)) + (let [_tag (:! Integer (assume (a;get +0 valueG))) + _last? (a;get +1 valueG) + _value (:! Top (assume (a;get +2 valueG)))] + (and (n.= tag (|> _tag host;i2l int-to-nat)) + (case _last? + (#;Some _last?') + (and last? (T/= "" (:! Text _last?'))) + + #;None + (not last?)) + (corresponds? [member _value]))))) + + _ + false)))) diff --git a/new-luxc/test/tests.lux b/new-luxc/test/tests.lux index 30a8ec522..92644ff48 100644 --- a/new-luxc/test/tests.lux +++ b/new-luxc/test/tests.lux @@ -14,9 +14,13 @@ (procedure ["_;A" common])) (synthesizer ["_;S" primitive] ["_;S" structure] + ## ["_;S" case] + (case ["_;S" special]) ["_;S" function] ["_;S" procedure] - ["_;S" loop])))) + ["_;S" loop]) + (generator ["_;G" primitive] + ["_;G" structure])))) ## [Program] (program: args |