diff options
Diffstat (limited to 'stdlib/source/lux/abstract/monad/indexed.lux')
-rw-r--r-- | stdlib/source/lux/abstract/monad/indexed.lux | 64 |
1 files changed, 64 insertions, 0 deletions
diff --git a/stdlib/source/lux/abstract/monad/indexed.lux b/stdlib/source/lux/abstract/monad/indexed.lux new file mode 100644 index 000000000..57a18c109 --- /dev/null +++ b/stdlib/source/lux/abstract/monad/indexed.lux @@ -0,0 +1,64 @@ +(.module: + [lux #* + [control + [monad] + ["p" parser]] + [data + [collection + ["." list ("#;." functor fold)]]] + ["." macro + ["s" syntax (#+ Syntax syntax:)]]]) + +(signature: #export (IxMonad m) + (: (All [p a] + (-> a (m p p a))) + wrap) + + (: (All [ii it io vi vo] + (-> (-> vi (m it io vo)) + (m ii it vi) + (m ii io vo))) + bind)) + +(type: Binding [Code Code]) + +(def: binding + (Syntax Binding) + (p.and s.any s.any)) + +(type: Context + (#Let (List Binding)) + (#Bind Binding)) + +(def: context + (Syntax Context) + (p.or (p.after (s.this (' #let)) + (s.tuple (p.some binding))) + binding)) + +(def: (pair-list [binding value]) + (All [a] (-> [a a] (List a))) + (list binding value)) + +(syntax: #export (do monad + {context (s.tuple (p.some context))} + expression) + (macro.with-gensyms [g!_ g!bind] + (wrap (list (` (let [(~' @) (~ monad) + {#..wrap (~' wrap) + #..bind (~ g!bind)} (~' @)] + (~ (list;fold (function (_ context next) + (case context + (#Let bindings) + (` (let [(~+ (|> bindings + (list;map pair-list) + list.concat))] + (~ next))) + + (#Bind [binding value]) + (` ((~ g!bind) + (.function ((~ g!_) (~ binding)) + (~ next)) + (~ value))))) + expression + (list.reverse context))))))))) |