4 files changed, 143 insertions(+), 248 deletions(-)
M README.md
R syntax/def-old.scm =>
R syntax/def.scm =>
A => syntax/define.scm
M README.md +1 -1
@@ 18,5 18,5 @@ The macros are currently written in synt
## License
Permissified ISC.
-## DOCUMENTATION
+## Documentation
There is none, however there are is info in the source comments.
R syntax/def-old.scm => +0 -107
@@ 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 ...)))))
R syntax/def.scm => +0 -140
@@ 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)))))
A => syntax/define.scm +142 -0
@@ 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 ...))))
+