This repository has been archived on 2022-08-10. You can view files and clone it, but cannot push or open issues or pull requests.
chez-openbsd/examples/macro.ss
2022-07-29 15:12:07 +02:00

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))