diff options
Diffstat (limited to '')
25 files changed, 417 insertions, 372 deletions
diff --git a/luxc/src/lux/analyser.clj b/luxc/src/lux/analyser.clj index 4522b9aea..abdd0acd7 100644 --- a/luxc/src/lux/analyser.clj +++ b/luxc/src/lux/analyser.clj @@ -182,8 +182,9 @@ (&&common/analyse-proc analyse exo-type ?procedure parameters)))) (&/$Nat idx) - (&/with-analysis-meta cursor exo-type - (&&lux/analyse-variant analyse (&/$Right exo-type) idx nil parameters)) + (|let [(&/$Cons [_ (&/$Bit ?right)] parameters*) parameters] + (&/with-analysis-meta cursor exo-type + (&&lux/analyse-variant analyse (&/$Right exo-type) (if ?right (inc idx) idx) ?right parameters*))) (&/$Tag ?ident) (&/with-analysis-meta cursor exo-type diff --git a/luxc/src/lux/analyser/case.clj b/luxc/src/lux/analyser/case.clj index 4d7b4ccca..d059ce189 100644 --- a/luxc/src/lux/analyser/case.clj +++ b/luxc/src/lux/analyser/case.clj @@ -360,15 +360,16 @@ [=test =kont] (analyse-pattern &/$None case-type unit-tuple kont)] (return (&/T [($VariantTestAC (&/T [idx (&/|length group) =test])) =kont]))) - (&/$Form (&/$Cons [_ (&/$Nat idx)] ?values)) - (|do [value-type* (adjust-type value-type) - case-type (&type/sum-at idx value-type*) - [=test =kont] (case (int (&/|length ?values)) - 0 (analyse-pattern &/$None case-type unit-tuple kont) - 1 (analyse-pattern &/$None case-type (&/|head ?values) kont) - ;; 1+ - (analyse-pattern &/$None case-type (&/T [(&/T ["" -1 -1]) (&/$Tuple ?values)]) kont))] - (return (&/T [($VariantTestAC (&/T [idx (&/|length (&type/flatten-sum value-type*)) =test])) =kont]))) + (&/$Form (&/$Cons [_ (&/$Nat idx)] (&/$Cons [_ (&/$Bit right?)] ?values))) + (let [idx (if right? (inc idx) idx)] + (|do [value-type* (adjust-type value-type) + case-type (&type/sum-at idx value-type*) + [=test =kont] (case (int (&/|length ?values)) + 0 (analyse-pattern &/$None case-type unit-tuple kont) + 1 (analyse-pattern &/$None case-type (&/|head ?values) kont) + ;; 1+ + (analyse-pattern &/$None case-type (&/T [(&/T ["" -1 -1]) (&/$Tuple ?values)]) kont))] + (return (&/T [($VariantTestAC (&/T [idx (&/|length (&type/flatten-sum value-type*)) =test])) =kont])))) (&/$Form (&/$Cons [_ (&/$Tag ?ident)] ?values)) (|do [[=module =name] (&&/resolved-ident ?ident) diff --git a/luxc/src/lux/analyser/lux.clj b/luxc/src/lux/analyser/lux.clj index fee56b624..eb47ac039 100644 --- a/luxc/src/lux/analyser/lux.clj +++ b/luxc/src/lux/analyser/lux.clj @@ -213,15 +213,11 @@ (|case exo-type* (&/$Sum _) (|do [vtype (&type/sum-at idx exo-type*) - :let [num-variant-types (&/|length (&type/flatten-sum exo-type*)) - is-last?* (if (nil? is-last?) - (= idx (dec num-variant-types)) - is-last?)] =value (analyse-variant-body analyse vtype ?values) _cursor &/cursor] - (if (= 1 num-variant-types) + (if (= 1 (&/|length (&type/flatten-sum exo-type*))) (return (&/|list =value)) - (return (&/|list (&&/|meta exo-type _cursor (&&/$variant idx is-last?* =value)))) + (return (&/|list (&&/|meta exo-type _cursor (&&/$variant idx is-last? =value)))) )) (&/$UnivQ _) diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index e375c7ed5..d6fa1c40a 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -1,172 +1,172 @@ ("lux def" dummy-cursor ["" 0 0] - [["" 0 0] (10 (0))] + [["" 0 0] (9 #1 (0 #0))] #1) ("lux def" double-quote ("lux i64 char" +34) - [dummy-cursor (10 (0))] + [dummy-cursor (9 #1 (0 #0))] #0) ("lux def" new-line ("lux i64 char" +10) - [dummy-cursor (10 (0))] + [dummy-cursor (9 #1 (0 #0))] #0) ("lux def" __paragraph ("lux text concat" new-line new-line) - [dummy-cursor (10 (0))] + [dummy-cursor (9 #1 (0 #0))] #0) ## (type: Any ## (Ex [a] a)) ("lux def" Any ("lux check type" - (10 ["lux" "Any"] - (8 (0) (4 1)))) + (9 #1 ["lux" "Any"] + (8 #0 (0 #0) (4 #0 1)))) [dummy-cursor - (10 (1 [[dummy-cursor (7 ["lux" "doc"])] - [dummy-cursor (5 ("lux text concat" - ("lux text concat" "The type of things whose type is irrelevant." __paragraph) - "It can be used to write functions or data-structures that can take, or return, anything."))]] - (0)))] + (9 #1 (0 #1 [[dummy-cursor (7 #0 ["lux" "doc"])] + [dummy-cursor (5 #0 ("lux text concat" + ("lux text concat" "The type of things whose type is irrelevant." __paragraph) + "It can be used to write functions or data-structures that can take, or return, anything."))]] + (0 #0)))] #1) ## (type: Nothing ## (All [a] a)) ("lux def" Nothing ("lux check type" - (10 ["lux" "Nothing"] - (7 (0) (4 1)))) + (9 #1 ["lux" "Nothing"] + (7 #0 (0 #0) (4 #0 1)))) [dummy-cursor - (10 (1 [[dummy-cursor (7 ["lux" "doc"])] - [dummy-cursor (5 ("lux text concat" - ("lux text concat" "The type of things whose type is undefined." __paragraph) - "Useful for expressions that cause errors or other 'extraordinary' conditions."))]] - (0)))] + (9 #1 (0 #1 [[dummy-cursor (7 #0 ["lux" "doc"])] + [dummy-cursor (5 #0 ("lux text concat" + ("lux text concat" "The type of things whose type is undefined." __paragraph) + "Useful for expressions that cause errors or other 'extraordinary' conditions."))]] + (0 #0)))] #1) ## (type: (List a) ## #Nil ## (#Cons a (List a))) ("lux def type tagged" List - (10 ["lux" "List"] - (7 (0) - (1 ## "lux.Nil" - Any - ## "lux.Cons" - (2 (4 1) - (9 (4 1) (4 0)))))) + (9 #1 ["lux" "List"] + (7 #0 (0 #0) + (1 #0 ## "lux.Nil" + Any + ## "lux.Cons" + (2 #0 (4 #0 1) + (9 #0 (4 #0 1) (4 #0 0)))))) [dummy-cursor - (10 (1 [[dummy-cursor (7 ["lux" "type-args"])] - [dummy-cursor (9 (1 [dummy-cursor (5 "a")] (0)))]] - (1 [[dummy-cursor (7 ["lux" "doc"])] - [dummy-cursor (5 "A potentially empty list of values.")]] - (0))))] + (9 #1 (0 #1 [[dummy-cursor (7 #0 ["lux" "type-args"])] + [dummy-cursor (9 #0 (0 #1 [dummy-cursor (5 #0 "a")] (0 #0)))]] + (0 #1 [[dummy-cursor (7 #0 ["lux" "doc"])] + [dummy-cursor (5 #0 "A potentially empty list of values.")]] + (0 #0))))] ["Nil" "Cons"] #1) ("lux def" Bit ("lux check type" - (10 ["lux" "Bit"] - (0 "#Bit" #Nil))) + (9 #1 ["lux" "Bit"] + (0 #0 "#Bit" #Nil))) [dummy-cursor - (10 (#Cons [[dummy-cursor (7 ["lux" "doc"])] - [dummy-cursor (5 "Your standard, run-of-the-mill boolean values (as bits).")]] - #Nil))] + (9 #1 (#Cons [[dummy-cursor (7 #0 ["lux" "doc"])] + [dummy-cursor (5 #0 "Your standard, run-of-the-mill boolean values (as bits).")]] + #Nil))] #1) ("lux def" I64 ("lux check type" - (10 ["lux" "I64"] - (7 (0) - (0 "#I64" (#Cons (4 1) #Nil))))) + (9 #1 ["lux" "I64"] + (7 #0 (0 #0) + (0 #0 "#I64" (#Cons (4 #0 1) #Nil))))) [dummy-cursor - (10 (#Cons [[dummy-cursor (7 ["lux" "doc"])] - [dummy-cursor (5 "64-bit integers without any semantics.")]] - #Nil))] + (9 #1 (#Cons [[dummy-cursor (7 #0 ["lux" "doc"])] + [dummy-cursor (5 #0 "64-bit integers without any semantics.")]] + #Nil))] #1) ("lux def" Nat ("lux check type" - (10 ["lux" "Nat"] - (0 "#I64" (#Cons (0 "#Nat" #Nil) #Nil)))) + (9 #1 ["lux" "Nat"] + (0 #0 "#I64" (#Cons (0 #0 "#Nat" #Nil) #Nil)))) [dummy-cursor - (10 (#Cons [[dummy-cursor (7 ["lux" "doc"])] - [dummy-cursor (5 ("lux text concat" - ("lux text concat" "Natural numbers (unsigned integers)." __paragraph) - "They start at zero (0) and extend in the positive direction."))]] - #Nil))] + (9 #1 (#Cons [[dummy-cursor (7 #0 ["lux" "doc"])] + [dummy-cursor (5 #0 ("lux text concat" + ("lux text concat" "Natural numbers (unsigned integers)." __paragraph) + "They start at zero (0) and extend in the positive direction."))]] + #Nil))] #1) ("lux def" Int ("lux check type" - (10 ["lux" "Int"] - (0 "#I64" (#Cons (0 "#Int" #Nil) #Nil)))) + (9 #1 ["lux" "Int"] + (0 #0 "#I64" (#Cons (0 #0 "#Int" #Nil) #Nil)))) [dummy-cursor - (10 (#Cons [[dummy-cursor (7 ["lux" "doc"])] - [dummy-cursor (5 "Your standard, run-of-the-mill integer numbers.")]] - #Nil))] + (9 #1 (#Cons [[dummy-cursor (7 #0 ["lux" "doc"])] + [dummy-cursor (5 #0 "Your standard, run-of-the-mill integer numbers.")]] + #Nil))] #1) ("lux def" Rev ("lux check type" - (10 ["lux" "Rev"] - (0 "#I64" (#Cons (0 "#Rev" #Nil) #Nil)))) + (9 #1 ["lux" "Rev"] + (0 #0 "#I64" (#Cons (0 #0 "#Rev" #Nil) #Nil)))) [dummy-cursor - (10 (#Cons [[dummy-cursor (7 ["lux" "doc"])] - [dummy-cursor (5 ("lux text concat" - ("lux text concat" "Fractional numbers that live in the interval [0,1)." __paragraph) - "Useful for probability, and other domains that work within that interval."))]] - #Nil))] + (9 #1 (#Cons [[dummy-cursor (7 #0 ["lux" "doc"])] + [dummy-cursor (5 #0 ("lux text concat" + ("lux text concat" "Fractional numbers that live in the interval [0,1)." __paragraph) + "Useful for probability, and other domains that work within that interval."))]] + #Nil))] #1) ("lux def" Frac ("lux check type" - (10 ["lux" "Frac"] - (0 "#Frac" #Nil))) + (9 #1 ["lux" "Frac"] + (0 #0 "#Frac" #Nil))) [dummy-cursor - (10 (#Cons [[dummy-cursor (7 ["lux" "doc"])] - [dummy-cursor (5 "Your standard, run-of-the-mill floating-point (fractional) numbers.")]] - #Nil))] + (9 #1 (#Cons [[dummy-cursor (7 #0 ["lux" "doc"])] + [dummy-cursor (5 #0 "Your standard, run-of-the-mill floating-point (fractional) numbers.")]] + #Nil))] #1) ("lux def" Text ("lux check type" - (10 ["lux" "Text"] - (0 "#Text" #Nil))) + (9 #1 ["lux" "Text"] + (0 #0 "#Text" #Nil))) [dummy-cursor - (10 (#Cons [[dummy-cursor (7 ["lux" "doc"])] - [dummy-cursor (5 "Your standard, run-of-the-mill string values.")]] - #Nil))] + (9 #1 (#Cons [[dummy-cursor (7 #0 ["lux" "doc"])] + [dummy-cursor (5 #0 "Your standard, run-of-the-mill string values.")]] + #Nil))] #1) ("lux def" Name ("lux check type" - (10 ["lux" "Name"] - (2 Text Text))) + (9 #1 ["lux" "Name"] + (2 #0 Text Text))) [dummy-cursor - (10 (#Cons [[dummy-cursor (7 ["lux" "doc"])] - [dummy-cursor (5 "A name. It is used as part of Lux syntax to represent identifiers and tags.")]] - #Nil))] + (9 #1 (#Cons [[dummy-cursor (7 #0 ["lux" "doc"])] + [dummy-cursor (5 #0 "A name. It is used as part of Lux syntax to represent identifiers and tags.")]] + #Nil))] #1) ## (type: (Maybe a) ## #None ## (#Some a)) ("lux def type tagged" Maybe - (10 ["lux" "Maybe"] - (7 #Nil - (1 ## "lux.None" - Any - ## "lux.Some" - (4 1)))) + (9 #1 ["lux" "Maybe"] + (7 #0 #Nil + (1 #0 ## "lux.None" + Any + ## "lux.Some" + (4 #0 1)))) [dummy-cursor - (10 (#Cons [[dummy-cursor (7 ["lux" "type-args"])] - [dummy-cursor (9 (#Cons [dummy-cursor (5 "a")] #Nil))]] - (#Cons [[dummy-cursor (7 ["lux" "doc"])] - [dummy-cursor (5 "A potentially missing value.")]] - #Nil)))] + (9 #1 (#Cons [[dummy-cursor (7 #0 ["lux" "type-args"])] + [dummy-cursor (9 #0 (#Cons [dummy-cursor (5 #0 "a")] #Nil))]] + (#Cons [[dummy-cursor (7 #0 ["lux" "doc"])] + [dummy-cursor (5 #0 "A potentially missing value.")]] + #Nil)))] ["None" "Some"] #1) @@ -184,43 +184,43 @@ ## (#Named Name Type) ## ) ("lux def type tagged" Type - (10 ["lux" "Type"] - ({Type - ({Type-List - ({Type-Pair - (9 Nothing - (7 #Nil - (1 ## "lux.Primitive" - (2 Text Type-List) - (1 ## "lux.Sum" - Type-Pair - (1 ## "lux.Product" - Type-Pair - (1 ## "lux.Function" - Type-Pair - (1 ## "lux.Parameter" - Nat - (1 ## "lux.Var" - Nat - (1 ## "lux.Ex" - Nat - (1 ## "lux.UnivQ" - (2 Type-List Type) - (1 ## "lux.ExQ" - (2 Type-List Type) - (1 ## "lux.Apply" - Type-Pair - ## "lux.Named" - (2 Name Type)))))))))))))} - ("lux check type" (2 Type Type)))} - ("lux check type" (9 Type List)))} - ("lux check type" (9 (4 1) (4 0))))) + (9 #1 ["lux" "Type"] + ({Type + ({Type-List + ({Type-Pair + (9 #0 Nothing + (7 #0 #Nil + (1 #0 ## "lux.Primitive" + (2 #0 Text Type-List) + (1 #0 ## "lux.Sum" + Type-Pair + (1 #0 ## "lux.Product" + Type-Pair + (1 #0 ## "lux.Function" + Type-Pair + (1 #0 ## "lux.Parameter" + Nat + (1 #0 ## "lux.Var" + Nat + (1 #0 ## "lux.Ex" + Nat + (1 #0 ## "lux.UnivQ" + (2 #0 Type-List Type) + (1 #0 ## "lux.ExQ" + (2 #0 Type-List Type) + (1 #0 ## "lux.Apply" + Type-Pair + ## "lux.Named" + (2 #0 Name Type)))))))))))))} + ("lux check type" (2 #0 Type Type)))} + ("lux check type" (9 #0 Type List)))} + ("lux check type" (9 #0 (4 #0 1) (4 #0 0))))) [dummy-cursor - (10 (#Cons [[dummy-cursor (7 ["lux" "doc"])] - [dummy-cursor (5 "This type represents the data-structures that are used to specify types themselves.")]] - (#Cons [[dummy-cursor (7 ["lux" "type-rec?"])] - [dummy-cursor (0 #1)]] - #Nil)))] + (9 #1 (#Cons [[dummy-cursor (7 #0 ["lux" "doc"])] + [dummy-cursor (5 #0 "This type represents the data-structures that are used to specify types themselves.")]] + (#Cons [[dummy-cursor (7 #0 ["lux" "type-rec?"])] + [dummy-cursor (0 #0 #1)]] + #Nil)))] ["Primitive" "Sum" "Product" "Function" "Parameter" "Var" "Ex" "UnivQ" "ExQ" "Apply" "Named"] #1) @@ -232,9 +232,9 @@ (#Named ["lux" "Cursor"] (#Product Text (#Product Nat Nat))) [dummy-cursor - (10 (#Cons [[dummy-cursor (7 ["lux" "doc"])] - [dummy-cursor (5 "Cursors are for specifying the location of Code nodes in Lux files during compilation.")]] - #Nil))] + (9 #1 (#Cons [[dummy-cursor (7 #0 ["lux" "doc"])] + [dummy-cursor (5 #0 "Cursors are for specifying the location of Code nodes in Lux files during compilation.")]] + #Nil))] ["module" "line" "column"] #1) @@ -248,11 +248,11 @@ (#Product (#Parameter 3) (#Parameter 1))))) [dummy-cursor - (10 (#Cons [[dummy-cursor (7 ["lux" "doc"])] - [dummy-cursor (5 "The type of things that can be annotated with meta-data of arbitrary types.")]] - (#Cons [[dummy-cursor (7 ["lux" "type-args"])] - [dummy-cursor (9 (#Cons [dummy-cursor (5 "m")] (#Cons [dummy-cursor (5 "v")] #Nil)))]] - #Nil)))] + (9 #1 (#Cons [[dummy-cursor (7 #0 ["lux" "doc"])] + [dummy-cursor (5 #0 "The type of things that can be annotated with meta-data of arbitrary types.")]] + (#Cons [[dummy-cursor (7 #0 ["lux" "type-args"])] + [dummy-cursor (9 #0 (#Cons [dummy-cursor (5 #0 "m")] (#Cons [dummy-cursor (5 #0 "v")] #Nil)))]] + #Nil)))] ["meta" "datum"] #1) @@ -302,9 +302,9 @@ (#Parameter 0)) (#Parameter 1))))) [dummy-cursor - (10 (#Cons [[dummy-cursor (7 ["lux" "type-args"])] - [dummy-cursor (9 (#Cons [dummy-cursor (5 "w")] #Nil))]] - #Nil))] + (9 #1 (#Cons [[dummy-cursor (7 #0 ["lux" "type-args"])] + [dummy-cursor (9 #0 (#Cons [dummy-cursor (5 #0 "w")] #Nil))]] + #Nil))] ["Bit" "Nat" "Int" "Rev" "Frac" "Text" "Identifier" "Tag" "Form" "Tuple" "Record"] #1) diff --git a/stdlib/source/lux/abstract/enum.lux b/stdlib/source/lux/abstract/enum.lux index 9f074f7c5..9470cd142 100644 --- a/stdlib/source/lux/abstract/enum.lux +++ b/stdlib/source/lux/abstract/enum.lux @@ -12,10 +12,14 @@ (def: #export (range enum from to) {#.doc "An inclusive [from, to] range of values."} (All [a] (-> (Enum a) a a (List a))) - (let [(^open "/@.") enum - <= (order.<= /@&order)] + (let [(^open "/@.") enum] (loop [end to output #.Nil] - (if (<= end from) - (recur (/@pred end) (#.Cons end output)) - output)))) + (cond (/@< end from) + (recur (/@pred end) (#.Cons end output)) + + (/@= end from) + (#.Cons end output) + + ## else + output)))) diff --git a/stdlib/source/lux/control/concatenative.lux b/stdlib/source/lux/control/concatenative.lux index 48c7cf2eb..1ba47f1af 100644 --- a/stdlib/source/lux/control/concatenative.lux +++ b/stdlib/source/lux/control/concatenative.lux @@ -176,12 +176,12 @@ (def: #export ||L (All [a b] (=> [a] [(| a b)])) (function (_ [stack l]) - [stack (0 l)])) + [stack (0 #0 l)])) (def: #export ||R (All [a b] (=> [b] [(| a b)])) (function (_ [stack r]) - [stack (1 r)])) + [stack (0 #1 r)])) (template [<input> <output> <word> <func>] [(def: #export <word> diff --git a/stdlib/source/lux/control/parser.lux b/stdlib/source/lux/control/parser.lux index 9b1d75cd1..ac01d0735 100644 --- a/stdlib/source/lux/control/parser.lux +++ b/stdlib/source/lux/control/parser.lux @@ -131,12 +131,12 @@ (function (_ tokens) (case (p1 tokens) (#try.Success [tokens' x1]) - (#try.Success [tokens' (0 x1)]) + (#try.Success [tokens' (0 #0 x1)]) (#try.Failure _) (run (do ..monad [x2 p2] - (wrap (1 x2))) + (wrap (0 #1 x2))) tokens) ))) diff --git a/stdlib/source/lux/data/collection/list.lux b/stdlib/source/lux/data/collection/list.lux index 9debb89eb..ce0d8f031 100644 --- a/stdlib/source/lux/data/collection/list.lux +++ b/stdlib/source/lux/data/collection/list.lux @@ -362,15 +362,16 @@ [(def: #export (<name> from to) {#.doc "Generates an inclusive interval of values [from, to]."} (-> <type> <type> (List <type>)) - (cond (<lt> to from) - (#.Cons from (<name> (inc from) to)) + (loop [end to + output #.Nil] + (cond (<lt> end from) + (recur (dec end) (#.Cons end output)) - ## > GT - (<lt> from to) - (#.Cons from (<name> (dec from) to)) + ("lux i64 =" end from) + (#.Cons end output) - ## (= to from) - (list from)))] + ## else + output)))] [i/range Int "lux i64 <"] [n/range Nat n.<] diff --git a/stdlib/source/lux/data/number/rev.lux b/stdlib/source/lux/data/number/rev.lux index b12a6f314..881043013 100644 --- a/stdlib/source/lux/data/number/rev.lux +++ b/stdlib/source/lux/data/number/rev.lux @@ -28,14 +28,14 @@ (def: #export (< reference sample) {#.doc "Rev(olution) less-than."} (-> Rev Rev Bit) - (//nat.< ("lux coerce" Nat reference) - ("lux coerce" Nat sample))) + (//nat.< (:coerce Nat reference) + (:coerce Nat sample))) (def: #export (<= reference sample) {#.doc "Rev(olution) less-than-equal."} (-> Rev Rev Bit) - (if (//nat.< ("lux coerce" Nat reference) - ("lux coerce" Nat sample)) + (if (//nat.< (:coerce Nat reference) + (:coerce Nat sample)) #1 ("lux i64 =" reference sample))) @@ -126,8 +126,8 @@ shift ("lux i64 -" trailing-zeroes 64) numerator ("lux i64 left-shift" shift 1)] (|> (:coerce Int numerator) - ("lux i64 /" ("lux coerce" Int denominator)) - ("lux i64 *" ("lux coerce" Int subject)) + ("lux i64 /" (:coerce Int denominator)) + ("lux i64 *" (:coerce Int subject)) (:coerce Rev))))) (def: #export (% param subject) @@ -141,7 +141,7 @@ {#.doc "Rev(olution) scale."} (-> Nat Rev Rev) (|> (:coerce Int subject) - ("lux i64 *" ("lux coerce" Int param)) + ("lux i64 *" (:coerce Int param)) (:coerce Rev))) (def: #export (reciprocal numerator) diff --git a/stdlib/source/lux/data/sum.lux b/stdlib/source/lux/data/sum.lux index 5b7dc5a61..a40aa4619 100644 --- a/stdlib/source/lux/data/sum.lux +++ b/stdlib/source/lux/data/sum.lux @@ -4,13 +4,13 @@ [abstract [equivalence (#+ Equivalence)]]]) -(template [<name> <type> <index>] +(template [<name> <type> <right?>] [(def: #export (<name> value) (All [a b] (-> <type> (| a b))) - (<index> value))] + (0 <right?> value))] - [left a 0] - [right b 1]) + [left a #0] + [right b #1]) (def: #export (either fl fr) (All [a b c] @@ -18,8 +18,8 @@ (-> (| a b) c))) (function (_ input) (case input - (0 l) (fl l) - (1 r) (fr r)))) + (0 #0 l) (fl l) + (0 #1 r) (fr r)))) (def: #export (each fl fr) (All [l l' r r'] @@ -27,19 +27,24 @@ (-> (| l r) (| l' r')))) (function (_ input) (case input - (0 l) (0 (fl l)) - (1 r) (1 (fr r))))) + (0 #0 l) (0 #0 (fl l)) + (0 #1 r) (0 #1 (fr r))))) -(template [<name> <side> <tag>] +(template [<name> <side> <right?>] [(def: #export (<name> es) (All [a b] (-> (List (| a b)) (List <side>))) (case es - #.Nil #.Nil - (#.Cons (<tag> x) es') (#.Cons [x (<name> es')]) - (#.Cons _ es') (<name> es')))] + #.Nil + #.Nil + + (#.Cons (0 <right?> x) es') + (#.Cons [x (<name> es')]) + + (#.Cons _ es') + (<name> es')))] - [lefts a 0] - [rights b 1] + [lefts a #0] + [rights b #1] ) (def: #export (partition xs) @@ -51,8 +56,8 @@ (#.Cons x xs') (let [[lefts rights] (partition xs')] (case x - (0 x') [(#.Cons x' lefts) rights] - (1 x') [lefts (#.Cons x' rights)])))) + (0 #0 x') [(#.Cons x' lefts) rights] + (0 #1 x') [lefts (#.Cons x' rights)])))) (structure: #export (equivalence l@= r@=) (All [l r] diff --git a/stdlib/source/lux/data/text/regex.lux b/stdlib/source/lux/data/text/regex.lux index af99c6f90..1777c2cac 100644 --- a/stdlib/source/lux/data/text/regex.lux +++ b/stdlib/source/lux/data/text/regex.lux @@ -322,12 +322,12 @@ (function (_ input) (case (left input) (#try.Success [input' [lt lv]]) - (#try.Success [input' [lt (0 lv)]]) + (#try.Success [input' [lt (0 #0 lv)]]) (#try.Failure _) (case (right input) (#try.Success [input' [rt rv]]) - (#try.Success [input' [rt (1 rv)]]) + (#try.Success [input' [rt (0 #1 rv)]]) (#try.Failure error) (#try.Failure error))))) diff --git a/stdlib/source/lux/math/random.lux b/stdlib/source/lux/math/random.lux index 744a94a89..4e94ba5bb 100644 --- a/stdlib/source/lux/math/random.lux +++ b/stdlib/source/lux/math/random.lux @@ -201,10 +201,10 @@ (if ? (do @ [=left left] - (wrap (0 =left))) + (wrap (0 #0 =left))) (do @ [=right right] - (wrap (1 =right)))))) + (wrap (0 #1 =right)))))) (def: #export (either left right) {#.doc "Homogeneous alternative combinator."} diff --git a/stdlib/source/lux/tool/compiler/language/lux/analysis.lux b/stdlib/source/lux/tool/compiler/language/lux/analysis.lux index f3dc89993..297fc7075 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/analysis.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/analysis.lux @@ -47,6 +47,24 @@ #right? Bit #value a}) +(def: #export (tag lefts right?) + (-> Nat Bit Nat) + (if right? + (inc lefts) + lefts)) + +(def: (lefts tag right?) + (-> Nat Bit Nat) + (if right? + (dec tag) + tag)) + +(def: #export (choice options pick) + (-> Nat Nat [Nat Bit]) + (let [right? (n.= (dec options) pick)] + [(..lefts pick right?) + right?])) + (type: #export (Tuple a) (List a)) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis.lux index 21a2b4d3f..8ca459028 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis.lux @@ -54,17 +54,23 @@ (def: (compile|structure archive compile else code') (-> Archive Phase (Fix (-> (Code' (Ann Cursor)) (Operation Analysis)))) (case code' - (^template [<tag> <analyser>] - (^ (#.Form (list& [_ (<tag> tag)] - values))) - (case values - (#.Cons value #.Nil) - (<analyser> compile tag archive value) - - _ - (<analyser> compile tag archive (` [(~+ values)])))) - ([#.Nat /structure.sum] - [#.Tag /structure.tagged-sum]) + (^ (#.Form (list& [_ (#.Tag tag)] + values))) + (case values + (#.Cons value #.Nil) + (/structure.tagged-sum compile tag archive value) + + _ + (/structure.tagged-sum compile tag archive (` [(~+ values)]))) + + (^ (#.Form (list& [_ (#.Nat lefts)] [_ (#.Bit right?)] + values))) + (case values + (#.Cons value #.Nil) + (/structure.sum compile lefts right? archive value) + + _ + (/structure.sum compile lefts right? archive (` [(~+ values)]))) (#.Tag tag) (/structure.tagged-sum compile tag archive (' [])) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/case.lux index 4638c33d9..01afd6142 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/case.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/case.lux @@ -84,7 +84,7 @@ (recur envs caseT') _ - (/.throw cannot-simplify-for-pattern-matching caseT))) + (/.throw ..cannot-simplify-for-pattern-matching caseT))) (#.Named name unnamedT) (recur envs unnamedT) @@ -119,7 +119,7 @@ (recur envs outputT) #.None - (/.throw cannot-simplify-for-pattern-matching caseT))) + (/.throw ..cannot-simplify-for-pattern-matching caseT))) (#.Product _) (|> caseT @@ -219,7 +219,7 @@ thenA]))) _ - (/.throw cannot-match-with-pattern [inputT' pattern]) + (/.throw ..cannot-match-with-pattern [inputT' pattern]) ))) [cursor (#.Record record)] @@ -239,7 +239,7 @@ (/.with-cursor cursor (analyse-pattern #.None inputT (` ((~ pattern))) next)) - (^ [cursor (#.Form (list& [_ (#.Nat idx)] values))]) + (^ [cursor (#.Form (list& [_ (#.Nat lefts)] [_ (#.Bit right?)] values))]) (/.with-cursor cursor (do ///.monad [inputT' (simplify-case inputT)] @@ -247,7 +247,8 @@ (#.Sum _) (let [flat-sum (type.flatten-variant inputT') size-sum (list.size flat-sum) - num-cases (maybe.default size-sum num-tags)] + num-cases (maybe.default size-sum num-tags) + idx (/.tag lefts right?)] (.case (list.nth idx flat-sum) (^multi (#.Some caseT) (n.< num-cases idx)) @@ -258,16 +259,12 @@ (type.variant (list.drop (dec num-cases) flat-sum)) (` [(~+ values)]) next) - (analyse-pattern #.None caseT (` [(~+ values)]) next)) - #let [right? (n.= (dec num-cases) idx) - lefts (if right? - (dec idx) - idx)]] + (analyse-pattern #.None caseT (` [(~+ values)]) next))] (wrap [(/.pattern/variant [lefts right? testP]) nextA])) _ - (/.throw sum-has-no-case [idx inputT]))) + (/.throw ..sum-has-no-case [idx inputT]))) (#.UnivQ _) (do ///.monad @@ -279,7 +276,7 @@ next)) _ - (/.throw cannot-match-with-pattern [inputT' pattern])))) + (/.throw ..cannot-match-with-pattern [inputT' pattern])))) (^ [cursor (#.Form (list& [_ (#.Tag tag)] values))]) (/.with-cursor cursor @@ -287,11 +284,12 @@ [tag (///extension.lift (macro.normalize tag)) [idx group variantT] (///extension.lift (macro.resolve-tag tag)) _ (//type.with-env - (check.check inputT variantT))] - (analyse-pattern (#.Some (list.size group)) inputT (` ((~ (code.nat idx)) (~+ values))) next))) + (check.check inputT variantT)) + #let [[lefts right?] (/.choice (list.size group) idx)]] + (analyse-pattern (#.Some (list.size group)) inputT (` ((~ (code.nat lefts)) (~ (code.bit right?)) (~+ values))) next))) _ - (/.throw not-a-pattern pattern) + (/.throw ..not-a-pattern pattern) )) (def: #export (case analyse branches archive inputC) @@ -318,4 +316,4 @@ (wrap (#/.Case inputA [outputH outputT]))) #.Nil - (/.throw cannot-have-empty-branches ""))) + (/.throw ..cannot-have-empty-branches ""))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/inference.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/inference.lux index 095120ac5..f4bae0122 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/inference.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/inference.lux @@ -145,7 +145,7 @@ (general archive analyse outputT args) #.None - (/.throw invalid-type-application inferT)) + (/.throw ..invalid-type-application inferT)) ## Arguments are inferred back-to-front because, by convention, ## Lux functions take the most important arguments *last*, which @@ -170,10 +170,10 @@ (general archive analyse inferT' args) _ - (/.throw cannot-infer [inferT args]))) + (/.throw ..cannot-infer [inferT args]))) _ - (/.throw cannot-infer [inferT args])) + (/.throw ..cannot-infer [inferT args])) )) (def: (substitute-bound target sub) @@ -222,7 +222,7 @@ (record' target originalT outputT) #.None - (/.throw invalid-type-application inferT)) + (/.throw ..invalid-type-application inferT)) (#.Product _) (///@wrap (|> inferT @@ -230,7 +230,7 @@ (substitute-bound target originalT))) _ - (/.throw not-a-record-type inferT))) + (/.throw ..not-a-record-type inferT))) (def: #export (record inferT) (-> Type (Operation Type)) @@ -271,10 +271,10 @@ (replace' currentT))))) #.None - (/.throw variant-tag-out-of-bounds [expected-size tag inferT])) + (/.throw ..variant-tag-out-of-bounds [expected-size tag inferT])) (n.< expected-size actual-size) - (/.throw smaller-variant-than-expected [expected-size actual-size]) + (/.throw ..smaller-variant-than-expected [expected-size actual-size]) (n.= boundary tag) (let [caseT (type.variant (list.drop boundary cases))] @@ -285,7 +285,7 @@ (replace' currentT)))))) ## else - (/.throw variant-tag-out-of-bounds [expected-size tag inferT]))) + (/.throw ..variant-tag-out-of-bounds [expected-size tag inferT]))) (#.Apply inputT funcT) (case (type.apply (list inputT) funcT) @@ -293,7 +293,7 @@ (variant tag expected-size outputT) #.None - (/.throw invalid-type-application inferT)) + (/.throw ..invalid-type-application inferT)) _ - (/.throw not-a-variant-type inferT)))) + (/.throw ..not-a-variant-type inferT)))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/structure.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/structure.lux index 7201a68ee..68da1dd68 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/structure.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/structure.lux @@ -87,86 +87,80 @@ [(code.tag keyI) valueC])) code.record))])) -(def: #export (sum analyse tag archive) - (-> Phase Nat Phase) - (function (recur valueC) - (do {@ ///.monad} - [expectedT (///extension.lift macro.expected-type) - expectedT' (//type.with-env - (check.clean expectedT))] - (/.with-stack ..cannot-analyse-variant [expectedT' tag valueC] - (case expectedT - (#.Sum _) - (let [flat (type.flatten-variant expectedT) - type-size (list.size flat) - right? (n.= (dec type-size) - tag) - lefts (if right? - (dec tag) - tag)] - (case (list.nth tag flat) - (#.Some variant-type) - (do @ - [valueA (//type.with-type variant-type - (analyse archive valueC))] - (wrap (/.variant [lefts right? valueA]))) +(def: #export (sum analyse lefts right? archive) + (-> Phase Nat Bit Phase) + (let [tag (/.tag lefts right?)] + (function (recur valueC) + (do {@ ///.monad} + [expectedT (///extension.lift macro.expected-type) + expectedT' (//type.with-env + (check.clean expectedT))] + (/.with-stack ..cannot-analyse-variant [expectedT' tag valueC] + (case expectedT + (#.Sum _) + (let [flat (type.flatten-variant expectedT)] + (case (list.nth tag flat) + (#.Some variant-type) + (do @ + [valueA (//type.with-type variant-type + (analyse archive valueC))] + (wrap (/.variant [lefts right? valueA]))) + + #.None + (/.throw //inference.variant-tag-out-of-bounds [(list.size flat) tag expectedT]))) + + (#.Named name unnamedT) + (//type.with-type unnamedT + (recur valueC)) + + (#.Var id) + (do @ + [?expectedT' (//type.with-env + (check.read id))] + (case ?expectedT' + (#.Some expectedT') + (//type.with-type expectedT' + (recur valueC)) - #.None - (/.throw //inference.variant-tag-out-of-bounds [type-size tag expectedT]))) + ## Cannot do inference when the tag is numeric. + ## This is because there is no way of knowing how many + ## cases the inferred sum type would have. + _ + (/.throw ..cannot-infer-numeric-tag [expectedT tag valueC]))) - (#.Named name unnamedT) - (//type.with-type unnamedT - (recur valueC)) + (^template [<tag> <instancer>] + (<tag> _) + (do @ + [[instance-id instanceT] (//type.with-env <instancer>)] + (//type.with-type (maybe.assume (type.apply (list instanceT) expectedT)) + (recur valueC)))) + ([#.UnivQ check.existential] + [#.ExQ check.var]) + + (#.Apply inputT funT) + (case funT + (#.Var funT-id) + (do @ + [?funT' (//type.with-env (check.read funT-id))] + (case ?funT' + (#.Some funT') + (//type.with-type (#.Apply inputT funT') + (recur valueC)) - (#.Var id) - (do @ - [?expectedT' (//type.with-env - (check.read id))] - (case ?expectedT' - (#.Some expectedT') - (//type.with-type expectedT' - (recur valueC)) + _ + (/.throw ..invalid-variant-type [expectedT tag valueC]))) _ - ## Cannot do inference when the tag is numeric. - ## This is because there is no way of knowing how many - ## cases the inferred sum type would have. - (/.throw cannot-infer-numeric-tag [expectedT tag valueC]) - )) - - (^template [<tag> <instancer>] - (<tag> _) - (do @ - [[instance-id instanceT] (//type.with-env <instancer>)] - (//type.with-type (maybe.assume (type.apply (list instanceT) expectedT)) - (recur valueC)))) - ([#.UnivQ check.existential] - [#.ExQ check.var]) - - (#.Apply inputT funT) - (case funT - (#.Var funT-id) - (do @ - [?funT' (//type.with-env (check.read funT-id))] - (case ?funT' - (#.Some funT') - (//type.with-type (#.Apply inputT funT') + (case (type.apply (list inputT) funT) + (#.Some outputT) + (//type.with-type outputT (recur valueC)) - _ - (/.throw invalid-variant-type [expectedT tag valueC]))) - + #.None + (/.throw ..not-a-quantified-type funT))) + _ - (case (type.apply (list inputT) funT) - (#.Some outputT) - (//type.with-type outputT - (recur valueC)) - - #.None - (/.throw not-a-quantified-type funT))) - - _ - (/.throw invalid-variant-type [expectedT tag valueC])))))) + (/.throw ..invalid-variant-type [expectedT tag valueC]))))))) (def: (typed-product archive analyse members) (-> Archive Phase (List Code) (Operation Analysis)) @@ -192,7 +186,7 @@ (wrap (#.Cons memberA memberA+))) _ - (/.throw cannot-analyse-tuple [expectedT members]))))] + (/.throw ..cannot-analyse-tuple [expectedT members]))))] (wrap (/.tuple membersA+)))) (def: #export (product archive analyse membersC) @@ -247,7 +241,7 @@ (product archive analyse membersC)) _ - (/.throw invalid-tuple-type [expectedT membersC]))) + (/.throw ..invalid-tuple-type [expectedT membersC]))) _ (case (type.apply (list inputT) funT) @@ -256,10 +250,10 @@ (product archive analyse membersC)) #.None - (/.throw not-a-quantified-type funT))) + (/.throw ..not-a-quantified-type funT))) _ - (/.throw invalid-tuple-type [expectedT membersC]) + (/.throw ..invalid-tuple-type [expectedT membersC]) )))) (def: #export (tagged-sum analyse tag archive valueC) @@ -267,21 +261,18 @@ (do {@ ///.monad} [tag (///extension.lift (macro.normalize tag)) [idx group variantT] (///extension.lift (macro.resolve-tag tag)) + #let [case-size (list.size group) + [lefts right?] (/.choice case-size idx)] expectedT (///extension.lift macro.expected-type)] (case expectedT (#.Var _) (do @ - [#let [case-size (list.size group)] - inferenceT (//inference.variant idx case-size variantT) - [inferredT valueA+] (//inference.general archive analyse inferenceT (list valueC)) - #let [right? (n.= (dec case-size) idx) - lefts (if right? - (dec idx) - idx)]] + [inferenceT (//inference.variant idx case-size variantT) + [inferredT valueA+] (//inference.general archive analyse inferenceT (list valueC))] (wrap (/.variant [lefts right? (|> valueA+ list.head maybe.assume)]))) _ - (..sum analyse idx archive valueC)))) + (..sum analyse lefts right? archive valueC)))) ## There cannot be any ambiguity or improper syntax when analysing ## records, so they must be normalized for further analysis. @@ -298,7 +289,7 @@ (wrap [key val])) _ - (/.throw record-keys-must-be-tags [key record]))) + (/.throw ..record-keys-must-be-tags [key record]))) record)) ## Lux already possesses the means to analyse tuples, so @@ -319,7 +310,7 @@ size-ts (list.size tag-set)] _ (if (n.= size-ts size-record) (wrap []) - (/.throw record-size-mismatch [size-ts size-record recordT record])) + (/.throw ..record-size-mismatch [size-ts size-record recordT record])) #let [tuple-range (list.indices size-ts) tag->idx (dictionary.from-list name.hash (list.zip2 tag-set tuple-range))] idx->val (monad.fold @ @@ -329,11 +320,11 @@ (case (dictionary.get key tag->idx) (#.Some idx) (if (dictionary.contains? idx idx->val) - (/.throw cannot-repeat-tag [key record]) + (/.throw ..cannot-repeat-tag [key record]) (wrap (dictionary.put idx val idx->val))) #.None - (/.throw tag-does-not-belong-to-record [key recordT])))) + (/.throw ..tag-does-not-belong-to-record [key recordT])))) (: (Dictionary Nat Code) (dictionary.new n.hash)) record) diff --git a/stdlib/source/poly/lux/abstract/equivalence.lux b/stdlib/source/poly/lux/abstract/equivalence.lux index 3ee6fb5c5..bb037c7cc 100644 --- a/stdlib/source/poly/lux/abstract/equivalence.lux +++ b/stdlib/source/poly/lux/abstract/equivalence.lux @@ -108,16 +108,21 @@ ## Variants (do @ [members (<type>.variant (p.many equivalence)) - #let [g!_ (code.local-identifier "_____________") + #let [last (dec (list.size members)) + g!_ (code.local-identifier "_____________") g!left (code.local-identifier "_____________left") g!right (code.local-identifier "_____________right")]] (wrap (` (: (~ (@Equivalence inputT)) (function ((~ g!_) (~ g!left) (~ g!right)) (case [(~ g!left) (~ g!right)] (~+ (list@join (list@map (function (_ [tag g!eq]) - (list (` [((~ (code.nat tag)) (~ g!left)) - ((~ (code.nat tag)) (~ g!right))]) - (` ((~ g!eq) (~ g!left) (~ g!right))))) + (if (nat.= last tag) + (list (` [((~ (code.nat (dec tag))) #1 (~ g!left)) + ((~ (code.nat (dec tag))) #1 (~ g!right))]) + (` ((~ g!eq) (~ g!left) (~ g!right)))) + (list (` [((~ (code.nat tag)) #0 (~ g!left)) + ((~ (code.nat tag)) #0 (~ g!right))]) + (` ((~ g!eq) (~ g!left) (~ g!right)))))) (list.enumerate members)))) (~ g!_) #0)))))) diff --git a/stdlib/source/poly/lux/abstract/functor.lux b/stdlib/source/poly/lux/abstract/functor.lux index 4fdff71ef..7381cc0b8 100644 --- a/stdlib/source/poly/lux/abstract/functor.lux +++ b/stdlib/source/poly/lux/abstract/functor.lux @@ -51,11 +51,15 @@ ## Variants (do @ [_ (wrap []) - membersC (<type>.variant (p.many (Arg<?> valueC)))] + membersC (<type>.variant (p.many (Arg<?> valueC))) + #let [last (dec (list.size membersC))]] (wrap (` (case (~ valueC) (~+ (list;join (list;map (function (_ [tag memberC]) - (list (` ((~ (code.nat tag)) (~ valueC))) - (` ((~ (code.nat tag)) (~ memberC))))) + (if (n.= last tag) + (list (` ((~ (code.nat (dec tag))) #1 (~ valueC))) + (` ((~ (code.nat (dec tag))) #1 (~ memberC)))) + (list (` ((~ (code.nat tag)) #0 (~ valueC))) + (` ((~ (code.nat tag)) #0 (~ memberC)))))) (list.enumerate membersC)))))))) ## Tuples (do p.monad diff --git a/stdlib/source/poly/lux/data/format/json.lux b/stdlib/source/poly/lux/data/format/json.lux index d3a32b27a..b324790fb 100644 --- a/stdlib/source/poly/lux/data/format/json.lux +++ b/stdlib/source/poly/lux/data/format/json.lux @@ -165,14 +165,21 @@ (do @ [#let [g!_ (code.local-identifier "_______") g!input (code.local-identifier "_______input")] - members (<type>.variant (p.many codec//encode))] + members (<type>.variant (p.many codec//encode)) + #let [last (dec (list.size members))]] (wrap (` (: (~ (@JSON//encode inputT)) (function ((~ g!_) (~ g!input)) (case (~ g!input) (~+ (list@join (list@map (function (_ [tag g!encode]) - (list (` ((~ (code.nat tag)) (~ g!input))) - (` ((~! /.json) [(~ (code.frac (..tag tag))) - ((~ g!encode) (~ g!input))])))) + (if (n.= last tag) + (list (` ((~ (code.nat (dec tag))) #1 (~ g!input))) + (` ((~! /.json) [(~ (code.frac (..tag (dec tag)))) + #1 + ((~ g!encode) (~ g!input))]))) + (list (` ((~ (code.nat tag)) #0 (~ g!input))) + (` ((~! /.json) [(~ (code.frac (..tag tag))) + #0 + ((~ g!encode) (~ g!input))]))))) (list.enumerate members)))))))))) (do @ [g!encoders (<type>.tuple (p.many codec//encode)) @@ -270,13 +277,20 @@ (wrap (` (: (~ (@JSON//decode inputT)) ((~! </>.array) ((~! p.some) (~ subC))))))) (do @ - [members (<type>.variant (p.many codec//decode))] + [members (<type>.variant (p.many codec//decode)) + #let [last (dec (list.size members))]] (wrap (` (: (~ (@JSON//decode inputT)) ($_ ((~! p.or)) (~+ (list@map (function (_ [tag memberC]) - (` (|> (~ memberC) - ((~! p.after) ((~! </>.number!) (~ (code.frac (..tag tag))))) - ((~! </>.array))))) + (if (n.= last tag) + (` (|> (~ memberC) + ((~! p.after) ((~! </>.number!) (~ (code.frac (..tag (dec tag)))))) + ((~! p.after) ((~! </>.boolean!) (~ (code.bit #1)))) + ((~! </>.array)))) + (` (|> (~ memberC) + ((~! p.after) ((~! </>.number!) (~ (code.frac (..tag tag))))) + ((~! p.after) ((~! </>.boolean!) (~ (code.bit #0)))) + ((~! </>.array)))))) (list.enumerate members)))))))) (do @ [g!decoders (<type>.tuple (p.many codec//decode))] diff --git a/stdlib/source/spec/compositor/analysis/type.lux b/stdlib/source/spec/compositor/analysis/type.lux index b2daee77a..718c1d01e 100644 --- a/stdlib/source/spec/compositor/analysis/type.lux +++ b/stdlib/source/spec/compositor/analysis/type.lux @@ -46,12 +46,12 @@ <type> (<code> value)]))] - [r.bit (0 "#Bit" (0)) code.bit] - [r.nat (0 "#I64" (1 (0 "#Nat" (0)) (0))) code.nat] - [r.int (0 "#I64" (1 (0 "#Int" (0)) (0))) code.int] - [r.rev (0 "#I64" (1 (0 "#Rev" (0)) (0))) code.rev] - [r.safe-frac (0 "#Frac" (0)) code.frac] - [(r.ascii/upper-alpha 5) (0 "#Text" (0)) code.text] + [r.bit (0 #0 "#Bit" (0 #0)) code.bit] + [r.nat (0 #0 "#I64" (0 #1 (0 #0 "#Nat" (0 #0)) (0 #0))) code.nat] + [r.int (0 #0 "#I64" (0 #1 (0 #0 "#Int" (0 #0)) (0 #0))) code.int] + [r.rev (0 #0 "#I64" (0 #1 (0 #0 "#Rev" (0 #0)) (0 #0))) code.rev] + [r.safe-frac (0 #0 "#Frac" (0 #0)) code.frac] + [(r.ascii/upper-alpha 5) (0 #0 "#Text" (0 #0)) code.text] ))))) (def: #export (spec expander state) diff --git a/stdlib/source/test/lux/data/sum.lux b/stdlib/source/test/lux/data/sum.lux index b90206fe7..7434d7509 100644 --- a/stdlib/source/test/lux/data/sum.lux +++ b/stdlib/source/test/lux/data/sum.lux @@ -19,23 +19,23 @@ (let [(^open "list/.") (list.equivalence text.equivalence)] ($_ _.and (_.test "Can inject values into Either." - (and (|> (/.left "Hello") (case> (0 "Hello") #1 _ #0)) - (|> (/.right "World") (case> (1 "World") #1 _ #0)))) + (and (|> (/.left "Hello") (case> (0 #0 "Hello") #1 _ #0)) + (|> (/.right "World") (case> (0 #1 "World") #1 _ #0)))) (_.test "Can discriminate eithers based on their cases." (let [[_lefts _rights] (/.partition (: (List (| Text Text)) - (list (0 "0") (1 "1") (0 "2"))))] + (list (0 #0 "0") (0 #1 "1") (0 #0 "2"))))] (and (list/= _lefts (/.lefts (: (List (| Text Text)) - (list (0 "0") (1 "1") (0 "2"))))) + (list (0 #0 "0") (0 #1 "1") (0 #0 "2"))))) (list/= _rights (/.rights (: (List (| Text Text)) - (list (0 "0") (1 "1") (0 "2")))))))) + (list (0 #0 "0") (0 #1 "1") (0 #0 "2")))))))) (_.test "Can apply a function to an Either value depending on the case." (and (n.= 10 (/.either (function (_ _) 10) (function (_ _) 20) - (: (| Text Text) (0 "")))) + (: (| Text Text) (0 #0 "")))) (n.= 20 (/.either (function (_ _) 10) (function (_ _) 20) - (: (| Text Text) (1 "")))))) + (: (| Text Text) (0 #1 "")))))) )))) diff --git a/stdlib/source/test/lux/data/text/regex.lux b/stdlib/source/test/lux/data/text/regex.lux index 7789cc9bf..49f20a726 100644 --- a/stdlib/source/test/lux/data/text/regex.lux +++ b/stdlib/source/test/lux/data/text/regex.lux @@ -259,15 +259,15 @@ Test ($_ _.and (_.test "Can specify alternative patterns." - (and (should-check ["a" (0 [])] (/.regex "a|b") "a") - (should-check ["b" (1 [])] (/.regex "a|b") "b") + (and (should-check ["a" (0 #0 [])] (/.regex "a|b") "a") + (should-check ["b" (0 #1 [])] (/.regex "a|b") "b") (should-fail (/.regex "a|b") "c"))) (_.test "Can have groups within alternations." - (and (should-check ["abc" (0 ["b" "c"])] (/.regex "a(.)(.)|b(.)(.)") "abc") - (should-check ["bcd" (1 ["c" "d"])] (/.regex "a(.)(.)|b(.)(.)") "bcd") + (and (should-check ["abc" (0 #0 ["b" "c"])] (/.regex "a(.)(.)|b(.)(.)") "abc") + (should-check ["bcd" (0 #1 ["c" "d"])] (/.regex "a(.)(.)|b(.)(.)") "bcd") (should-fail (/.regex "a(.)(.)|b(.)(.)") "cde") - (should-check ["123-456-7890" (0 ["123" "456-7890" "456" "7890"])] + (should-check ["123-456-7890" (0 #0 ["123" "456-7890" "456" "7890"])] (/.regex "(\d{3})-((\d{3})-(\d{4}))|b(.)d") "123-456-7890"))) )) diff --git a/stdlib/source/test/lux/macro.lux b/stdlib/source/test/lux/macro.lux index 6d65a8c3f..4875820b6 100644 --- a/stdlib/source/test/lux/macro.lux +++ b/stdlib/source/test/lux/macro.lux @@ -1,9 +1,7 @@ (.module: [lux #* - ["%" data/text/format (#+ format)] - [abstract/monad (#+ do)] - ["r" math/random (#+ Random)] - ["_" test (#+ Test)]] + ["_" test (#+ Test)] + ["%" data/text/format]] {1 ["." /]} ["." / #_ diff --git a/stdlib/source/test/lux/type/implicit.lux b/stdlib/source/test/lux/type/implicit.lux index 14b7c9524..520776996 100644 --- a/stdlib/source/test/lux/type/implicit.lux +++ b/stdlib/source/test/lux/type/implicit.lux @@ -1,41 +1,44 @@ (.module: [lux #* - ["%" data/text/format (#+ format)] - ["r" math/random (#+ Random)] + ["%" data/text/format] ["_" test (#+ Test)] - [abstract/monad (#+ do)] [abstract [equivalence (#+)] - [functor (#+)]] + [functor (#+)] + [monad (#+ do)]] [data ["." bit ("#@." equivalence)] [number ["n" nat]] [collection - ["." list]]]] + ["." list]]] + [math + ["." random (#+ Random)]]] {1 ["." /]}) (def: #export test Test (<| (_.context (%.name (name-of /._))) - (do r.monad - [x r.nat - y r.nat] + (do {@ random.monad} + [#let [digit (:: @ map (n.% 10) random.nat)] + left digit + right digit + #let [start (n.min left right) + end (n.max left right)]] ($_ _.and (_.test "Can automatically select first-order structures." (let [(^open "list@.") (list.equivalence n.equivalence)] - (and (bit@= (:: n.equivalence = x y) - (/.::: = x y)) - (list@= (list.n/range 1 10) - (/.::: map inc (list.n/range 0 9))) - ))) + (and (bit@= (:: n.equivalence = left right) + (/.::: = left right)) + (list@= (:: list.functor map inc (list.n/range start end)) + (/.::: map inc (list.n/range start end)))))) (_.test "Can automatically select second-order structures." (/.::: = - (list.n/range 1 10) - (list.n/range 1 10))) + (list.n/range start end) + (list.n/range start end))) (_.test "Can automatically select third-order structures." - (let [lln (/.::: map (list.n/range 1) - (list.n/range 1 10))] + (let [lln (/.::: map (list.n/range start) + (list.n/range start end))] (/.::: = lln lln))) )))) |