From 11a60b1a77ddd0d5c4fa138d5820dccbbf11c3e1 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Fri, 9 Feb 2018 20:37:06 -0800 Subject: [PATCH] Downcase explicit arguments to syntax-check and syntax-match?. Also replace '(keyword ...) -> '(_ ...) in syntax-check patterns. --- src/compiler/back/asmmac.scm | 2 +- src/compiler/back/lapgn3.scm | 2 +- src/compiler/base/macros.scm | 46 +++++------ src/compiler/machines/i386/insmac.scm | 4 +- .../machines/svm/assembler-compiler.scm | 4 +- src/compiler/machines/svm/machine.scm | 26 +++---- src/compiler/machines/x86-64/insmac.scm | 4 +- src/edwin/clsmac.scm | 9 +-- src/edwin/macros.scm | 32 ++++---- src/pgsql/pgsql.scm | 8 +- src/runtime/arith.scm | 2 +- src/runtime/bytevector.scm | 2 +- src/runtime/debug.scm | 2 +- src/runtime/defstr.scm | 2 +- src/runtime/generic-io.scm | 4 +- src/runtime/host-adapter.scm | 2 +- src/runtime/http-syntax.scm | 4 +- src/runtime/mit-macros.scm | 76 +++++++++---------- src/runtime/mit-syntax.scm | 30 ++++---- src/runtime/pgsql.scm | 8 +- src/runtime/structure-parser.scm | 40 +++++----- src/runtime/syntax-check.scm | 2 +- src/runtime/syntax-declaration.scm | 14 ++-- src/runtime/syntax-rules.scm | 5 +- src/runtime/sysmac.scm | 2 +- src/runtime/url.scm | 6 +- src/sos/macros.scm | 16 ++-- src/star-parser/matcher.scm | 10 +-- src/star-parser/parser.scm | 8 +- src/star-parser/shared.scm | 10 +-- src/xml/xhtml.scm | 4 +- src/xml/xml-struct.scm | 2 +- src/xml/xpath.scm | 2 +- tests/runtime/test-syntax-rename.scm | 4 +- 34 files changed, 196 insertions(+), 198 deletions(-) diff --git a/src/compiler/back/asmmac.scm b/src/compiler/back/asmmac.scm index 8104ecf26..bc119385f 100644 --- a/src/compiler/back/asmmac.scm +++ b/src/compiler/back/asmmac.scm @@ -31,7 +31,7 @@ USA. (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 diff --git a/src/compiler/back/lapgn3.scm b/src/compiler/back/lapgn3.scm index 923b8fbc7..771eca546 100644 --- a/src/compiler/back/lapgn3.scm +++ b/src/compiler/back/lapgn3.scm @@ -81,7 +81,7 @@ USA. (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)) diff --git a/src/compiler/base/macros.scm b/src/compiler/base/macros.scm index ff26f94a4..73a2bf604 100644 --- a/src/compiler/base/macros.scm +++ b/src/compiler/base/macros.scm @@ -32,7 +32,7 @@ USA. (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 @@ -44,7 +44,7 @@ USA. (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) @@ -59,10 +59,10 @@ USA. (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) @@ -73,7 +73,7 @@ USA. (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) @@ -109,7 +109,7 @@ USA. (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?))))))) @@ -137,11 +137,11 @@ USA. (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?))))))) @@ -149,7 +149,7 @@ USA. (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 @@ -179,7 +179,7 @@ USA. (define-syntax descriptor-list (sc-macro-transformer (let ((pattern - `(IDENTIFIER SYMBOL + `(identifier symbol * ,(lambda (x) (or (symbol? x) (and (pair? x) @@ -208,7 +208,7 @@ USA. (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)) @@ -220,7 +220,7 @@ USA. (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)) @@ -232,7 +232,7 @@ USA. (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)) @@ -244,7 +244,7 @@ USA. (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)) @@ -282,7 +282,7 @@ USA. '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))) @@ -312,7 +312,7 @@ USA. (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) @@ -331,7 +331,7 @@ USA. (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 @@ -341,21 +341,21 @@ USA. (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))))) (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))) @@ -372,7 +372,7 @@ USA. (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)) @@ -382,7 +382,7 @@ USA. (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) diff --git a/src/compiler/machines/i386/insmac.scm b/src/compiler/machines/i386/insmac.scm index c8b93bce4..f202dbd03 100644 --- a/src/compiler/machines/i386/insmac.scm +++ b/src/compiler/machines/i386/insmac.scm @@ -31,7 +31,7 @@ USA. (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))) @@ -72,7 +72,7 @@ USA. (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 diff --git a/src/compiler/machines/svm/assembler-compiler.scm b/src/compiler/machines/svm/assembler-compiler.scm index 15fa1e1c8..2ac1c1c1a 100644 --- a/src/compiler/machines/svm/assembler-compiler.scm +++ b/src/compiler/machines/svm/assembler-compiler.scm @@ -281,7 +281,7 @@ USA. (values (reverse! true) (reverse! false))))) (define (abbrev-def? input) - (syntax-match? '('DEFINE-ABBREVIATION (SYMBOL * DATUM) EXPRESSION) + (syntax-match? '('define-abbreviation (symbol * datum) expression) input)) (define (define-parser keyword pattern parser) @@ -331,7 +331,7 @@ USA. (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))) diff --git a/src/compiler/machines/svm/machine.scm b/src/compiler/machines/svm/machine.scm index 6078ccdc1..4f1ee7093 100644 --- a/src/compiler/machines/svm/machine.scm +++ b/src/compiler/machines/svm/machine.scm @@ -70,7 +70,7 @@ USA. (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))) @@ -85,7 +85,7 @@ USA. (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) @@ -98,7 +98,7 @@ USA. (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) @@ -175,7 +175,7 @@ USA. (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))) @@ -322,7 +322,7 @@ USA. (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) @@ -402,19 +402,19 @@ USA. (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) diff --git a/src/compiler/machines/x86-64/insmac.scm b/src/compiler/machines/x86-64/insmac.scm index b57a380c0..0f62f0101 100644 --- a/src/compiler/machines/x86-64/insmac.scm +++ b/src/compiler/machines/x86-64/insmac.scm @@ -31,7 +31,7 @@ USA. (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))) @@ -75,7 +75,7 @@ USA. (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 diff --git a/src/edwin/clsmac.scm b/src/edwin/clsmac.scm index f29d2262e..ad7074653 100644 --- a/src/edwin/clsmac.scm +++ b/src/edwin/clsmac.scm @@ -37,7 +37,7 @@ USA. (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)) @@ -66,9 +66,9 @@ USA. ,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)))) @@ -88,8 +88,7 @@ USA. (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)) diff --git a/src/edwin/macros.scm b/src/edwin/macros.scm index 850683016..b94c5d878 100644 --- a/src/edwin/macros.scm +++ b/src/edwin/macros.scm @@ -35,7 +35,7 @@ USA. (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))) @@ -61,7 +61,7 @@ USA. (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)) @@ -88,7 +88,7 @@ USA. (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))))) @@ -99,7 +99,7 @@ USA. (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))))) @@ -107,7 +107,7 @@ USA. (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) @@ -125,7 +125,7 @@ USA. (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)) @@ -141,7 +141,7 @@ USA. (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))))) @@ -151,7 +151,7 @@ USA. (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) @@ -177,7 +177,7 @@ USA. ,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) @@ -191,10 +191,10 @@ USA. (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)) @@ -234,9 +234,9 @@ USA. (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))) @@ -256,7 +256,7 @@ USA. (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))))) diff --git a/src/pgsql/pgsql.scm b/src/pgsql/pgsql.scm index 80a489fec..4d939a6eb 100644 --- a/src/pgsql/pgsql.scm +++ b/src/pgsql/pgsql.scm @@ -282,7 +282,7 @@ USA. (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) @@ -337,7 +337,7 @@ USA. (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)) @@ -484,7 +484,7 @@ USA. (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)))) @@ -568,7 +568,7 @@ USA. (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) diff --git a/src/runtime/arith.scm b/src/runtime/arith.scm index 3875d679f..18b349a89 100644 --- a/src/runtime/arith.scm +++ b/src/runtime/arith.scm @@ -34,7 +34,7 @@ USA. (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))))) diff --git a/src/runtime/bytevector.scm b/src/runtime/bytevector.scm index 7351107de..43131d274 100644 --- a/src/runtime/bytevector.scm +++ b/src/runtime/bytevector.scm @@ -212,7 +212,7 @@ USA. (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))))) diff --git a/src/runtime/debug.scm b/src/runtime/debug.scm index 65a71c0e2..e5b17b1fa 100644 --- a/src/runtime/debug.scm +++ b/src/runtime/debug.scm @@ -229,7 +229,7 @@ USA. (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)))) diff --git a/src/runtime/defstr.scm b/src/runtime/defstr.scm index 7976e305b..fdb65328e 100644 --- a/src/runtime/defstr.scm +++ b/src/runtime/defstr.scm @@ -77,7 +77,7 @@ differences: (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 diff --git a/src/runtime/generic-io.scm b/src/runtime/generic-io.scm index aa965651e..b864c2539 100644 --- a/src/runtime/generic-io.scm +++ b/src/runtime/generic-io.scm @@ -600,7 +600,7 @@ USA. (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))) @@ -844,7 +844,7 @@ USA. (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))) diff --git a/src/runtime/host-adapter.scm b/src/runtime/host-adapter.scm index f55249f8b..25a3b007e 100644 --- a/src/runtime/host-adapter.scm +++ b/src/runtime/host-adapter.scm @@ -155,7 +155,7 @@ USA. (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)) diff --git a/src/runtime/http-syntax.scm b/src/runtime/http-syntax.scm index f01baefe9..ab720f787 100644 --- a/src/runtime/http-syntax.scm +++ b/src/runtime/http-syntax.scm @@ -861,8 +861,8 @@ USA. (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) diff --git a/src/runtime/mit-macros.scm b/src/runtime/mit-macros.scm index ad96cc578..b964ad87a 100644 --- a/src/runtime/mit-macros.scm +++ b/src/runtime/mit-macros.scm @@ -34,7 +34,7 @@ USA. (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))))) @@ -59,12 +59,12 @@ USA. (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) @@ -72,7 +72,7 @@ USA. (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) @@ -147,7 +147,7 @@ USA. (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)) @@ -158,10 +158,10 @@ USA. (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))) @@ -193,14 +193,14 @@ USA. `(,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) @@ -214,7 +214,7 @@ USA. (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)) @@ -265,7 +265,7 @@ USA. (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)))))) @@ -291,7 +291,7 @@ USA. (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) @@ -305,7 +305,7 @@ USA. (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)) @@ -332,7 +332,7 @@ USA. (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)) @@ -349,7 +349,7 @@ USA. (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))) @@ -364,7 +364,7 @@ USA. (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) @@ -438,9 +438,9 @@ USA. (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))) @@ -563,7 +563,7 @@ USA. ((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)))) ;;;; SRFI 2: AND-LET* @@ -582,17 +582,17 @@ USA. (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))) @@ -617,9 +617,9 @@ USA. (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)))))) @@ -628,7 +628,7 @@ USA. (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) @@ -639,7 +639,7 @@ USA. (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)))))) @@ -647,9 +647,9 @@ USA. (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 @@ -662,11 +662,11 @@ USA. (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) @@ -682,7 +682,7 @@ USA. (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)) @@ -711,7 +711,7 @@ USA. (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)) @@ -727,7 +727,7 @@ USA. (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 () diff --git a/src/runtime/mit-syntax.scm b/src/runtime/mit-syntax.scm index eaf1036da..b2b8f8f64 100644 --- a/src/runtime/mit-syntax.scm +++ b/src/runtime/mit-syntax.scm @@ -33,7 +33,7 @@ USA. (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 @@ -60,13 +60,13 @@ USA. ;;;; 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))) @@ -86,11 +86,11 @@ USA. (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)) @@ -100,18 +100,18 @@ USA. (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 @@ -135,7 +135,7 @@ USA. (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)))) ;;;; Definitions @@ -151,7 +151,7 @@ USA. (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) @@ -199,7 +199,7 @@ USA. (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))) @@ -214,7 +214,7 @@ USA. (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))) @@ -236,7 +236,7 @@ USA. ;; 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 @@ -267,7 +267,7 @@ USA. (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)) @@ -287,7 +287,7 @@ USA. ;;;; 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)))) diff --git a/src/runtime/pgsql.scm b/src/runtime/pgsql.scm index 3dc47214a..658b17145 100644 --- a/src/runtime/pgsql.scm +++ b/src/runtime/pgsql.scm @@ -70,7 +70,7 @@ USA. (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) @@ -123,7 +123,7 @@ USA. (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)) @@ -274,7 +274,7 @@ USA. (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)))) @@ -354,7 +354,7 @@ USA. (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)))) diff --git a/src/runtime/structure-parser.scm b/src/runtime/structure-parser.scm index da4bbcb6c..9207138d1 100644 --- a/src/runtime/structure-parser.scm +++ b/src/runtime/structure-parser.scm @@ -32,7 +32,7 @@ USA. (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))))) @@ -47,7 +47,7 @@ USA. (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))))) @@ -63,7 +63,7 @@ USA. (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))))) @@ -124,9 +124,9 @@ USA. (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))) @@ -809,7 +809,7 @@ USA. 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) @@ -845,13 +845,13 @@ USA. (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 @@ -995,11 +995,11 @@ USA. ((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))))) @@ -1009,16 +1009,16 @@ USA. 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))))) diff --git a/src/runtime/syntax-check.scm b/src/runtime/syntax-check.scm index 1db64bddf..0b6bb647b 100644 --- a/src/runtime/syntax-check.scm +++ b/src/runtime/syntax-check.scm @@ -39,7 +39,7 @@ USA. (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) diff --git a/src/runtime/syntax-declaration.scm b/src/runtime/syntax-declaration.scm index 8038c4b99..80b0cb343 100644 --- a/src/runtime/syntax-declaration.scm +++ b/src/runtime/syntax-declaration.scm @@ -91,12 +91,12 @@ USA. (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)))) @@ -132,9 +132,9 @@ USA. (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)) diff --git a/src/runtime/syntax-rules.scm b/src/runtime/syntax-rules.scm index 954ce9a28..a768083b2 100644 --- a/src/runtime/syntax-rules.scm +++ b/src/runtime/syntax-rules.scm @@ -38,8 +38,7 @@ USA. (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)) @@ -254,7 +253,7 @@ USA. `(,(compiler->keyword (lambda (form environment) environment ;ignore - (syntax-check '(KEYWORD DATUM) form) + (syntax-check '(_ datum) form) (output/constant (cadr form)))) ,expression)) diff --git a/src/runtime/sysmac.scm b/src/runtime/sysmac.scm index 3c4835b25..10eeff558 100644 --- a/src/runtime/sysmac.scm +++ b/src/runtime/sysmac.scm @@ -77,7 +77,7 @@ USA. (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 '?)) diff --git a/src/runtime/url.scm b/src/runtime/url.scm index 82e85fc68..0cab4bcec 100644 --- a/src/runtime/url.scm +++ b/src/runtime/url.scm @@ -1044,21 +1044,21 @@ USA. '((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))) diff --git a/src/sos/macros.scm b/src/sos/macros.scm index 65d66572c..9d0b6bff2 100644 --- a/src/sos/macros.scm +++ b/src/sos/macros.scm @@ -34,7 +34,7 @@ USA. (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 @@ -158,9 +158,9 @@ USA. (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))) @@ -273,7 +273,7 @@ USA. (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) @@ -292,7 +292,7 @@ USA. (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) @@ -310,7 +310,7 @@ USA. (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) @@ -326,7 +326,7 @@ USA. (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) @@ -343,7 +343,7 @@ USA. (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) diff --git a/src/star-parser/matcher.scm b/src/star-parser/matcher.scm index 1b4d14aa5..e1e05266e 100644 --- a/src/star-parser/matcher.scm +++ b/src/star-parser/matcher.scm @@ -86,11 +86,11 @@ USA. (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)))) @@ -225,7 +225,7 @@ USA. (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))))) @@ -272,7 +272,7 @@ USA. (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)) @@ -294,7 +294,7 @@ USA. (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) diff --git a/src/star-parser/parser.scm b/src/star-parser/parser.scm index bb5965b59..13f9d61f2 100644 --- a/src/star-parser/parser.scm +++ b/src/star-parser/parser.scm @@ -83,11 +83,11 @@ USA. (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)))) @@ -207,7 +207,7 @@ USA. (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))))) @@ -256,7 +256,7 @@ USA. (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)) diff --git a/src/star-parser/shared.scm b/src/star-parser/shared.scm index 28b23761d..333503cb8 100644 --- a/src/star-parser/shared.scm +++ b/src/star-parser/shared.scm @@ -595,9 +595,9 @@ USA. (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))))))) @@ -1004,7 +1004,7 @@ USA. 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))))) @@ -1021,7 +1021,7 @@ USA. ('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))))) diff --git a/src/xml/xhtml.scm b/src/xml/xhtml.scm index a35576885..02642d7d6 100644 --- a/src/xml/xhtml.scm +++ b/src/xml/xhtml.scm @@ -57,7 +57,7 @@ USA. (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))) @@ -134,7 +134,7 @@ USA. (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)))) diff --git a/src/xml/xml-struct.scm b/src/xml/xml-struct.scm index b66cd95fb..de1654a34 100644 --- a/src/xml/xml-struct.scm +++ b/src/xml/xml-struct.scm @@ -423,7 +423,7 @@ USA. (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))) diff --git a/src/xml/xpath.scm b/src/xml/xpath.scm index eb7f1efc0..e8276956a 100644 --- a/src/xml/xpath.scm +++ b/src/xml/xpath.scm @@ -221,7 +221,7 @@ USA. (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 diff --git a/tests/runtime/test-syntax-rename.scm b/tests/runtime/test-syntax-rename.scm index a8ad0aeba..164aad02d 100644 --- a/tests/runtime/test-syntax-rename.scm +++ b/tests/runtime/test-syntax-rename.scm @@ -34,13 +34,13 @@ USA. (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) -- 2.25.1