From 6ffd0692d840298850307497f5275c44d0ff8f5d Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 16 Oct 2017 23:24:21 -0400 Subject: - Re-named "Lux" type to "Meta". - Moved lux/type/* under lux/meta/*. --- stdlib/test/test/lux.lux | 8 +- stdlib/test/test/lux/control/parser.lux | 6 +- stdlib/test/test/lux/data/format/json.lux | 14 +-- stdlib/test/test/lux/data/text/regex.lux | 6 +- stdlib/test/test/lux/macro/code.lux | 32 ----- stdlib/test/test/lux/macro/poly/eq.lux | 70 ----------- stdlib/test/test/lux/macro/poly/functor.lux | 30 ----- stdlib/test/test/lux/macro/syntax.lux | 153 ------------------------ stdlib/test/test/lux/meta/code.lux | 32 +++++ stdlib/test/test/lux/meta/poly/eq.lux | 70 +++++++++++ stdlib/test/test/lux/meta/poly/functor.lux | 30 +++++ stdlib/test/test/lux/meta/syntax.lux | 153 ++++++++++++++++++++++++ stdlib/test/test/lux/meta/type.lux | 157 +++++++++++++++++++++++++ stdlib/test/test/lux/meta/type/auto.lux | 39 ++++++ stdlib/test/test/lux/meta/type/check.lux | 176 ++++++++++++++++++++++++++++ stdlib/test/test/lux/meta/type/object.lux | 83 +++++++++++++ stdlib/test/test/lux/type.lux | 157 ------------------------- stdlib/test/test/lux/type/auto.lux | 39 ------ stdlib/test/test/lux/type/check.lux | 176 ---------------------------- stdlib/test/test/lux/type/object.lux | 83 ------------- stdlib/test/tests.lux | 20 ++-- 21 files changed, 767 insertions(+), 767 deletions(-) delete mode 100644 stdlib/test/test/lux/macro/code.lux delete mode 100644 stdlib/test/test/lux/macro/poly/eq.lux delete mode 100644 stdlib/test/test/lux/macro/poly/functor.lux delete mode 100644 stdlib/test/test/lux/macro/syntax.lux create mode 100644 stdlib/test/test/lux/meta/code.lux create mode 100644 stdlib/test/test/lux/meta/poly/eq.lux create mode 100644 stdlib/test/test/lux/meta/poly/functor.lux create mode 100644 stdlib/test/test/lux/meta/syntax.lux create mode 100644 stdlib/test/test/lux/meta/type.lux create mode 100644 stdlib/test/test/lux/meta/type/auto.lux create mode 100644 stdlib/test/test/lux/meta/type/check.lux create mode 100644 stdlib/test/test/lux/meta/type/object.lux delete mode 100644 stdlib/test/test/lux/type.lux delete mode 100644 stdlib/test/test/lux/type/auto.lux delete mode 100644 stdlib/test/test/lux/type/check.lux delete mode 100644 stdlib/test/test/lux/type/object.lux (limited to 'stdlib/test') diff --git a/stdlib/test/test/lux.lux b/stdlib/test/test/lux.lux index 5ff53793c..88f8c6f79 100644 --- a/stdlib/test/test/lux.lux +++ b/stdlib/test/test/lux.lux @@ -8,8 +8,8 @@ (data [maybe] [text "T/" Eq] text/format) - [macro] - (macro ["s" syntax #+ syntax:]))) + [meta] + (meta ["s" syntax #+ syntax:]))) (context: "Value identity." [size (|> r;nat (:: @ map (|>. (n.% +100) (n.max +10)))) @@ -163,10 +163,10 @@ (test "Can have defaults for Maybe values." (and (is "yolo" (maybe;default "yolo" - #;None)) + #;None)) (is "lol" (maybe;default "yolo" - (#;Some "lol"))))) + (#;Some "lol"))))) )) (template: (hypotenuse x y) diff --git a/stdlib/test/test/lux/control/parser.lux b/stdlib/test/test/lux/control/parser.lux index 0f6b4a4b1..3a2483f6b 100644 --- a/stdlib/test/test/lux/control/parser.lux +++ b/stdlib/test/test/lux/control/parser.lux @@ -12,9 +12,9 @@ [ident] ["E" error]) ["r" math/random] - [macro] - (macro [code] - ["s" syntax #+ syntax:])) + [meta] + (meta [code] + ["s" syntax #+ syntax:])) lux/test) ## [Utils] diff --git a/stdlib/test/test/lux/data/format/json.lux b/stdlib/test/test/lux/data/format/json.lux index 67e636d36..7ab580684 100644 --- a/stdlib/test/test/lux/data/format/json.lux +++ b/stdlib/test/test/lux/data/format/json.lux @@ -16,17 +16,17 @@ (coll [sequence #+ sequence] ["d" dict] [list])) - [macro #+ with-gensyms] - (macro [code] - [syntax #+ syntax:] - [poly #+ derived:] - [poly/eq] - [poly/json]) + [meta #+ with-gensyms] + (meta [code] + [syntax #+ syntax:] + [poly #+ derived:] + [poly/eq] + [poly/json] + (type [unit])) ["r" math/random] (time ["ti" instant] ["tda" date] ["tdu" duration]) - (type [unit]) test) (test (lux (time ["_;" instant] ["_;" duration] diff --git a/stdlib/test/test/lux/data/text/regex.lux b/stdlib/test/test/lux/data/text/regex.lux index f0b5bd3c2..29ec9a896 100644 --- a/stdlib/test/test/lux/data/text/regex.lux +++ b/stdlib/test/test/lux/data/text/regex.lux @@ -9,9 +9,9 @@ text/format (text [lexer] ["&" regex])) - [macro] - (macro [code] - ["s" syntax #+ syntax:]) + [meta] + (meta [code] + ["s" syntax #+ syntax:]) ["r" math/random]) lux/test) diff --git a/stdlib/test/test/lux/macro/code.lux b/stdlib/test/test/lux/macro/code.lux deleted file mode 100644 index 64bdf5f1c..000000000 --- a/stdlib/test/test/lux/macro/code.lux +++ /dev/null @@ -1,32 +0,0 @@ -(;module: - lux - (lux [io] - (control [monad #+ do Monad]) - (data [text "T/" Eq] - text/format - [number]) - ["r" math/random] - (macro ["&" code])) - lux/test) - -(context: "Code" - (with-expansions - [ (do-template [ ] - [(test (format "Can produce Code node: " ) - (and (T/= (&;to-text )) - (:: &;Eq = )))] - - [(&;bool true) "true"] - [(&;bool false) "false"] - [(&;int 123) "123"] - [(&;frac 123.0) "123.0"] - [(&;text "\n") "\"\\n\""] - [(&;tag ["yolo" "lol"]) "#yolo;lol"] - [(&;symbol ["yolo" "lol"]) "yolo;lol"] - [(&;form (list (&;bool true) (&;int 123))) "(true 123)"] - [(&;tuple (list (&;bool true) (&;int 123))) "[true 123]"] - [(&;record (list [(&;bool true) (&;int 123)])) "{true 123}"] - [(&;local-tag "lol") "#lol"] - [(&;local-symbol "lol") "lol"] - )] - ($_ seq ))) diff --git a/stdlib/test/test/lux/macro/poly/eq.lux b/stdlib/test/test/lux/macro/poly/eq.lux deleted file mode 100644 index 525b668a8..000000000 --- a/stdlib/test/test/lux/macro/poly/eq.lux +++ /dev/null @@ -1,70 +0,0 @@ -(;module: - lux - (lux [io] - (control [monad #+ do Monad] - [eq #+ Eq]) - (data text/format - [bool] - [number "i/" Number] - [text] - [maybe] - (coll [list])) - ["r" math/random] - [macro] - (macro [poly #+ derived:] - ["&" poly/eq])) - lux/test) - -## [Utils] -(type: Variant - (#Case0 Bool) - (#Case1 Int) - (#Case2 Frac)) - -(type: #rec Recursive - (#Number Frac) - (#Addition Frac Recursive)) - -(type: Record - {#unit Unit - #bool Bool - #int Int - #frac Frac - #text Text - #maybe (Maybe Int) - #list (List Int) - #variant Variant - #tuple [Int Frac Text] - #recursive Recursive}) - -(def: gen-recursive - (r;Random Recursive) - (r;rec (function [gen-recursive] - (r;alt r;frac - (r;seq r;frac gen-recursive))))) - -(def: gen-record - (r;Random Record) - (do r;Monad - [size (:: @ map (n.% +2) r;nat) - #let [gen-int (|> r;int (:: @ map (|>. i/abs (i.% 1_000_000))))]] - ($_ r;seq - (:: @ wrap []) - r;bool - gen-int - r;frac - (r;text size) - (r;maybe gen-int) - (r;list size gen-int) - ($_ r;alt r;bool gen-int r;frac) - ($_ r;seq gen-int r;frac (r;text size)) - gen-recursive))) - -(derived: (&;Eq Record)) - -## [Tests] -(context: "Eq polytypism" - [sample gen-record - #let [(^open "&/") Eq]] - (test "Every instance equals itself." - (&/= sample sample))) diff --git a/stdlib/test/test/lux/macro/poly/functor.lux b/stdlib/test/test/lux/macro/poly/functor.lux deleted file mode 100644 index 45e54bae7..000000000 --- a/stdlib/test/test/lux/macro/poly/functor.lux +++ /dev/null @@ -1,30 +0,0 @@ -(;module: - lux - (lux [io] - (control [monad #+ do Monad] - [functor] - [eq #+ Eq] - [state]) - (data text/format - [bool] - [number "i/" Number] - [text] - [identity]) - ["r" math/random] - [macro] - (macro [poly #+ derived:] - ["&" poly/functor])) - lux/test) - -## [Utils] -(derived: (&;Functor ;Maybe)) - -(derived: (&;Functor ;List)) - -(derived: (&;Functor state;State)) - -(derived: (&;Functor identity;Identity)) - -## [Tests] -(context: "Functor polytypism." - (test "" true)) diff --git a/stdlib/test/test/lux/macro/syntax.lux b/stdlib/test/test/lux/macro/syntax.lux deleted file mode 100644 index b159bf999..000000000 --- a/stdlib/test/test/lux/macro/syntax.lux +++ /dev/null @@ -1,153 +0,0 @@ -(;module: - lux - (lux [io] - (control [monad #+ do Monad] - [eq #+ Eq] - ["p" parser]) - (data [text "Text/" Monoid] - text/format - [number] - [bool] - [ident] - ["E" error]) - ["r" math/random] - [macro] - (macro [code] - ["s" syntax #+ syntax: Syntax])) - lux/test) - -## [Utils] -(def: (enforced? parser input) - (-> (Syntax []) (List Code) Bool) - (case (p;run input parser) - (#;Right [_ []]) - true - - _ - false)) - -(def: (found? parser input) - (-> (Syntax Bool) (List Code) Bool) - (case (p;run input parser) - (#;Right [_ true]) - true - - _ - false)) - -(def: (is? Eq test parser input) - (All [a] (-> (Eq a) a (Syntax a) (List Code) Bool)) - (case (p;run input parser) - (#;Right [_ output]) - (:: Eq = test output) - - _ - false)) - -(def: (fails? input) - (All [a] (-> (E;Error a) Bool)) - (case input - (#;Left _) - true - - _ - false)) - -(syntax: (match pattern input) - (wrap (list (` (case (~ input) - (^ (#;Right [(~' _) (~ pattern)])) - true - - (~' _) - false))))) - -## [Tests] -(context: "Simple value syntax." - (with-expansions - [ (do-template [ ] - [(test - (and (is? (list ( ))) - (found? (s;this? ( )) (list ( ))) - (enforced? (s;this ( )) (list ( )))))] - - ["Can parse Bool syntax." true code;bool bool;Eq s;bool] - ["Can parse Nat syntax." +123 code;nat number;Eq s;nat] - ["Can parse Int syntax." 123 code;int number;Eq s;int] - ["Can parse Deg syntax." .123 code;deg number;Eq s;deg] - ["Can parse Frac syntax." 123.0 code;frac number;Eq s;frac] - ["Can parse Text syntax." "\n" code;text text;Eq s;text] - ["Can parse Symbol syntax." ["yolo" "lol"] code;symbol ident;Eq s;symbol] - ["Can parse Tag syntax." ["yolo" "lol"] code;tag ident;Eq s;tag] - )] - ($_ seq - - - (test "Can parse symbols belonging to the current namespace." - (and (match "yolo" - (p;run (list (code;local-symbol "yolo")) - s;local-symbol)) - (fails? (p;run (list (code;symbol ["yolo" "lol"])) - s;local-symbol)))) - - (test "Can parse tags belonging to the current namespace." - (and (match "yolo" - (p;run (list (code;local-tag "yolo")) - s;local-tag)) - (fails? (p;run (list (code;tag ["yolo" "lol"])) - s;local-tag)))) - ))) - -(context: "Complex value syntax." - (with-expansions - [ (do-template [ ] - [(test (format "Can parse " " syntax.") - (and (match [true 123] - (p;run (list ( (list (code;bool true) (code;int 123)))) - ( (p;seq s;bool s;int)))) - (match true - (p;run (list ( (list (code;bool true)))) - ( s;bool))) - (fails? (p;run (list ( (list (code;bool true) (code;int 123)))) - ( s;bool))) - (match (#;Left true) - (p;run (list ( (list (code;bool true)))) - ( (p;alt s;bool s;int)))) - (match (#;Right 123) - (p;run (list ( (list (code;int 123)))) - ( (p;alt s;bool s;int)))) - (fails? (p;run (list ( (list (code;frac 123.0)))) - ( (p;alt s;bool s;int))))))] - - ["form" s;form code;form] - ["tuple" s;tuple code;tuple])] - ($_ seq - - - (test "Can parse record syntax." - (match [true 123] - (p;run (list (code;record (list [(code;bool true) (code;int 123)]))) - (s;record (p;seq s;bool s;int))))) - ))) - -(context: "Combinators" - ($_ seq - (test "Can parse any Code." - (match [_ (#;Bool true)] - (p;run (list (code;bool true) (code;int 123)) - s;any))) - - (test "Can check whether the end has been reached." - (and (match true - (p;run (list) - s;end?)) - (match false - (p;run (list (code;bool true)) - s;end?)))) - - (test "Can ensure the end has been reached." - (and (match [] - (p;run (list) - s;end!)) - (fails? (p;run (list (code;bool true)) - s;end!)))) - )) diff --git a/stdlib/test/test/lux/meta/code.lux b/stdlib/test/test/lux/meta/code.lux new file mode 100644 index 000000000..7c3706f13 --- /dev/null +++ b/stdlib/test/test/lux/meta/code.lux @@ -0,0 +1,32 @@ +(;module: + lux + (lux [io] + (control [monad #+ do Monad]) + (data [text "T/" Eq] + text/format + [number]) + ["r" math/random] + (meta ["&" code])) + lux/test) + +(context: "Code" + (with-expansions + [ (do-template [ ] + [(test (format "Can produce Code node: " ) + (and (T/= (&;to-text )) + (:: &;Eq = )))] + + [(&;bool true) "true"] + [(&;bool false) "false"] + [(&;int 123) "123"] + [(&;frac 123.0) "123.0"] + [(&;text "\n") "\"\\n\""] + [(&;tag ["yolo" "lol"]) "#yolo;lol"] + [(&;symbol ["yolo" "lol"]) "yolo;lol"] + [(&;form (list (&;bool true) (&;int 123))) "(true 123)"] + [(&;tuple (list (&;bool true) (&;int 123))) "[true 123]"] + [(&;record (list [(&;bool true) (&;int 123)])) "{true 123}"] + [(&;local-tag "lol") "#lol"] + [(&;local-symbol "lol") "lol"] + )] + ($_ seq ))) diff --git a/stdlib/test/test/lux/meta/poly/eq.lux b/stdlib/test/test/lux/meta/poly/eq.lux new file mode 100644 index 000000000..28cc1167a --- /dev/null +++ b/stdlib/test/test/lux/meta/poly/eq.lux @@ -0,0 +1,70 @@ +(;module: + lux + (lux [io] + (control [monad #+ do Monad] + [eq #+ Eq]) + (data text/format + [bool] + [number "i/" Number] + [text] + [maybe] + (coll [list])) + ["r" math/random] + [meta] + (meta [poly #+ derived:] + ["&" poly/eq])) + lux/test) + +## [Utils] +(type: Variant + (#Case0 Bool) + (#Case1 Int) + (#Case2 Frac)) + +(type: #rec Recursive + (#Number Frac) + (#Addition Frac Recursive)) + +(type: Record + {#unit Unit + #bool Bool + #int Int + #frac Frac + #text Text + #maybe (Maybe Int) + #list (List Int) + #variant Variant + #tuple [Int Frac Text] + #recursive Recursive}) + +(def: gen-recursive + (r;Random Recursive) + (r;rec (function [gen-recursive] + (r;alt r;frac + (r;seq r;frac gen-recursive))))) + +(def: gen-record + (r;Random Record) + (do r;Monad + [size (:: @ map (n.% +2) r;nat) + #let [gen-int (|> r;int (:: @ map (|>. i/abs (i.% 1_000_000))))]] + ($_ r;seq + (:: @ wrap []) + r;bool + gen-int + r;frac + (r;text size) + (r;maybe gen-int) + (r;list size gen-int) + ($_ r;alt r;bool gen-int r;frac) + ($_ r;seq gen-int r;frac (r;text size)) + gen-recursive))) + +(derived: (&;Eq Record)) + +## [Tests] +(context: "Eq polytypism" + [sample gen-record + #let [(^open "&/") Eq]] + (test "Every instance equals itself." + (&/= sample sample))) diff --git a/stdlib/test/test/lux/meta/poly/functor.lux b/stdlib/test/test/lux/meta/poly/functor.lux new file mode 100644 index 000000000..8ece07447 --- /dev/null +++ b/stdlib/test/test/lux/meta/poly/functor.lux @@ -0,0 +1,30 @@ +(;module: + lux + (lux [io] + (control [monad #+ do Monad] + [functor] + [eq #+ Eq] + [state]) + (data text/format + [bool] + [number "i/" Number] + [text] + [identity]) + ["r" math/random] + [meta] + (meta [poly #+ derived:] + ["&" poly/functor])) + lux/test) + +## [Utils] +(derived: (&;Functor ;Maybe)) + +(derived: (&;Functor ;List)) + +(derived: (&;Functor state;State)) + +(derived: (&;Functor identity;Identity)) + +## [Tests] +(context: "Functor polytypism." + (test "" true)) diff --git a/stdlib/test/test/lux/meta/syntax.lux b/stdlib/test/test/lux/meta/syntax.lux new file mode 100644 index 000000000..511c56e68 --- /dev/null +++ b/stdlib/test/test/lux/meta/syntax.lux @@ -0,0 +1,153 @@ +(;module: + lux + (lux [io] + (control [monad #+ do Monad] + [eq #+ Eq] + ["p" parser]) + (data [text "Text/" Monoid] + text/format + [number] + [bool] + [ident] + ["E" error]) + ["r" math/random] + [meta] + (meta [code] + ["s" syntax #+ syntax: Syntax])) + lux/test) + +## [Utils] +(def: (enforced? parser input) + (-> (Syntax []) (List Code) Bool) + (case (p;run input parser) + (#;Right [_ []]) + true + + _ + false)) + +(def: (found? parser input) + (-> (Syntax Bool) (List Code) Bool) + (case (p;run input parser) + (#;Right [_ true]) + true + + _ + false)) + +(def: (is? Eq test parser input) + (All [a] (-> (Eq a) a (Syntax a) (List Code) Bool)) + (case (p;run input parser) + (#;Right [_ output]) + (:: Eq = test output) + + _ + false)) + +(def: (fails? input) + (All [a] (-> (E;Error a) Bool)) + (case input + (#;Left _) + true + + _ + false)) + +(syntax: (match pattern input) + (wrap (list (` (case (~ input) + (^ (#;Right [(~' _) (~ pattern)])) + true + + (~' _) + false))))) + +## [Tests] +(context: "Simple value syntax." + (with-expansions + [ (do-template [ ] + [(test + (and (is? (list ( ))) + (found? (s;this? ( )) (list ( ))) + (enforced? (s;this ( )) (list ( )))))] + + ["Can parse Bool syntax." true code;bool bool;Eq s;bool] + ["Can parse Nat syntax." +123 code;nat number;Eq s;nat] + ["Can parse Int syntax." 123 code;int number;Eq s;int] + ["Can parse Deg syntax." .123 code;deg number;Eq s;deg] + ["Can parse Frac syntax." 123.0 code;frac number;Eq s;frac] + ["Can parse Text syntax." "\n" code;text text;Eq s;text] + ["Can parse Symbol syntax." ["yolo" "lol"] code;symbol ident;Eq s;symbol] + ["Can parse Tag syntax." ["yolo" "lol"] code;tag ident;Eq s;tag] + )] + ($_ seq + + + (test "Can parse symbols belonging to the current namespace." + (and (match "yolo" + (p;run (list (code;local-symbol "yolo")) + s;local-symbol)) + (fails? (p;run (list (code;symbol ["yolo" "lol"])) + s;local-symbol)))) + + (test "Can parse tags belonging to the current namespace." + (and (match "yolo" + (p;run (list (code;local-tag "yolo")) + s;local-tag)) + (fails? (p;run (list (code;tag ["yolo" "lol"])) + s;local-tag)))) + ))) + +(context: "Complex value syntax." + (with-expansions + [ (do-template [ ] + [(test (format "Can parse " " syntax.") + (and (match [true 123] + (p;run (list ( (list (code;bool true) (code;int 123)))) + ( (p;seq s;bool s;int)))) + (match true + (p;run (list ( (list (code;bool true)))) + ( s;bool))) + (fails? (p;run (list ( (list (code;bool true) (code;int 123)))) + ( s;bool))) + (match (#;Left true) + (p;run (list ( (list (code;bool true)))) + ( (p;alt s;bool s;int)))) + (match (#;Right 123) + (p;run (list ( (list (code;int 123)))) + ( (p;alt s;bool s;int)))) + (fails? (p;run (list ( (list (code;frac 123.0)))) + ( (p;alt s;bool s;int))))))] + + ["form" s;form code;form] + ["tuple" s;tuple code;tuple])] + ($_ seq + + + (test "Can parse record syntax." + (match [true 123] + (p;run (list (code;record (list [(code;bool true) (code;int 123)]))) + (s;record (p;seq s;bool s;int))))) + ))) + +(context: "Combinators" + ($_ seq + (test "Can parse any Code." + (match [_ (#;Bool true)] + (p;run (list (code;bool true) (code;int 123)) + s;any))) + + (test "Can check whether the end has been reached." + (and (match true + (p;run (list) + s;end?)) + (match false + (p;run (list (code;bool true)) + s;end?)))) + + (test "Can ensure the end has been reached." + (and (match [] + (p;run (list) + s;end!)) + (fails? (p;run (list (code;bool true)) + s;end!)))) + )) diff --git a/stdlib/test/test/lux/meta/type.lux b/stdlib/test/test/lux/meta/type.lux new file mode 100644 index 000000000..062021a3c --- /dev/null +++ b/stdlib/test/test/lux/meta/type.lux @@ -0,0 +1,157 @@ +(;module: + lux + (lux [io] + (control ["M" monad #+ do Monad] + pipe) + (data [text "Text/" Monoid] + text/format + [number] + [maybe] + (coll [list])) + ["r" math/random] + (meta ["&" type])) + lux/test) + +## [Utils] +(def: gen-name + (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)) + +(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) + ))))) + +## [Tests] +(context: "Types" + [sample gen-type] + (test "Every type is equal to itself." + (:: &;Eq = sample sample))) + +(context: "Type application" + (test "Can apply quantified types (universal and existential quantification)." + (and (maybe;default false + (do maybe;Monad + [partial (&;apply (list Bool) Ann) + full (&;apply (list Int) partial)] + (wrap (:: &;Eq = full (#;Product Bool Int))))) + (|> (&;apply (list Bool) Text) + (case> #;None true _ false))))) + +(context: "Naming" + (let [base (#;Named ["" "a"] (#;Product Bool Int)) + aliased (#;Named ["" "c"] + (#;Named ["" "b"] + base))] + ($_ seq + (test "Can remove aliases from an already-named type." + (:: &;Eq = + base + (&;un-alias aliased))) + + (test "Can remove all names from a type." + (and (not (:: &;Eq = + base + (&;un-name aliased))) + (:: &;Eq = + (&;un-name base) + (&;un-name aliased))))))) + +(context: "Type construction [structs]" + [size (|> r;nat (:: @ map (n.% +3))) + members (|> gen-type + (r;filter (function [type] + (case type + (^or (#;Sum _) (#;Product _)) + false + + _ + true))) + (list;repeat size) + (M;seq @)) + #let [(^open "&/") &;Eq + (^open "L/") (list;Eq &;Eq)]] + (with-expansions + [ (do-template [ ] + [(test (format "Can build and tear-down " " types.") + (let [flat (|> members )] + (or (L/= members flat) + (and (L/= (list) members) + (L/= (list ) flat)))))] + + ["variant" &;variant &;flatten-variant Void] + ["tuple" &;tuple &;flatten-tuple Unit] + )] + ($_ seq + + ))) + +(context: "Type construction [parameterized]" + [size (|> r;nat (:: @ map (n.% +3))) + members (M;seq @ (list;repeat size gen-type)) + extra (|> gen-type + (r;filter (function [type] + (case type + (^or (#;Function _) (#;Apply _)) + false + + _ + true)))) + #let [(^open "&/") &;Eq + (^open "L/") (list;Eq &;Eq)]] + ($_ seq + (test "Can build and tear-down function types." + (let [[inputs output] (|> (&;function members extra) &;flatten-function)] + (and (L/= members inputs) + (&/= extra output)))) + + (test "Can build and tear-down application types." + (let [[tfunc tparams] (|> extra (&;application members) &;flatten-application)] + (n.= (list;size members) (list;size tparams)))) + )) + +(context: "Type construction [higher order]" + [size (|> r;nat (:: @ map (n.% +3))) + extra (|> gen-type + (r;filter (function [type] + (case type + (^or (#;UnivQ _) (#;ExQ _)) + false + + _ + true)))) + #let [(^open "&/") &;Eq]] + (with-expansions + [ (do-template [ ] + [(test (format "Can build and tear-down " " types.") + (let [[flat-size flat-body] (|> extra ( size) )] + (and (n.= size flat-size) + (&/= extra flat-body))))] + + ["universally-quantified" &;univ-q &;flatten-univ-q] + ["existentially-quantified" &;ex-q &;flatten-ex-q] + )] + ($_ seq + + ))) diff --git a/stdlib/test/test/lux/meta/type/auto.lux b/stdlib/test/test/lux/meta/type/auto.lux new file mode 100644 index 000000000..6e506e9f8 --- /dev/null +++ b/stdlib/test/test/lux/meta/type/auto.lux @@ -0,0 +1,39 @@ +(;module: + lux + (lux [io] + (control [monad #+ do Monad] + functor + [eq]) + (data [text "Text/" Monoid] + text/format + [number] + [bool "B/" Eq] + maybe + (coll [list])) + ["r" math/random] + (meta [type] + type/auto)) + lux/test) + +(context: "Automatic structure selection" + [x r;nat + y r;nat] + ($_ seq + (test "Can automatically select first-order structures." + (let [(^open "L/") (list;Eq number;Eq)] + (and (B/= (:: number;Eq = x y) + (::: = x y)) + (L/= (list;n.range +1 +10) + (::: map n.inc (list;n.range +0 +9))) + ))) + + (test "Can automatically select second-order structures." + (::: = + (list;n.range +1 +10) + (list;n.range +1 +10))) + + (test "Can automatically select third-order structures." + (let [lln (::: map (list;n.range +1) + (list;n.range +1 +10))] + (::: = lln lln))) + )) diff --git a/stdlib/test/test/lux/meta/type/check.lux b/stdlib/test/test/lux/meta/type/check.lux new file mode 100644 index 000000000..c6ac6c9b1 --- /dev/null +++ b/stdlib/test/test/lux/meta/type/check.lux @@ -0,0 +1,176 @@ +(;module: + lux + (lux [io] + (control [monad #+ do Monad]) + (data [text "text/" Monoid Eq] + text/format + [number] + maybe + (coll [list])) + ["r" math/random] + (meta [type] + ["@" type/check])) + lux/test) + +## [Utils] +(def: gen-name + (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)) + +(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) + ))))) + +(def: (valid-type? type) + (-> Type Bool) + (case type + (#;Host name params) + (list;every? valid-type? params) + + (^or #;Void #;Unit (#;Ex id)) + true + + (^template [] + ( left right) + (and (valid-type? left) (valid-type? right))) + ([#;Sum] [#;Product] [#;Function]) + + (#;Named name type') + (valid-type? type') + + _ + false)) + +(def: (type-checks? input) + (-> (@;Check []) Bool) + (case (@;run @;fresh-context input) + (#;Right []) + true + + (#;Left error) + false)) + +## [Tests] +(context: "Top and Bottom" + [sample (|> gen-type (r;filter valid-type?))] + ($_ seq + (test "Top is the super-type of everything." + (@;checks? Top sample)) + + (test "Bottom is the sub-type of everything." + (@;checks? sample Bottom)) + )) + +(context: "Simple type-checking." + ($_ seq + (test "Unit and Void match themselves." + (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)))))) + + (test "Names don't affect type-checking." + (and (type-checks? (do @;Monad + [[id ex] @;existential] + (@;check (#;Named ["module" "name"] ex) + 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) + (#;Named ["module" "name"] ex)))))) + + (test "Can type-check functions." + (and (@;checks? (#;Function Bottom Top) + (#;Function Top Bottom)) + (not (@;checks? (#;Function Top Bottom) + (#;Function Bottom Top))))) + )) + +(context: "Type application" + [meta gen-type + data gen-type] + (test "Can type-check type application." + (and (@;checks? (|> Ann (#;Apply meta) (#;Apply data)) + (type;tuple (list meta data))) + (@;checks? (type;tuple (list meta data)) + (|> Ann (#;Apply meta) (#;Apply data)))))) + +(context: "Host types" + [nameL gen-name + nameR (|> gen-name (r;filter (. not (text/= nameL)))) + paramL gen-type + 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)) + (#;Host nameL (list paramL)))) + + (test "Names matter to host types." + (not (@;checks? (#;Host nameL (list paramL)) + (#;Host nameR (list paramL))))) + + (test "Parameters matter to host types." + (not (@;checks? (#;Host nameL (list paramL)) + (#;Host nameL (list paramR))))) + )) + +(context: "Type-vars" + ($_ seq + (test "Type-vars check against themselves." + (type-checks? (@;with (function [[id 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)))))) + + (test "Can't rebind already bound type-vars." + (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 (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 (function [[id var]] + (do @;Monad + [_ (@;check var Bottom)] + (@;check #;Unit var)))))) + )) diff --git a/stdlib/test/test/lux/meta/type/object.lux b/stdlib/test/test/lux/meta/type/object.lux new file mode 100644 index 000000000..c6b7d0f80 --- /dev/null +++ b/stdlib/test/test/lux/meta/type/object.lux @@ -0,0 +1,83 @@ +(;module: + lux + (lux (data (coll [list])) + (meta (type object)))) + +## No parameters +(interface: Counter + (inc [] @) + (read [] Nat)) + +(class: NatC Counter + Nat + + (def: inc + (update@Counter n.inc)) + + (def: read + get@Counter)) + +(interface: Resettable-Counter + #super Counter + (reset [] @)) + +(class: NatRC Resettable-Counter + #super NatC + Unit + + (def: reset + (set@Counter +0))) + +## With parameters +(interface: (Collection a) + (add [a] @) + (size [] Nat)) + +(class: (ListC a) (Collection a) + (List a) + + (def: (add elem) + (update@Collection (|>. (#;Cons elem)))) + + (def: size + (|>. get@Collection list;size))) + +(interface: (Iterable a) + #super (Collection a) + (enumerate [] (List a))) + +(class: (ListI a) (Iterable a) + #super (ListC a) + Unit + + (def: enumerate + get@Collection)) + +## Polymorphism +(def: (poly0 counter) + (-> Counter Nat) + (read counter)) + +(def: poly0-0 Nat (poly0 (new@NatC +0))) +(def: poly0-1 Nat (poly0 (new@NatRC +0 []))) + +(def: (poly1 counter) + (-> Resettable-Counter Nat) + (n.+ (read counter) + (read (reset counter)))) + +(def: poly1-0 Nat (poly1 (new@NatRC +0 []))) + +(def: (poly2 counter) + (-> NatC Nat) + (read counter)) + +(def: poly2-0 Nat (poly2 (new@NatC +0))) +(def: poly2-1 Nat (poly2 (new@NatRC +0 []))) + +(def: (poly3 counter) + (-> NatRC Nat) + (n.+ (read counter) + (read (reset counter)))) + +(def: poly3-0 Nat (poly3 (new@NatRC +0 []))) diff --git a/stdlib/test/test/lux/type.lux b/stdlib/test/test/lux/type.lux deleted file mode 100644 index 3953fcb5b..000000000 --- a/stdlib/test/test/lux/type.lux +++ /dev/null @@ -1,157 +0,0 @@ -(;module: - lux - (lux [io] - (control ["M" monad #+ do Monad] - pipe) - (data [text "Text/" Monoid] - text/format - [number] - [maybe] - (coll [list])) - ["r" math/random] - ["&" type]) - lux/test) - -## [Utils] -(def: gen-name - (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)) - -(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) - ))))) - -## [Tests] -(context: "Types" - [sample gen-type] - (test "Every type is equal to itself." - (:: &;Eq = sample sample))) - -(context: "Type application" - (test "Can apply quantified types (universal and existential quantification)." - (and (maybe;default false - (do maybe;Monad - [partial (&;apply (list Bool) Ann) - full (&;apply (list Int) partial)] - (wrap (:: &;Eq = full (#;Product Bool Int))))) - (|> (&;apply (list Bool) Text) - (case> #;None true _ false))))) - -(context: "Naming" - (let [base (#;Named ["" "a"] (#;Product Bool Int)) - aliased (#;Named ["" "c"] - (#;Named ["" "b"] - base))] - ($_ seq - (test "Can remove aliases from an already-named type." - (:: &;Eq = - base - (&;un-alias aliased))) - - (test "Can remove all names from a type." - (and (not (:: &;Eq = - base - (&;un-name aliased))) - (:: &;Eq = - (&;un-name base) - (&;un-name aliased))))))) - -(context: "Type construction [structs]" - [size (|> r;nat (:: @ map (n.% +3))) - members (|> gen-type - (r;filter (function [type] - (case type - (^or (#;Sum _) (#;Product _)) - false - - _ - true))) - (list;repeat size) - (M;seq @)) - #let [(^open "&/") &;Eq - (^open "L/") (list;Eq &;Eq)]] - (with-expansions - [ (do-template [ ] - [(test (format "Can build and tear-down " " types.") - (let [flat (|> members )] - (or (L/= members flat) - (and (L/= (list) members) - (L/= (list ) flat)))))] - - ["variant" &;variant &;flatten-variant Void] - ["tuple" &;tuple &;flatten-tuple Unit] - )] - ($_ seq - - ))) - -(context: "Type construction [parameterized]" - [size (|> r;nat (:: @ map (n.% +3))) - members (M;seq @ (list;repeat size gen-type)) - extra (|> gen-type - (r;filter (function [type] - (case type - (^or (#;Function _) (#;Apply _)) - false - - _ - true)))) - #let [(^open "&/") &;Eq - (^open "L/") (list;Eq &;Eq)]] - ($_ seq - (test "Can build and tear-down function types." - (let [[inputs output] (|> (&;function members extra) &;flatten-function)] - (and (L/= members inputs) - (&/= extra output)))) - - (test "Can build and tear-down application types." - (let [[tfunc tparams] (|> extra (&;application members) &;flatten-application)] - (n.= (list;size members) (list;size tparams)))) - )) - -(context: "Type construction [higher order]" - [size (|> r;nat (:: @ map (n.% +3))) - extra (|> gen-type - (r;filter (function [type] - (case type - (^or (#;UnivQ _) (#;ExQ _)) - false - - _ - true)))) - #let [(^open "&/") &;Eq]] - (with-expansions - [ (do-template [ ] - [(test (format "Can build and tear-down " " types.") - (let [[flat-size flat-body] (|> extra ( size) )] - (and (n.= size flat-size) - (&/= extra flat-body))))] - - ["universally-quantified" &;univ-q &;flatten-univ-q] - ["existentially-quantified" &;ex-q &;flatten-ex-q] - )] - ($_ seq - - ))) diff --git a/stdlib/test/test/lux/type/auto.lux b/stdlib/test/test/lux/type/auto.lux deleted file mode 100644 index 55e374c50..000000000 --- a/stdlib/test/test/lux/type/auto.lux +++ /dev/null @@ -1,39 +0,0 @@ -(;module: - lux - (lux [io] - (control [monad #+ do Monad] - functor - [eq]) - (data [text "Text/" Monoid] - text/format - [number] - [bool "B/" Eq] - maybe - (coll [list])) - ["r" math/random] - [type] - type/auto) - lux/test) - -(context: "Automatic structure selection" - [x r;nat - y r;nat] - ($_ seq - (test "Can automatically select first-order structures." - (let [(^open "L/") (list;Eq number;Eq)] - (and (B/= (:: number;Eq = x y) - (::: = x y)) - (L/= (list;n.range +1 +10) - (::: map n.inc (list;n.range +0 +9))) - ))) - - (test "Can automatically select second-order structures." - (::: = - (list;n.range +1 +10) - (list;n.range +1 +10))) - - (test "Can automatically select third-order structures." - (let [lln (::: map (list;n.range +1) - (list;n.range +1 +10))] - (::: = lln lln))) - )) diff --git a/stdlib/test/test/lux/type/check.lux b/stdlib/test/test/lux/type/check.lux deleted file mode 100644 index 67000157d..000000000 --- a/stdlib/test/test/lux/type/check.lux +++ /dev/null @@ -1,176 +0,0 @@ -(;module: - lux - (lux [io] - (control [monad #+ do Monad]) - (data [text "text/" Monoid Eq] - text/format - [number] - maybe - (coll [list])) - ["r" math/random] - [type] - ["@" type/check]) - lux/test) - -## [Utils] -(def: gen-name - (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)) - -(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) - ))))) - -(def: (valid-type? type) - (-> Type Bool) - (case type - (#;Host name params) - (list;every? valid-type? params) - - (^or #;Void #;Unit (#;Ex id)) - true - - (^template [] - ( left right) - (and (valid-type? left) (valid-type? right))) - ([#;Sum] [#;Product] [#;Function]) - - (#;Named name type') - (valid-type? type') - - _ - false)) - -(def: (type-checks? input) - (-> (@;Check []) Bool) - (case (@;run @;fresh-context input) - (#;Right []) - true - - (#;Left error) - false)) - -## [Tests] -(context: "Top and Bottom" - [sample (|> gen-type (r;filter valid-type?))] - ($_ seq - (test "Top is the super-type of everything." - (@;checks? Top sample)) - - (test "Bottom is the sub-type of everything." - (@;checks? sample Bottom)) - )) - -(context: "Simple type-checking." - ($_ seq - (test "Unit and Void match themselves." - (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)))))) - - (test "Names don't affect type-checking." - (and (type-checks? (do @;Monad - [[id ex] @;existential] - (@;check (#;Named ["module" "name"] ex) - 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) - (#;Named ["module" "name"] ex)))))) - - (test "Can type-check functions." - (and (@;checks? (#;Function Bottom Top) - (#;Function Top Bottom)) - (not (@;checks? (#;Function Top Bottom) - (#;Function Bottom Top))))) - )) - -(context: "Type application" - [meta gen-type - data gen-type] - (test "Can type-check type application." - (and (@;checks? (|> Ann (#;Apply meta) (#;Apply data)) - (type;tuple (list meta data))) - (@;checks? (type;tuple (list meta data)) - (|> Ann (#;Apply meta) (#;Apply data)))))) - -(context: "Host types" - [nameL gen-name - nameR (|> gen-name (r;filter (. not (text/= nameL)))) - paramL gen-type - 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)) - (#;Host nameL (list paramL)))) - - (test "Names matter to host types." - (not (@;checks? (#;Host nameL (list paramL)) - (#;Host nameR (list paramL))))) - - (test "Parameters matter to host types." - (not (@;checks? (#;Host nameL (list paramL)) - (#;Host nameL (list paramR))))) - )) - -(context: "Type-vars" - ($_ seq - (test "Type-vars check against themselves." - (type-checks? (@;with (function [[id 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)))))) - - (test "Can't rebind already bound type-vars." - (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 (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 (function [[id var]] - (do @;Monad - [_ (@;check var Bottom)] - (@;check #;Unit var)))))) - )) diff --git a/stdlib/test/test/lux/type/object.lux b/stdlib/test/test/lux/type/object.lux deleted file mode 100644 index c85ff5770..000000000 --- a/stdlib/test/test/lux/type/object.lux +++ /dev/null @@ -1,83 +0,0 @@ -(;module: - lux - (lux (data (coll [list])) - (type object))) - -## No parameters -(interface: Counter - (inc [] @) - (read [] Nat)) - -(class: NatC Counter - Nat - - (def: inc - (update@Counter n.inc)) - - (def: read - get@Counter)) - -(interface: Resettable-Counter - #super Counter - (reset [] @)) - -(class: NatRC Resettable-Counter - #super NatC - Unit - - (def: reset - (set@Counter +0))) - -## With parameters -(interface: (Collection a) - (add [a] @) - (size [] Nat)) - -(class: (ListC a) (Collection a) - (List a) - - (def: (add elem) - (update@Collection (|>. (#;Cons elem)))) - - (def: size - (|>. get@Collection list;size))) - -(interface: (Iterable a) - #super (Collection a) - (enumerate [] (List a))) - -(class: (ListI a) (Iterable a) - #super (ListC a) - Unit - - (def: enumerate - get@Collection)) - -## Polymorphism -(def: (poly0 counter) - (-> Counter Nat) - (read counter)) - -(def: poly0-0 Nat (poly0 (new@NatC +0))) -(def: poly0-1 Nat (poly0 (new@NatRC +0 []))) - -(def: (poly1 counter) - (-> Resettable-Counter Nat) - (n.+ (read counter) - (read (reset counter)))) - -(def: poly1-0 Nat (poly1 (new@NatRC +0 []))) - -(def: (poly2 counter) - (-> NatC Nat) - (read counter)) - -(def: poly2-0 Nat (poly2 (new@NatC +0))) -(def: poly2-1 Nat (poly2 (new@NatRC +0 []))) - -(def: (poly3 counter) - (-> NatRC Nat) - (n.+ (read counter) - (read (reset counter)))) - -(def: poly3-0 Nat (poly3 (new@NatRC +0 []))) diff --git a/stdlib/test/tests.lux b/stdlib/test/tests.lux index 8d20ef379..aa816c4d3 100644 --- a/stdlib/test/tests.lux +++ b/stdlib/test/tests.lux @@ -62,14 +62,14 @@ (math ["_;" random] (logic ["_;" continuous] ["_;" fuzzy])) - (macro ["_;" code] - ["_;" syntax] - (poly ["poly_;" eq] - ["poly_;" functor])) - ["_;" type] - (type ["_;" check] - ["_;" auto] - ["_;" object]) + (meta ["_;" code] + ["_;" syntax] + (poly ["poly_;" eq] + ["poly_;" functor]) + ["_;" type] + (type ["_;" check] + ["_;" auto] + ["_;" object])) (world ["_;" blob] ["_;" file] (net ["_;" tcp] @@ -86,9 +86,9 @@ [html] [css]) (coll (tree ["tree_;" parser]))) - [macro] (math [random]) - (type [unit]) + [meta] + (meta (type [unit])) [world/env]) ) -- cgit v1.2.3