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