From ea15b844b51ff60f9785c6791507f813729f85c3 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 14 Sep 2021 03:21:21 -0400 Subject: Better list pairing. --- .../documentation/lux/data/collection/list.lux | 5 +- stdlib/source/library/lux.lux | 216 +++++++++++---------- stdlib/source/library/lux/abstract/comonad.lux | 7 +- stdlib/source/library/lux/data/collection/list.lux | 14 +- stdlib/source/library/lux/macro/syntax.lux | 36 ++-- .../tool/compiler/language/lux/phase/analysis.lux | 7 +- stdlib/source/test/lux/data/collection/list.lux | 19 +- 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 @@ _ ))))) 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 [ ] [(def: .public ( 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 [ (in [var - (` ((~! ..self_documenting) (' (~ var)) - (~ parser)))])] - (case var - [_ {.#Symbol ["" _]}] - + [vars+parsers (case (list.pairs args) + {.#Some args} + (monad.each ! + (: (-> [Code Code] (Meta [Code Code])) + (function (_ [var parser]) + (with_expansions [ (in [var + (` ((~! ..self_documenting) (' (~ var)) + (~ parser)))])] + (case var + [_ {.#Symbol ["" _]}] + - [_ {.#Symbol _}] - (in [var parser]) + [_ {.#Symbol _}] + (in [var parser]) - _ - )))) - (list.pairs args)) + _ + )))) + 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)] -- cgit v1.2.3