diff options
Diffstat (limited to 'stdlib/source/lux/control/monad.lux')
| -rw-r--r-- | stdlib/source/lux/control/monad.lux | 73 |
1 files changed, 43 insertions, 30 deletions
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) |