M README.md +5 -6
@@ 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 @@ Install it in your site-dir and import i
(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.
A => examples.scm +39 -0
@@ 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!)
M syntax/def.scm => syntax/def-old.scm +1 -1
@@ 61,7 61,7 @@
;; for example in cond clauses.
(define-module (syntax def)
- #:export (def))
+ #:export (def def2))
(define-syntax %define
(syntax-rules (define)
M syntax/def.scm +96 -63
@@ 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)))))