aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--luxc/src/lux/analyser.clj5
-rw-r--r--luxc/src/lux/analyser/case.clj19
-rw-r--r--luxc/src/lux/analyser/lux.clj8
-rw-r--r--stdlib/source/lux.lux266
-rw-r--r--stdlib/source/lux/abstract/enum.lux14
-rw-r--r--stdlib/source/lux/control/concatenative.lux4
-rw-r--r--stdlib/source/lux/control/parser.lux4
-rw-r--r--stdlib/source/lux/data/collection/list.lux15
-rw-r--r--stdlib/source/lux/data/number/rev.lux14
-rw-r--r--stdlib/source/lux/data/sum.lux37
-rw-r--r--stdlib/source/lux/data/text/regex.lux4
-rw-r--r--stdlib/source/lux/math/random.lux4
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/analysis.lux18
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/analysis.lux28
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/analysis/case.lux30
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/analysis/inference.lux20
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/analysis/structure.lux167
-rw-r--r--stdlib/source/poly/lux/abstract/equivalence.lux13
-rw-r--r--stdlib/source/poly/lux/abstract/functor.lux10
-rw-r--r--stdlib/source/poly/lux/data/format/json.lux30
-rw-r--r--stdlib/source/spec/compositor/analysis/type.lux12
-rw-r--r--stdlib/source/test/lux/data/sum.lux14
-rw-r--r--stdlib/source/test/lux/data/text/regex.lux10
-rw-r--r--stdlib/source/test/lux/macro.lux6
-rw-r--r--stdlib/source/test/lux/type/implicit.lux37
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)))
))))