diff options
Diffstat (limited to '')
| -rw-r--r-- | source/lux/control/comonad.lux | 44 |
1 files changed, 21 insertions, 23 deletions
diff --git a/source/lux/control/comonad.lux b/source/lux/control/comonad.lux index ce9a7e7de..2543f34da 100644 --- a/source/lux/control/comonad.lux +++ b/source/lux/control/comonad.lux @@ -1,17 +1,13 @@ -## Copyright (c) Eduardo Julian. All rights reserved. -## The use and distribution terms for this software are covered by the -## Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -## which can be found in the file epl-v10.html at the root of this distribution. -## By using this software in any fashion, you are agreeing to be bound by -## the terms of this license. -## You must not remove this notice, or any other, from this software. +## Copyright (c) Eduardo Julian. All rights reserved. +## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +## If a copy of the MPL was not distributed with this file, +## You can obtain one at http://mozilla.org/MPL/2.0/. (;import lux (../functor #as F) - lux/data/list - lux/meta/macro) + (lux/data/list #refer #all #open ("" List/Fold))) -## Signatures +## [Signatures] (defsig #export (CoMonad w) (: (F;Functor w) _functor) @@ -22,33 +18,35 @@ (-> (w a) (w (w a)))) split)) -## Functions +## [Functions] (def #export (extend w f ma) (All [w a b] (-> (CoMonad w) (-> (w a) b) (w a) (w b))) (using w - (using _functor - (map f (split ma))))) + (map f (split ma)))) -## Syntax +## [Syntax] (defmacro #export (be tokens state) (case tokens - (\ (list monad (#;Meta [_ (#;TupleS bindings)]) body)) - (let [body' (foldL (: (-> Syntax (, Syntax Syntax) Syntax) + (#;Cons comonad (#;Cons [_ (#;TupleS bindings)] (#;Cons body #;Nil))) + (let [g!map (: AST [["" -1 -1] (#;SymbolS ["" " map "])]) + g!split (: AST [["" -1 -1] (#;SymbolS ["" " split "])]) + body' (foldL (: (-> AST (, AST AST) AST) (lambda [body' binding] (let [[var value] binding] (case var - (#;Meta [_ (#;TagS ["" "let"])]) - (` (;let (~ value) (~ body'))) + [_ (#;TagS ["" "let"])] + (` (let (~ value) (~ body'))) _ - (` (extend (;lambda [(~ var)] (~ body')) - (~ value))))))) + (` (|> (~ value) (~ g!split) ((~ g!map) (lambda [(~ var)] (~ body'))))) + )))) body (reverse (as-pairs bindings)))] - (#;Right [state (list (` (;case (~ monad) - {#;return ;return #;bind ;bind} - (~ body'))))])) + (#;Right [state (#;Cons (` (case (~ comonad) + {#_functor {#F;map (~ g!map)} #unwrap (~ (' unwrap)) #split (~ g!split)} + (~ body'))) + #;Nil)])) _ (#;Left "Wrong syntax for be"))) |