aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/documentation/lux/data/collection/list.lux5
-rw-r--r--stdlib/source/library/lux.lux216
-rw-r--r--stdlib/source/library/lux/abstract/comonad.lux7
-rw-r--r--stdlib/source/library/lux/data/collection/list.lux14
-rw-r--r--stdlib/source/library/lux/macro/syntax.lux36
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis.lux7
-rw-r--r--stdlib/source/test/lux/data/collection/list.lux19
7 files changed, 175 insertions, 129 deletions
diff --git a/stdlib/source/documentation/lux/data/collection/list.lux b/stdlib/source/documentation/lux/data/collection/list.lux
index a05c33072..6275507f7 100644
--- a/stdlib/source/documentation/lux/data/collection/list.lux
+++ b/stdlib/source/documentation/lux/data/collection/list.lux
@@ -32,9 +32,8 @@
[(partition satisfies? list)])
(documentation: /.pairs
- (format "Cut the list into pairs of 2."
- \n "Caveat emptor: If the list has an un-even number of elements, the last one will be skipped.")
- [(pairs xs)])
+ "Cut the list into pairs of 2."
+ [(pairs list)])
(documentation: /.split_at
""
diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux
index c5d4a40f6..6dff86c3c 100644
--- a/stdlib/source/library/lux.lux
+++ b/stdlib/source/library/lux.lux
@@ -1246,24 +1246,37 @@
..Tuple)
(def:''' .private (pairs xs)
- (All (_ a) (-> ($' List a) ($' List (Tuple a a))))
+ (All (_ a) (-> ($' List a) ($' Maybe ($' List (Tuple a a)))))
({{#Item x {#Item y xs'}}
- {#Item [x y] (pairs xs')}
+ ({{#Some tail}
+ {#Some {#Item [x y] tail}}
+
+ {#None}
+ {#None}}
+ (pairs xs'))
+
+ {#End}
+ {#Some {#End}}
_
- {#End}}
+ {#None}}
xs))
(macro:' .private (let' tokens)
- ({{#Item [[_ {#Tuple bindings}] {#Item [body {#End}]}]}
- (in_meta (list (list#mix ("lux type check" (-> (Tuple Code Code) Code
- Code)
- (function' [binding body]
- ({[label value]
- (form$ (list (variant$ (list label body)) value))}
- binding)))
- body
- (list#reversed (pairs bindings)))))
+ ({{#Item [_ {#Tuple bindings}] {#Item body {#End}}}
+ ({{#Some bindings}
+ (in_meta (list (list#mix ("lux type check" (-> (Tuple Code Code) Code
+ Code)
+ (function' [binding body]
+ ({[label value]
+ (form$ (list (variant$ (list label body)) value))}
+ binding)))
+ body
+ (list#reversed bindings))))
+
+ {#None}
+ (failure "Wrong syntax for let'")}
+ (pairs bindings))
_
(failure "Wrong syntax for let'")}
@@ -1393,33 +1406,38 @@
(macro:' .private (do tokens)
({{#Item monad {#Item [_ {#Tuple bindings}] {#Item body {#End}}}}
- (let' [g!in (local_symbol$ "in")
- g!then (local_symbol$ " then ")
- body' (list#mix ("lux type check" (-> (Tuple Code Code) Code Code)
- (function' [binding body']
- (let' [[var value] binding]
- ({[_ {#Symbol [module short]}]
- ({""
- (form$ (list g!then
- (form$ (list (tuple$ (list (local_symbol$ "") var)) body'))
- value))
+ ({{#Some bindings}
+ (let' [g!in (local_symbol$ "in")
+ g!then (local_symbol$ " then ")
+ body' (list#mix ("lux type check" (-> (Tuple Code Code) Code Code)
+ (function' [binding body']
+ (let' [[var value] binding]
+ ({[_ {#Symbol [module short]}]
+ ({""
+ (form$ (list g!then
+ (form$ (list (tuple$ (list (local_symbol$ "") var)) body'))
+ value))
+
+ _
+ (form$ (list var value body'))}
+ module)
+
_
- (form$ (list var value body'))}
- module)
-
-
- _
- (form$ (list g!then
- (form$ (list (tuple$ (list (local_symbol$ "") var)) body'))
- value))}
- var))))
- body
- (list#reversed (pairs bindings)))]
- (in_meta (list (form$ (list (variant$ (list (tuple$ (list (symbol$ [..prelude_module "#in"]) g!in
- (symbol$ [..prelude_module "#then"]) g!then))
- body'))
- monad)))))
+ (form$ (list g!then
+ (form$ (list (tuple$ (list (local_symbol$ "") var)) body'))
+ value))}
+ var))))
+ body
+ (list#reversed bindings))]
+ (in_meta (list (form$ (list (variant$ (list (tuple$ (list (symbol$ [..prelude_module "#in"]) g!in
+ (symbol$ [..prelude_module "#then"]) g!then))
+ body'))
+ monad)))))
+
+ {#None}
+ (failure "Wrong syntax for do")}
+ (pairs bindings))
_
(failure "Wrong syntax for do")}
@@ -1945,10 +1963,6 @@
(-> Frac Text)
("lux f64 encode" x))
-(def:''' .private (multiple? div n)
- (-> Nat Nat Bit)
- (|> n (n/% div) ("lux i64 =" 0)))
-
(def:''' .public (not x)
(-> Bit Bit)
(if x #0 #1))
@@ -2416,17 +2430,21 @@
(macro:' .public (let tokens)
(case tokens
(^ (list [_ {#Tuple bindings}] body))
- (if (multiple? 2 (list#size bindings))
- (|> bindings pairs list#reversed
- (list#mix (: (-> [Code Code] Code Code)
- (function' [lr body']
- (let' [[l r] lr]
- (if (symbol? l)
- (` ({(~ l) (~ body')} (~ r)))
- (` (case (~ r) (~ l) (~ body')))))))
- body)
- list
- in_meta)
+ (case (..pairs bindings)
+ {#Some bindings}
+ (|> bindings
+ list#reversed
+ (list#mix (: (-> [Code Code] Code Code)
+ (function' [lr body']
+ (let' [[l r] lr]
+ (if (symbol? l)
+ (` ({(~ l) (~ body')} (~ r)))
+ (` (case (~ r) (~ l) (~ body')))))))
+ body)
+ list
+ in_meta)
+
+ {#None}
(failure "let requires an even number of parts"))
_
@@ -3780,19 +3798,22 @@
(failure "Wrong syntax for ^open")))
(macro: .public (cond tokens)
- (if ("lux i64 =" 0 (n/% 2 (list#size tokens)))
- (failure "cond requires an uneven number of arguments.")
- (case (list#reversed tokens)
- (^ (list& else branches'))
+ (case (list#reversed tokens)
+ (^ (list& else branches'))
+ (case (pairs branches')
+ {#Some branches'}
(in_meta (list (list#mix (: (-> [Code Code] Code Code)
(function (_ branch else)
(let [[right left] branch]
(` (if (~ left) (~ right) (~ else))))))
else
- (pairs branches'))))
-
- _
- (failure "Wrong syntax for cond"))))
+ branches')))
+
+ {#None}
+ (failure "cond requires an uneven number of arguments."))
+
+ _
+ (failure "Wrong syntax for cond")))
(def: (enumeration' idx xs)
(All (_ a)
@@ -4309,32 +4330,36 @@
{#None})]
(case ?params
{#Some [name bindings body]}
- (let [pairs (pairs bindings)
- vars (list#each product#left pairs)
- inits (list#each product#right pairs)]
- (if (every? symbol? inits)
- (do meta_monad
- [inits' (: (Meta (List Symbol))
- (case (monad#each maybe_monad symbol_name inits)
- {#Some inits'} (in_meta inits')
- {#None} (failure "Wrong syntax for loop")))
- init_types (monad#each meta_monad type_definition inits')
- expected ..expected_type]
- (in_meta (list (` (("lux type check"
- (-> (~+ (list#each type_code init_types))
- (~ (type_code expected)))
- (function ((~ name) (~+ vars))
- (~ body)))
- (~+ inits))))))
- (do meta_monad
- [aliases (monad#each meta_monad
- (: (-> Code (Meta Code))
- (function (_ _) (..generated_symbol "")))
- inits)]
- (in_meta (list (` (let [(~+ (..interleaved aliases inits))]
- (.loop (~ name)
- [(~+ (..interleaved vars aliases))]
- (~ body)))))))))
+ (case (pairs bindings)
+ {#Some pairs}
+ (let [vars (list#each product#left pairs)
+ inits (list#each product#right pairs)]
+ (if (every? symbol? inits)
+ (do meta_monad
+ [inits' (: (Meta (List Symbol))
+ (case (monad#each maybe_monad symbol_name inits)
+ {#Some inits'} (in_meta inits')
+ {#None} (failure "Wrong syntax for loop")))
+ init_types (monad#each meta_monad type_definition inits')
+ expected ..expected_type]
+ (in_meta (list (` (("lux type check"
+ (-> (~+ (list#each type_code init_types))
+ (~ (type_code expected)))
+ (function ((~ name) (~+ vars))
+ (~ body)))
+ (~+ inits))))))
+ (do meta_monad
+ [aliases (monad#each meta_monad
+ (: (-> Code (Meta Code))
+ (function (_ _) (..generated_symbol "")))
+ inits)]
+ (in_meta (list (` (let [(~+ (..interleaved aliases inits))]
+ (.loop (~ name)
+ [(~+ (..interleaved vars aliases))]
+ (~ body)))))))))
+
+ {#None}
+ (failure "Wrong syntax for loop"))
{#None}
(failure "Wrong syntax for loop"))))
@@ -4749,21 +4774,12 @@
(in_meta (list pick))
(target_pick target options' default)))))
-(def: (pairs' tokens)
- (-> (List Code) (Maybe (List [Code Code])))
- (if (|> tokens
- list#size
- (n/% 2)
- ("lux i64 =" 0))
- {#Some (pairs tokens)}
- {#None}))
-
(macro: .public (for tokens)
(do meta_monad
[target ..target]
(case tokens
(^ (list [_ {#Tuple options}]))
- (case (pairs' options)
+ (case (pairs options)
{#Some options}
(target_pick target options {#None})
@@ -4771,7 +4787,7 @@
(failure (..wrong_syntax_error (symbol ..for))))
(^ (list [_ {#Tuple options}] default))
- (case (pairs' options)
+ (case (pairs options)
{#Some options}
(target_pick target options {#Some default})
@@ -4906,13 +4922,15 @@
(macro: .public (:let tokens)
(case tokens
(^ (list [_ {#Tuple bindings}] bodyT))
- (if (multiple? 2 (list#size bindings))
+ (case (..pairs bindings)
+ {#Some bindings}
(in_meta (list (` (..with_expansions [(~+ (|> bindings
- ..pairs
(list#each (function (_ [localT valueT])
(list localT (` (..as_is (~ valueT))))))
(list#mix list#composite (list))))]
(~ bodyT)))))
+
+ {#None}
(..failure ":let requires an even number of parts"))
_
diff --git a/stdlib/source/library/lux/abstract/comonad.lux b/stdlib/source/library/lux/abstract/comonad.lux
index e3b0f9dbc..8c61becd7 100644
--- a/stdlib/source/library/lux/abstract/comonad.lux
+++ b/stdlib/source/library/lux/abstract/comonad.lux
@@ -35,7 +35,8 @@
_
{.#None}))
{.#Some [?name comonad bindings body]}
- (if (|> bindings list.size (n.% 2) (n.= 0))
+ (case (list.pairs bindings)
+ {.#Some bindings}
(let [[module short] (symbol ..be)
symbol (: (-> Text Code)
(|>> ($_ "lux text concat" module " " short " ") [""] {.#Symbol} [location.dummy]))
@@ -56,7 +57,7 @@
_
<default>)))))
body
- (list.reversed (list.pairs bindings)))]
+ (list.reversed bindings))]
{.#Right [state (list (case ?name
{.#Some name}
(let [name [location.dummy {.#Symbol ["" name]}]]
@@ -70,6 +71,8 @@
(` (.case (~ comonad)
[(~ g!each) (~' out) (~ g!disjoint)]
(~ body')))))]})
+
+ {.#None}
{.#Left "'be' bindings must have an even number of parts."})
{.#None}
diff --git a/stdlib/source/library/lux/data/collection/list.lux b/stdlib/source/library/lux/data/collection/list.lux
index b4fb8e4d6..6860eb4d6 100644
--- a/stdlib/source/library/lux/data/collection/list.lux
+++ b/stdlib/source/library/lux/data/collection/list.lux
@@ -76,13 +76,21 @@
[in {.#Item head out}]))))
(def: .public (pairs xs)
- (All (_ a) (-> (List a) (List [a a])))
+ (All (_ a) (-> (List a) (Maybe (List [a a]))))
(case xs
(^ (list& x1 x2 xs'))
- {.#Item [x1 x2] (pairs xs')}
+ (case (pairs xs')
+ {.#Some tail}
+ {.#Some (list& [x1 x2] tail)}
+
+ {.#None}
+ {.#None})
+
+ (^ (list))
+ {.#Some (list)}
_
- {.#End}))
+ {.#None}))
(template [<name> <then> <else>]
[(def: .public (<name> n xs)
diff --git a/stdlib/source/library/lux/macro/syntax.lux b/stdlib/source/library/lux/macro/syntax.lux
index 1f61650f1..f15a73808 100644
--- a/stdlib/source/library/lux/macro/syntax.lux
+++ b/stdlib/source/library/lux/macro/syntax.lux
@@ -57,25 +57,27 @@
{try.#Success [export_policy [name args] body]}
(with_symbols [g!tokens g!body g!error]
(do [! meta.monad]
- [_ (if (|> args list.size nat.even?)
- (in [])
- (meta.failure "Syntax pattern expects pairs of bindings and code-parsers."))
- vars+parsers (monad.each !
- (: (-> [Code Code] (Meta [Code Code]))
- (function (_ [var parser])
- (with_expansions [<default> (in [var
- (` ((~! ..self_documenting) (' (~ var))
- (~ parser)))])]
- (case var
- [_ {.#Symbol ["" _]}]
- <default>
+ [vars+parsers (case (list.pairs args)
+ {.#Some args}
+ (monad.each !
+ (: (-> [Code Code] (Meta [Code Code]))
+ (function (_ [var parser])
+ (with_expansions [<default> (in [var
+ (` ((~! ..self_documenting) (' (~ var))
+ (~ parser)))])]
+ (case var
+ [_ {.#Symbol ["" _]}]
+ <default>
- [_ {.#Symbol _}]
- (in [var parser])
+ [_ {.#Symbol _}]
+ (in [var parser])
- _
- <default>))))
- (list.pairs args))
+ _
+ <default>))))
+ args)
+
+ _
+ (meta.failure "Syntax pattern expects pairs of bindings and code-parsers."))
this_module meta.current_module_name
.let [g!state (code.symbol ["" "*lux*"])
error_msg (code.text (macro.wrong_syntax_error [this_module name]))]]
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis.lux
index 7f0b63249..c11976f72 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis.lux
@@ -87,8 +87,11 @@
(/reference.reference reference)
(^ {.#Form (list [_ {.#Variant branches}] input)})
- (if (n.even? (list.size branches))
- (/case.case compile (list.pairs branches) archive input)
+ (case (list.pairs branches)
+ {.#Some branches}
+ (/case.case compile branches archive input)
+
+ {.#None}
(//.except ..unrecognized_syntax [location.dummy code']))
(^ {.#Form (list& [_ {.#Text extension_name}] extension_args)})
diff --git a/stdlib/source/test/lux/data/collection/list.lux b/stdlib/source/test/lux/data/collection/list.lux
index 5003567ee..a91db974f 100644
--- a/stdlib/source/test/lux/data/collection/list.lux
+++ b/stdlib/source/test/lux/data/collection/list.lux
@@ -281,8 +281,18 @@
sample/2 ..random]
($_ _.and
(_.cover [/.pairs]
- (n.= (n./ 2 (/.size sample/0))
- (/.size (/.pairs sample/0))))
+ (let [even_sized? (|> sample/0
+ /.size
+ (n.% 2)
+ (n.= 0))]
+ (case (/.pairs sample/0)
+ {.#Some pairs/0}
+ (and even_sized?
+ (n.= (n./ 2 (/.size sample/0))
+ (/.size pairs/0)))
+
+ {.#None}
+ (not even_sized?))))
(_.cover [/.zipped/2]
(let [zipped (/.zipped/2 sample/0 sample/1)
zipped::size (/.size zipped)
@@ -412,7 +422,10 @@
(let [sample+ (/.interposed separator sample)]
(and (n.= (|> (/.size sample) (n.* 2) --)
(/.size sample+))
- (|> sample+ /.pairs (/.every? (|>> product.right (n.= separator))))))))
+ (|> sample+
+ /.pairs
+ (maybe.else (list))
+ (/.every? (|>> product.right (n.= separator))))))))
(_.cover [/.iterations]
(or (/.empty? sample)
(let [size (/.size sample)]
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-25 15:28:08 +0000