[plt-scheme] macro writing

Hi all,

Peter had posted this code a few days ago; I bounced him a reply 
off-list with a rewrite in the style that I would have written this 
macro. As it apparently has the same functionality, I'm bouncing it back 
out to the list for archival purposes. If anyone has any stylistic 
comments or other feedback, though, please fire away. I'm always 
interested in improving my macro-fu.

Cheers,
M

;; This could also be code in a module that
;; you 'require-for-syntax' in.
(begin-for-syntax
   (define get-args
     (lambda (args)
       (syntax-case args (/)
         [() (syntax ())]
         [(/ a1 ...) (syntax ())]
         [(a2 a3 ...) (cons (syntax a2)
                            (get-args (syntax
                                       (a3 ...))))]
         )))
   (define get-local-init
     (lambda (args)
       (syntax-case args ()
         [() (syntax ())]
         [(a2 a3 ...) (cons (list (syntax a2) #f)
                            (get-local-init (syntax (a3 ...))))]
         [(a1 ...) (list (list (syntax (a1 ...)) #f))]
         )))

   (define get-locals
     (lambda (args)
       (syntax-case args (/)
         [() (syntax ())]
         [(/ a1 ...) (get-local-init (syntax (a1 ...)))]
         [(a2 a3 ...) (get-locals (syntax (a3 ...)))]
         )))
   )

(define-syntax (defun stx)
   (syntax-case stx ()
     ((_ n1 (args ...) e1 e2 ...)
      (let ([new-args (get-args (syntax (args ...)))]
            [new-locals (get-locals (syntax (args ...)))])

        ;; Personally, I'm fond of the quasiquote-syntax
        ;; form. It allows me to quickly and easily express
        ;; syntactic forms without all the (syntax ...) calls...

        (if (null? new-locals)
            #`(define (n1 #, at new-args) e1 e2 ...)
            #`(define (n1 #, at new-args)
                      (let* (#, at new-locals)
                        e1 e2 ...)))
            ))
      ))

Ivanyi Peter wrote:

> P.S: Here is the code. (The per sign (/) separates arguments
> and local variables.)
> ---------------------------------------------------------------------------------
> 
> (define-syntax defun
>   (letrec
>       ((get-args
>         (lambda (args)
>           (syntax-case args (/)
>             (() (syntax ()))
>             ((/ a1 ...) (syntax ()))
>             ((a2 a3 ...) (cons (syntax a2) (get-args (syntax
> (a3 ...)))))
>           )
>         )
>        )
>        (get-local-init
>         (lambda (args)
>           (syntax-case args ()
>             (() (syntax ()))
>             ((a2 a3 ...) (cons (list (syntax a2) #f)
> (get-local-init (syntax (a3 ...)))))
>             ((a1 ...) (list (list (syntax (a1 ...)) #f)))
>           )
>         )
>        )
>        (get-locals
>         (lambda (args)
>           (syntax-case args (/)
>             (() (syntax ()))
>             ((/ a1 ...) (get-local-init (syntax (a1 ...))))
>             ((a2 a3 ...) (get-locals (syntax (a3 ...))))
>           )
>         )
>        )
>        
>       )
>       
>     (lambda (x)
>       (syntax-case x ()
>         ((_ n1 (args ...) e1 e2 ...)
>          (with-syntax
>              (((new-args ...) (get-args (syntax (args ...)))))
>            (with-syntax
>                (((new-locals ...) (get-locals (syntax (args
> ...)))))
>              (if (null? (syntax (new-locals ...)))
>                (syntax (define (n1 new-args ...) e1 e2 ...))
>                (syntax (define (n1 new-args ...)
>                          (let* (new-locals ...)
>                          e1 e2 ...)))
>              )
>            )
>          )
>         )
>       )
>     )
>   )
> )
> 
> (defun a1 () (+ 1 2))
> (defun a2 (a) (+ 1 a))
> (defun a3 (a b) (+ a b))
> (defun a4 (a b c) (+ a b c))
> (defun a5 (/) (+ 2 3))
> (defun a6 (/ a) (+ 2 3))
> (defun a7 (/ a b) (+ 2 3))
> (defun a8 (/ a b c) (+ 2 3))
> (defun a9 (a b /) (+ a b))
> (defun aa (a b / c) (+ a b))
> (defun ab (a b / c d) (+ a b))
> (defun ac (a b / c d e) (+ a b))
> 
> 
> 
> _______________________________________________________________________________
> Élvezd az internet nyújtotta szabadságot! Vásárolj kényelmesen és biztonságosan Virtuális kártyáddal!
> [origo] klikkbank diák számlacsomag http://www.klikkbank.hu/lakossagi/termekek/diak_szamlacsomag/index.html
> 
> 
> _________________________________________________
>   For list-related administrative tasks:
>   http://list.cs.brown.edu/mailman/listinfo/plt-scheme