Scheme macro source: rewriter-widget, a widely applicable macro interface 
Author Message
 Scheme macro source: rewriter-widget, a widely applicable macro interface

Are we supposed to be happy we simply have a groovy language like Scheme, or
should we be {*filter*}ing that it's not perfect?  I happen to like the {*filter*}ing.
With all the neat things to {*filter*} about, this message only deals with one.
It's hard to resist an obliging tease about Lisp/Scheme's cosmetics, but
somehow I'l-- oh.  Oops.

Anyway, it seems to me that the language definition folks can't seem to settle
upon a low-level macro facility.  In this respect, I think the committees are
too simplistic in their decision process.  Consider the following.  Perhaps
weight an issue by:
o  the length of time the issue has existed
o  the length of time the issue has been recognized as being a problem
o  the severity
o  the quality of viable solutions to the issue
o  all the stuff I haven't thought of
Make the amount of agreement necessary inversely proportional to the weight.  A
new tweak?  Impossible.  After a little consideration, unanimous approval.  But
an old issue?  Recognized as being a problem for a long time?  One that has a
huge influence on language use?  One for which several good solutions exists?
And all the things I haven't thought of?  I would expect a motion and a second
should be sufficient.  Hell, at this point, I'd expect a "Cuz I say so dammit!
Close yer pieholes!  Shh!  Ok?  Good.  What's next...?" to be sufficient.
(Somebody just try it, maybe it'll work.)

               There is a huge difference between resolving
               an impasse and recklessly charging ahead.

I'm still shocked that a weaker pattern-matching style was adopted before a
more idiomatic and powerful rewriter-style sty-- oops, sorry.  Back to
rewriters/transformers/expanders/wachamacallits.  My time of writing the same
macros in almost-equivalent implementations is past (unless the incentive
matches "\\$[1-9][0-9][0-9]+/hr").  I simply do not have the patience.

This seems to be a fair (not good) approach, a function `rewriter-widget' which
takes a consistent macro definition, consults local macro conventions, and
(explicitly) evaluates a suitable expression.  It tries to make use of
explicit-renaming features if available, or simulate the behavior with a
`gensym', provided.  A quite reasonable hint from the programmer is also
required.  You'll see, it's almost like a feature even.

I just finished it, so this code has only been lightly tested, is untweaked,
rather ugly, and I'm still not happy with its syntax/calling sequence.  So
gimme some grief, as long as you gimme fixes and suggestions too.

Seems to work well enough for both Gambit and Scheme48, which are different in
some of the important ways.  Tweak a few straightforward variables, it'll
handle most rewriter implementations with recognizable syntax.


;; [procedure] (rewriter-widget signature bindings . body)
;;     `signature' is a cons of `name' and `parameters'
;;     `name' is defined to be a rewriter accepting `parameters'.
;;     The body of the macro is `body' embedded
;;     within a `let' whose bindings are `bindings'.
;;     In addition to providing a way to bind values
;;     from the current environment in the rewriter,
;;     some special binding forms are handled.
;;     A binding like `(name)' binds `name' to a unique symbol.
;;     This is suitable for, say, making an invisible global binding.
;;     A binding like `(name value #t)' binds `name' to
;;     a compulsory renaming of `value', a hygienic renaming
;;     of `value' if possible, a unique symbol otherwise.
;;     This is suitable for, say, making a local hygienic binding.
;;     A binding like `(name value #f)' binds `name' to
;;     an advisory renaming of `value', a hygienic renaming
;;     of `value' if possible, or simply `value' otherwise.
;;     This is suitable for, say, referencing global definitions.
;;     The #t/#f answers the question, "Is this compulsory?";
;;     simply put, "Does this symbol absolutely need to be distinct?".
;;     `body' is the rewriter's body, a list of expressions.
;;     Its environment includes the names in `bindings',
;;     as well as several internal symbols prefixed with "$_*".
;;     The result of this expression is undefined.
;;     The implementation's rewriter format is described by:
;;         rewriter-widget:definer
;;         rewriter-widget:signature-format?
;;         rewriter-widget:parameter-style
;;     Issues of renaming and hygienicity are described by:
;;         rewriter-widget:unique-renamer
;;         rewriter-widget:compulsory-renamer
;;         rewriter-widget:advisory-renamer
;;         rewriter-widget:advisory-comparer
;;     This must be bound to a function that evaluates an expression:
;;         rewriter-widget:evaluate-1
;;     Example values suitable for Scheme48 and Gambit are included.
;; [variable] rewriter-widget:definer
;;     The name of the defining form.  Typical values include:
;;         'define-syntax
;;         'define-macro
;;         'define-rewriter
;;         'defmacro
;;         'macro
;;         'prefrobnicate
;;     Your guess is as good as mine.
;; [variable] rewriter-widget:signature-format?
;;     An indication of the general layout:
;;         #t: (definer (name . parameters) ...)
;;         #f: (definer name (lambda parameters ...))
;; [variable] rewriter-widget:parameter-style
;;     An indication of the parameter format:
;;         'form-body-direct:   (form-body-1 form-body-2 ...)
;;         'form-body-indirect: (form-body)
;;         'form-complete:      (form)
;;         'explicit-renaming:  (form rename compare)
;; [variable] rewriter-widget:unique-renamer
;;     A procedure which returns a unique symbol given a symbol.
;;     Typical values include:
;;         generate-symbol:       Just use this, provided here
;;         (lambda (x) (gensym)): `gensym' may not be provided
;; [variable] rewriter-widget:compulsory-renamer
;;     A procedure which returns a compulsory renaming given a symbol,
;;     or an indication that a built-in hygienic renamer is to be used.
;;     Typical values include:
;;         'rename:               Use a built-in hygienic renamer
;;         generate-symbol:       Just use this otherwise, provided here
;;         (lambda (x) (gensym)): `gensym' may not be provided
;; [variable] rewriter-widget:advisory-renamer
;;     A procedure which returns an advisory renaming given a argument,
;;     or an indication that a built-in hygienc renamer is to be used,
;;     or an indication that the identity function should be used.
;;     Typical values include:
;;         'rename:   The renamer supplied to the expander
;;         'identity: Do not perform advisory renames
;; [variable] advisory-comparer
;;     This is poorly defined, I haven't used it.
;;     The name of the symbol comparison function,
;;     passed two symbols (possibly advisory-renamed).
;;     All bets are off for compulsory bindings.
;;     Typical values include:
;;         'compare: The comparer supplied to the expander
;;         'eq?:     Suitable for identity advisory bindings
;; [procedure] rewriter-widget:evaluate-1
;;     A procedure provided to evaluate a single form
;;     in the current interaction environment.
;;     (Not just a name/representation, the procedure itself.)
;;     Typical values include:
;;         (lambda (x) (eval x (interaction-environment)))
;;         eval (capable of accepting just a form)
;; [function] (generate-symbol [name] [increment?])
;;     (generate-symbol        ) -> (generate-symbol (string->symbol "")   )
;;     (generate-symbol      #t) -> (generate-symbol (string->symbol "") #t)
;;     (generate-symbol      #f) -> (generate-symbol (string->symbol "") #f)
;;     (generate-symbol name   ) -> (generate-symbol name #t)
;;     (generate-symbol name #t) -> A new symbol resembling `name'
;;     (generate-symbol name #f) -> The previous symbol resembling `name'

(define generate-symbol
  (let ((table '()))
    (lambda arguments
      (define (generate-symbol name increment?)
        (let ((binding (assq name table)))
          (or binding
            (begin (set! binding (cons name 0))
                   (set! table (cons binding table))))
          (if increment?
            (set-cdr! binding (+ (cdr binding) 1)))
          (string->symbol (string-append (symbol->string name) "$_*"
                                         (number->string (cdr binding))))))
      (case (length arguments)
        ((0) (generate-symbol (string->symbol "") #t))
        ((1) (if (symbol? (car arguments))
               (generate-symbol (car arguments) #t)
               (generate-symbol (string->symbol "") (car arguments))))
        ((2) (apply generate-symbol arguments))))))

;; Scheme48-suitable definitions for rewriter-widget controls.
(define rewriter-widget:definer            'define-syntax)
(define rewriter-widget:signature-format?  #f)
(define rewriter-widget:parameter-style    'explicit-renaming)
(define rewriter-widget:unique-renamer     generate-symbol)
(define rewriter-widget:compulsory-renamer 'rename)
(define rewriter-widget:advisory-renamer   'rename)
(define rewriter-widget:advisory-comparer  'compare)
(define rewriter-widget:evaluate-1         (lambda (x) (eval x (interaction-environment))))

;; Gambit-suitable settings for rewriter-widget controls.
;(set! rewriter-widget:definer            'define-macro)
;(set! rewriter-widget:signature-format?  #t)
;(set! rewriter-widget:parameter-style    'form-body-direct)
;(set! rewriter-widget:unique-renamer     generate-symbol)
;(set! rewriter-widget:compulsory-renamer generate-symbol)
;(set! rewriter-widget:advisory-renamer   'identity)
;(set! rewriter-widget:advisory-comparer  'eq?)
;(set! rewriter-widget:evaluate-1         eval)

;; PhooeyScheme-suitable settings for rewriter-widget controls.

(define (rewriter-widget signature bindings . body)

  (let ((name       (car signature))
        (parameters (cdr signature)))

    (define (rebind x)
      (let ((name (car x)) (tail (cdr x)))
        (list name (if (null? tail)
                     (list 'quote (rewriter-widget:unique-renamer name))
                     (if (null? (cdr tail))
                       (car tail)
                       (let ((value (car tail)))
                         (if (cadr tail)
                           (case rewriter-widget:compulsory-renamer
                             ((rename) (list '$_*rename (list 'quote value)))
                             (else     (list 'quote (rewriter-widget:compulsory-renamer value))))
                           (case rewriter-widget:advisory-renamer
                             ((rename)   (list '$_*rename (list 'quote value)))
                             ((identity) (list 'quote value))
                             (else       (list 'quote (rewriter-widget:advisory-renamer value)))))))))))

    (define (applyify x)
      (list (list 'apply (cons 'lambda (cons parameters body)) x)))


     (let* ((inner     (case rewriter-widget:parameter-style
                         ((form-body-direct)   body)
                         ((form-body-indirect) (applyify 'form-body))
                         ((form-complete)      (applyify '(cdr $_*form)))
                         ((explicit-renaming)  (applyify '(cdr $_*form)))))

            (middle    (cons 'let (cons (map rebind bindings) inner)))

            (outer     (if rewriter-widget:signature-format?
                         (list 'lambda
                               (case rewriter-widget:parameter-style
                                 ((form-body-direct)   parameters)
                                 ((form-body-indirect) (list '$_*form-body))
                                 ((form-complete)      (list '$_*form))
                                 ((explicit-renaming)  (list '$_*form '$_*rename '$_*compare)))

            (signature (if rewriter-widget:signature-format?
                         (cons name (case rewriter-widget:parameter-style
                                      ((form-body-direct)   parameters)
                                      ((form-body-indirect) (list '$_*form-body))
                                      ((form-complete)      (list '$_*form))
                                      ((explicit-renaming)  (list '$_*form '$_*rename '$_*compare))))

       (list rewriter-widget:definer signature outer)))))

;; Local variables:
;; eval: "The following is simply an indentation declaration."
;; eval: (put 'rewriter-widget 'scheme-indent-function 2)
;; End:

Wed, 23 May 2001 03:00:00 GMT  
 [ 1 post ] 

 Relevant Pages 

1. A macro involving two sub-macros - where the 2nd macro needs results from the first

2. Scheme macro source: define/keyed, for defining keyword-triggered arguments

3. macro -vs- macro/codeblock

4. Help with macros writing macros in Bigloo

5. syntax-rules macros with sub-macros

6. Macros defining macros with define-syntax

7. symbol-macros and regular macros

8. Question about a macro-defining macro

9. Macro-Defining Macros

10. macro macros

11. Local macro within a macro?

12. how much macro is too much macro


Powered by phpBB® Forum Software