diff options
Diffstat (limited to '')
| -rw-r--r-- | new-luxc/test/test/luxc/analyser/case.lux | 9 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/analyser/function.lux | 23 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/analyser/procedure/host.jvm.lux | 11 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/analyser/reference.lux | 10 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/analyser/structure.lux | 91 |
5 files changed, 73 insertions, 71 deletions
diff --git a/new-luxc/test/test/luxc/analyser/case.lux b/new-luxc/test/test/luxc/analyser/case.lux index 983dff6f5..f75ebce00 100644 --- a/new-luxc/test/test/luxc/analyser/case.lux +++ b/new-luxc/test/test/luxc/analyser/case.lux @@ -6,6 +6,7 @@ (data [bool "B/" Eq<Bool>] ["R" result] [product] + [maybe] [text "T/" Eq<Text>] text/format (coll [list "L/" Monad<List>] @@ -111,8 +112,8 @@ (r/map product;right gen-primitive) (do r;Monad<Random> [choice (|> r;nat (:: @ map (n.% (list;size variant-tags)))) - #let [choiceT (assume (list;nth choice variant-tags)) - choiceC (assume (list;nth choice primitivesC))]] + #let [choiceT (maybe;assume (list;nth choice variant-tags)) + choiceC (maybe;assume (list;nth choice primitivesC))]] (wrap (` ((~ choiceT) (~ choiceC))))) (do r;Monad<Random> [size (|> r;nat (:: @ map (n.% +3))) @@ -156,10 +157,10 @@ redundant-branchesC (<| (L/map (branch outputC)) list;concat (list (list;take redundancy-idx redundant-patterns) - (list (assume (list;nth redundancy-idx redundant-patterns))) + (list (maybe;assume (list;nth redundancy-idx redundant-patterns))) (list;drop redundancy-idx redundant-patterns))) heterogeneous-branchesC (list;concat (list (list;take heterogeneous-idx exhaustive-branchesC) - (list (let [[_pattern _body] (assume (list;nth heterogeneous-idx exhaustive-branchesC))] + (list (let [[_pattern _body] (maybe;assume (list;nth heterogeneous-idx exhaustive-branchesC))] [_pattern heterogeneousC])) (list;drop (n.inc heterogeneous-idx) exhaustive-branchesC))) ]] diff --git a/new-luxc/test/test/luxc/analyser/function.lux b/new-luxc/test/test/luxc/analyser/function.lux index 827e9a245..f26025034 100644 --- a/new-luxc/test/test/luxc/analyser/function.lux +++ b/new-luxc/test/test/luxc/analyser/function.lux @@ -4,15 +4,14 @@ (control [monad #+ do] pipe) (data ["R" result] + [maybe] [product] - [text "T/" Eq<Text>] + [text "text/" Eq<Text>] text/format - (coll [list "L/" Functor<List>] - ["S" set])) + (coll [list "list/" Functor<List>])) ["r" math/random "r/" Monad<Random>] - [type "Type/" Eq<Type>] - (type ["TC" check]) - [macro #+ Monad<Lux>] + [type "type/" Eq<Type>] + [macro] (macro [code]) test) (luxc ["&" base] @@ -28,7 +27,7 @@ (-> Type (R;Result [Type la;Analysis]) Bool) (case result (#R;Success [exprT exprA]) - (Type/= expectedT exprT) + (type/= expectedT exprT) _ false)) @@ -58,7 +57,7 @@ (macro;run (init-compiler [])) (case> (#R;Success [applyT applyA]) (let [[funcA argsA] (flatten-apply applyA)] - (and (Type/= expectedT applyT) + (and (type/= expectedT applyT) (n.= num-args (list;size argsA)))) (#R;Error error) @@ -66,7 +65,7 @@ (context: "Function definition." [func-name (r;text +5) - arg-name (|> (r;text +5) (r;filter (|>. (T/= func-name) not))) + arg-name (|> (r;text +5) (r;filter (|>. (text/= func-name) not))) [outputT outputC] gen-primitive [inputT _] gen-primitive] ($_ seq @@ -111,8 +110,8 @@ partial-args (|> r;nat (:: @ map (n.% full-args))) var-idx (|> r;nat (:: @ map (|>. (n.% full-args) (n.max +1)))) inputsTC (r;list full-args gen-primitive) - #let [inputsT (L/map product;left inputsTC) - inputsC (L/map product;right inputsTC)] + #let [inputsT (list/map product;left inputsTC) + inputsC (list/map product;right inputsTC)] [outputT outputC] gen-primitive #let [funcT (type;function inputsT outputT) partialT (type;function (list;drop partial-args inputsT) outputT) @@ -122,7 +121,7 @@ (list varT) (list;drop (n.inc var-idx) inputsT)))) varT) - poly-inputT (assume (list;nth var-idx inputsT)) + poly-inputT (maybe;assume (list;nth var-idx inputsT)) partial-poly-inputsT (list;drop (n.inc var-idx) inputsT) partial-polyT1 (<| (type;function partial-poly-inputsT) poly-inputT) diff --git a/new-luxc/test/test/luxc/analyser/procedure/host.jvm.lux b/new-luxc/test/test/luxc/analyser/procedure/host.jvm.lux index 87c315750..c45143d5b 100644 --- a/new-luxc/test/test/luxc/analyser/procedure/host.jvm.lux +++ b/new-luxc/test/test/luxc/analyser/procedure/host.jvm.lux @@ -4,10 +4,11 @@ (control [monad #+ do] pipe) (concurrency [atom]) - (data text/format - [text "text/" Eq<Text>] - ["R" result] + (data ["R" result] [product] + [maybe] + [text "text/" Eq<Text>] + text/format (coll [array] [list "list/" Fold<List>] [dict])) @@ -247,7 +248,7 @@ #let [[unboxed boxed] (: [Text Text] (|> entries (list;nth choice) - (default ["java.lang.Object" "java.lang.Object"])))]] + (maybe;default ["java.lang.Object" "java.lang.Object"])))]] (wrap [unboxed boxed])))) (context: "Array." @@ -320,7 +321,7 @@ (:: @ map (function [idx] (|> throwables (list;nth idx) - (default "java.lang.Object"))))) + (maybe;default "java.lang.Object"))))) #let [throwableC (`' (_lux_check (+0 (~ (code;text throwable)) (+0)) ("jvm object null")))]] ($_ seq diff --git a/new-luxc/test/test/luxc/analyser/reference.lux b/new-luxc/test/test/luxc/analyser/reference.lux index 5601318aa..5cc607080 100644 --- a/new-luxc/test/test/luxc/analyser/reference.lux +++ b/new-luxc/test/test/luxc/analyser/reference.lux @@ -4,8 +4,8 @@ (control [monad #+ do] pipe) (data ["R" result]) - ["r" math/random "R/" Monad<Random>] - [type "Type/" Eq<Type>] + ["r" math/random] + [type "type/" Eq<Type>] [macro #+ Monad<Lux>] test) (luxc ["&;" scope] @@ -30,7 +30,7 @@ (@;analyse-reference ["" var-name])))) (macro;run (init-compiler [])) (case> (#R;Success [_type (#~;Variable idx)]) - (Type/= ref-type _type) + (type/= ref-type _type) _ false))) @@ -38,12 +38,12 @@ (|> (do Monad<Lux> [_ (&module;create +0 module-name) _ (&module;define [module-name var-name] - [ref-type (list) (:! Void [])])] + [ref-type (' {}) (:! Void [])])] (@common;with-unknown-type (@;analyse-reference [module-name var-name]))) (macro;run (init-compiler [])) (case> (#R;Success [_type (#~;Definition idx)]) - (Type/= ref-type _type) + (type/= ref-type _type) _ false))) diff --git a/new-luxc/test/test/luxc/analyser/structure.lux b/new-luxc/test/test/luxc/analyser/structure.lux index d9595492e..d4d915364 100644 --- a/new-luxc/test/test/luxc/analyser/structure.lux +++ b/new-luxc/test/test/luxc/analyser/structure.lux @@ -3,17 +3,18 @@ (lux [io] (control [monad #+ do] pipe) - (data [bool "B/" Eq<Bool>] + (data [bool "bool/" Eq<Bool>] ["R" result] [product] + [maybe] [text] text/format - (coll [list "L/" Functor<List>] + (coll [list "list/" Functor<List>] ["S" set])) ["r" math/random "r/" Monad<Random>] - [type "Type/" Eq<Type>] - (type ["TC" check]) - [macro #+ Monad<Lux>] + [type "type/" Eq<Type>] + (type ["tc" check]) + [macro] (macro [code]) test) (luxc ["&" base] @@ -61,14 +62,14 @@ primitives (r;list size gen-primitive) +choice (|> r;nat (:: @ map (n.% (n.inc size)))) [_ +valueC] gen-primitive - #let [variantT (type;variant (L/map product;left primitives)) - [valueT valueC] (assume (list;nth choice primitives)) + #let [variantT (type;variant (list/map product;left primitives)) + [valueT valueC] (maybe;assume (list;nth choice primitives)) +size (n.inc size) +primitives (list;concat (list (list;take choice primitives) (list [(#;Bound +1) +valueC]) (list;drop choice primitives))) - [+valueT +valueC] (assume (list;nth +choice +primitives)) - +variantT (type;variant (L/map product;left +primitives))]] + [+valueT +valueC] (maybe;assume (list;nth +choice +primitives)) + +variantT (type;variant (list/map product;left +primitives))]] ($_ seq (test "Can analyse sum." (|> (&;with-scope @@ -79,7 +80,7 @@ [(flatten-variant sumA) (#;Some [tag last? valueA])]) (and (n.= tag choice) - (B/= last? (n.= (n.dec size) choice))) + (bool/= last? (n.= (n.dec size) choice))) _ false))) @@ -87,9 +88,9 @@ (|> (&;with-scope (@common;with-var (function [[var-id varT]] - (do Monad<Lux> - [_ (&;within-type-env - (TC;check varT variantT))] + (do macro;Monad<Lux> + [_ (&;with-type-env + (tc;check varT variantT))] (&;with-expected-type varT (@;analyse-sum analyse choice valueC)))))) (macro;run (init-compiler [])) @@ -97,7 +98,7 @@ [(flatten-variant sumA) (#;Some [tag last? valueA])]) (and (n.= tag choice) - (B/= last? (n.= (n.dec size) choice))) + (bool/= last? (n.= (n.dec size) choice))) _ false))) @@ -140,15 +141,15 @@ primitives (r;list size gen-primitive) choice (|> r;nat (:: @ map (n.% size))) [_ +valueC] gen-primitive - #let [[singletonT singletonC] (|> primitives (list;nth choice) assume) + #let [[singletonT singletonC] (|> primitives (list;nth choice) maybe;assume) +primitives (list;concat (list (list;take choice primitives) (list [(#;Bound +1) +valueC]) (list;drop choice primitives))) - +tupleT (type;tuple (L/map product;left +primitives))]] + +tupleT (type;tuple (list/map product;left +primitives))]] ($_ seq (test "Can analyse product." - (|> (&;with-expected-type (type;tuple (L/map product;left primitives)) - (@;analyse-product analyse (L/map product;right primitives))) + (|> (&;with-expected-type (type;tuple (list/map product;left primitives)) + (@;analyse-product analyse (list/map product;right primitives))) (macro;run (init-compiler [])) (case> (#R;Success tupleA) (n.= size (list;size (flatten-tuple tupleA))) @@ -157,10 +158,10 @@ false))) (test "Can infer product." (|> (@common;with-unknown-type - (@;analyse-product analyse (L/map product;right primitives))) + (@;analyse-product analyse (list/map product;right primitives))) (macro;run (init-compiler [])) (case> (#R;Success [_type tupleA]) - (and (Type/= (type;tuple (L/map product;left primitives)) + (and (type/= (type;tuple (list/map product;left primitives)) _type) (n.= size (list;size (flatten-tuple tupleA)))) @@ -179,11 +180,11 @@ (|> (&;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))))] + (do macro;Monad<Lux> + [_ (&;with-type-env + (tc;check varT (type;tuple (list/map product;left primitives))))] (&;with-expected-type varT - (@;analyse-product analyse (L/map product;right primitives))))))) + (@;analyse-product analyse (list/map product;right primitives))))))) (macro;run (init-compiler [])) (case> (#R;Success [_ tupleA]) (n.= size (list;size (flatten-tuple tupleA))) @@ -193,7 +194,7 @@ (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)))) + (@;analyse-product analyse (list/map product;right +primitives)))) (macro;run (init-compiler [])) (case> (#R;Success _) true @@ -203,7 +204,7 @@ (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)))) + (@;analyse-product analyse (list/map product;right +primitives)))) (macro;run (init-compiler [])) (case> (#R;Success _) false @@ -219,9 +220,9 @@ (case> (^multi (#R;Success [_ _ sumT sumA]) [(flatten-variant sumA) (#;Some [tag last? valueA])]) - (and (Type/= variantT sumT) + (and (type/= variantT sumT) (n.= tag choice) - (B/= last? (n.= (n.dec size) choice))) + (bool/= last? (n.= (n.dec size) choice))) _ false))) @@ -233,7 +234,7 @@ (case> (^multi (#R;Success [_ _ productT productA]) [(flatten-tuple productA) membersA]) - (and (Type/= tupleT productT) + (and (type/= tupleT productT) (n.= size (list;size membersA))) _ @@ -248,9 +249,9 @@ module-name (r;text +5) type-name (r;text +5) #let [varT (#;Bound +1) - primitivesT (L/map product;left primitives) - [choiceT choiceC] (assume (list;nth choice primitives)) - [other-choiceT other-choiceC] (assume (list;nth other-choice primitives)) + primitivesT (list/map product;left primitives) + [choiceT choiceC] (maybe;assume (list;nth choice primitives)) + [other-choiceT other-choiceC] (maybe;assume (list;nth other-choice primitives)) variantT (type;variant primitivesT) namedT (#;Named [module-name type-name] variantT) polyT (|> (type;variant (list;concat (list (list;take choice primitivesT) @@ -258,12 +259,12 @@ (list;drop (n.inc choice) primitivesT)))) (type;univ-q +1)) named-polyT (#;Named [module-name type-name] polyT) - choice-tag (assume (list;nth choice tags)) - other-choice-tag (assume (list;nth other-choice tags))]] + choice-tag (maybe;assume (list;nth choice tags)) + other-choice-tag (maybe;assume (list;nth other-choice tags))]] ($_ seq (test "Can infer tagged sum." (|> (@module;with-module +0 module-name - (do Monad<Lux> + (do macro;Monad<Lux> [_ (@module;declare-tags tags false namedT)] (&;with-scope (@common;with-unknown-type @@ -271,7 +272,7 @@ (check-variant-inference variantT choice size))) (test "Tagged sums specialize when type-vars get bound." (|> (@module;with-module +0 module-name - (do Monad<Lux> + (do macro;Monad<Lux> [_ (@module;declare-tags tags false named-polyT)] (&;with-scope (@common;with-unknown-type @@ -279,7 +280,7 @@ (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> + (do macro;Monad<Lux> [_ (@module;declare-tags tags false named-polyT)] (&;with-scope (@common;with-unknown-type @@ -287,7 +288,7 @@ (check-variant-inference polyT other-choice size))) (test "Can specialize generic tagged sums." (|> (@module;with-module +0 module-name - (do Monad<Lux> + (do macro;Monad<Lux> [_ (@module;declare-tags tags false named-polyT)] (&;with-scope (&;with-expected-type variantT @@ -297,7 +298,7 @@ [(flatten-variant sumA) (#;Some [tag last? valueA])]) (and (n.= tag other-choice) - (B/= last? (n.= (n.dec size) other-choice))) + (bool/= last? (n.= (n.dec size) other-choice))) _ false))) @@ -311,9 +312,9 @@ type-name (r;text +5) choice (|> r;nat (:: @ map (n.% size))) #let [varT (#;Bound +1) - tagsC (L/map (|>. [module-name] code;tag) tags) - primitivesT (L/map product;left primitives) - primitivesC (L/map product;right primitives) + tagsC (list/map (|>. [module-name] code;tag) tags) + primitivesT (list/map product;left primitives) + primitivesC (list/map product;right primitives) tupleT (type;tuple primitivesT) namedT (#;Named [module-name type-name] tupleT) recordC (list;zip2 tagsC primitivesC) @@ -325,7 +326,7 @@ ($_ seq (test "Can infer record." (|> (@module;with-module +0 module-name - (do Monad<Lux> + (do macro;Monad<Lux> [_ (@module;declare-tags tags false namedT)] (&;with-scope (@common;with-unknown-type @@ -333,7 +334,7 @@ (check-record-inference tupleT size))) (test "Records specialize when type-vars get bound." (|> (@module;with-module +0 module-name - (do Monad<Lux> + (do macro;Monad<Lux> [_ (@module;declare-tags tags false named-polyT)] (&;with-scope (@common;with-unknown-type @@ -341,7 +342,7 @@ (check-record-inference tupleT size))) (test "Can specialize generic records." (|> (@module;with-module +0 module-name - (do Monad<Lux> + (do macro;Monad<Lux> [_ (@module;declare-tags tags false named-polyT)] (&;with-scope (&;with-expected-type tupleT |