aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--lux-mode/lux-mode.el2
-rw-r--r--new-luxc/source/luxc/analyser/case.lux16
-rw-r--r--stdlib/source/lux.lux8
-rw-r--r--stdlib/source/lux/concurrency/frp.lux4
-rw-r--r--stdlib/source/lux/control/effect.lux20
-rw-r--r--stdlib/source/lux/data/coll/ordered.lux88
-rw-r--r--stdlib/source/lux/data/coll/vector.lux4
-rw-r--r--stdlib/source/lux/data/number.lux22
-rw-r--r--stdlib/source/lux/data/text/regex.lux8
-rw-r--r--stdlib/source/lux/host.jvm.lux8
-rw-r--r--stdlib/source/lux/macro/poly.lux50
-rw-r--r--stdlib/source/lux/macro/syntax/common.lux10
-rw-r--r--stdlib/test/test/lux/data/text.lux16
13 files changed, 128 insertions, 128 deletions
diff --git a/lux-mode/lux-mode.el b/lux-mode/lux-mode.el
index 1556d40d8..a7a2b3466 100644
--- a/lux-mode/lux-mode.el
+++ b/lux-mode/lux-mode.el
@@ -221,7 +221,7 @@ Called by `imenu--generic-function'."
"exec" "let" "with-expansions" "if" "cond" "do" "be" "open" "loop" "recur" "comment" "list" "list&" "io" "vector" "tree"
"get@" "set@" "update@" "|>" "|>." "<|" "<|." "_$" "$_" "~" "~@" "~'" "::" ":::" "default"
"|" "&" "->" "All" "Ex" "Rec" "host" "$" "type"
- "^" "^or" "^slots" "^=>" "^~" "^@" "^template" "^open" "^|>" "^stream&" "^regex"
+ "^" "^or" "^slots" "^multi" "^~" "^@" "^template" "^open" "^|>" "^stream&" "^regex"
"bin" "oct" "hex"
"@pre" "@post"
"sig" "struct" "derive"
diff --git a/new-luxc/source/luxc/analyser/case.lux b/new-luxc/source/luxc/analyser/case.lux
index ee009b1ab..239d846d1 100644
--- a/new-luxc/source/luxc/analyser/case.lux
+++ b/new-luxc/source/luxc/analyser/case.lux
@@ -166,8 +166,8 @@
size-sum (list;size flat-sum)
num-cases (default size-sum num-tags)]
(case (list;nth idx flat-sum)
- (^=> (#;Some case-type)
- (n.< num-cases idx))
+ (^multi (#;Some case-type)
+ (n.< num-cases idx))
(if (and (n.> num-cases size-sum)
(n.= (n.dec num-cases) idx))
(do Monad<Lux>
@@ -315,8 +315,8 @@
[#PartialC #PartialC]
(R/wrap #PartialC)
- (^=> [(#BoolC sideA) (#BoolC sideSF)]
- (xor sideA sideSF))
+ (^multi [(#BoolC sideA) (#BoolC sideSF)]
+ (xor sideA sideSF))
(R/wrap #TotalC)
[(#VariantC allA casesA) (#VariantC allSF casesSF)]
@@ -368,13 +368,13 @@
(wrap (#SeqC leftM rightA))))
## The left part will always match, so the addition is redundant.
- (^=> [(#SeqC left right) single]
- (C/= left single))
+ (^multi [(#SeqC left right) single]
+ (C/= left single))
redundant-pattern
## The right part is not necessary, since it can always match the left.
- (^=> [single (#SeqC left right)]
- (C/= left single))
+ (^multi [single (#SeqC left right)]
+ (C/= left single))
(R/wrap single)
[_ (#AltC leftS rightS)]
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux
index 737c38fd3..f801ebebd 100644
--- a/stdlib/source/lux.lux
+++ b/stdlib/source/lux.lux
@@ -5460,12 +5460,12 @@
(: (List [Code Code]) (reverse levels)))]
(list init-pattern inner-pattern-body)))
-(macro: #export (^=> tokens)
+(macro: #export (^multi tokens)
{#;doc (doc "Multi-level pattern matching."
"Useful in situations where the result of a branch depends on further refinements on the values being matched."
"For example:"
(case (split (size static) uri)
- (^=> (#;Some [chunk uri']) [(Text/= static chunk) true])
+ (^multi (#;Some [chunk uri']) [(Text/= static chunk) true])
(match-uri endpoint? parts' uri')
_
@@ -5474,7 +5474,7 @@
"Short-cuts can be taken when using boolean tests."
"The example above can be rewritten as..."
(case (split (size static) uri)
- (^=> (#;Some [chunk uri']) (Text/= static chunk))
+ (^multi (#;Some [chunk uri']) (Text/= static chunk))
(match-uri endpoint? parts' uri')
_
@@ -5501,7 +5501,7 @@
(wrap output)))
_
- (fail "Wrong syntax for ^=>")))
+ (fail "Wrong syntax for ^multi")))
(macro: #export (ident-for tokens)
{#;doc (doc "Given a symbol or a tag, gives back a 2 tuple with the prefix and name parts, both as Text."
diff --git a/stdlib/source/lux/concurrency/frp.lux b/stdlib/source/lux/concurrency/frp.lux
index e84534bbc..914351d22 100644
--- a/stdlib/source/lux/concurrency/frp.lux
+++ b/stdlib/source/lux/concurrency/frp.lux
@@ -274,8 +274,8 @@
[_ (&;wait time)
#let [next-inputs (loop [last-resolved-node inputs']
(case (&;poll last-resolved-node)
- (^=> (#;Some (#;Some [_ next-node]))
- (&;resolved? next-node))
+ (^multi (#;Some (#;Some [_ next-node]))
+ (&;resolved? next-node))
(recur next-node)
_
diff --git a/stdlib/source/lux/control/effect.lux b/stdlib/source/lux/control/effect.lux
index 447012689..b684d1874 100644
--- a/stdlib/source/lux/control/effect.lux
+++ b/stdlib/source/lux/control/effect.lux
@@ -318,16 +318,16 @@
[input (macro;find-type var)
output macro;expected-type]
(case [input output]
- (^=> [(#;App eff0 _) (#;App stackT0 recT0)]
- [(type;apply-type stackT0 recT0) (#;Some unfoldT0)]
- [stackT0 (^ (#;App (#;Named (ident-for M;Free) _)
- stackT1))]
- [(type;apply-type stackT1 recT0) (#;Some unfoldT1)]
- [(flatten-effect-stack unfoldT1) stack]
- [(|> stack list;enumerate
- (list;find (function [[idx effect]]
- (same-effect? effect eff0))))
- (#;Some [idx _])])
+ (^multi [(#;App eff0 _) (#;App stackT0 recT0)]
+ [(type;apply-type stackT0 recT0) (#;Some unfoldT0)]
+ [stackT0 (^ (#;App (#;Named (ident-for M;Free) _)
+ stackT1))]
+ [(type;apply-type stackT1 recT0) (#;Some unfoldT1)]
+ [(flatten-effect-stack unfoldT1) stack]
+ [(|> stack list;enumerate
+ (list;find (function [[idx effect]]
+ (same-effect? effect eff0))))
+ (#;Some [idx _])])
(wrap (list (` (#M;Effect (:: (~ g!functor) (~' map) (~' wrap)
(~ (nest-effect idx (list;size stack) (code;symbol var))))))))
diff --git a/stdlib/source/lux/data/coll/ordered.lux b/stdlib/source/lux/data/coll/ordered.lux
index 47bf7cd65..4735f38ae 100644
--- a/stdlib/source/lux/data/coll/ordered.lux
+++ b/stdlib/source/lux/data/coll/ordered.lux
@@ -112,8 +112,8 @@
(case (get@ #color self)
#Red
(case (get@ #left self)
- (^=> (#;Some left)
- [(get@ #color left) #Red])
+ (^multi (#;Some left)
+ [(get@ #color left) #Red])
(red (get@ #value self)
(#;Some (blacken left))
(#;Some (black (get@ #value parent)
@@ -122,8 +122,8 @@
_
(case (get@ #right self)
- (^=> (#;Some right)
- [(get@ #color right) #Red])
+ (^multi (#;Some right)
+ [(get@ #color right) #Red])
(red (get@ #value right)
(#;Some (black (get@ #value self)
(get@ #left self)
@@ -148,8 +148,8 @@
(case (get@ #color self)
#Red
(case (get@ #right self)
- (^=> (#;Some right)
- [(get@ #color right) #Red])
+ (^multi (#;Some right)
+ [(get@ #color right) #Red])
(red (get@ #value self)
(#;Some (black (get@ #value parent)
(get@ #left parent)
@@ -158,8 +158,8 @@
_
(case (get@ #left self)
- (^=> (#;Some left)
- [(get@ #color left) #Red])
+ (^multi (#;Some left)
+ [(get@ #color left) #Red])
(red (get@ #value left)
(#;Some (black (get@ #value parent)
(get@ #left parent)
@@ -229,18 +229,18 @@
(def: (left-balance value ?left ?right)
(All [a] (-> a (Maybe (Node a)) (Maybe (Node a)) (Node a)))
(case ?left
- (^=> (#;Some left)
- [(get@ #color left) #Red]
- [(get@ #left left) (#;Some left.left)]
- [(get@ #color left.left) #Red])
+ (^multi (#;Some left)
+ [(get@ #color left) #Red]
+ [(get@ #left left) (#;Some left.left)]
+ [(get@ #color left.left) #Red])
(red (get@ #value left)
(#;Some (blacken left.left))
(#;Some (black value (get@ #right left) ?right)))
- (^=> (#;Some left)
- [(get@ #color left) #Red]
- [(get@ #right left) (#;Some left.right)]
- [(get@ #color left.right) #Red])
+ (^multi (#;Some left)
+ [(get@ #color left) #Red]
+ [(get@ #right left) (#;Some left.right)]
+ [(get@ #color left.right) #Red])
(red (get@ #value left.right)
(#;Some (black (get@ #value left)
(get@ #left left)
@@ -255,18 +255,18 @@
(def: (right-balance value ?left ?right)
(All [a] (-> a (Maybe (Node a)) (Maybe (Node a)) (Node a)))
(case ?right
- (^=> (#;Some right)
- [(get@ #color right) #Red]
- [(get@ #right right) (#;Some right.right)]
- [(get@ #color right.right) #Red])
+ (^multi (#;Some right)
+ [(get@ #color right) #Red]
+ [(get@ #right right) (#;Some right.right)]
+ [(get@ #color right.right) #Red])
(red (get@ #value right)
(#;Some (black value ?left (get@ #left right)))
(#;Some (blacken right.right)))
- (^=> (#;Some right)
- [(get@ #color right) #Red]
- [(get@ #left right) (#;Some right.left)]
- [(get@ #color right.left) #Red])
+ (^multi (#;Some right)
+ [(get@ #color right) #Red]
+ [(get@ #left right) (#;Some right.left)]
+ [(get@ #color right.left) #Red])
(red (get@ #value right.left)
(#;Some (black value ?left (get@ #left right.left)))
(#;Some (black (get@ #value right)
@@ -279,20 +279,20 @@
(def: (balance-left-remove value ?left ?right)
(All [a] (-> a (Maybe (Node a)) (Maybe (Node a)) (Node a)))
(case ?left
- (^=> (#;Some left)
- [(get@ #color left) #Red])
+ (^multi (#;Some left)
+ [(get@ #color left) #Red])
(red value (#;Some (blacken left)) ?right)
_
(case ?right
- (^=> (#;Some right)
- [(get@ #color right) #Black])
+ (^multi (#;Some right)
+ [(get@ #color right) #Black])
(right-balance value ?left (#;Some (redden right)))
- (^=> (#;Some right)
- [(get@ #color right) #Red]
- [(get@ #left right) (#;Some right.left)]
- [(get@ #color right.left) #Black])
+ (^multi (#;Some right)
+ [(get@ #color right) #Red]
+ [(get@ #left right) (#;Some right.left)]
+ [(get@ #color right.left) #Black])
(red (get@ #value right.left)
(#;Some (black value ?left (get@ #left right.left)))
(#;Some (right-balance (get@ #value right)
@@ -306,20 +306,20 @@
(def: (balance-right-remove value ?left ?right)
(All [a] (-> a (Maybe (Node a)) (Maybe (Node a)) (Node a)))
(case ?right
- (^=> (#;Some right)
- [(get@ #color right) #Red])
+ (^multi (#;Some right)
+ [(get@ #color right) #Red])
(red value ?left (#;Some (blacken right)))
_
(case ?left
- (^=> (#;Some left)
- [(get@ #color left) #Black])
+ (^multi (#;Some left)
+ [(get@ #color left) #Black])
(left-balance value (#;Some (redden left)) ?right)
- (^=> (#;Some left)
- [(get@ #color left) #Red]
- [(get@ #right left) (#;Some left.right)]
- [(get@ #color left.right) #Black])
+ (^multi (#;Some left)
+ [(get@ #color left) #Red]
+ [(get@ #right left) (#;Some left.right)]
+ [(get@ #color left.right) #Black])
(red (get@ #value left.right)
(#;Some (left-balance (get@ #value left)
(:: Functor<Maybe> map redden (get@ #left left))
@@ -419,8 +419,8 @@
[side-outcome _]
(if go-left?
(case (get@ #left root)
- (^=> (#;Some left)
- [(get@ #color left) #Black])
+ (^multi (#;Some left)
+ [(get@ #color left) #Black])
[(#;Some (balance-left-remove root-val side-outcome (get@ #right root)))
false]
@@ -428,8 +428,8 @@
[(#;Some (red root-val side-outcome (get@ #right root)))
false])
(case (get@ #right root)
- (^=> (#;Some right)
- [(get@ #color right) #Black])
+ (^multi (#;Some right)
+ [(get@ #color right) #Black])
[(#;Some (balance-right-remove root-val (get@ #left root) side-outcome))
false]
diff --git a/stdlib/source/lux/data/coll/vector.lux b/stdlib/source/lux/data/coll/vector.lux
index 5c17d53eb..999b2932d 100644
--- a/stdlib/source/lux/data/coll/vector.lux
+++ b/stdlib/source/lux/data/coll/vector.lux
@@ -127,8 +127,8 @@
(|> (array;clone hierarchy)
(array;put sub-idx (#Hierarchy (put' (level-down level) idx val sub-node))))
- (^=> (#;Some (#Base base))
- (n.= +0 (level-down level)))
+ (^multi (#;Some (#Base base))
+ (n.= +0 (level-down level)))
(|> (array;clone hierarchy)
(array;put sub-idx (|> (array;clone base)
(array;put (branch-idx idx) val)
diff --git a/stdlib/source/lux/data/number.lux b/stdlib/source/lux/data/number.lux
index eee553ac9..b14d196bd 100644
--- a/stdlib/source/lux/data/number.lux
+++ b/stdlib/source/lux/data/number.lux
@@ -297,9 +297,9 @@
(let [repr-size (_lux_proc ["text" "size"] [repr])]
(if (n.>= +2 repr-size)
(case (_lux_proc ["text" "char"] [repr +0])
- (^=> (#;Some #".")
- [(:: <nat> decode (_lux_proc ["text" "append"] ["+" (de-prefix repr)]))
- (#;Some output)])
+ (^multi (#;Some #".")
+ [(:: <nat> decode (_lux_proc ["text" "append"] ["+" (de-prefix repr)]))
+ (#;Some output)])
(#R;Success (:! Deg output))
_
@@ -338,8 +338,8 @@
decimal-part (assume (_lux_proc ["text" "clip"] [repr (n.inc split-index) (_lux_proc ["text" "size"] [repr])]))]
(case [(:: <int> decode whole-part)
(:: <int> decode decimal-part)]
- (^=> [(#;Some whole) (#;Some decimal)]
- (i.>= 0 decimal))
+ (^multi [(#;Some whole) (#;Some decimal)]
+ (i.>= 0 decimal))
(let [sign (if (i.< 0 whole)
-1.0
1.0)
@@ -563,16 +563,16 @@
(#R;Success value)
(#R;Success [state (list [meta (#;Nat value)])])
- (^=> (#R;Error _)
- [(:: <int> decode repr) (#R;Success value)])
+ (^multi (#R;Error _)
+ [(:: <int> decode repr) (#R;Success value)])
(#R;Success [state (list [meta (#;Int value)])])
- (^=> (#R;Error _)
- [(:: <deg> decode repr) (#R;Success value)])
+ (^multi (#R;Error _)
+ [(:: <deg> decode repr) (#R;Success value)])
(#R;Success [state (list [meta (#;Deg value)])])
- (^=> (#R;Error _)
- [(:: <real> decode repr) (#R;Success value)])
+ (^multi (#R;Error _)
+ [(:: <real> decode repr) (#R;Success value)])
(#R;Success [state (list [meta (#;Real value)])])
_
diff --git a/stdlib/source/lux/data/text/regex.lux b/stdlib/source/lux/data/text/regex.lux
index 34fdc36fa..95a932905 100644
--- a/stdlib/source/lux/data/text/regex.lux
+++ b/stdlib/source/lux/data/text/regex.lux
@@ -501,9 +501,9 @@
do-something-else))}
(do @
[g!temp (macro;gensym "temp")]
- (wrap (list& (` (^=> (~ g!temp)
- [(&;run (~ g!temp) (regex (~ (code;text pattern))))
- (#;Right (~ (default g!temp
- bindings)))]))
+ (wrap (list& (` (^multi (~ g!temp)
+ [(&;run (~ g!temp) (regex (~ (code;text pattern))))
+ (#;Right (~ (default g!temp
+ bindings)))]))
body
branches))))
diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux
index c72a683d1..b31def073 100644
--- a/stdlib/source/lux/host.jvm.lux
+++ b/stdlib/source/lux/host.jvm.lux
@@ -289,12 +289,12 @@
(-> Primitive-Mode (List TypeParam) Bool GenericType Code)
Code)
(case [name+params mode in-array?]
- (^=> [[prim #;Nil] #ManualPrM false]
- [(manual-primitive-to-type prim) (#;Some output)])
+ (^multi [[prim #;Nil] #ManualPrM false]
+ [(manual-primitive-to-type prim) (#;Some output)])
output
- (^=> [[prim #;Nil] #AutoPrM false]
- [(auto-primitive-to-type prim) (#;Some output)])
+ (^multi [[prim #;Nil] #AutoPrM false]
+ [(auto-primitive-to-type prim) (#;Some output)])
output
[[name params] _ _]
diff --git a/stdlib/source/lux/macro/poly.lux b/stdlib/source/lux/macro/poly.lux
index ecf5e2019..869d80de4 100644
--- a/stdlib/source/lux/macro/poly.lux
+++ b/stdlib/source/lux/macro/poly.lux
@@ -214,9 +214,9 @@
(-> Ident (Matcher Type))
(;function [:type:]
(case (type;un-name :type:)
- (^=> (#;App :quant: :arg:)
- [(type;un-alias :quant:) (#;Named actual _)]
- (Ident/= name actual))
+ (^multi (#;App :quant: :arg:)
+ [(type;un-alias :quant:) (#;Named actual _)]
+ (Ident/= name actual))
(:: macro;Monad<Lux> wrap :arg:)
_
@@ -226,9 +226,9 @@
(-> Ident (Matcher [Type Type]))
(;function [:type:]
(case (type;un-name :type:)
- (^=> (#;App (#;App :quant: :arg0:) :arg1:)
- [(type;un-alias :quant:) (#;Named actual _)]
- (Ident/= name actual))
+ (^multi (#;App (#;App :quant: :arg0:) :arg1:)
+ [(type;un-alias :quant:) (#;Named actual _)]
+ (Ident/= name actual))
(:: macro;Monad<Lux> wrap [:arg0: :arg1:])
_
@@ -262,20 +262,20 @@
(do Monad<Lux>
[[t-func t-args] (apply :type:)]
(case t-func
- (^=> (#;Bound t-func-idx)
- (n.= +0 (adjusted-idx env t-func-idx))
- [(do maybe;Monad<Maybe>
- [=func (dict;get +0 env)
- =args (mapM @ (;function [t-arg]
- (case t-arg
- (#;Bound idx)
- (dict;get (adjusted-idx env idx) env)
-
- _
- #;None))
- t-args)]
- (wrap (` ((~ (product;right =func)) (~@ (List/map product;right =args))))))
- (#;Some call)])
+ (^multi (#;Bound t-func-idx)
+ (n.= +0 (adjusted-idx env t-func-idx))
+ [(do maybe;Monad<Maybe>
+ [=func (dict;get +0 env)
+ =args (mapM @ (;function [t-arg]
+ (case t-arg
+ (#;Bound idx)
+ (dict;get (adjusted-idx env idx) env)
+
+ _
+ #;None))
+ t-args)]
+ (wrap (` ((~ (product;right =func)) (~@ (List/map product;right =args))))))
+ (#;Some call)])
(wrap call)
_
@@ -286,8 +286,8 @@
(-> Env Nat (Matcher Unit))
(;function [:type:]
(case :type:
- (^=> (#;Bound idx)
- (n.= var-id (adjusted-idx env idx)))
+ (^multi (#;Bound idx)
+ (n.= var-id (adjusted-idx env idx)))
(:: macro;Monad<Lux> wrap [])
_
@@ -353,9 +353,9 @@
(#;Some name)
(wrap name)
- (^=> #;None
- [(derivation-name (product;right poly-func) (List/map product;right poly-args))
- (#;Some derived-name)])
+ (^multi #;None
+ [(derivation-name (product;right poly-func) (List/map product;right poly-args))
+ (#;Some derived-name)])
(wrap derived-name)
_
diff --git a/stdlib/source/lux/macro/syntax/common.lux b/stdlib/source/lux/macro/syntax/common.lux
index 4f27108cd..1aa43c7cf 100644
--- a/stdlib/source/lux/macro/syntax/common.lux
+++ b/stdlib/source/lux/macro/syntax/common.lux
@@ -113,11 +113,11 @@
(-> (List [Ident Code]) (List Text))
(default (list)
(case (list;find (|>. product;left (Ident/= ["lux" "func-args"])) meta-data)
- (^=> (#;Some [_ value])
- [(s;run (list value) list-meta^)
- (#;Right [_ args])]
- [(s;run args (s;some text-meta^))
- (#;Right [_ args])])
+ (^multi (#;Some [_ value])
+ [(s;run (list value) list-meta^)
+ (#;Right [_ args])]
+ [(s;run args (s;some text-meta^))
+ (#;Right [_ args])])
(#;Some args)
_
diff --git a/stdlib/test/test/lux/data/text.lux b/stdlib/test/test/lux/data/text.lux
index d5deef0a4..aa316a7ad 100644
--- a/stdlib/test/test/lux/data/text.lux
+++ b/stdlib/test/test/lux/data/text.lux
@@ -29,14 +29,14 @@
sample (R;text size)]
(assert "" (|> sample
(&;nth idx)
- (case> (^=> (#;Some char)
- [(char;as-text char) char']
- [[(&;index-of' char' sample)
- (&;last-index-of' char' sample)
- (&;index-of char' idx sample)
- (&;last-index-of char' idx sample)]
- [(#;Some io) (#;Some lio)
- (#;Some io') (#;Some lio')]])
+ (case> (^multi (#;Some char)
+ [(char;as-text char) char']
+ [[(&;index-of' char' sample)
+ (&;last-index-of' char' sample)
+ (&;index-of char' idx sample)
+ (&;last-index-of char' idx sample)]
+ [(#;Some io) (#;Some lio)
+ (#;Some io') (#;Some lio')]])
(and (n.<= idx io)
(n.>= idx lio)
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-08 05:22:36 +0000