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