From 2a3946e713821880ecc47580e754315349f2fe73 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 13 Nov 2017 20:02:18 -0400 Subject: - Type-vars no longer get deleted. - Fixed some bugs. --- stdlib/test/test/lux/meta/type/check.lux | 68 +++++++++++--------------------- 1 file changed, 23 insertions(+), 45 deletions(-) (limited to 'stdlib/test') diff --git a/stdlib/test/test/lux/meta/type/check.lux b/stdlib/test/test/lux/meta/type/check.lux index 21eed2f72..b1239fa43 100644 --- a/stdlib/test/test/lux/meta/type/check.lux +++ b/stdlib/test/test/lux/meta/type/check.lux @@ -159,36 +159,42 @@ (context: "Type-vars" ($_ seq (test "Type-vars check against themselves." - (type-checks? (@;with (function [[id var]] (@;check var var))))) + (type-checks? (do @;Monad + [[id var] @;var] + (@;check var var)))) (test "Can bind unbound type-vars by type-checking against them." - (and (type-checks? (@;with (function [[id var]] (@;check var #;Unit)))) - (type-checks? (@;with (function [[id var]] (@;check #;Unit var)))))) + (and (type-checks? (do @;Monad + [[id var] @;var] + (@;check var #;Unit))) + (type-checks? (do @;Monad + [[id var] @;var] + (@;check #;Unit var))))) (test "Cannot rebind already bound type-vars." - (not (type-checks? (@;with (function [[id var]] - (do @;Monad - [_ (@;check var #;Unit)] - (@;check var #;Void))))))) + (not (type-checks? (do @;Monad + [[id var] @;var + _ (@;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 (function [[id var]] - (do @;Monad - [_ (@;check var Top)] - (@;check var #;Unit)))))) + (type-checks? (do @;Monad + [[id var] @;var + _ (@;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 (function [[id var]] - (do @;Monad - [_ (@;check var Bottom)] - (@;check #;Unit var)))))) + (type-checks? (do @;Monad + [[id var] @;var + _ (@;check var Bottom)] + (@;check #;Unit var)))) )) (def: (build-ring num-connections) (-> Nat (@;Check [[Nat Type] (List [Nat Type]) [Nat Type]])) (do @;Monad - [[head-id head-type] @;create - ids+types (monad;seq @ (list;repeat num-connections @;create)) + [[head-id head-type] @;var + ids+types (monad;seq @ (list;repeat num-connections @;var)) [tail-id tail-type] (monad;fold @ (function [[tail-id tail-type] [_head-id _head-type]] (do @ [_ (@;check head-type tail-type)] @@ -234,34 +240,6 @@ (@;assert "" (and rings-were-erased? same-types?)))))) - (test "Can delete variables from rings." - (type-checks? (do @;Monad - [[[head-id head-type] ids+types [tail-id tail-type]] (build-ring num-connections) - #let [ids (list/map product;left ids+types) - all-ids (#;Cons head-id ids) - num-all-ids (list;size all-ids) - [_ idx] (r;run (r;pcg-32 pick-pcg) - (|> r;nat (:: r;Monad map (n.% num-all-ids))))] - #let [pick (maybe;assume (list;nth idx all-ids))] - _ (@;delete pick)] - (if (n.= +0 num-connections) - (wrap []) - (do @ - [ring (@;ring (if (n.= head-id pick) - tail-id - head-id)) - #let [without-removal (|> (list (list;take idx all-ids) - (list;drop (n.inc idx) all-ids)) - list;concat - (list;sort n.<))]] - (let [missing-link? (n.= (n.dec num-all-ids) (set;size ring)) - ids-match? (|> (set;to-list ring) - (list;sort n.<) - (:: (list;Eq number;Eq) = without-removal))] - (@;assert "" - (and missing-link? - ids-match?))))) - ))) (test "Can merge multiple rings of variables." (type-checks? (do @;Monad [[[head-idL head-typeL] ids+typesL [tail-idL tail-typeL]] (build-ring num-connections) -- cgit v1.2.3