From bbcd1d3ed70cafdf75b8d2340ad97fafa91cd776 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 11 Oct 2017 18:58:28 -0400 Subject: - Forgot to commit update to tests for lux/type/check. --- stdlib/test/test/lux/type/check.lux | 146 ++++++++++++++++++------------------ 1 file changed, 73 insertions(+), 73 deletions(-) (limited to 'stdlib') diff --git a/stdlib/test/test/lux/type/check.lux b/stdlib/test/test/lux/type/check.lux index 83d7cc5a3..938bb44b1 100644 --- a/stdlib/test/test/lux/type/check.lux +++ b/stdlib/test/test/lux/type/check.lux @@ -2,45 +2,45 @@ lux (lux [io] (control [monad #+ do Monad]) - (data [text "Text/" Monoid Eq] + (data [text "text/" Monoid Eq] text/format [number] maybe (coll [list])) - ["R" math/random] + ["r" math/random] [type] - ["&" type/check]) + ["@" type/check]) lux/test) ## [Utils] (def: gen-name - (R;Random Text) - (do R;Monad - [size (|> R;nat (:: @ map (n.% +10)))] - (R;text size))) + (r;Random Text) + (do r;Monad + [size (|> r;nat (:: @ map (n.% +10)))] + (r;text size))) (def: gen-ident - (R;Random Ident) - (R;seq gen-name gen-name)) + (r;Random Ident) + (r;seq gen-name gen-name)) (def: gen-type - (R;Random Type) - (let [(^open "R/") R;Monad] - (R;rec (function [gen-type] - ($_ R;alt - (R;seq gen-name (R/wrap (list))) - (R/wrap []) - (R/wrap []) - (R;seq gen-type gen-type) - (R;seq gen-type gen-type) - (R;seq gen-type gen-type) - R;nat - R;nat - R;nat - (R;seq (R/wrap (list)) gen-type) - (R;seq (R/wrap (list)) gen-type) - (R;seq gen-type gen-type) - (R;seq gen-ident gen-type) + (r;Random Type) + (let [(^open "r/") r;Monad] + (r;rec (function [gen-type] + ($_ r;alt + (r;seq gen-name (r/wrap (list))) + (r/wrap []) + (r/wrap []) + (r;seq gen-type gen-type) + (r;seq gen-type gen-type) + (r;seq gen-type gen-type) + r;nat + r;nat + r;nat + (r;seq (r/wrap (list)) gen-type) + (r;seq (r/wrap (list)) gen-type) + (r;seq gen-type gen-type) + (r;seq gen-ident gen-type) ))))) (def: (valid-type? type) @@ -64,8 +64,8 @@ false)) (def: (type-checks? input) - (-> (&;Check []) Bool) - (case (&;run &;fresh-context input) + (-> (@;Check []) Bool) + (case (@;run @;fresh-context input) (#;Right []) true @@ -74,48 +74,48 @@ ## [Tests] (context: "Top and Bottom" - [sample (|> gen-type (R;filter valid-type?))] + [sample (|> gen-type (r;filter valid-type?))] ($_ seq (test "Top is the super-type of everything." - (&;checks? Top sample)) + (@;checks? Top sample)) (test "Bottom is the sub-type of everything." - (&;checks? sample Bottom)) + (@;checks? sample Bottom)) )) (context: "Simple type-checking." ($_ seq (test "Unit and Void match themselves." - (and (&;checks? Void Void) - (&;checks? Unit Unit))) + (and (@;checks? Void Void) + (@;checks? Unit Unit))) (test "Existential types only match with themselves." - (and (type-checks? (do &;Monad - [[id ex] &;existential] - (&;check ex ex))) - (not (type-checks? (do &;Monad - [[lid lex] &;existential - [rid rex] &;existential] - (&;check lex rex)))))) + (and (type-checks? (do @;Monad + [[id ex] @;existential] + (@;check ex ex))) + (not (type-checks? (do @;Monad + [[lid lex] @;existential + [rid rex] @;existential] + (@;check lex rex)))))) (test "Names don't affect type-checking." - (and (type-checks? (do &;Monad - [[id ex] &;existential] - (&;check (#;Named ["module" "name"] ex) + (and (type-checks? (do @;Monad + [[id ex] @;existential] + (@;check (#;Named ["module" "name"] ex) ex))) - (type-checks? (do &;Monad - [[id ex] &;existential] - (&;check ex + (type-checks? (do @;Monad + [[id ex] @;existential] + (@;check ex (#;Named ["module" "name"] ex)))) - (type-checks? (do &;Monad - [[id ex] &;existential] - (&;check (#;Named ["module" "name"] ex) + (type-checks? (do @;Monad + [[id ex] @;existential] + (@;check (#;Named ["module" "name"] ex) (#;Named ["module" "name"] ex)))))) (test "Can type-check functions." - (and (&;checks? (#;Function Bottom Top) + (and (@;checks? (#;Function Bottom Top) (#;Function Top Bottom)) - (not (&;checks? (#;Function Top Bottom) + (not (@;checks? (#;Function Top Bottom) (#;Function Bottom Top))))) )) @@ -123,54 +123,54 @@ [meta gen-type data gen-type] (test "Can type-check type application." - (and (&;checks? (#;Apply data (#;Apply meta Meta)) + (and (@;checks? (#;Apply data (#;Apply meta Meta)) (type;tuple (list meta data))) - (&;checks? (type;tuple (list meta data)) + (@;checks? (type;tuple (list meta data)) (#;Apply data (#;Apply meta Meta)))))) (context: "Host types" [nameL gen-name - nameR (|> gen-name (R;filter (. not (Text/= nameL)))) + nameR (|> gen-name (r;filter (. not (text/= nameL)))) paramL gen-type - paramR (|> gen-type (R;filter (|>. (&;checks? paramL) not)))] + paramR (|> gen-type (r;filter (|>. (@;checks? paramL) not)))] ($_ seq (test "Host types match when they have the same name and the same parameters." - (&;checks? (#;Host nameL (list paramL)) + (@;checks? (#;Host nameL (list paramL)) (#;Host nameL (list paramL)))) (test "Names matter to host types." - (not (&;checks? (#;Host nameL (list paramL)) + (not (@;checks? (#;Host nameL (list paramL)) (#;Host nameR (list paramL))))) (test "Parameters matter to host types." - (not (&;checks? (#;Host nameL (list paramL)) + (not (@;checks? (#;Host nameL (list paramL)) (#;Host nameL (list paramR))))) )) (context: "Type-vars" ($_ seq (test "Type-vars check against themselves." - (type-checks? (&;with-var (function [[id var]] (&;check var var))))) + (type-checks? (@;with (function [[id var]] (@;check var var))))) (test "Can bind unbound type-vars by type-checking against them." - (and (type-checks? (&;with-var (function [[id var]] (&;check var #;Unit)))) - (type-checks? (&;with-var (function [[id var]] (&;check #;Unit var)))))) + (and (type-checks? (@;with (function [[id var]] (@;check var #;Unit)))) + (type-checks? (@;with (function [[id var]] (@;check #;Unit var)))))) (test "Can't rebind already bound type-vars." - (not (type-checks? (&;with-var (function [[id var]] - (do &;Monad - [_ (&;check var #;Unit)] - (&;check var #;Void))))))) + (not (type-checks? (@;with (function [[id var]] + (do @;Monad + [_ (@;check var #;Unit)] + (@;check var #;Void))))))) (test "If the type bound to a var is a super-type to another, then the var is also a super-type." - (type-checks? (&;with-var (function [[id var]] - (do &;Monad - [_ (&;check var Top)] - (&;check var #;Unit)))))) + (type-checks? (@;with (function [[id var]] + (do @;Monad + [_ (@;check var Top)] + (@;check var #;Unit)))))) (test "If the type bound to a var is a sub-type of another, then the var is also a sub-type." - (type-checks? (&;with-var (function [[id var]] - (do &;Monad - [_ (&;check var Bottom)] - (&;check #;Unit var)))))) + (type-checks? (@;with (function [[id var]] + (do @;Monad + [_ (@;check var Bottom)] + (@;check #;Unit var)))))) )) -- cgit v1.2.3