90 lines
3.6 KiB
Scheme
90 lines
3.6 KiB
Scheme
|
;;; Copyright (C) 1989 R. Kent Dybvig
|
||
|
|
|
||
|
|
;;; Permission is hereby granted, free of charge, to any person obtaining a
|
||
|
|
;;; copy of this software and associated documentation files (the "Software"),
|
||
|
|
;;; to deal in the Software without restriction, including without limitation
|
||
|
|
;;; the rights to use, copy, modify, merge, publish, distribute, sublicense,
|
||
|
|
;;; and/or sell copies of the Software, and to permit persons to whom the
|
||
|
|
;;; Software is furnished to do so, subject to the following conditions:
|
||
|
|
;;;
|
||
|
|
;;; The above copyright notice and this permission notice shall be included in
|
||
|
|
;;; all copies or substantial portions of the Software.
|
||
|
|
;;;
|
||
|
|
;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||
|
|
;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||
|
|
;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
|
||
|
|
;;; THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||
|
|
;;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
|
||
|
|
;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
|
||
|
|
;;; DEALINGS IN THE SOFTWARE.
|
||
|
|
|
||
|
|
;;; PCScheme/MacScheme "macro" defined in terms of "syntax-case":
|
||
|
|
|
||
|
|
(define-syntax macro
|
||
|
|
(lambda (x)
|
||
|
|
(syntax-case x ()
|
||
|
|
((_ name fcn)
|
||
|
|
#'(define-syntax name
|
||
|
|
(lambda (x)
|
||
|
|
(syntax-case x ()
|
||
|
|
((k . stuff)
|
||
|
|
(datum->syntax-object #'k
|
||
|
|
(fcn (syntax-object->datum x)))))))))))
|
||
|
|
|
||
|
|
|
||
|
|
;;; PCScheme/MacScheme "macro" defined in terms of "extend-syntax":
|
||
|
|
;;; requires (current-expand eps-expand)
|
||
|
|
|
||
|
|
;(extend-syntax (macro)
|
||
|
|
; [(macro name fcn)
|
||
|
|
; (eval-when (compile load eval)
|
||
|
|
; (let ([f fcn])
|
||
|
|
; (extend-syntax (name)
|
||
|
|
; [anything
|
||
|
|
; ((with ([w 'with]) w)
|
||
|
|
; ([v (f 'anything)]) v)])))])
|
||
|
|
|
||
|
|
;;; The strange expression "(with ([w 'with]) w)" is used to insert the
|
||
|
|
;;; keyword "with" into the expansion. The "eval-when" in the expansion is
|
||
|
|
;;; necessary to allow macros defined in a file to be used later in the
|
||
|
|
;;; file, even if the file is compiled with "compile-file". If it were
|
||
|
|
;;; left out, the implicit "eval-when" wrapped around the "extend-syntax"
|
||
|
|
;;; would cause it to be evaluated, but without the enclosing "let"
|
||
|
|
;;; expression. The enclosing "let" expression is necessary to cause the
|
||
|
|
;;; function to be evaluated once, which may be important if the function
|
||
|
|
;;; something other than a simple lambda expression.
|
||
|
|
|
||
|
|
|
||
|
|
;;; PCScheme/MacScheme "macro" defined in terms of "define-syntax-expander":
|
||
|
|
;;; requires (current-expand eps-expand)
|
||
|
|
|
||
|
|
;(extend-syntax (macro)
|
||
|
|
; [(macro name fcn)
|
||
|
|
; (define-syntax-expander name
|
||
|
|
; (let ([f fcn])
|
||
|
|
; (lambda (x e) (e (f x) e))))])
|
||
|
|
|
||
|
|
;;; The "eval-when" is not necessary because "define-syntax-expander"
|
||
|
|
;;; expands into an "eval-when" expression, and the "let" expression is
|
||
|
|
;;; tucked inside the "define-syntax-expander" expression.
|
||
|
|
|
||
|
|
;;; If you want to see the expander generated by either of the above
|
||
|
|
;;; "extend-syntax" definitions looks like, use "extend-syntax/code" in
|
||
|
|
;;; place of "extend-syntax":
|
||
|
|
|
||
|
|
;;; > (extend-syntax/code (macro)
|
||
|
|
;;; [(macro name fcn)
|
||
|
|
;;; (define-syntax-expander name
|
||
|
|
;;; (let ([f fcn])
|
||
|
|
;;; (lambda (x e) (e (f x) e))))])
|
||
|
|
;;;
|
||
|
|
;;; (lambda (x e)
|
||
|
|
;;; (unless (procedure? e)
|
||
|
|
;;; (error 'macro "~s is not a procedure" e))
|
||
|
|
;;; (e (cond
|
||
|
|
;;; [(syntax-match? '(macro * *) x)
|
||
|
|
;;; `(define-syntax-expander ,(cadr x)
|
||
|
|
;;; (let ([f ,@(cddr x)]) (lambda (x e) (e (f x) e))))]
|
||
|
|
;;; [else (error 'macro "invalid syntax ~s" x)])
|
||
|
|
;;; e))
|