From 701bd4a9ad93d10ad8b6a0ef747869d544c5da8b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@hornquist.se>
Date: Sat, 10 Nov 2018 18:37:16 +0100
Subject: Fix problem with do notation being really broken.

---
 control/monad.scm | 32 ++++----------------------------
 data/optional.scm | 38 ++------------------------------------
 2 files changed, 6 insertions(+), 64 deletions(-)

diff --git a/control/monad.scm b/control/monad.scm
index e5dc89d..8bc46bf 100644
--- a/control/monad.scm
+++ b/control/monad.scm
@@ -1,39 +1,15 @@
 (define-module (control monad)
   #:use-module (control monad procedures)
-  ;; #:use-module (control monad syntax)
-  #:export (do <-)
-  ;; #:re-export (>>= do <-)
-                )
+  #:export (do)
+  #:re-export (>>=))
 
 (define-syntax do
   (syntax-rules (<- let =)
     ((_ let var = val rest ...)
      (let ((var val)) (do rest ...)))
-    ((_ ptrn <- val rest ...)
-     (<- ptrn val rest ...))
+    ((_ var <- val rest ...)
+     (>>= val (lambda (var) (do rest ...))))
     ((_ a) a)
     ((_ token rest ...)
      (begin token (do rest ...)))))
 
-(define-syntax <-
-  (syntax-rules (just writer)
-    ((_ (just var) val rest ...)
-     (>>= val (lambda (var) rest ...)))
-    ((_ (writer var) val rest ...)
-     (>>= val (lambda (var) rest ...))))
-  
-  
-  #;
-  (lambda (x)
-    (syntax-case x (just writer)
-      ((_ (just var) val rest ...)
-       #'(>>= val (lambda (var) rest ...)))
-      ((_ (writer var) val rest ...)
-       #'(>>= val (lambda (var) rest ...)))
-      #; 
-      ((_ (left var) val rest ...)      ;
-      #'(>>= val (lambda (var) rest ...)))
-      #; 
-      ((_ (right var) val rest ...)     ;
-      #'(>>= val (lambda (var) rest ...))))))
-
diff --git a/data/optional.scm b/data/optional.scm
index 462c01b..a1968f0 100644
--- a/data/optional.scm
+++ b/data/optional.scm
@@ -4,9 +4,8 @@
   #:use-module (control monad)
   #:export (nothing just
                     nothing? just?
-                    return-optional
-                    do <-)
-  ;; #:re-export (>>=)
+                    return-optional)
+  #:re-export (>>=)
   )
 
 (define-class <optional> ()
@@ -46,36 +45,3 @@
 (define-method (mappend (a <optional>) (b <optional>))
   (match a
     (($ ))))
-
-
-(define-syntax do
-  (syntax-rules (<- let =)
-    ((_ let var = val rest ...)
-     (let ((var val)) (do rest ...)))
-    ((_ ptrn <- val rest ...)
-     (<- ptrn val rest ...))
-    ((_ a) a)
-    ((_ token rest ...)
-     (begin token (do rest ...)))))
-
-(define-syntax <-
-  (syntax-rules (just writer)
-    ((_ (just var) val rest ...)
-     (>>= val (lambda (var) rest ...)))
-    ((_ (writer var) val rest ...)
-     (>>= val (lambda (var) rest ...))))
-  
-  
-  #;
-  (lambda (x)
-    (syntax-case x (just writer)
-      ((_ (just var) val rest ...)
-       #'(>>= val (lambda (var) rest ...)))
-      ((_ (writer var) val rest ...)
-       #'(>>= val (lambda (var) rest ...)))
-      #; 
-      ((_ (left var) val rest ...)      ;
-      #'(>>= val (lambda (var) rest ...)))
-      #; 
-      ((_ (right var) val rest ...)     ;
-      #'(>>= val (lambda (var) rest ...))))))
-- 
cgit v1.2.3