# HG changeset patch
# User Linus Björnstam <bjornstam.linus@fastmail.se>
# Date 1565265622 -7200
#      Thu Aug 08 14:00:22 2019 +0200
# Node ID b9f2f35995befab5cf0cd37e932545549437b476
# Parent  d6caf093bdc904692f942b82b5adfd70f341fa46
Update

diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -1,4 +1,4 @@
-A small utility macro to allow defines in expression context in the "toplevel" of function bodies.
+A small utility macro to allow defines in expression context of function bodies.
 Install it in your site-dir and import it using (use-modules (syntax def))
 
 ## Example
@@ -6,15 +6,14 @@
     (use-modules (syntax def))
     (def (divide-minus-one a b)
       (when (= b 1) (error "We don't allow that here"))
-      (define b* (- b 1))
+      (def b* (- b 1))
       (/ a b*))
 
-This transforms all defines in expression context to (letrec ...). It also supports using (def ...) in expression
-context, but those are transformed into let*, which has less overhead in guile (2.2 at least).
+This transforms all defines in expression context to (letrec ...). It also supports using (let! ...) and (let\*! ...) in expression
+context, but those are transformed into let and  let* respectively, which has less overhead than letrec in guile.
 
 ## Portability
-The macros are currently written in syntax-rules. If that isn't supported in your scheme, then I'm not really sure
-it is a scheme.
+The macros are currently written in syntax-case. If that isn't supported in your scheme, then tough luck.
 
 ## License
 Permissified ISC.
diff --git a/examples.scm b/examples.scm
new file mode 100644
--- /dev/null
+++ b/examples.scm
@@ -0,0 +1,39 @@
+(use-modules (syntax def))
+
+;; This is a sort of contrived example since you wouldn't write it like this.
+(def (fib n)
+  (unless (positive? n)
+    (error "positives only!"))
+  (def (internal-fib n a b)
+    (cond
+     ((zero? n) a)
+     (else
+      (let*! next-a b)
+      (let*! next-b (+ a b))
+      (let*! next-n (1- n))
+      (internal-fib next-n next-a next-b))))
+  (internal-fib n 0 1))
+
+
+;; That code expands into:
+(define (fib1 n)
+  (if ((@@ (guile) not) (positive? n))
+      (error "positives only!"))
+  (let internal-fib ((n n) (a 0) (b 1))
+    (if (zero? n)
+        a
+        (let* ((next-a b) (next-b (+ a b)) (next-n (#{1-}# n)))
+          (internal-fib next-n next-a next-b)))))
+
+;; and optimizes into
+(define (fib2 n)
+  (if (> n 0)
+      (if #f #f)
+      (throw 'misc-error #f "positives only!" '() #f))
+  (let internal-fib ((n n) (a 0) (b 1))
+    (if (= n 0)
+        a
+        (let* ((next-b (+ a b)) (next-n (- n 1)))
+          (internal-fib next-n b next-b)))))
+
+;; which is as good as it gets when you don't want to use parallel assignment (future improvement!)
diff --git a/syntax/def.scm b/syntax/def-old.scm
copy from syntax/def.scm
copy to syntax/def-old.scm
--- a/syntax/def.scm
+++ b/syntax/def-old.scm
@@ -61,7 +61,7 @@
 ;; for example in cond clauses.
 
 (define-module (syntax def)
-  #:export (def))
+  #:export (def def2))
 
 (define-syntax %define
   (syntax-rules (define)
diff --git a/syntax/def.scm b/syntax/def.scm
--- a/syntax/def.scm
+++ b/syntax/def.scm
@@ -8,10 +8,10 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;
 ;; 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
+;; 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 "toplevel" place within the function body.
+;; at any place within the function body.
 ;;
 ;; Example:
 ;; in guile the following is not allowed:
@@ -24,50 +24,74 @@
 ;;
 ;; 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.
+;; 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?
-;; 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.
+;; 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.
 ;;
-;; If %body finds a (def ...) it turns it into a simple (let ...). Guile transforms
-;; any chained lets into let*.
+;; 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.
 ;;
-;;; 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.
+;;; Is it tested?
+;; Nope. I had some code that went into an infinite loop, but I can't seem to reproduce it.
 ;;
-;; (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.
+;;; 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 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.
+;;; 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))
+  #: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 (define)
-    ((_ (bindings ...) (define (name formals ...) body ...) rest ...)
+  (syntax-rules (def)
+    ((_ (bindings ...) (def (name formals ...) body ...) rest ...)
      (%define (bindings ... (name (%lambda (formals ...) body ...))) rest ...))
-    ((_ (bindings ...) (define name expr) rest ...)
+    ((_ (bindings ...) (def name expr) rest ...)
      (%define (bindings ... (name expr)) rest ...))
     ((_ bindings rest ...)
      (letrec bindings
@@ -75,33 +99,42 @@
 
 
 (define-syntax %lambda
-  (syntax-rules ()
-    ((_ (. formals) body ...)
-     (lambda* formals body ...))
-    ((_ (formals ...) body ...)
-     (lambda* (formals ...) body ...))))
+  (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
-  (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 ...)))))
+  (lambda (stx)
+    (syntax-case stx ()
+      ((_ stuff ...)
+       (with-syntax (((body ...) (transverse #'(() stuff ...))))
+         #'(begin body ...)))
+      ((_ atom)
+       #'atom)
+      ((_) #'(begin)))))