diff options
Diffstat (limited to '')
-rw-r--r-- | stdlib/source/library/lux/abstract/comonad.lux | 97 |
1 files changed, 49 insertions, 48 deletions
diff --git a/stdlib/source/library/lux/abstract/comonad.lux b/stdlib/source/library/lux/abstract/comonad.lux index 5bb928e6a..54f8707a3 100644 --- a/stdlib/source/library/lux/abstract/comonad.lux +++ b/stdlib/source/library/lux/abstract/comonad.lux @@ -23,57 +23,58 @@ (-> (w a) (w (w a)))) disjoint))) -(macro: .public (be tokens state) - (case (is (Maybe [(Maybe Text) Code (List Code) Code]) - (case tokens - (pattern (list [_ {.#Tuple (list [_ {.#Symbol ["" name]}] comonad)}] [_ {.#Tuple bindings}] body)) - {.#Some [{.#Some name} comonad bindings body]} - - (pattern (list comonad [_ {.#Tuple bindings}] body)) - {.#Some [{.#None} comonad bindings body]} +(def: .public be + (macro (_ tokens state) + (case (is (Maybe [(Maybe Text) Code (List Code) Code]) + (case tokens + (pattern (list [_ {.#Tuple (list [_ {.#Symbol ["" name]}] comonad)}] [_ {.#Tuple bindings}] body)) + {.#Some [{.#Some name} comonad bindings body]} + + (pattern (list comonad [_ {.#Tuple bindings}] body)) + {.#Some [{.#None} comonad bindings body]} - _ - {.#None})) - {.#Some [?name comonad bindings body]} - (case (list.pairs bindings) - {.#Some bindings} - (let [[module short] (symbol ..be) - symbol (is (-> Text Code) - (|>> (all "lux text concat" module " " short " ") [""] {.#Symbol} [location.dummy])) - g!_ (symbol "_") - g!each (symbol "each") - g!disjoint (symbol "disjoint") - body' (list#mix (is (-> [Code Code] Code Code) - (function (_ binding body') - (with_expansions [<default> (` (|> (~ value) (~ g!disjoint) ((~ g!each) (function ((~ g!_) (~ var)) (~ body')))))] - (let [[var value] binding] - (case var - [_ {.#Symbol ["" _]}] - <default> + _ + {.#None})) + {.#Some [?name comonad bindings body]} + (case (list.pairs bindings) + {.#Some bindings} + (let [[module short] (symbol ..be) + symbol (is (-> Text Code) + (|>> (all "lux text concat" module " " short " ") [""] {.#Symbol} [location.dummy])) + g!_ (symbol "_") + g!each (symbol "each") + g!disjoint (symbol "disjoint") + body' (list#mix (is (-> [Code Code] Code Code) + (function (_ binding body') + (with_expansions [<default> (` (|> (~ value) (~ g!disjoint) ((~ g!each) (function ((~ g!_) (~ var)) (~ body')))))] + (let [[var value] binding] + (case var + [_ {.#Symbol ["" _]}] + <default> - [_ {.#Symbol _}] - (` ((~ var) (~ value) (~ body'))) + [_ {.#Symbol _}] + (` ((~ var) (~ value) (~ body'))) - _ - <default>))))) - body - (list.reversed bindings))] - {.#Right [state (list (case ?name - {.#Some name} - (let [name [location.dummy {.#Symbol ["" name]}]] + _ + <default>))))) + body + (list.reversed bindings))] + {.#Right [state (list (case ?name + {.#Some name} + (let [name [location.dummy {.#Symbol ["" name]}]] + (` (.case (~ comonad) + (~ name) + (.case (~ name) + [(~ g!each) (~' out) (~ g!disjoint)] + (~ body'))))) + + {.#None} (` (.case (~ comonad) - (~ name) - (.case (~ name) - [(~ g!each) (~' out) (~ g!disjoint)] - (~ body'))))) + [(~ g!each) (~' out) (~ g!disjoint)] + (~ body')))))]}) + + {.#None} + {.#Left "'be' bindings must have an even number of parts."}) - {.#None} - (` (.case (~ comonad) - [(~ g!each) (~' out) (~ g!disjoint)] - (~ body')))))]}) - {.#None} - {.#Left "'be' bindings must have an even number of parts."}) - - {.#None} - {.#Left "Wrong syntax for 'be'"})) + {.#Left "Wrong syntax for 'be'"}))) |