diff options
Diffstat (limited to 'stdlib')
| -rw-r--r-- | stdlib/source/lux/data/struct/vector.lux | 5 | ||||
| -rw-r--r-- | stdlib/source/lux/type.lux | 6 | ||||
| -rw-r--r-- | stdlib/test/test/lux/data/ident.lux | 19 | ||||
| -rw-r--r-- | stdlib/test/test/lux/type.lux | 34 |
4 files changed, 42 insertions, 22 deletions
diff --git a/stdlib/source/lux/data/struct/vector.lux b/stdlib/source/lux/data/struct/vector.lux index 4e4922d0c..fbe3dbd97 100644 --- a/stdlib/source/lux/data/struct/vector.lux +++ b/stdlib/source/lux/data/struct/vector.lux @@ -436,8 +436,7 @@ (def: applicative Applicative<Vector>) (def: join - (let [(^open) Functor<Vector> - (^open) Fold<Vector> + (let [(^open) Fold<Vector> (^open) Monoid<Vector>] - (fold append unit))) + (fold (lambda [post pre] (append pre post)) unit))) ) diff --git a/stdlib/source/lux/type.lux b/stdlib/source/lux/type.lux index c81d5e23d..a721c0926 100644 --- a/stdlib/source/lux/type.lux +++ b/stdlib/source/lux/type.lux @@ -8,6 +8,7 @@ (lux (control eq monad) (data [text "Text/" Monoid<Text> Eq<Text>] + [ident "Ident/" Eq<Ident>] [number "Nat/" Codec<Text,Nat>] maybe (struct [list #+ "List/" Monad<List> Monoid<List> Fold<List>])) @@ -79,9 +80,8 @@ (and (= xleft yleft) (= xright yright)) - [(#;NamedT [xmodule xname] xtype) (#;NamedT [ymodule yname] ytype)] - (and (Text/= xmodule ymodule) - (Text/= xname yname) + [(#;NamedT xname xtype) (#;NamedT yname ytype)] + (and (Ident/= xname yname) (= xtype ytype)) (^template [<tag>] diff --git a/stdlib/test/test/lux/data/ident.lux b/stdlib/test/test/lux/data/ident.lux index 6c435686f..14adc5371 100644 --- a/stdlib/test/test/lux/data/ident.lux +++ b/stdlib/test/test/lux/data/ident.lux @@ -8,23 +8,28 @@ (lux (codata [io]) (control monad) (data ["&" ident] - [text "Text/" Eq<Text>]) + [text "Text/" Eq<Text>] + text/format) (math ["R" random]) pipe) lux/test) +(def: (gen-part size) + (-> Nat (R;Random Text)) + (|> (R;text size) (R;filter (. not (text;contains? ";"))))) + (test: "Idents" [## First Ident sizeM1 (|> R;nat (:: @ map (n.% +100))) - sizeN1 (|> R;nat (:: @ map (n.% +100))) - module1 (R;text sizeM1) - name1 (R;text sizeN1) + sizeN1 (|> R;nat (:: @ map (|>. (n.% +100) (n.max +1)))) + module1 (gen-part sizeM1) + name1 (gen-part sizeN1) #let [ident1 [module1 name1]] ## Second Ident sizeM2 (|> R;nat (:: @ map (n.% +100))) - sizeN2 (|> R;nat (:: @ map (n.% +100))) - module2 (R;text sizeM2) - name2 (R;text sizeN2) + sizeN2 (|> R;nat (:: @ map (|>. (n.% +100) (n.max +1)))) + module2 (gen-part sizeM2) + name2 (gen-part sizeN2) #let [ident2 [module2 name2]] #let [(^open "&/") &;Eq<Ident> (^open "&/") &;Codec<Text,Ident>]] diff --git a/stdlib/test/test/lux/type.lux b/stdlib/test/test/lux/type.lux index 0e203f376..1f33db816 100644 --- a/stdlib/test/test/lux/type.lux +++ b/stdlib/test/test/lux/type.lux @@ -85,19 +85,27 @@ (test: "Type construction [structs]" [size (|> R;nat (:: @ map (n.% +3))) - members (seqM @ (list;repeat size gen-type)) + members (|> gen-type + (R;filter (lambda [type] + (case type + (^or (#;SumT _) (#;ProdT _)) + false + + _ + true))) + (list;repeat size) + (seqM @)) #let [(^open "&/") &;Eq<Type> (^open "L/") (list;Eq<List> &;Eq<Type>)]] (let% [<struct-tests> (do-template [<desc> <ctor> <dtor> <unit>] [(assert (format "Can build and tear-down " <desc> " types.") (let [flat (|> members <ctor> <dtor>)] - (or (n.= (list;size members) (list;size flat)) - (and (n.= +0 (list;size members)) - (n.= +1 (list;size flat)) - (|> flat list;head (default (undefined)) (&/= <unit>))))))] + (or (L/= members flat) + (and (L/= (list) members) + (L/= (list <unit>) flat)))))] - ["variant" &;variant &;flatten-variant #;VoidT] - ["tuple" &;tuple &;flatten-tuple #;UnitT] + ["variant" &;variant &;flatten-variant Void] + ["tuple" &;tuple &;flatten-tuple Unit] )] ($_ seq <struct-tests> @@ -106,13 +114,21 @@ (test: "Type construction [parameterized]" [size (|> R;nat (:: @ map (n.% +3))) members (seqM @ (list;repeat size gen-type)) - extra gen-type + extra (|> gen-type + (R;filter (lambda [type] + (case type + (^or (#;LambdaT _) (#;ProdT _)) + false + + _ + true)))) #let [(^open "&/") &;Eq<Type> (^open "L/") (list;Eq<List> &;Eq<Type>)]] ($_ seq (assert "Can build and tear-down function types." (let [[inputs output] (|> (&;function members extra) &;flatten-function)] - (n.= (list;size members) (list;size inputs)))) + (and (L/= members inputs) + (&/= extra output)))) (assert "Can build and tear-down application types." (let [[tfunc tparams] (|> members (&;application extra) &;flatten-application)] |