diff options
Diffstat (limited to 'control')
| -rw-r--r-- | control/monad.scm | 16 | ||||
| -rw-r--r-- | control/monad/state.scm | 19 |
2 files changed, 24 insertions, 11 deletions
diff --git a/control/monad.scm b/control/monad.scm index e964b48..4b756c7 100644 --- a/control/monad.scm +++ b/control/monad.scm @@ -37,6 +37,17 @@ ;;; ---------------------------------------- +;; This makes all curly infix operators be left associative, +;; discarding regular order of operations. +;; It does however work in my below example where I do +;; > f <$> a <*> b +;; Which is all that really matters. +(define-syntax $nfx$ + (syntax-rules () + ((_ single) single) + ((_ a * b rest ...) + ($nfx$ (* a b) rest ...)))) + ;; sequence :: (list (M a)) → M (list a) (define (sequence in-list) "Evaluate each monadic action in the structure from left to right, and collect @@ -44,7 +55,8 @@ the results. For a version that ignores the results see sequence_. https://hackage.haskell.org/package/base-4.12.0.0/docs/Control-Monad.html#g:4" (define ((f done) item) (append done (list item))) (fold (lambda (m-item m-done) - #!curly-infix {{ f <$> m-done } <*> m-item }) + #!curly-infix { f <$> m-done <*> m-item }) + ;; TODO this fails on a list of length 0 ((return (car in-list)) '()) in-list)) @@ -54,4 +66,4 @@ https://hackage.haskell.org/package/base-4.12.0.0/docs/Control-Monad.html#g:4" left to right, and collect the results. For a version that ignores the results see mapM_. https://hackage.haskell.org/package/base-4.12.0.0/docs/Control-Monad.html#g:4" - (sequence (map proc items))) + (sequence (map (lambda (x) (>>= x proc)) items))) diff --git a/control/monad/state.scm b/control/monad/state.scm index f7190af..b5fefe3 100644 --- a/control/monad/state.scm +++ b/control/monad/state.scm @@ -2,9 +2,8 @@ #:use-module (oop goops) #:use-module (ice-9 match) #:use-module (control monad) - #:use-module (data functor) #:export (return-state run-state get put modify) - #:re-export (>>= >> fmap)) + #:re-export (>>= >> fmap return)) ;; Alternative implementation of get. @@ -49,14 +48,16 @@ ((v _) ((proc (f v)) new-st-list))))) -(define-stateful-method ((>> (a <state>) (b <state>)) st-list-a) - (let ((st-list-b ((proc a) st-list-a))) - ((proc b) st-list-b))) +;; (define-stateful-method ((>> (a <state>) (b <state>)) st-list-a) +;; (let ((st-list-b ((proc a) st-list-a))) +;; ((proc b) st-list-b))) (define-stateful ((return-state v) st-list) "Sets the return value to v" (cons v (cdr st-list))) +(define-method (return (a <state>)) return-state) + (define-stateful ((get) st-list) "Sets the return value of state to st." (match st-list @@ -72,10 +73,10 @@ ((r s) (list '() (proc s))))) -(define-stateful-method ((fmap (f <procedure>) (s <state>)) st-list) - (match ((proc s) st-list) - ((r st) - (list (f r) st)))) +;; (define-stateful-method ((fmap (f <procedure>) (s <state>)) st-list) +;; (match ((proc s) st-list) +;; ((r st) +;; (list (f r) st)))) (define-method (run-state (st <state>) init) "Exec state with init as starting state value and st." |