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 ++++++++++---------
 data/either.scm         |  4 +++-
 data/monoid.scm         |  1 +
 data/stack.scm          |  3 +++
 data/writer.scm         |  1 +
 6 files changed, 32 insertions(+), 12 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."
diff --git a/data/either.scm b/data/either.scm
index d6e0f73..c597a60 100644
--- a/data/either.scm
+++ b/data/either.scm
@@ -1,3 +1,5 @@
+;;; TODO UNFINISHED
+
 (define-module (data either)
   #:use-module (oop goops)
   #:use-module (ice-9 match))
@@ -22,7 +24,7 @@
 (define-method (>>= (this <either>)
                     (proc <procedure>))
   (case (slot-ref this 'dir)
-    ((left) this) 
+    ((left) this)
     ((right) (match this (($ <either> slot) (proc slot))))))
 
 (define return-either right)
diff --git a/data/monoid.scm b/data/monoid.scm
index 45d30cd..d33557e 100644
--- a/data/monoid.scm
+++ b/data/monoid.scm
@@ -1,3 +1,4 @@
+;;; ???
 (define-module (data monoid)
   #:use-module (oop goops)
   #:use-module (srfi srfi-1)
diff --git a/data/stack.scm b/data/stack.scm
index c28d648..d470394 100644
--- a/data/stack.scm
+++ b/data/stack.scm
@@ -1,4 +1,5 @@
 (define-module (data stack)
+  #:export (pop peek push)
   #:use-module (control monad)
   #:use-module (control monad state))
 
@@ -6,6 +7,8 @@
 ;;; in action. These functions assume that they are in a
 ;;; (state list) monad. But dynamic types!
 
+;;; TODO test these for empty stack
+
 (define (pop)
   (do st <- (get)
       let top = (car st)
diff --git a/data/writer.scm b/data/writer.scm
index 93f3798..bf391c2 100644
--- a/data/writer.scm
+++ b/data/writer.scm
@@ -30,6 +30,7 @@
                       (writer val (<> monoid-a monoid-b))
                       )))))
 
+;;; TODO replace this
 (define (return-writer val)
   (writer val ""))
 
-- 
cgit v1.2.3