From e41ade0f54d47ec3e07593f0763521aedc8ad390 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Mon, 18 Mar 2019 18:25:25 +0100
Subject: Assorted comments and cleanup.

---
 control/monad.scm       | 16 ++++++++++++++--
 control/monad/state.scm | 19 ++++++++++---------
 2 files changed, 24 insertions(+), 11 deletions(-)

(limited to 'control')

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."
-- 
cgit v1.2.3