aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/control/comonad.lux44
-rw-r--r--stdlib/source/lux/control/monad.lux73
-rw-r--r--stdlib/source/lux/data/text/lexer.lux8
3 files changed, 71 insertions, 54 deletions
diff --git a/stdlib/source/lux/control/comonad.lux b/stdlib/source/lux/control/comonad.lux
index dda076003..eca4cd4f1 100644
--- a/stdlib/source/lux/control/comonad.lux
+++ b/stdlib/source/lux/control/comonad.lux
@@ -1,7 +1,7 @@
(;module:
lux
["F" ../functor]
- [lux/data/coll/list #* "" Fold<List>])
+ (lux/data/coll [list "list/" Fold<List>]))
## [Signatures]
(sig: #export (CoMonad w)
@@ -33,26 +33,28 @@
(square (head inputs)))))}
(case tokens
(#;Cons comonad (#;Cons [_ (#;Tuple bindings)] (#;Cons body #;Nil)))
- (let [g!map (: Code [_cursor (#;Symbol ["" " map "])])
- g!split (: Code [_cursor (#;Symbol ["" " split "])])
- body' (fold (: (-> [Code Code] Code Code)
- (function [binding body']
- (let [[var value] binding]
- (case var
- [_ (#;Tag ["" "let"])]
- (` (let (~ value) (~ body')))
+ (if (|> bindings list;size (n.% +2) (n.= +0))
+ (let [g!map (: Code [_cursor (#;Symbol ["" " map "])])
+ g!split (: Code [_cursor (#;Symbol ["" " split "])])
+ body' (list/fold (: (-> [Code Code] Code Code)
+ (function [binding body']
+ (let [[var value] binding]
+ (case var
+ [_ (#;Tag ["" "let"])]
+ (` (let (~ value) (~ body')))
- _
- (` (|> (~ value) (~ g!split) ((~ g!map) (function [(~ var)] (~ body')))))
- ))))
- body
- (reverse (as-pairs bindings)))]
- (#;Right [state (#;Cons (` ("lux case" (~ comonad)
- (~' @)
- ("lux case" (~' @)
- {#functor {#F;map (~ g!map)} #unwrap (~' unwrap) #split (~ g!split)}
- (~ body'))))
- #;Nil)]))
+ _
+ (` (|> (~ value) (~ g!split) ((~ g!map) (function [(~ var)] (~ body')))))
+ ))))
+ body
+ (list;reverse (list;as-pairs bindings)))]
+ (#;Right [state (#;Cons (` ("lux case" (~ comonad)
+ (~' @)
+ ("lux case" (~' @)
+ {#functor {#F;map (~ g!map)} #unwrap (~' unwrap) #split (~ g!split)}
+ (~ body'))))
+ #;Nil)]))
+ (#;Left "'be' bindings must have an even number of parts."))
_
- (#;Left "Wrong syntax for be")))
+ (#;Left "Wrong syntax for 'be'")))
diff --git a/stdlib/source/lux/control/monad.lux b/stdlib/source/lux/control/monad.lux
index f9f7cab96..856509baa 100644
--- a/stdlib/source/lux/control/monad.lux
+++ b/stdlib/source/lux/control/monad.lux
@@ -4,7 +4,7 @@
(applicative #as A)))
## [Utils]
-(def: (L/fold f init xs)
+(def: (list/fold f init xs)
(All [a b]
(-> (-> b a a) a (List b) a))
(case xs
@@ -12,14 +12,25 @@
init
(#;Cons x xs')
- (L/fold f (f x init) xs')))
+ (list/fold f (f x init) xs')))
+
+(def: (list/size xs)
+ (All [a] (-> (List a) Nat))
+ (loop [counter +0
+ xs xs]
+ (case xs
+ #;Nil
+ counter
+
+ (#;Cons _ xs')
+ (recur (n.inc counter) xs'))))
(def: (reverse xs)
(All [a]
(-> (List a) (List a)))
- (L/fold (function [head tail] (#;Cons head tail))
- #;Nil
- xs))
+ (list/fold (function [head tail] (#;Cons head tail))
+ #;Nil
+ xs))
(def: (as-pairs xs)
(All [a] (-> (List a) (List [a a])))
@@ -49,33 +60,35 @@
(wrap (f3 z))))}
(case tokens
(#;Cons monad (#;Cons [_ (#;Tuple bindings)] (#;Cons body #;Nil)))
- (let [g!map (: Code [_cursor (#;Symbol ["" " map "])])
- g!join (: Code [_cursor (#;Symbol ["" " join "])])
- g!apply (: Code [_cursor (#;Symbol ["" " apply "])])
- body' (L/fold (: (-> [Code Code] Code Code)
- (function [binding body']
- (let [[var value] binding]
- (case var
- [_ (#;Tag ["" "let"])]
- (` (let (~ value) (~ body')))
-
- _
- (` (|> (~ value) ((~ g!map) (function [(~ var)] (~ body'))) (~ g!join)))
- ))))
- body
- (reverse (as-pairs bindings)))]
- (#;Right [state (#;Cons (` ("lux case" (~ monad)
- (~' @)
- ("lux case" (~' @)
- {#applicative {#A;functor {#F;map (~ g!map)}
- #A;wrap (~' wrap)
- #A;apply (~ g!apply)}
- #join (~ g!join)}
- (~ body'))))
- #;Nil)]))
+ (if (|> bindings list/size (n.% +2) (n.= +0))
+ (let [g!map (: Code [_cursor (#;Symbol ["" " map "])])
+ g!join (: Code [_cursor (#;Symbol ["" " join "])])
+ g!apply (: Code [_cursor (#;Symbol ["" " apply "])])
+ body' (list/fold (: (-> [Code Code] Code Code)
+ (function [binding body']
+ (let [[var value] binding]
+ (case var
+ [_ (#;Tag ["" "let"])]
+ (` (let (~ value) (~ body')))
+
+ _
+ (` (|> (~ value) ((~ g!map) (function [(~ var)] (~ body'))) (~ g!join)))
+ ))))
+ body
+ (reverse (as-pairs bindings)))]
+ (#;Right [state (#;Cons (` ("lux case" (~ monad)
+ (~' @)
+ ("lux case" (~' @)
+ {#applicative {#A;functor {#F;map (~ g!map)}
+ #A;wrap (~' wrap)
+ #A;apply (~ g!apply)}
+ #join (~ g!join)}
+ (~ body'))))
+ #;Nil)]))
+ (#;Left "'do' bindings must have an even number of parts."))
_
- (#;Left "Wrong syntax for do")))
+ (#;Left "Wrong syntax for 'do'")))
## [Functions]
(def: #export (seq monad xs)
diff --git a/stdlib/source/lux/data/text/lexer.lux b/stdlib/source/lux/data/text/lexer.lux
index 7ad4a0954..45effa773 100644
--- a/stdlib/source/lux/data/text/lexer.lux
+++ b/stdlib/source/lux/data/text/lexer.lux
@@ -66,11 +66,13 @@
(-> Text (Lexer Unit))
(function [[offset tape]]
(case (text;index-of reference offset tape)
- (^multi (#;Some where) (n.= offset where))
- (#E;Success [[(n.+ (text;size reference) offset) tape] []])
+ (#;Some where)
+ (if (n.= offset where)
+ (#E;Success [[(n.+ (text;size reference) offset) tape] []])
+ (#E;Error ($_ text/compose "Could not match: " (text;encode reference) " @ " (maybe;assume (text;clip' offset tape)))))
_
- (#E;Error ($_ text/compose "Could not match: " (text;encode reference) " @ " tape)))))
+ (#E;Error ($_ text/compose "Could not match: " (text;encode reference))))))
(def: #export (this? reference)
{#;doc "Lex a text if it matches the given sample."}
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-25 04:16:10 +0000