module/slib/macwork.scm

   1 ;;;; "macwork.scm": Will Clinger's macros that work.    -*- Scheme -*-
   2 ;Copyright 1992 William Clinger
   3 ;
   4 ; Permission to copy this software, in whole or in part, to use this
   5 ; software for any lawful purpose, and to redistribute this software
   6 ; is granted subject to the restriction that all copies made of this
   7 ; software must include this copyright notice in full.
   8 ;
   9 ; I also request that you send me a copy of any improvements that you
  10 ; make to this software so that they may be incorporated within it to
  11 ; the benefit of the Scheme community.
  12
  13 (slib:load (in-vicinity (program-vicinity) "mwexpand"))
  14
  15 ;;;; Miscellaneous routines.
  16
  17 (define (mw:warn msg . more)
  18   (display "WARNING from macro expander:")
  19   (newline)
  20   (display msg)
  21   (newline)
  22   (for-each (lambda (x) (write x) (newline))
  23             more))
  24
  25 (define (mw:error msg . more)
  26   (display "ERROR detected during macro expansion:")
  27   (newline)
  28   (display msg)
  29   (newline)
  30   (for-each (lambda (x) (write x) (newline))
  31             more)
  32   (mw:quit #f))
  33
  34 (define (mw:bug msg . more)
  35   (display "BUG in macro expander: ")
  36   (newline)
  37   (display msg)
  38   (newline)
  39   (for-each (lambda (x) (write x) (newline))
  40             more)
  41   (mw:quit #f))
  42
  43 ; Given a <formals>, returns a list of bound variables.
  44
  45 (define (mw:make-null-terminated x)
  46   (cond ((null? x) '())
  47         ((pair? x)
  48          (cons (car x) (mw:make-null-terminated (cdr x))))
  49         (else (list x))))
  50
  51 ; Returns the length of the given list, or -1 if the argument
  52 ; is not a list.  Does not check for circular lists.
  53
  54 (define (mw:safe-length x)
  55   (define (loop x n)
  56     (cond ((null? x) n)
  57           ((pair? x) (loop (cdr x) (+ n 1)))
  58           (else -1)))
  59   (loop x 0))
  60
  61 (require 'common-list-functions)
  62
  63 ; Given an association list, copies the association pairs.
  64
  65 (define (mw:syntax-copy alist)
  66   (map (lambda (x) (cons (car x) (cdr x)))
  67        alist))
  68
  69 ;;;; Implementation-dependent parameters and preferences that determine
  70 ; how identifiers are represented in the output of the macro expander.
  71 ;
  72 ; The basic problem is that there are no reserved words, so the
  73 ; syntactic keywords of core Scheme that are used to express the
  74 ; output need to be represented by data that cannot appear in the
  75 ; input.  This file defines those data.
  76
  77 ; The following definitions assume that identifiers of mixed case
  78 ; cannot appear in the input.
  79
  80 ;(define mw:begin1  (string->symbol "Begin"))
  81 ;(define mw:define1 (string->symbol "Define"))
  82 ;(define mw:quote1  (string->symbol "Quote"))
  83 ;(define mw:lambda1 (string->symbol "Lambda"))
  84 ;(define mw:if1     (string->symbol "If"))
  85 ;(define mw:set!1   (string->symbol "Set!"))
  86
  87 (define mw:begin1  'begin)
  88 (define mw:define1 'define)
  89 (define mw:quote1  'quote)
  90 (define mw:lambda1 'lambda)
  91 (define mw:if1     'if)
  92 (define mw:set!1   'set!)
  93
  94 ; The following defines an implementation-dependent expression
  95 ; that evaluates to an undefined (not unspecified!) value, for
  96 ; use in expanding the (define x) syntax.
  97
  98 (define mw:undefined (list (string->symbol "Undefined")))
  99
 100 ; A variable is renamed by suffixing a vertical bar followed by a unique
 101 ; integer.  In IEEE and R4RS Scheme, a vertical bar cannot appear as part
 102 ; of an identifier, but presumably this is enforced by the reader and not
 103 ; by the compiler.  Any other character that cannot appear as part of an
 104 ; identifier may be used instead of the vertical bar.
 105
 106 (define mw:suffix-character #\|)
 107
 108 (slib:load (in-vicinity (program-vicinity) "mwdenote"))
 109 (slib:load (in-vicinity (program-vicinity) "mwsynrul"))
 110
 111 (define macro:expand macwork:expand)
 112
 113 ;;; Here are EVAL, EVAL! and LOAD which expand macros.  You can replace the
 114 ;;; implementation's eval and load with them if you like.
 115 (define base:eval slib:eval)
 116 (define base:load load)
 117
 118 (define (macwork:eval x) (base:eval (macwork:expand x)))
 119 (define macro:eval macwork:eval)
 120
 121 (define (macwork:load <pathname>)
 122   (slib:eval-load <pathname> macwork:eval))
 123 (define macro:load macwork:load)
 124
 125 (provide 'macros-that-work)
 126 (provide 'macro)