Also replace '(keyword ...) -> '(_ ...) in syntax-check patterns.
(define-syntax define-instruction
(rsc-macro-transformer
(lambda (form environment)
- (if (syntax-match? '(SYMBOL * (DATUM + DATUM)) (cdr form))
+ (if (syntax-match? '(symbol * (datum + datum)) (cdr form))
`(,(close-syntax 'ADD-INSTRUCTION! environment)
',(cadr form)
,(compile-database (cddr form) environment
(let-syntax
((->label
(sc-macro-transformer
- (let ((pattern `(EXPRESSION IDENTIFIER ? ,string?)))
+ (let ((pattern `(expression identifier ? ,string?)))
(lambda (form environment)
(if (syntax-match? pattern (cdr form))
(let ((find (close-syntax (cadr form) environment))
(define-syntax last-reference
(sc-macro-transformer
(lambda (form environment)
- (if (syntax-match? '(IDENTIFIER) (cdr form))
+ (if (syntax-match? '(identifier) (cdr form))
(let ((name (close-syntax (cadr form) environment)))
`(IF COMPILER:PRESERVE-DATA-STRUCTURES?
,name
(define-syntax package
(rsc-macro-transformer
(lambda (form environment)
- (if (syntax-match? '((* IDENTIFIER) * EXPRESSION) (cdr form))
+ (if (syntax-match? '((* identifier) * expression) (cdr form))
(let ((names (cadr form))
(body (cddr form)))
`(,(close-syntax 'BEGIN environment)
(define-syntax define-export
(rsc-macro-transformer
(lambda (form environment)
- (cond ((syntax-match? '(IDENTIFIER EXPRESSION) (cdr form))
+ (cond ((syntax-match? '(identifier expression) (cdr form))
`(,(close-syntax 'SET! environment)
,@(cdr form)))
- ((syntax-match? '((IDENTIFIER . MIT-BVL) + EXPRESSION) (cdr form))
+ ((syntax-match? '((identifier . mit-bvl) + expression) (cdr form))
`(,(close-syntax 'SET! environment)
,(caadr form)
(,(close-syntax 'NAMED-LAMBDA environment)
(define-syntax define-vector-slots
(sc-macro-transformer
(let ((pattern
- `(SYMBOL ,exact-nonnegative-integer?
+ `(symbol ,exact-nonnegative-integer?
* ,(lambda (x)
(or (symbol? x)
(and (pair? x)
(define-syntax define-root-type
(sc-macro-transformer
(let ((pattern
- `(SYMBOL * ,(lambda (x)
+ `(symbol * ,(lambda (x)
(or (symbol? x)
(and (pair? x)
(list-of-type? x symbol?)))))))
(reserved (caddr form))
(enumeration (close-syntax (cadddr form) environment)))
(let ((parent
- (close-syntax (symbol name '-TAG) environment)))
- `(define-syntax ,(symbol 'DEFINE- name)
+ (close-syntax (symbol name '-tag) environment)))
+ `(define-syntax ,(symbol 'define- name)
(sc-macro-transformer
(let ((pattern
- `(SYMBOL * ,(lambda (x)
+ `(symbol * ,(lambda (x)
(or (symbol? x)
(and (pair? x)
(list-of-type? x symbol?)))))))
(if (syntax-match? pattern (cdr form))
(let ((type (cadr form))
(slots (cddr form)))
- (let ((tag-name (symbol type '-TAG)))
+ (let ((tag-name (symbol type '-tag)))
(let ((tag-ref
(close-syntax tag-name environment)))
`(BEGIN
(define-syntax descriptor-list
(sc-macro-transformer
(let ((pattern
- `(IDENTIFIER SYMBOL
+ `(identifier symbol
* ,(lambda (x)
(or (symbol? x)
(and (pair? x)
(define-syntax make-snode
(sc-macro-transformer
(lambda (form environment)
- (if (syntax-match? '(+ EXPRESSION) (cdr form))
+ (if (syntax-match? '(+ expression) (cdr form))
(let ((tag (close-syntax (cadr form) environment))
(extra
(map (lambda (form) (close-syntax form environment))
(define-syntax make-pnode
(sc-macro-transformer
(lambda (form environment)
- (if (syntax-match? '(+ EXPRESSION) (cdr form))
+ (if (syntax-match? '(+ expression) (cdr form))
(let ((tag (close-syntax (cadr form) environment))
(extra
(map (lambda (form) (close-syntax form environment))
(define-syntax make-rvalue
(sc-macro-transformer
(lambda (form environment)
- (if (syntax-match? '(+ EXPRESSION) (cdr form))
+ (if (syntax-match? '(+ expression) (cdr form))
(let ((tag (close-syntax (cadr form) environment))
(extra
(map (lambda (form) (close-syntax form environment))
(define-syntax make-lvalue
(sc-macro-transformer
(lambda (form environment)
- (if (syntax-match? '(+ EXPRESSION) (cdr form))
+ (if (syntax-match? '(+ expression) (cdr form))
(let ((tag (close-syntax (cadr form) environment))
(extra
(map (lambda (form) (close-syntax form environment))
'RTL:PREDICATE-TYPES))))
(define (define-rtl-common form wrap-constructor types)
- (if (syntax-match? '(SYMBOL SYMBOL * SYMBOL) (cdr form))
+ (if (syntax-match? '(symbol symbol * symbol) (cdr form))
(let ((type (cadr form))
(prefix (caddr form))
(components (cdddr form)))
(define-syntax define-rule
(rsc-macro-transformer
(lambda (form environment)
- (if (syntax-match? '(IDENTIFIER DATUM + DATUM) (cdr form))
+ (if (syntax-match? '(identifier datum + datum) (cdr form))
(receive (pattern matcher)
(rule->matcher (caddr form) (cdddr form) environment)
`(,(case (cadr form)
(define-syntax rule-matcher
(rsc-macro-transformer
(lambda (form environment)
- (if (syntax-match? '(DATUM + DATUM) (cdr form))
+ (if (syntax-match? '(datum + datum) (cdr form))
(receive (pattern matcher)
(rule->matcher (cadr form) (cddr form) environment)
pattern
(define-syntax lap
(rsc-macro-transformer
(lambda (form environment)
- (if (syntax-match? '(* DATUM) (cdr form))
+ (if (syntax-match? '(* datum) (cdr form))
`(,(close-syntax 'QUASIQUOTE environment) ,(cdr form))
(ill-formed-syntax form)))))
(define-syntax inst-ea
(rsc-macro-transformer
(lambda (form environment)
- (if (syntax-match? '(DATUM) (cdr form))
+ (if (syntax-match? '(datum) (cdr form))
`(,(close-syntax 'QUASIQUOTE environment) ,(cadr form))
(ill-formed-syntax form)))))
\f
(define-syntax define-enumeration
(sc-macro-transformer
(lambda (form environment)
- (if (syntax-match? '(SYMBOL (* SYMBOL)) (cdr form))
+ (if (syntax-match? '(symbol (* symbol)) (cdr form))
(let ((name (cadr form))
(elements (caddr form)))
(let ((enumeration (symbol name 'S)))
(define-syntax enumeration-case
(sc-macro-transformer
(lambda (form environment)
- (if (syntax-match? '(SYMBOL EXPRESSION * (DATUM * EXPRESSION)) (cdr form))
+ (if (syntax-match? '(symbol expression * (datum * expression)) (cdr form))
(enumeration-case-1 (caddr form) (cdddr form) environment
(lambda (element)
(symbol (cadr form) '/ element))
(define-syntax cfg-node-case
(sc-macro-transformer
(lambda (form environment)
- (if (syntax-match? '(EXPRESSION * (DATUM * EXPRESSION)) (cdr form))
+ (if (syntax-match? '(expression * (datum * expression)) (cdr form))
(enumeration-case-1 (cadr form) (cddr form) environment
(lambda (element) (symbol element '-TAG))
(lambda (expression)
(define-syntax define-trivial-instruction
(sc-macro-transformer
(lambda (form environment)
- (if (syntax-match? '(IDENTIFIER DATUM * DATUM) (cdr form))
+ (if (syntax-match? '(identifier datum * datum) (cdr form))
`(DEFINE-INSTRUCTION ,(cadr form)
(()
(BYTE (8 ,(close-syntax (caddr form) environment)))
(sc-macro-transformer
(lambda (form environment)
environment
- (if (syntax-match? '(IDENTIFIER ? SYMBOL) (cdr form))
+ (if (syntax-match? '(identifier ? symbol) (cdr form))
`(DEFINE (,(cadr form) EXPRESSION)
(LET ((MATCH-RESULT (PATTERN-LOOKUP ,ea-database-name EXPRESSION)))
(AND MATCH-RESULT
(values (reverse! true) (reverse! false)))))
(define (abbrev-def? input)
- (syntax-match? '('DEFINE-ABBREVIATION (SYMBOL * DATUM) EXPRESSION)
+ (syntax-match? '('define-abbreviation (symbol * datum) expression)
input))
\f
(define (define-parser keyword pattern parser)
(set-coding-type-defns!
coding-type
(map (lambda (input)
- (if (not (syntax-match? '('DEFINE-CODE-SEQUENCE DATUM * DATUM)
+ (if (not (syntax-match? '('define-code-sequence datum * datum)
input))
(error "Illegal sequence definition:" input))
(parse-code-sequence coding-type (cadr input) (cddr input)))
(sc-macro-transformer
(lambda (form environment)
environment
- (if (syntax-match? '(SYMBOL * SYMBOL) (cdr form))
+ (if (syntax-match? '(symbol * symbol) (cdr form))
(let ((tag (cadr form))
(params (cddr form)))
(let ((name (symbol 'INST: tag)))
(sc-macro-transformer
(lambda (form environment)
environment
- (if (syntax-match? '(* SYMBOL) (cdr form))
+ (if (syntax-match? '(* symbol) (cdr form))
`(BEGIN
,@(let loop ((names (cdr form)))
(if (pair? names)
(sc-macro-transformer
(lambda (form environment)
environment
- (if (syntax-match? '(* SYMBOL) (cdr form))
+ (if (syntax-match? '(* symbol) (cdr form))
`(BEGIN
,@(let loop ((names (cdr form)))
(if (pair? names)
(sc-macro-transformer
(lambda (form environment)
environment
- (if (syntax-match? '(SYMBOL * SYMBOL) (cdr form))
+ (if (syntax-match? '(symbol * symbol) (cdr form))
(let ((tag (cadr form))
(params (cddr form)))
(let ((name (symbol 'EA: tag)))
(sc-macro-transformer
(lambda (form environment)
environment
- (if (syntax-match? '(* SYMBOL) (cdr form))
+ (if (syntax-match? '(* symbol) (cdr form))
(let ((alist
(let loop ((names (cdr form)) (index 0))
(if (pair? names)
(define (interpreter-register:unbound?)
(rtl:make-machine-register regnum:value))
-
+
(define-syntax define-machine-register
(sc-macro-transformer
(lambda (form environment)
(if (syntax-match? '(symbol identifier) (cdr form))
- (let ((name (symbol 'INTERPRETER- (cadr form)))
+ (let ((name (symbol 'interpreter- (cadr form)))
(regnum (close-syntax (caddr form) environment)))
- `(BEGIN
- (DEFINE (,name)
- (RTL:MAKE-MACHINE-REGISTER ,regnum))
- (DEFINE (,(symbol name '?) EXPRESSION)
- (AND (RTL:REGISTER? EXPRESSION)
- (FIX:= (RTL:REGISTER-NUMBER EXPRESSION) ,regnum)))))
+ `(begin
+ (define (,name)
+ (rtl:make-machine-register ,regnum))
+ (define (,(symbol name '?) expression)
+ (and (rtl:register? expression)
+ (fix:= (rtl:register-number expression) ,regnum)))))
(ill-formed-syntax form)))))
(define-machine-register stack-pointer regnum:stack-pointer)
(define-syntax define-trivial-instruction
(sc-macro-transformer
(lambda (form environment)
- (if (syntax-match? '(IDENTIFIER DATUM * DATUM) (cdr form))
+ (if (syntax-match? '(identifier datum * datum) (cdr form))
`(DEFINE-INSTRUCTION ,(cadr form)
(()
(BITS (8 ,(close-syntax (caddr form) environment)))
(sc-macro-transformer
(lambda (form environment)
environment
- (if (syntax-match? '(IDENTIFIER * SYMBOL) (cdr form))
+ (if (syntax-match? '(identifier * symbol) (cdr form))
`(DEFINE (,(cadr form) EXPRESSION)
(LET ((MATCH-RESULT (PATTERN-LOOKUP ,ea-database-name EXPRESSION)))
(AND MATCH-RESULT
(define-syntax define-class
(rsc-macro-transformer
(lambda (form environment)
- (if (and (syntax-match? '(IDENTIFIER DATUM (* SYMBOL)) (cdr form))
+ (if (and (syntax-match? '(identifier datum (* symbol)) (cdr form))
(or (identifier? (caddr form))
(null? (caddr form))))
(let ((name (cadr form))
,name
',operation
,expression))))
- (cond ((syntax-match? '(IDENTIFIER SYMBOL EXPRESSION) (cdr form))
+ (cond ((syntax-match? '(identifier symbol expression) (cdr form))
(finish (cadr form) (caddr form) (cadddr form)))
- ((and (syntax-match? '(IDENTIFIER (SYMBOL . MIT-BVL) + EXPRESSION)
+ ((and (syntax-match? '(identifier (symbol . mit-bvl) + expression)
(cdr form))
(pair? (cdr (caddr form)))
(identifier? (cadr (caddr form))))
(make-unmapped-macro-reference-trap
(compiler-item
(lambda (form environment)
- (syntax-check '(KEYWORD IDENTIFIER EXPRESSION (* IDENTIFIER) + EXPRESSION)
- form)
+ (syntax-check '(_ identifier expression (* identifier) + expression) form)
(let ((class-name (cadr form))
(self (caddr form))
(free-names (cadddr form))
(sc-macro-transformer
(lambda (form env)
env
- (if (syntax-match? '(SYMBOL SYMBOL SYMBOL) (cdr form))
+ (if (syntax-match? '(symbol symbol symbol) (cdr form))
(let ((type (cadr form))
(new (caddr form))
(old (cadddr form)))
(lambda (form environment)
(capture-syntactic-environment
(lambda (instance-environment)
- (if (syntax-match? '(SYMBOL EXPRESSION EXPRESSION EXPRESSION)
+ (if (syntax-match? '(symbol expression expression expression)
(cdr form))
(let ((name (list-ref form 1))
(description (list-ref form 2))
(define-syntax ref-command-object
(sc-macro-transformer
(lambda (form environment)
- (if (syntax-match? '(SYMBOL) (cdr form))
+ (if (syntax-match? '(symbol) (cdr form))
(close-syntax (command-name->scheme-name (cadr form)) environment)
(ill-formed-syntax form)))))
(sc-macro-transformer
(lambda (form environment)
environment
- (if (syntax-match? '(SYMBOL) (cdr form))
+ (if (syntax-match? '(symbol) (cdr form))
`(COMMAND-PROCEDURE (REF-COMMAND-OBJECT ,(cadr form)))
(ill-formed-syntax form)))))
(sc-macro-transformer
(lambda (form environment)
environment
- (if (syntax-match? '(SYMBOL) (cdr form))
+ (if (syntax-match? '(symbol) (cdr form))
(let ((variable-name (command-name->scheme-name (cadr form))))
`(LET ((_ENV (->ENVIRONMENT '(EDWIN))))
(AND (ENVIRONMENT-BOUND? _ENV ',variable-name)
(expand-variable-definition form environment `#T))))
(define (expand-variable-definition form environment buffer-local?)
- (if (and (syntax-match? '(SYMBOL + EXPRESSION) (cdr form))
+ (if (and (syntax-match? '(symbol + expression) (cdr form))
(<= (length form) 6))
`(,(close-syntax 'DEFINE environment)
,(variable-name->scheme-name (list-ref form 1))
(define-syntax ref-variable-object
(sc-macro-transformer
(lambda (form environment)
- (if (syntax-match? '(SYMBOL) (cdr form))
+ (if (syntax-match? '(symbol) (cdr form))
(close-syntax (variable-name->scheme-name (cadr form)) environment)
(ill-formed-syntax form)))))
(define-syntax ref-variable
(sc-macro-transformer
(lambda (form environment)
- (if (syntax-match? '(SYMBOL ? EXPRESSION) (cdr form))
+ (if (syntax-match? '(symbol ? expression) (cdr form))
(let ((name `(REF-VARIABLE-OBJECT ,(cadr form))))
(if (pair? (cddr form))
`(VARIABLE-LOCAL-VALUE ,(close-syntax (caddr form) environment)
,value))))))
(define (expand-variable-assignment form environment generator)
- (if (and (syntax-match? '(SYMBOL * EXPRESSION) (cdr form))
+ (if (and (syntax-match? '(symbol * expression) (cdr form))
(<= (length form) 4))
(generator `(REF-VARIABLE-OBJECT ,(list-ref form 1))
(if (> (length form) 2)
(define-syntax define-major-mode
(sc-macro-transformer
(let ((pattern
- `(SYMBOL ,(lambda (x) (or (not x) (symbol? x)))
+ `(symbol ,(lambda (x) (or (not x) (symbol? x)))
,(lambda (x) (or (not x) (string? x)))
- EXPRESSION
- ? EXPRESSION)))
+ expression
+ ? expression)))
(lambda (form environment)
(if (syntax-match? pattern (cdr form))
(let ((name (list-ref form 1))
(define-syntax define-minor-mode
(sc-macro-transformer
(let ((pattern
- `(SYMBOL ,(lambda (x) (or (not x) (string? x)))
- EXPRESSION
- ? EXPRESSION)))
+ `(symbol ,(lambda (x) (or (not x) (string? x)))
+ expression
+ ? expression)))
(lambda (form environment)
(if (syntax-match? pattern (cdr form))
(let ((name (list-ref form 1)))
(define-syntax ref-mode-object
(sc-macro-transformer
(lambda (form environment)
- (if (syntax-match? '(SYMBOL) (cdr form))
+ (if (syntax-match? '(symbol) (cdr form))
(close-syntax (mode-name->scheme-name (cadr form)) environment)
(ill-formed-syntax form)))))
(sc-macro-transformer
(lambda (form environment)
environment
- (if (syntax-match? '(IDENTIFIER * IDENTIFIER) (cdr form))
+ (if (syntax-match? '(identifier * identifier) (cdr form))
`(BEGIN
,@(let loop ((names (cddr form)) (index 0))
(if (pair? names)
(sc-macro-transformer
(lambda (form environment)
environment
- (if (syntax-match? '(SYMBOL EXPRESSION) (cdr form))
+ (if (syntax-match? '(symbol expression) (cdr form))
(let ((type (cadr form)))
(let ((type? (symbol type '?))
(guarantee-type (symbol 'GUARANTEE- type))
(sc-macro-transformer
(lambda (form environment)
environment
- (if (syntax-match? '(SYMBOL) (cdr form))
+ (if (syntax-match? '(symbol) (cdr form))
(let ((field (cadr form)))
`(DEFINE (,(symbol 'PGSQL-CONN- field) OBJECT)
(,(symbol 'PQ- field) (CONNECTION->HANDLE OBJECT))))
(sc-macro-transformer
(lambda (form environment)
environment
- (if (syntax-match? '(SYMBOL) (cdr form))
+ (if (syntax-match? '(symbol) (cdr form))
(let* ((field (cadr form))
(operator (symbol 'PGSQL- field)))
`(DEFINE (,operator OBJECT)
(define-syntax copy
(sc-macro-transformer
(lambda (form environment)
- (if (syntax-match? '(IDENTIFIER) (cdr form))
+ (if (syntax-match? '(identifier) (cdr form))
(let ((identifier (close-syntax (cadr form) environment)))
`(LOCAL-DECLARE ((INTEGRATE ,identifier)) ,identifier))
(ill-formed-syntax form)))))
(er-macro-transformer
(lambda (form rename compare)
rename compare
- (syntax-check '(KEYWORD EXPRESSION EXPRESSION) form)
+ (syntax-check '(_ expression expression) form)
(if (fix:fixnum? #xFFFFFFFF)
(cadr form)
(caddr form)))))
(define-syntax define-command
(sc-macro-transformer
(lambda (form environment)
- (if (syntax-match? '((IDENTIFIER IDENTIFIER IDENTIFIER) + EXPRESSION)
+ (if (syntax-match? '((identifier identifier identifier) + expression)
(cdr form))
(let ((dstate (cadr (cadr form)))
(port (caddr (cadr form))))
(define-syntax define-structure
(sc-macro-transformer
(lambda (form use-environment)
- (syntax-check '(KEYWORD + DATUM) form)
+ (syntax-check '(_ + datum) form)
(capture-syntactic-environment
(lambda (closing-environment)
(let ((structure
(sc-macro-transformer
(lambda (form environment)
environment
- (if (syntax-match? '(SYMBOL) (cdr form))
+ (if (syntax-match? '(symbol) (cdr form))
(let ((root (cadr form)))
(let ((aliases (symbol root '-ALIASES))
(proc (symbol 'DEFINE- root '-ALIAS)))
(sc-macro-transformer
(lambda (form environment)
environment
- (if (syntax-match? '(SYMBOL + DATUM) (cdr form))
+ (if (syntax-match? '(symbol + datum) (cdr form))
(let ((name (cadr form))
(start (caddr form))
(code-points (cdddr form)))
(er-macro-transformer
(lambda (form rename compare)
rename compare
- (syntax-check '(keyword expression expression) form)
+ (syntax-check '(_ expression expression) form)
(let ((bpo (bytes-per-object)))
(case bpo
((4) (cadr form))
(sc-macro-transformer
(lambda (form env)
env
- (if (and (syntax-match? '(SYMBOL ('EOF + DATUM)
- + (EXPRESSION + DATUM))
+ (if (and (syntax-match? '(symbol ('eof + datum)
+ + (expression + datum))
(cdr form))
(let loop ((clauses (cddr form)))
(and (pair? clauses)
(er-macro-transformer
(lambda (form rename compare)
(let ((if-error (lambda () (ill-formed-syntax form))))
- (if (syntax-match? '(+ (DATUM * FORM)) (cdr form))
+ (if (syntax-match? '(+ (datum * form)) (cdr form))
(let loop ((clauses (cdr form)))
(let ((req (caar clauses))
(if-true (lambda () `(,(rename 'BEGIN) ,@(cdar clauses)))))
(if (and p ((cdr p)))
(if-true)
(if-false))))
- ((and (syntax-match? '(IDENTIFIER DATUM) req)
+ ((and (syntax-match? '(identifier datum) req)
(compare (rename 'NOT) (car req)))
(req-loop (cadr req)
if-false
if-true))
- ((and (syntax-match? '(IDENTIFIER * DATUM) req)
+ ((and (syntax-match? '(identifier * datum) req)
(compare (rename 'AND) (car req)))
(let and-loop ((reqs (cdr req)))
(if (pair? reqs)
(lambda () (and-loop (cdr reqs)))
if-false)
(if-true))))
- ((and (syntax-match? '(IDENTIFIER * DATUM) req)
+ ((and (syntax-match? '(identifier * datum) req)
(compare (rename 'OR) (car req)))
(let or-loop ((reqs (cdr req)))
(if (pair? reqs)
(er-macro-transformer
(lambda (form rename compare)
compare ;ignore
- (if (syntax-match? '(R4RS-BVL FORM + FORM) (cdr form))
+ (if (syntax-match? '(r4rs-bvl form + form) (cdr form))
(let ((r-lambda (rename 'LAMBDA)))
`(,(rename 'CALL-WITH-VALUES)
(,r-lambda () ,(caddr form))
(er-macro-transformer
(lambda (form rename compare)
compare ;ignore
- (if (syntax-match? '(IDENTIFIER
- (IDENTIFIER * IDENTIFIER)
- IDENTIFIER
- * (IDENTIFIER IDENTIFIER ? IDENTIFIER))
+ (if (syntax-match? '(identifier
+ (identifier * identifier)
+ identifier
+ * (identifier identifier ? identifier))
(cdr form))
(let ((type (cadr form))
(constructor (car (caddr form)))
`(,keyword:define ,name ,value)))))
(define (parse-define-form form rename)
- (cond ((syntax-match? '((DATUM . MIT-BVL) + FORM) (cdr form))
+ (cond ((syntax-match? '((datum . mit-bvl) + form) (cdr form))
(parse-define-form
`(,(car form) ,(caadr form)
,(if (identifier? (caadr form))
`(,(rename 'NAMED-LAMBDA) ,@(cdr form))
`(,(rename 'LAMBDA) ,(cdadr form) ,@(cddr form))))
rename))
- ((syntax-match? '(IDENTIFIER ? EXPRESSION) (cdr form))
+ ((syntax-match? '(identifier ? expression) (cdr form))
(values (cadr form)
(if (pair? (cddr form))
(caddr form)
(er-macro-transformer
(lambda (form rename compare)
compare ;ignore
- (cond ((syntax-match? '(IDENTIFIER (* (IDENTIFIER ? EXPRESSION)) + FORM)
+ (cond ((syntax-match? '(identifier (* (identifier ? expression)) + form)
(cdr form))
(let ((name (cadr form))
(bindings (caddr form))
(else
(error "Unrecognized named-let-strategy:"
named-let-strategy))))))
- ((syntax-match? '((* (IDENTIFIER ? EXPRESSION)) + FORM) (cdr form))
+ ((syntax-match? '((* (identifier ? expression)) + form) (cdr form))
`(,keyword:let ,@(cdr (normalize-let-bindings form))))
(else
(ill-formed-syntax form))))))
(expand/let* form (rename 'LET-SYNTAX)))))
(define (expand/let* form let-keyword)
- (syntax-check '(KEYWORD (* DATUM) + FORM) form)
+ (syntax-check '(_ (* datum) + form) form)
(let ((bindings (cadr form))
(body (cddr form)))
(if (pair? bindings)
(er-macro-transformer
(lambda (form rename compare)
(declare (ignore compare))
- (syntax-check '(KEYWORD (* (IDENTIFIER ? EXPRESSION)) + FORM) form)
+ (syntax-check '(_ (* (identifier ? expression)) + form) form)
(let ((bindings (cadr form))
(r-lambda (rename 'LAMBDA))
(r-named-lambda (rename 'NAMED-LAMBDA))
(er-macro-transformer
(lambda (form rename compare)
(declare (ignore compare))
- (syntax-check '(KEYWORD (* (IDENTIFIER ? EXPRESSION)) + FORM) form)
+ (syntax-check '(_ (* (identifier ? expression)) + form) form)
(let ((bindings (cadr form))
(r-lambda (rename 'LAMBDA))
(r-named-lambda (rename 'NAMED-LAMBDA))
(er-macro-transformer
(lambda (form rename compare)
compare ;ignore
- (syntax-check '(KEYWORD * EXPRESSION) form)
+ (syntax-check '(_ * expression) form)
(let ((operands (cdr form)))
(if (pair? operands)
(let ((if-keyword (rename 'IF)))
(define-syntax :case
(er-macro-transformer
(lambda (form rename compare)
- (syntax-check '(KEYWORD EXPRESSION + (DATUM * EXPRESSION)) form)
+ (syntax-check '(_ expression + (datum * expression)) form)
(letrec
((process-clause
(lambda (clause rest)
(define-syntax :do
(er-macro-transformer
(lambda (form rename compare)
- (syntax-check '(KEYWORD (* (IDENTIFIER EXPRESSION ? EXPRESSION))
- (+ FORM)
- * FORM)
+ (syntax-check '(_ (* (identifier expression ? expression))
+ (+ form)
+ * form)
form)
(let ((bindings (cadr form))
(r-loop (rename 'DO-LOOP)))
((UNQUOTE-SPLICING) (syntax-error ",@ in illegal context:" arg))
(else `(,(rename mode) ,@arg))))
- (syntax-check '(KEYWORD EXPRESSION) form)
+ (syntax-check '(_ expression) form)
(descend-quasiquote (cadr form) 0 finalize-quasiquote))))
\f
;;;; SRFI 2: AND-LET*
(let ((%and (rename 'AND))
(%let (rename 'LET))
(%begin (rename 'BEGIN)))
- (cond ((syntax-match? '(() * FORM) (cdr form))
+ (cond ((syntax-match? '(() * form) (cdr form))
`(,%begin #T ,@(cddr form)))
- ((syntax-match? '((* DATUM) * FORM) (cdr form))
+ ((syntax-match? '((* datum) * form) (cdr form))
(let ((clauses (cadr form))
(body (cddr form)))
(define (expand clause recur)
- (cond ((syntax-match? 'IDENTIFIER clause)
+ (cond ((syntax-match? 'identifier clause)
(recur clause))
- ((syntax-match? '(EXPRESSION) clause)
+ ((syntax-match? '(expression) clause)
(recur (car clause)))
- ((syntax-match? '(IDENTIFIER EXPRESSION) clause)
+ ((syntax-match? '(identifier expression) clause)
(let ((tail (recur (car clause))))
(and tail `(,%let (,clause) ,tail))))
(else #f)))
(er-macro-transformer
(lambda (form rename compare)
rename compare ;ignore
- (cond ((syntax-match? '(IDENTIFIER EXPRESSION) (cdr form))
+ (cond ((syntax-match? '(identifier expression) (cdr form))
`(,keyword:access ,@(cdr form)))
- ((syntax-match? '(IDENTIFIER IDENTIFIER + FORM) (cdr form))
+ ((syntax-match? '(identifier identifier + form) (cdr form))
`(,keyword:access ,(cadr form) (,(car form) ,@(cddr form))))
(else
(ill-formed-syntax form))))))
(er-macro-transformer
(lambda (form rename compare)
compare ;ignore
- (syntax-check '(KEYWORD EXPRESSION * EXPRESSION) form)
+ (syntax-check '(_ expression * expression) form)
(let ((self (make-synthetic-identifier 'SELF)))
`(,(rename 'LETREC) ((,self (,(rename 'CONS-STREAM*)
,@(cdr form)
(er-macro-transformer
(lambda (form rename compare)
compare ;ignore
- (syntax-check '(KEYWORD EXPRESSION EXPRESSION) form)
+ (syntax-check '(_ expression expression) form)
`(,(rename 'CONS) ,(cadr form)
(,(rename 'DELAY) ,(caddr form))))))
(er-macro-transformer
(lambda (form rename compare)
compare ;ignore
- (cond ((syntax-match? '(EXPRESSION EXPRESSION) (cdr form))
+ (cond ((syntax-match? '(expression expression) (cdr form))
`(,(rename 'CONS-STREAM) ,(cadr form) ,(caddr form)))
- ((syntax-match? '(EXPRESSION * EXPRESSION) (cdr form))
+ ((syntax-match? '(expression * expression) (cdr form))
`(,(rename 'CONS-STREAM) ,(cadr form)
(,(rename 'CONS-STREAM*) ,@(cddr form))))
(else
(let ((r-begin (rename 'BEGIN))
(r-declare (rename 'DECLARE))
(r-define (rename 'DEFINE)))
- (cond ((syntax-match? '(IDENTIFIER EXPRESSION) (cdr form))
+ (cond ((syntax-match? '(identifier expression) (cdr form))
`(,r-begin
(,r-declare (INTEGRATE ,(cadr form)))
(,r-define ,@(cdr form))))
- ((syntax-match? '((IDENTIFIER * IDENTIFIER) + FORM) (cdr form))
+ ((syntax-match? '((identifier * identifier) + form) (cdr form))
`(,r-begin
(,r-declare (INTEGRATE-OPERATOR ,(caadr form)))
(,r-define ,(cadr form)
(er-macro-transformer
(lambda (form rename compare)
compare
- (syntax-check '(KEYWORD (* (FORM ? EXPRESSION)) + FORM) form)
+ (syntax-check '(_ (* (form ? expression)) + form) form)
(let ((left-hand-sides (map car (cadr form)))
(right-hand-sides (map cdr (cadr form)))
(r-define (rename 'DEFINE))
(er-macro-transformer
(lambda (form rename compare)
compare
- (syntax-check '(KEYWORD (* (EXPRESSION EXPRESSION)) + FORM) form)
+ (syntax-check '(_ (* (expression expression)) + form) form)
(let ((r-parameterize* (rename 'parameterize*))
(r-list (rename 'list))
(r-cons (rename 'cons))
(er-macro-transformer
(lambda (form rename compare)
compare
- (syntax-check '(KEYWORD (* (IDENTIFIER * DATUM)) + FORM) form)
+ (syntax-check '(_ (* (identifier * datum)) + form) form)
(let ((r-let (rename 'LET))
(r-declare (rename 'DECLARE)))
`(,r-let ()
(define (transformer-keyword procedure-name transformer->expander)
(lambda (form senv)
- (syntax-check '(KEYWORD EXPRESSION) form)
+ (syntax-check '(_ expression) form)
(let ((transformer (compile-expr-item (classify-form-cadr form senv))))
(transformer->expander (transformer-eval transformer senv)
senv
;;;; Core primitives
(define (compiler:lambda form senv)
- (syntax-check '(KEYWORD MIT-BVL + FORM) form)
+ (syntax-check '(_ mit-bvl + form) form)
(receive (bvl body)
(compile/lambda (cadr form) (cddr form) senv)
(output/lambda bvl body)))
(define (compiler:named-lambda form senv)
- (syntax-check '(KEYWORD (IDENTIFIER . MIT-BVL) + FORM) form)
+ (syntax-check '(_ (identifier . mit-bvl) + form) form)
(receive (bvl body)
(compile/lambda (cdadr form) (cddr form) senv)
(output/named-lambda (identifier->symbol (caadr form)) bvl body)))
(output/body (compile-body-items (item->list item))))
(define (classifier:begin form senv)
- (syntax-check '(KEYWORD * FORM) form)
+ (syntax-check '(_ * form) form)
(classify-body (cdr form) senv))
(define (compiler:if form senv)
- (syntax-check '(KEYWORD EXPRESSION EXPRESSION ? EXPRESSION) form)
+ (syntax-check '(_ expression expression ? expression) form)
(output/conditional
(compile-expr-item (classify-form-cadr form senv))
(compile-expr-item (classify-form-caddr form senv))
(define (compiler:quote form senv)
(declare (ignore senv))
- (syntax-check '(keyword datum) form)
+ (syntax-check '(_ datum) form)
(output/constant (strip-syntactic-closures (cadr form))))
(define (compiler:quote-identifier form senv)
- (syntax-check '(keyword identifier) form)
+ (syntax-check '(_ identifier) form)
(let ((item (lookup-identifier (cadr form) senv)))
(if (not (var-item? item))
(syntax-error "Can't quote a keyword identifier:" form))
(output/quoted-identifier (var-item-id item))))
(define (compiler:set! form senv)
- (syntax-check '(KEYWORD FORM ? EXPRESSION) form)
+ (syntax-check '(_ form ? expression) form)
(receive (name environment-item)
(classify/location (cadr form) senv)
(let ((value
(syntax-error "Variable required in this context:" form)))))
(define (compiler:delay form senv)
- (syntax-check '(KEYWORD EXPRESSION) form)
+ (syntax-check '(_ expression) form)
(output/delay (compile-expr-item (classify-form-cadr form senv))))
\f
;;;; Definitions
(classify-form-caddr form senv))))))
(define (classifier:define-syntax form senv)
- (syntax-check '(keyword identifier expression) form)
+ (syntax-check '(_ identifier expression) form)
(let ((name (cadr form))
(item (classify-form-caddr form senv)))
(keyword-binder senv name item)
(compile-body-item seq-item))))))))))
(define (classifier:let-syntax form env)
- (syntax-check '(keyword (* (identifier expression)) + form) form)
+ (syntax-check '(_ (* (identifier expression)) + form) form)
(let ((bindings (cadr form))
(body (cddr form))
(binding-env (make-internal-senv env)))
(classifier->keyword classifier:let-syntax))
(define (classifier:letrec-syntax form env)
- (syntax-check '(keyword (* (identifier expression)) + form) form)
+ (syntax-check '(_ (* (identifier expression)) + form) form)
(let ((bindings (cadr form))
(body (cddr form))
(binding-env (make-internal-senv env)))
;; the compiler wants this, but it would be nice to eliminate this
;; hack.
(define (compiler:or form senv)
- (syntax-check '(KEYWORD * EXPRESSION) form)
+ (syntax-check '(_ * expression) form)
(if (pair? (cdr form))
(let loop ((expressions (cdr form)))
(let ((compiled
(compile-expr-item (access-item/environment item)))))
(define (compiler:the-environment form senv)
- (syntax-check '(KEYWORD) form)
+ (syntax-check '(_) form)
(if (not (senv-top-level? senv))
(syntax-error "This form allowed only at top level:" form))
(output/the-environment))
;;;; Declarations
(define (classifier:declare form senv)
- (syntax-check '(keyword * (identifier * datum)) form)
+ (syntax-check '(_ * (identifier * datum)) form)
(decl-item
(lambda ()
(classify/declarations (cdr form) senv))))
(sc-macro-transformer
(lambda (form environment)
environment
- (if (syntax-match? '(IDENTIFIER * IDENTIFIER) (cdr form))
+ (if (syntax-match? '(identifier * identifier) (cdr form))
`(BEGIN
,@(let loop ((names (cddr form)) (index 0))
(if (pair? names)
(sc-macro-transformer
(lambda (form environment)
environment
- (if (syntax-match? '(SYMBOL EXPRESSION) (cdr form))
+ (if (syntax-match? '(symbol expression) (cdr form))
(let ((type (cadr form)))
(let ((type? (symbol type '?))
(guarantee-type (symbol 'GUARANTEE- type))
(sc-macro-transformer
(lambda (form environment)
environment
- (if (syntax-match? '(SYMBOL) (cdr form))
+ (if (syntax-match? '(symbol) (cdr form))
(let ((field (cadr form)))
`(DEFINE (,(symbol 'PGSQL-CONN- field) OBJECT)
(,(symbol 'PQ- field) (CONNECTION->HANDLE OBJECT))))
(sc-macro-transformer
(lambda (form environment)
environment
- (if (syntax-match? '(SYMBOL) (cdr form))
+ (if (syntax-match? '(symbol) (cdr form))
(let ((field (cadr form)))
`(DEFINE (,(symbol 'PGSQL- field) OBJECT)
(,(symbol 'PQ- field) (RESULT->HANDLE OBJECT))))
(define-syntax object-parser
(sc-macro-transformer
(lambda (form env)
- (if (syntax-match? '(FORM) (cdr form))
+ (if (syntax-match? '(form) (cdr form))
(compile-top-level (cadr form) 'OBJECT env)
(ill-formed-syntax form)))))
(define-syntax list-parser
(sc-macro-transformer
(lambda (form env)
- (if (syntax-match? '(* FORM) (cdr form))
+ (if (syntax-match? '(* form) (cdr form))
(compile-top-level `(SEQ ,@(cdr form)) 'LIST env)
(ill-formed-syntax form)))))
(define-syntax vector-parser
(sc-macro-transformer
(lambda (form env)
- (if (syntax-match? '(* FORM) (cdr form))
+ (if (syntax-match? '(* form) (cdr form))
(compile-top-level `(SEQ ,@(cdr form)) 'VECTOR env)
(ill-formed-syntax form)))))
(boolean? pattern)
(null? pattern))
(rewrite-pattern `(QUOTE ,pattern)))
- ((syntax-match? '('+ * FORM) pattern)
+ ((syntax-match? '('+ * form) pattern)
(rewrite-pattern `(SEQ ,@(cdr pattern) (* ,@(cdr pattern)))))
- ((syntax-match? '('? * FORM) pattern)
+ ((syntax-match? '('? * form) pattern)
(rewrite-pattern `(ALT (SEQ ,@(cdr pattern)) (VALUES))))
(else pattern)))
\f
rewrite-loop
(lambda (expr loop)
(let ((expr (rewrite-form expr loop)))
- (if (syntax-match? '('LAMBDA (* SYMBOL) EXPRESSION)
+ (if (syntax-match? '('lambda (* symbol) expression)
(car expr))
(optimize-let (cadar expr)
(cdr expr)
(define (substitutable? expr)
(or (symbol? expr)
(number? expr)
- (syntax-match? `('CAR ,substitutable?) expr)
- (syntax-match? `('CDR ,substitutable?) expr)
- (syntax-match? `('VECTOR-LENGTH ,substitutable?) expr)
- (syntax-match? `('FIX:+ ,substitutable? ,substitutable?) expr)
- (syntax-match? `('FIX:< ,substitutable? ,substitutable?) expr)
- (syntax-match? `('FIX:= ,substitutable? ,substitutable?) expr)
- (syntax-match? `('VECTOR-REF ,substitutable? ,substitutable?) expr)))
+ (syntax-match? `('car ,substitutable?) expr)
+ (syntax-match? `('cdr ,substitutable?) expr)
+ (syntax-match? `('vector-length ,substitutable?) expr)
+ (syntax-match? `('fix:+ ,substitutable? ,substitutable?) expr)
+ (syntax-match? `('fix:< ,substitutable? ,substitutable?) expr)
+ (syntax-match? `('fix:= ,substitutable? ,substitutable?) expr)
+ (syntax-match? `('vector-ref ,substitutable? ,substitutable?) expr)))
(define (count-refs-in name expr)
(walk-expr expr
((memq '#F (cdr expr))
(win '#F))
((any (lambda (expr)
- (syntax-match? '('AND * EXPRESSION) expr))
+ (syntax-match? '('and * expression) expr))
(cdr expr))
(win `(AND
,@(append-map (lambda (expr)
- (if (syntax-match? '('AND * EXPRESSION) expr)
+ (if (syntax-match? '('and * expression) expr)
(cdr expr)
(list expr)))
(cdr expr)))))
if-constant if-quote if-reference
if-lambda if-loop if-form)
(let loop ((expr expr))
- (cond ((syntax-match? '('LAMBDA (* SYMBOL) EXPRESSION) expr)
+ (cond ((syntax-match? '('lambda (* symbol) expression) expr)
(if-lambda expr loop))
- ((syntax-match? '('LET SYMBOL (* (SYMBOL EXPRESSION)) EXPRESSION)
+ ((syntax-match? '('let symbol (* (symbol expression)) expression)
expr)
(if-loop expr loop))
- ((syntax-match? '('QUOTE EXPRESSION) expr)
+ ((syntax-match? '('quote expression) expr)
(if-quote expr))
- ((syntax-match? '(+ EXPRESSION) expr)
+ ((syntax-match? '(+ expression) expr)
(if-form expr loop))
- ((syntax-match? 'IDENTIFIER expr)
+ ((syntax-match? 'identifier expr)
(if-reference expr))
(else
(if-constant expr)))))
(define (syntax-match? pattern object)
(let ((match-error
(lambda ()
- (error:bad-range-argument pattern 'SYNTAX-MATCH?))))
+ (error:bad-range-argument pattern 'syntax-match?))))
(cond ((procedure? pattern)
(pattern object))
((symbol? pattern)
(lambda (declaration procedure)
(list (car declaration)
(let loop ((varset (cadr declaration)))
- (cond ((syntax-match? '('SET * IDENTIFIER) varset)
+ (cond ((syntax-match? '('set * identifier) varset)
(cons (car varset)
(map procedure (cdr varset))))
- ((syntax-match?* '(('UNION * DATUM)
- ('INTERSECTION * DATUM)
- ('DIFFERENCE DATUM DATUM))
+ ((syntax-match?* '(('union * datum)
+ ('intersection * datum)
+ ('difference datum datum))
varset)
(cons (car varset)
(map loop (cdr varset))))
(cadr rule))
(map (lambda (clause)
(if (syntax-match?*
- '(('NULL-VALUE IDENTIFIER DATUM)
- ('SINGLETON IDENTIFIER)
- ('WRAPPER IDENTIFIER ? DATUM))
+ '(('null-value identifier datum)
+ ('singleton identifier)
+ ('wrapper identifier ? datum))
clause)
(cons* (car clause)
(procedure (cadr clause))
(define-syntax syntax-rules
(er-macro-transformer
(lambda (form rename compare)
- (syntax-check '(KEYWORD (* IDENTIFIER) * ((IDENTIFIER . DATUM) EXPRESSION))
- form)
+ (syntax-check '(_ (* identifier) * ((identifier . datum) expression)) form)
(let ((keywords (cadr form))
(clauses (cddr form)))
(if (let loop ((keywords keywords))
`(,(compiler->keyword
(lambda (form environment)
environment ;ignore
- (syntax-check '(KEYWORD DATUM) form)
+ (syntax-check '(_ datum) form)
(output/constant (cadr form))))
,expression))
(define-syntax define-guarantee
(sc-macro-transformer
(lambda (form environment)
- (if (syntax-match? '(SYMBOL EXPRESSION) (cdr form))
+ (if (syntax-match? '(symbol expression) (cdr form))
(let ((root (cadr form))
(desc (close-syntax (caddr form) environment)))
(let ((p-name (symbol root '?))
'((PPU-FINISH BUFFER PURI #F))
'()))))
- (define (action:push? action) (syntax-match? '('PUSH ? SYMBOL) action))
+ (define (action:push? action) (syntax-match? '('push ? symbol) action))
(define (expand:push action)
`(WRITE-CHAR ,(if (pair? (cdr action))
(string-ref (symbol->string (cadr action)) 0)
'CHAR)
BUFFER))
- (define (action:set? action) (syntax-match? '('SET SYMBOL) action))
+ (define (action:set? action) (syntax-match? '('set symbol) action))
(define (expand:set action)
`(,(symbol 'BUFFER-> (cadr action)) BUFFER PURI))
(define (action:go? action) (symbol? action))
(define (expand:go action) `(,(symbol 'PPU: action) PORT BUFFER PURI))
- (if (syntax-match? '(SYMBOL + (SYMBOL * DATUM)) (cdr form))
+ (if (syntax-match? '(symbol + (symbol * datum)) (cdr form))
(let ((state-name (cadr form))
(clauses (cddr form)))
(let ((name (symbol 'PPU: state-name)))
(lambda (s a)
(error (string-append "Malformed " s ":") a))))
(lambda (form environment)
- (if (syntax-match? '(DATUM (* EXPRESSION) * DATUM) (cdr form))
+ (if (syntax-match? '(datum (* expression) * datum) (cdr form))
(let ((name (cadr form))
(superclasses (caddr form))
(slot-arguments
(else (lose "class name" name))))
(define (parse-constructor-option class-name lose option)
- (cond ((syntax-match? `(SYMBOL (* SYMBOL) . ,optional?) (cdr option))
+ (cond ((syntax-match? `(symbol (* symbol) . ,optional?) (cdr option))
(values (cadr option) (caddr option) (cdddr option)))
- ((syntax-match? `((* SYMBOL) . ,optional?) (cdr option))
+ ((syntax-match? `((* symbol) . ,optional?) (cdr option))
(values (default-constructor-name class-name)
(cadr option)
(cddr option)))
(define-syntax define-generic
(rsc-macro-transformer
(lambda (form environment)
- (if (syntax-match? '(IDENTIFIER MIT-BVL) (cdr form))
+ (if (syntax-match? '(identifier mit-bvl) (cdr form))
(call-with-values (lambda () (parse-mit-lambda-list (caddr form)))
(lambda (required optional rest)
`(,(close-syntax 'DEFINE environment)
(define-syntax define-method
(rsc-macro-transformer
(lambda (form environment)
- (if (syntax-match? '(IDENTIFIER DATUM + EXPRESSION) (cdr form))
+ (if (syntax-match? '(identifier datum + expression) (cdr form))
(call-with-values
(lambda () (parse-specialized-lambda-list (caddr form)))
(lambda (required specializers optional rest)
(define-syntax define-computed-method
(rsc-macro-transformer
(lambda (form environment)
- (if (syntax-match? '(IDENTIFIER DATUM + EXPRESSION) (cdr form))
+ (if (syntax-match? '(identifier datum + expression) (cdr form))
(call-with-values
(lambda () (parse-specialized-lambda-list (caddr form)))
(lambda (required specializers optional rest)
(define-syntax define-computed-emp
(rsc-macro-transformer
(lambda (form environment)
- (if (syntax-match? '(IDENTIFIER EXPRESSION DATUM + EXPRESSION) (cdr form))
+ (if (syntax-match? '(identifier expression datum + expression) (cdr form))
(call-with-values
(lambda () (parse-specialized-lambda-list (cadddr form)))
(lambda (required specializers optional rest)
(define-syntax method
(rsc-macro-transformer
(lambda (form environment)
- (if (syntax-match? '(DATUM + EXPRESSION) (cdr form))
+ (if (syntax-match? '(datum + expression) (cdr form))
(call-with-values
(lambda () (parse-specialized-lambda-list (cadr form)))
(lambda (required specializers optional rest)
(lambda (form environment)
(let ((r-dme (close-syntax 'DEFINE-*MATCHER-EXPANDER environment))
(r-lambda (close-syntax 'LAMBDA environment)))
- (cond ((syntax-match? '(SYMBOL EXPRESSION) (cdr form))
+ (cond ((syntax-match? '(symbol expression) (cdr form))
`(,r-dme ',(cadr form)
(,r-lambda ()
,(caddr form))))
- ((syntax-match? '((SYMBOL . MIT-BVL) + EXPRESSION) (cdr form))
+ ((syntax-match? '((symbol . mit-bvl) + expression) (cdr form))
`(,r-dme ',(car (cadr form))
(,r-lambda ,(cdr (cadr form))
,@(cddr form))))
(define-syntax *matcher
(sc-macro-transformer
(lambda (form environment)
- (if (syntax-match? '(EXPRESSION) (cdr form))
+ (if (syntax-match? '(expression) (cdr form))
(generate-matcher-code (cadr form) environment)
(ill-formed-syntax form)))))
(define-syntax define-matcher
(rsc-macro-transformer
(lambda (form environment)
- (if (syntax-match? '((SYMBOL . MIT-BVL) + EXPRESSION) (cdr form))
+ (if (syntax-match? '((symbol . mit-bvl) + expression) (cdr form))
(let ((name (car (cadr form)))
(parameters (cdr (cadr form)))
(compiler-body (cddr form))
(define-syntax define-atomic-matcher
(rsc-macro-transformer
(lambda (form environment)
- (if (syntax-match? '(DATUM + EXPRESSION) (cdr form))
+ (if (syntax-match? '(datum + expression) (cdr form))
(let ((r-dm (close-syntax 'DEFINE-MATCHER environment))
(r-wem (close-syntax 'WRAP-EXTERNAL-MATCHER environment)))
`(,r-dm ,(cadr form)
(lambda (form environment)
(let ((r-dpe (close-syntax 'DEFINE-*PARSER-EXPANDER environment))
(r-lambda (close-syntax 'LAMBDA environment)))
- (cond ((syntax-match? '(SYMBOL EXPRESSION) (cdr form))
+ (cond ((syntax-match? '(symbol expression) (cdr form))
`(,r-dpe ',(cadr form)
(,r-lambda ()
,(caddr form))))
- ((syntax-match? '((SYMBOL . MIT-BVL) + EXPRESSION) (cdr form))
+ ((syntax-match? '((symbol . mit-bvl) + expression) (cdr form))
`(,r-dpe ',(car (cadr form))
(,r-lambda ,(cdr (cadr form))
,@(cddr form))))
(define-syntax *parser
(sc-macro-transformer
(lambda (form environment)
- (if (syntax-match? '(EXPRESSION) (cdr form))
+ (if (syntax-match? '(expression) (cdr form))
(generate-parser-code (cadr form) environment)
(ill-formed-syntax form)))))
(define-syntax define-parser
(rsc-macro-transformer
(lambda (form environment)
- (if (syntax-match? '((SYMBOL . MIT-BVL) + EXPRESSION) (cdr form))
+ (if (syntax-match? '((symbol . mit-bvl) + expression) (cdr form))
(let ((name (car (cadr form)))
(parameters (cdr (cadr form)))
(compiler-body (cddr form))
(or (boolean? body)
(symbol? body)
(and (syntax-match?
- '('BEGIN
- ('SET-PARSER-BUFFER-POINTER! EXPRESSION IDENTIFIER)
- EXPRESSION)
+ '('begin
+ ('set-parser-buffer-pointer! expression identifier)
+ expression)
body)
(or (boolean? (caddr body))
(symbol? (caddr body)))))))
EXPRESSION)
(lambda (expression)
(let ((expression* (car (last-pair (caddr expression)))))
- (and (syntax-match? '('IF EXPRESSION EXPRESSION EXPRESSION)
+ (and (syntax-match? '('if expression expression expression)
expression*)
(equal? (cadddr expression*)
(cadddr expression)))))
('BEGIN . (+ EXPRESSION)))
(lambda (expression)
(let ((expression* (car (last-pair (cadddr expression)))))
- (and (syntax-match? '('IF EXPRESSION EXPRESSION EXPRESSION)
+ (and (syntax-match? '('if expression expression expression)
expression*)
(equal? (caddr expression*)
(caddr expression)))))
(sc-macro-transformer
(lambda (form environment)
environment
- (if (syntax-match? '(DATUM DATUM DATUM) (cdr form))
+ (if (syntax-match? '(datum datum datum) (cdr form))
(let ((version (cadr form))
(public-id (caddr form))
(system-id (cadddr form)))
(sc-macro-transformer
(lambda (form environment)
environment
- (if (syntax-match? '(SYMBOL SYMBOL ? 'EMPTY) (cdr form))
+ (if (syntax-match? '(symbol symbol ? 'empty) (cdr form))
(let ((name (cadr form))
(context (caddr form))
(empty? (pair? (cdddr form))))
(define-syntax define-xml-printer
(sc-macro-transformer
(lambda (form environment)
- (if (syntax-match? '(IDENTIFIER EXPRESSION) (cdr form))
+ (if (syntax-match? '(identifier expression) (cdr form))
(let ((name (cadr form))
(accessor (caddr form)))
(let ((root (symbol 'XML- name)))
(define-syntax define-simple-content
(sc-macro-transformer
(lambda (form environment)
- (if (syntax-match? '(IDENTIFIER EXPRESSION) (cdr form))
+ (if (syntax-match? '(identifier expression) (cdr form))
(let ((node-type (close-syntax (cadr form) environment))
(item-type (close-syntax (caddr form) environment)))
`(BEGIN
(define-syntax outer
(sc-macro-transformer
(lambda (form use-env)
- (syntax-check '(keyword identifier) form)
+ (syntax-check '(_ identifier) form)
(let* ((raw (cadr form))
(closed (close-syntax raw use-env)))
`(define-syntax ,(close-syntax 'inner use-env)
(sc-macro-transformer
(lambda (form use-env)
- (syntax-check '(keyword) form)
+ (syntax-check '(_) form)
`(,(quote-identifier ,raw)
,(quote ,raw)
,(quote-identifier ,closed)
projects / mit-scheme.git / commitdiff