diff options
Diffstat (limited to 'new-luxc/test/test/luxc/analyser/structure.lux')
| -rw-r--r-- | new-luxc/test/test/luxc/analyser/structure.lux | 378 |
1 files changed, 189 insertions, 189 deletions
diff --git a/new-luxc/test/test/luxc/analyser/structure.lux b/new-luxc/test/test/luxc/analyser/structure.lux index 597388aa2..914b1bf3b 100644 --- a/new-luxc/test/test/luxc/analyser/structure.lux +++ b/new-luxc/test/test/luxc/analyser/structure.lux @@ -55,7 +55,7 @@ _ #;None)) -(test: "Sums" +(context: "Sums" [size (|> r;nat (:: @ map (|>. (n.% +10) (n.max +2)))) choice (|> r;nat (:: @ map (n.% size))) primitives (r;list size gen-primitive) @@ -70,72 +70,72 @@ [+valueT +valueC] (assume (list;nth +choice +primitives)) +variantT (type;variant (L/map product;left +primitives))]] ($_ seq - (assert "Can analyse sum." - (|> (&;with-scope - (&;with-expected-type variantT - (@;analyse-sum analyse choice valueC))) - (macro;run (init-compiler [])) - (case> (^multi (#R;Success [_ sumA]) - [(flatten-variant sumA) - (#;Some [tag last? valueA])]) - (and (n.= tag choice) - (B/= last? (n.= (n.dec size) choice))) + (test "Can analyse sum." + (|> (&;with-scope + (&;with-expected-type variantT + (@;analyse-sum analyse choice valueC))) + (macro;run (init-compiler [])) + (case> (^multi (#R;Success [_ sumA]) + [(flatten-variant sumA) + (#;Some [tag last? valueA])]) + (and (n.= tag choice) + (B/= last? (n.= (n.dec size) choice))) - _ - false))) - (assert "Can analyse sum through bound type-vars." - (|> (&;with-scope - (@common;with-var - (function [[var-id varT]] - (do Monad<Lux> - [_ (&;within-type-env - (TC;check varT variantT))] - (&;with-expected-type varT - (@;analyse-sum analyse choice valueC)))))) - (macro;run (init-compiler [])) - (case> (^multi (#R;Success [_ sumA]) - [(flatten-variant sumA) - (#;Some [tag last? valueA])]) - (and (n.= tag choice) - (B/= last? (n.= (n.dec size) choice))) - - _ - false))) - (assert "Cannot analyse sum through unbound type-vars." - (|> (&;with-scope - (@common;with-var - (function [[var-id varT]] + _ + false))) + (test "Can analyse sum through bound type-vars." + (|> (&;with-scope + (@common;with-var + (function [[var-id varT]] + (do Monad<Lux> + [_ (&;within-type-env + (TC;check varT variantT))] (&;with-expected-type varT - (@;analyse-sum analyse choice valueC))))) - (macro;run (init-compiler [])) - (case> (#R;Success _) - false + (@;analyse-sum analyse choice valueC)))))) + (macro;run (init-compiler [])) + (case> (^multi (#R;Success [_ sumA]) + [(flatten-variant sumA) + (#;Some [tag last? valueA])]) + (and (n.= tag choice) + (B/= last? (n.= (n.dec size) choice))) + + _ + false))) + (test "Cannot analyse sum through unbound type-vars." + (|> (&;with-scope + (@common;with-var + (function [[var-id varT]] + (&;with-expected-type varT + (@;analyse-sum analyse choice valueC))))) + (macro;run (init-compiler [])) + (case> (#R;Success _) + false - _ - true))) - (assert "Can analyse sum through existential quantification." - (|> (&;with-scope - (&;with-expected-type (type;ex-q +1 +variantT) - (@;analyse-sum analyse +choice +valueC))) - (macro;run (init-compiler [])) - (case> (#R;Success _) - true + _ + true))) + (test "Can analyse sum through existential quantification." + (|> (&;with-scope + (&;with-expected-type (type;ex-q +1 +variantT) + (@;analyse-sum analyse +choice +valueC))) + (macro;run (init-compiler [])) + (case> (#R;Success _) + true - (#R;Error error) - false))) - (assert "Can analyse sum through universal quantification." - (|> (&;with-scope - (&;with-expected-type (type;univ-q +1 +variantT) - (@;analyse-sum analyse +choice +valueC))) - (macro;run (init-compiler [])) - (case> (#R;Success _) - (not (n.= choice +choice)) + (#R;Error error) + false))) + (test "Can analyse sum through universal quantification." + (|> (&;with-scope + (&;with-expected-type (type;univ-q +1 +variantT) + (@;analyse-sum analyse +choice +valueC))) + (macro;run (init-compiler [])) + (case> (#R;Success _) + (not (n.= choice +choice)) - (#R;Error error) - (n.= choice +choice)))) + (#R;Error error) + (n.= choice +choice)))) )) -(test: "Products" +(context: "Products" [size (|> r;nat (:: @ map (|>. (n.% +10) (n.max +2)))) primitives (r;list size gen-primitive) choice (|> r;nat (:: @ map (n.% size))) @@ -146,70 +146,70 @@ (list;drop choice primitives))) +tupleT (type;tuple (L/map product;left +primitives))]] ($_ seq - (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 [])) - (case> (#R;Success tupleA) - (n.= size (list;size (flatten-tuple tupleA))) + (test "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 [])) + (case> (#R;Success tupleA) + (n.= size (list;size (flatten-tuple tupleA))) - _ - false))) - (assert "Can infer product." - (|> (@common;with-unknown-type - (@;analyse-product analyse (L/map product;right primitives))) - (macro;run (init-compiler [])) - (case> (#R;Success [_type tupleA]) - (and (Type/= (type;tuple (L/map product;left primitives)) - _type) - (n.= size (list;size (flatten-tuple tupleA)))) + _ + false))) + (test "Can infer product." + (|> (@common;with-unknown-type + (@;analyse-product analyse (L/map product;right primitives))) + (macro;run (init-compiler [])) + (case> (#R;Success [_type tupleA]) + (and (Type/= (type;tuple (L/map product;left primitives)) + _type) + (n.= size (list;size (flatten-tuple tupleA)))) - _ - false))) - (assert "Can analyse pseudo-product (singleton tuple)" - (|> (&;with-expected-type singletonT - (analyse (` [(~ singletonC)]))) - (macro;run (init-compiler [])) - (case> (#R;Success singletonA) - true + _ + false))) + (test "Can analyse pseudo-product (singleton tuple)" + (|> (&;with-expected-type singletonT + (analyse (` [(~ singletonC)]))) + (macro;run (init-compiler [])) + (case> (#R;Success singletonA) + true - (#R;Error error) - false))) - (assert "Can analyse product through bound type-vars." - (|> (&;with-scope - (@common;with-var - (function [[var-id varT]] - (do Monad<Lux> - [_ (&;within-type-env - (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 [])) - (case> (#R;Success [_ tupleA]) - (n.= size (list;size (flatten-tuple tupleA))) + (#R;Error error) + false))) + (test "Can analyse product through bound type-vars." + (|> (&;with-scope + (@common;with-var + (function [[var-id varT]] + (do Monad<Lux> + [_ (&;within-type-env + (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 [])) + (case> (#R;Success [_ tupleA]) + (n.= size (list;size (flatten-tuple tupleA))) - _ - false))) - (assert "Can analyse product through existential quantification." - (|> (&;with-scope - (&;with-expected-type (type;ex-q +1 +tupleT) - (@;analyse-product analyse (L/map product;right +primitives)))) - (macro;run (init-compiler [])) - (case> (#R;Success _) - true + _ + false))) + (test "Can analyse product through existential quantification." + (|> (&;with-scope + (&;with-expected-type (type;ex-q +1 +tupleT) + (@;analyse-product analyse (L/map product;right +primitives)))) + (macro;run (init-compiler [])) + (case> (#R;Success _) + true - (#R;Error error) - false))) - (assert "Cannot analyse product through universal quantification." - (|> (&;with-scope - (&;with-expected-type (type;univ-q +1 +tupleT) - (@;analyse-product analyse (L/map product;right +primitives)))) - (macro;run (init-compiler [])) - (case> (#R;Success _) - false + (#R;Error error) + false))) + (test "Cannot analyse product through universal quantification." + (|> (&;with-scope + (&;with-expected-type (type;univ-q +1 +tupleT) + (@;analyse-product analyse (L/map product;right +primitives)))) + (macro;run (init-compiler [])) + (case> (#R;Success _) + false - (#R;Error error) - true))) + (#R;Error error) + true))) )) (def: (check-variant-inference variantT choice size analysis) @@ -239,7 +239,7 @@ _ false))) -(test: "Tagged Sums" +(context: "Tagged Sums" [size (|> r;nat (:: @ map (|>. (n.% +10) (n.max +2)))) tags (|> (r;set text;Hash<Text> size (r;text +5)) (:: @ map S;to-list)) choice (|> r;nat (:: @ map (n.% size))) @@ -261,49 +261,49 @@ choice-tag (assume (list;nth choice tags)) other-choice-tag (assume (list;nth other-choice tags))]] ($_ seq - (assert "Can infer tagged sum." - (|> (@module;with-module +0 module-name - (do Monad<Lux> - [_ (@module;declare-tags tags false namedT)] - (&;with-scope - (@common;with-unknown-type - (@;analyse-tagged-sum analyse [module-name choice-tag] choiceC))))) - (check-variant-inference variantT choice size))) - (assert "Tagged sums specialize when type-vars get bound." - (|> (@module;with-module +0 module-name - (do Monad<Lux> - [_ (@module;declare-tags tags false named-polyT)] - (&;with-scope - (@common;with-unknown-type - (@;analyse-tagged-sum analyse [module-name choice-tag] choiceC))))) - (check-variant-inference variantT choice size))) - (assert "Tagged sum inference retains universal quantification when type-vars are not bound." - (|> (@module;with-module +0 module-name - (do Monad<Lux> - [_ (@module;declare-tags tags false named-polyT)] - (&;with-scope - (@common;with-unknown-type - (@;analyse-tagged-sum analyse [module-name other-choice-tag] other-choiceC))))) - (check-variant-inference polyT other-choice size))) - (assert "Can specialize generic tagged sums." - (|> (@module;with-module +0 module-name - (do Monad<Lux> - [_ (@module;declare-tags tags false named-polyT)] - (&;with-scope - (&;with-expected-type variantT - (@;analyse-tagged-sum analyse [module-name other-choice-tag] other-choiceC))))) - (macro;run (init-compiler [])) - (case> (^multi (#R;Success [_ _ sumA]) - [(flatten-variant sumA) - (#;Some [tag last? valueA])]) - (and (n.= tag other-choice) - (B/= last? (n.= (n.dec size) other-choice))) + (test "Can infer tagged sum." + (|> (@module;with-module +0 module-name + (do Monad<Lux> + [_ (@module;declare-tags tags false namedT)] + (&;with-scope + (@common;with-unknown-type + (@;analyse-tagged-sum analyse [module-name choice-tag] choiceC))))) + (check-variant-inference variantT choice size))) + (test "Tagged sums specialize when type-vars get bound." + (|> (@module;with-module +0 module-name + (do Monad<Lux> + [_ (@module;declare-tags tags false named-polyT)] + (&;with-scope + (@common;with-unknown-type + (@;analyse-tagged-sum analyse [module-name choice-tag] choiceC))))) + (check-variant-inference variantT choice size))) + (test "Tagged sum inference retains universal quantification when type-vars are not bound." + (|> (@module;with-module +0 module-name + (do Monad<Lux> + [_ (@module;declare-tags tags false named-polyT)] + (&;with-scope + (@common;with-unknown-type + (@;analyse-tagged-sum analyse [module-name other-choice-tag] other-choiceC))))) + (check-variant-inference polyT other-choice size))) + (test "Can specialize generic tagged sums." + (|> (@module;with-module +0 module-name + (do Monad<Lux> + [_ (@module;declare-tags tags false named-polyT)] + (&;with-scope + (&;with-expected-type variantT + (@;analyse-tagged-sum analyse [module-name other-choice-tag] other-choiceC))))) + (macro;run (init-compiler [])) + (case> (^multi (#R;Success [_ _ sumA]) + [(flatten-variant sumA) + (#;Some [tag last? valueA])]) + (and (n.= tag other-choice) + (B/= last? (n.= (n.dec size) other-choice))) - _ - false))) + _ + false))) )) -(test: "Records" +(context: "Records" [size (|> r;nat (:: @ map (|>. (n.% +10) (n.max +2)))) tags (|> (r;set text;Hash<Text> size (r;text +5)) (:: @ map S;to-list)) primitives (r;list size gen-primitive) @@ -323,35 +323,35 @@ (type;univ-q +1)) named-polyT (#;Named [module-name type-name] polyT)]] ($_ seq - (assert "Can infer record." - (|> (@module;with-module +0 module-name - (do Monad<Lux> - [_ (@module;declare-tags tags false namedT)] - (&;with-scope - (@common;with-unknown-type - (@;analyse-record analyse recordC))))) - (check-record-inference tupleT size))) - (assert "Records specialize when type-vars get bound." - (|> (@module;with-module +0 module-name - (do Monad<Lux> - [_ (@module;declare-tags tags false named-polyT)] - (&;with-scope - (@common;with-unknown-type - (@;analyse-record analyse recordC))))) - (check-record-inference tupleT size))) - (assert "Can specialize generic records." - (|> (@module;with-module +0 module-name - (do Monad<Lux> - [_ (@module;declare-tags tags false named-polyT)] - (&;with-scope - (&;with-expected-type tupleT - (@;analyse-record analyse recordC))))) - (macro;run (init-compiler [])) - (case> (^multi (#R;Success [_ _ productA]) - [(flatten-tuple productA) - membersA]) - (n.= size (list;size membersA)) + (test "Can infer record." + (|> (@module;with-module +0 module-name + (do Monad<Lux> + [_ (@module;declare-tags tags false namedT)] + (&;with-scope + (@common;with-unknown-type + (@;analyse-record analyse recordC))))) + (check-record-inference tupleT size))) + (test "Records specialize when type-vars get bound." + (|> (@module;with-module +0 module-name + (do Monad<Lux> + [_ (@module;declare-tags tags false named-polyT)] + (&;with-scope + (@common;with-unknown-type + (@;analyse-record analyse recordC))))) + (check-record-inference tupleT size))) + (test "Can specialize generic records." + (|> (@module;with-module +0 module-name + (do Monad<Lux> + [_ (@module;declare-tags tags false named-polyT)] + (&;with-scope + (&;with-expected-type tupleT + (@;analyse-record analyse recordC))))) + (macro;run (init-compiler [])) + (case> (^multi (#R;Success [_ _ productA]) + [(flatten-tuple productA) + membersA]) + (n.= size (list;size membersA)) - _ - false))) + _ + false))) )) |