# HG changeset patch
# User Linus Björnstam <bjornstam.linus@fastmail.se>
# Date 1566385130 -7200
#      Wed Aug 21 12:58:50 2019 +0200
# Node ID 9ea499203e265fbc0390a84af7a41c956903c6a7
# Parent  b9f2f35995befab5cf0cd37e932545549437b476
much better solution

diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -18,5 +18,5 @@
 ## License
 Permissified ISC.
 
-## DOCUMENTATION
+## Documentation
 There is none, however there are is info in the source comments.
diff --git a/syntax/def-old.scm b/syntax/def-old.scm
deleted file mode 100644
--- a/syntax/def-old.scm
+++ /dev/null
@@ -1,107 +0,0 @@
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Copyright 2019 Linus Björnstam
-;;
-;; Permission to use, copy, modify, and/or distribute this software for any
-;; purpose with or without fee is hereby granted, provided that the above
-;; copyright notice and this permission notice appear in all source copies.
-;; The software is provided "as is", without any express or implied warranties.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;; A small extension to define* that allows for arbitrary positions of defines in
-;; the toplevel of a function body.  Guile follows r6rs in that it does not allow
-;; defines in "expression context", which means all (define ...) must happen at
-;; the top of a funciton definition. This macro solves that, in that it allows defines
-;; at any "toplevel" place within the function body.
-;;
-;; Example:
-;; in guile the following is not allowed:
-;;
-;;   (define (do-stuff a b)
-;;     (define c (wowza a))
-;;     (unless c (error "holy hell"))
-;;     (define abc (+ a b c))
-;;     (/ 100 abc))
-;;
-;; because (define abc ...) is in expression context.
-;; You solve this by using let, let*, letrec or letrec* as appropriate.
-;; OR by using this macro.
-;; The above code would work just fine if you replaced the top define with def.
-;; It transforms defines in expression context to letrec, and as an added bonus
-;; transforms (def ...) in expression context to (let* ...). Why? Because
-;; it is less heavy than letrec. If you have a function that is called a million times
-;; that has very little overhead, you will actually have quite a speedup by not using
-;; defines in the function body, at least on guile 2.2.
-;;
-;;; How does it work?
-;; Well, I'm glad you asked! The magic macro is %body, which walks through the body of
-;; def. It if finds a define, it dispatches that part of the body to %define.
-;; %define takes all defines it can find in a row and turns them into a letrec.
-;;
-;; If %body finds a (def ...) it turns it into a simple (let ...). Guile transforms
-;; any chained lets into let*.
-;;
-;;; What are the finer details?
-;; It does not recursively walk the body, so only "local toplevel" defines/defs are
-;; transformed. Doing that would be non-trivial using syntax-rules and quite simple 
-;; using syntax-case. I spent a total of 5 minutes writing this macro, and getting the
-;; inns and outs of recursive body transversal correct would have taken some more time.
-;;
-;; (def (name formals ...) body ...) gets transformed into (define* ...). This is a fine
-;; transformation to do, since any define* that does not use the extra features is the same
-;; as a regular define in every way. Internal (define (...) ...) are converted to lambda*.
-;; This is fine for the same reason.
-;;
-;;; Is it well tested?
-;; I wrote this code in 6 minutes, and it worked as I expected on the first try. I did not
-;; do any testing whatsoever. It might actually not work at all for you.
-;;
-;;; Future of this macro?
-;; I will probably convert it to syntax-case to do proper transversals and rewriting of
-;; function bodies. I want to allow for arbitrary placement of defines and defs, like
-;; for example in cond clauses.
-
-(define-module (syntax def)
-  #:export (def def2))
-
-(define-syntax %define
-  (syntax-rules (define)
-    ((_ (bindings ...) (define (name formals ...) body ...) rest ...)
-     (%define (bindings ... (name (%lambda (formals ...) body ...))) rest ...))
-    ((_ (bindings ...) (define name expr) rest ...)
-     (%define (bindings ... (name expr)) rest ...))
-    ((_ bindings rest ...)
-     (letrec bindings
-       (%body rest ...)))))
-
-
-(define-syntax %lambda
-  (syntax-rules ()
-    ((_ (. formals) body ...)
-     (lambda* formals body ...))
-    ((_ (formals ...) body ...)
-     (lambda* (formals ...) body ...))))
-
-(define-syntax %body
-  (syntax-rules (def define)
-    ((_ (define stuff ...) rest ...)
-     (%define () (define stuff ...) rest ...))
-    ((_ (def (name formals ...) body ...) rest ...)
-     (let ((name (%lambda (formals ...) (%body body ...))))
-       (%body rest ...)))
-    ((_ (def name expr) rest ...)
-     (let ((name expr))
-       (%body rest ...)))
-
-    ;; Just a simple expression and nothing more.
-    ;; %body is now unnecessary and it can die.
-    ((_ end)
-     end)
-    ;; A non-def(ine) expression. Examine the rest!
-    ((_ expr rest ...)
-     (begin expr (%body rest ...)))))
-
-(define-syntax def
-  (syntax-rules ()
-    ((_ name expr) (define name expr))
-    ((_ (name formals ...) body ...)
-     (define* (name formals ...) (%body body ...)))))
diff --git a/syntax/def.scm b/syntax/def.scm
deleted file mode 100644
--- a/syntax/def.scm
+++ /dev/null
@@ -1,140 +0,0 @@
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Copyright 2019 Linus Björnstam
-;;
-;; Permission to use, copy, modify, and/or distribute this software for any
-;; purpose with or without fee is hereby granted, provided that the above
-;; copyright notice and this permission notice appear in all source copies.
-;; The software is provided "as is", without any express or implied warranties.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;; A small extension to define* that allows for arbitrary positions of defines in
-;; any place in a function body.  Guile follows r6rs in that it does not allow
-;; defines in "expression context", which means all (define ...) must happen at
-;; the top of a funciton definition. This macro solves that, in that it allows defines
-;; at any place within the function body.
-;;
-;; Example:
-;; in guile the following is not allowed:
-;;
-;;   (define (do-stuff a b)
-;;     (define c (wowza a))
-;;     (unless c (error "holy hell"))
-;;     (define abc (+ a b c))
-;;     (/ 100 abc))
-;;
-;; because (define abc ...) is in expression context.
-;; You solve this by using let, let*, letrec or letrec* as appropriate.
-;; OR by using this macro. Rewritten for the macro syntax, it would look like this:
-;;
-;;  (def (do-stuff a b)
-;;    (let! c (wowza a))
-;;    (unless c (error "holy hell!"))
-;;    (let! abc (+ a b c))
-;;    (/ 100 abc))
-;;
-;; All the binds are converted to lets, and subsequent expressions are inserted into the let
-;; body. Subsequent binds are converted into (let* ...). If you want to define recursive functions
-;; you must use (def ...). (def ...) anywhere in the function body is converted to letrec.
-;;
-;;; Examples
-;; can be found in the examples.scm file in the project root.
-;;
-;;; How does it work?
-;; It transverses the body of the function and when it finds any (def ...)s or a (let! ...)s
-;; it converts them into letrec or let* respectively and rewrites the code so that any following
-;; expressions are in the letrec/let* body. Any def or let! body is transversed as well.
-;;
-;; The macro %define converts all subsequent defs into a letrec and then continues to transverse
-;; the body. The %lambda macro is just a helper macro that rewrites the lambda body like def does.
-;;
-;;; Is it tested?
-;; Nope. I had some code that went into an infinite loop, but I can't seem to reproduce it.
-;;
-;;; Why provide a let! binding?
-;; Because letrec has quite a bit of overhead in cases where it can't be optimized. let* does not.
-;; If all bindings are known at compile time and you are not doing anything fancy, this will not matter
-;; much, but for those other cases where you don't need recursive functions let! will bring the overhead
-;; down.
-;;
-;;; Is this a good solution?
-;; No. It's actually quite bad. Try this: (def (hej blah) (if blah #t (let! a 5) (let! b 8) (display "WHAT?!")))
-;; Oh yes. That is ugly, at best.
-
-(define-module (syntax def)
-  #:export (def let! let*!))
-
-(define-syntax def
-  (lambda (stx)
-    (syntax-case stx ()
-      ((_ (name formals ...) body ...)
-       #'(define* (name formals ...) (%body body ...)))
-      ((_ name expr ...) #'(define name (%body expr ...))))))
-
-(define-syntax-rule (let! ...)
-  (syntax-error "Usage of let! outside def"))
-
-(define-syntax-rule (let*! ...)
-  (syntax-error "Usage of let*! outside def"))
-
-(define-syntax %let!
-  (syntax-rules (let!)
-    ((_ (bindings ...) (let! (name formals ...) body ...) rest ...)
-     (%let! (bindings ... (name (%lambda (formals ...) body ...))) rest ...))
-    ((_ (bindings ...) (let! name expr) rest ...)
-     (%let! (bindings ... (name expr)) rest ...))
-    ((_ bindings rest ...)
-     (let bindings
-       (%body rest ...)))))
-
-
-(define-syntax %define
-  (syntax-rules (def)
-    ((_ (bindings ...) (def (name formals ...) body ...) rest ...)
-     (%define (bindings ... (name (%lambda (formals ...) body ...))) rest ...))
-    ((_ (bindings ...) (def name expr) rest ...)
-     (%define (bindings ... (name expr)) rest ...))
-    ((_ bindings rest ...)
-     (letrec bindings
-       (%body rest ...)))))
-
-
-(define-syntax %lambda
-  (lambda (stx)
-    (syntax-case stx ()
-      ((_ (. formals) body ...)
-       (with-syntax (((newbody ...) (transverse #'(() body ...))))
-         #'(lambda* formals newbody ...)))
-      ((_ (formals ...) body ...)
-       (with-syntax (((newbody ...) (transverse #'(() body ...))))
-         #'(lambda* (formals ...) newbody ...))))))
-
-
-
-(define (transverse stx)
-  (syntax-case stx (def let! let*!)
-    ((acc) #'acc)
-    (((acc ...) (def stuff ...) rest ...)
-     #'(acc ... (%define () (def stuff ...) rest ...)))
-    (((acc ...) (let! stuff ...) rest ...)
-     #'(acc ... (%let! () (let! stuff ...) rest ...)))
-
-    (((acc ...) (let*! (name formals ...) stuff ...) rest ...)
-     #'(acc ... (let ((name (%lambda (formals ...) stuff ...))) (%body stuff ...))))
-    (((acc ...) (let*! name stuff ...) rest ...)
-     #'(acc ... (let ((name  (%body stuff ...))) (%body rest ...))))
-
-    (((acc ...) (stuff ...) rest ...)
-     (with-syntax ((newacc (transverse #'(() stuff ...))))
-       (transverse #'((acc ... newacc) rest ...))))
-    (((acc ...) atom rest ...)
-     (transverse #'((acc ... atom) rest ...)))))
-
-(define-syntax %body
-  (lambda (stx)
-    (syntax-case stx ()
-      ((_ stuff ...)
-       (with-syntax (((body ...) (transverse #'(() stuff ...))))
-         #'(begin body ...)))
-      ((_ atom)
-       #'atom)
-      ((_) #'(begin)))))
diff --git a/syntax/define.scm b/syntax/define.scm
new file mode 100644
--- /dev/null
+++ b/syntax/define.scm
@@ -0,0 +1,142 @@
+;; Fix guile to have definitions in expression context in most common constructs.
+;; nothing for srfi-11 so far. This is written using syntax-rules and should
+;; be portable across implementation.
+
+
+
+(define-module (syntax define)
+  #:use-module (ice-9 receive)
+  #:replace ((new-lambda . lambda)
+             (new-define . define)
+             (new-begin . begin)
+             (new-let . let)
+             (new-let* . let*)
+             (let-letrec . letrec)
+             (new-letrec* . letrec*)
+             (new-case . case)
+             (new-cond . cond)
+             ))
+
+
+
+(define-syntax new-lambda
+  (syntax-rules ()
+    ((_ formals body body* ...)
+     (lambda formals (new-begin body body* ...)))))
+
+(define-syntax new-define
+  (syntax-rules ()
+    ((_ (name args ...) body body* ...)
+     (define name (new-lambda (args ...) body body* ...)))
+    ((_ name expr) (define name expr))))
+
+
+(define-syntax new-begin
+  (syntax-rules ()
+    ((_ one-thing-only)
+     one-thing-only)
+    ((_ stuff ...)
+     (%parse-body () stuff ...))))
+
+(define-syntax new-let
+  (syntax-rules ()
+    ((_ clauses body body* ...)
+     (let clauses (new-begin body body* ...)))))
+
+(define-syntax new-let*
+  (syntax-rules ()
+    ((_ clauses body body* ...)
+     (let* clauses (new-begin body body* ...)))))
+
+(define-syntax new-letrec
+  (syntax-rules ()
+    ((_ clauses body body* ...)
+     (letrec clauses (new-begin body body* ...)))))
+
+(define-syntax new-letrec*
+  (syntax-rules ()
+    ((_ clauses body body* ...)
+     (letrec* clauses (new-begin body body* ...)))))
+
+(define-syntax new-case
+  (syntax-rules (else =>)
+    ;; Special case for else with a lambda-clause.
+    ((_ expr
+        (test body ...)
+        (else => else-body ...))
+     (case expr
+       (test (new-begin body ...))
+       (else => (new-begin else-body ...))))
+    ((_ expr
+        (test body ...) ...)
+     (case expr
+       (test (new-begin body ...)) ...))))
+
+
+
+
+;; Exploits the fact that cond is just transformed into an if.
+;; This means we can, as with case, just re-use guile's own
+;; cond. Guile supports a non-standard guard-case. This should be removed
+;; if porting to any other scheme.
+(define-syntax new-cond
+  (syntax-rules (=> else)
+    ;; Guile-specific guard case
+    ((_ (test guard => body ...) rest ...)
+     (receive vals test
+       (if (apply guard vals)
+           (apply (new-begin body ...) vals)
+           (internal-cond rest ...))))
+
+    ;; Lambda case
+    ((_ (test => body ...) rest ...)
+     (let ((temp test))
+        (if test
+            ((new-begin body ...) temp)
+            (internal-cond rest ...))))
+
+    ;; Else case
+    ((_ (else body ...))
+     (new-begin body ...))
+
+    ;; No clauses left and no else clause.
+    ((_) (if #f #f))
+
+    ;; Normal case
+    ((_ (test body ...) rest ...)
+     (if test
+          (new-begin body ...)
+          (internal-cond rest ...)))))
+
+
+
+;;(%parse-define (clauses ...) body ...)
+(define-syntax %parse-define
+  (syntax-rules (new-define)
+    ;; procedure definition
+    ((_ (clauses ...) (new-define (name args ...) body body* ...) rest ... )
+     (%parse-define (clauses ... (name (new-lambda (args ...) body body* ...))) rest ... ))
+
+    ;; Variable definition
+    ((_ (clauses ...) (new-define name expr) rest ...)
+     (%parse-define (clauses ... (name expr)) rest ...))
+
+    ;; Exit
+    ((_ clauses rest ...)
+     (letrec clauses
+       (%parse-body () rest ...)))))
+
+;; A macro that transverses expressions
+;; (%parse-body (seen-exprssions ...) rest ...)
+(define-syntax %parse-body
+  (syntax-rules (new-define)
+    ;; Found no definitions. Just exit
+    ((_ (exprs ...))
+     (begin exprs ...))
+    ;; A definition, exit to %parse-define
+    ((_ (exprs ...) (new-define stuff ...) rest ...)
+     (begin exprs ... (%parse-define () (new-define stuff ...) rest ... )))
+    ;; Just a new expression.
+    ((_ (exprs ...) new-expr rest ...)
+     (%parse-body (exprs ... new-expr) rest ...))))
+