From 77a47304368cd716c05507ce9cebbbab3a2b965a Mon Sep 17 00:00:00 2001 From: Rose Hogenson Date: Tue, 12 Jul 2022 21:44:41 -0700 Subject: Remove redundant parentheses in the match macro. I'm marginally reducing verbosity with this change, without sacrificing readability. --- csc/cps.csc | 6 +++--- csc/macros.csc | 40 ++++++++++++++++++++-------------------- csc/match-test.csc | 8 ++++---- csc/match.csc | 2 +- 4 files changed, 28 insertions(+), 28 deletions(-) diff --git a/csc/cps.csc b/csc/cps.csc index 827f4b7..a5b7d3b 100644 --- a/csc/cps.csc +++ b/csc/cps.csc @@ -116,9 +116,9 @@ (define (to-cps expr continuation) (match expr - (_ (when (or (constant? expr) - (lexical-ref? expr) - (library-ref? expr))) + (_ when (or (constant? expr) + (lexical-ref? expr) + (library-ref? expr)) (continuation expr)) ((% %lexical-set ref arg) (to-cps diff --git a/csc/macros.csc b/csc/macros.csc index 045194b..41225ae 100644 --- a/csc/macros.csc +++ b/csc/macros.csc @@ -229,7 +229,7 @@ (define-syntax syntax-case-match-pattern (syntax-rules (_ when) - ((syntax-case-match-pattern x pattern (when condition) result result* ...) + ((syntax-case-match-pattern x pattern when condition result result* ...) (syntax-case-match-pattern x pattern (if condition (let () result result* ...) @@ -303,24 +303,24 @@ (define (expand-syntax-object syntax) (syntax-case syntax ('() (raise-syntax-error "nil by itself is an error (did you mean to use quote?)" syntax)) - ((macro-name . tail) (when (identifier? macro-name)) + ((macro-name . tail) when (identifier? macro-name) (let ((macro-body (resolve-identifier macro-name))) (if (macro-transformer? macro-body) ((transformer-function macro-body) syntax) (expand-procedure-call macro-name tail)))) ((procedure . arguments) (expand-procedure-call procedure arguments)) - (_ (when (identifier? syntax)) + (_ when (identifier? syntax) (let ((binding (resolve-identifier syntax))) (if (macro-transformer? binding) (raise-syntax-error "macro is not allowed in this context" syntax) binding))) - (_ (when (let ((expr (syntax->expression syntax))) - (or (boolean? expr) - (char? expr) - (number? expr) - (string? expr) - (vector? expr)))) + (_ when (let ((expr (syntax->expression syntax))) + (or (boolean? expr) + (char? expr) + (number? expr) + (string? expr) + (vector? expr))) (make-constant (syntax->expression syntax))) (_ (raise-syntax-error "unexpected expression type" (clean-syntax syntax))))) @@ -456,11 +456,11 @@ (define (pattern-bindings ellipsis literals pattern object) (syntax-case pattern - (lit (when (matches-literals literals lit)) + (lit when (matches-literals literals lit) (if (and (identifier? object) (free-identifier=? object lit)) (alist->substitutions '()) #f)) - ((p ellip . p*) (when (and (identifier? ellip) (not (matches-literals literals ellip)) (free-identifier=? ellipsis ellip))) + ((p ellip . p*) when (and (identifier? ellip) (not (matches-literals literals ellip)) (free-identifier=? ellipsis ellip)) (let* ((n (syntax-improper-list-length object)) (m (syntax-improper-list-length p*)) (n-m (- n m))) @@ -478,9 +478,9 @@ (let ((bindings* (pattern-bindings ellipsis literals p* object))) (and bindings* (merge bindings bindings*))))) #f))) - (underscore (when (is-underscore underscore)) + (underscore when (is-underscore underscore) (alist->substitutions '())) - (ident (when (identifier? ident)) + (ident when (identifier? ident) ; Each time the expander encounters a macro use, it applies an ; antimark to the input form. ; @@ -544,12 +544,12 @@ (define (expand-template ellipsis ellipsis-nesting substitutions template) (syntax-case template ('() (with-wrap '() template)) - ((head ellip . tail) (when (and (identifier? ellip) (free-identifier=? ellip ellipsis))) + ((head ellip . tail) when (and (identifier? ellip) (free-identifier=? ellip ellipsis)) (let-values (((extra-ellipses tail) (let loop ((tail tail) (extra-ellipses '())) (syntax-case tail - ((ellip . tail) (when (and (identifier? ellip) (free-identifier=? ellip ellipsis))) + ((ellip . tail) when (and (identifier? ellip) (free-identifier=? ellip ellipsis)) (loop tail (cons ellip extra-ellipses))) (_ (values extra-ellipses tail)))))) (let loop ((i 0) @@ -577,7 +577,7 @@ (cons (expand-template ellipsis ellipsis-nesting substitutions head) (expand-template ellipsis ellipsis-nesting substitutions tail)) template)) - (ident (when (identifier? ident)) + (ident when (identifier? ident) (guard (e ((key-not-found-error? e) template)) (ellipsis-lookup substitutions ellipsis-nesting template))) (_ template))) @@ -617,7 +617,7 @@ (make-macro-transformer (lambda (input-form) (syntax-case syntax-rules-form - ((_ ellipsis literals . rules) (when (identifier? ellipsis)) + ((_ ellipsis literals . rules) when (identifier? ellipsis) (syntax-match ellipsis literals rules input-form)) ((_ literals . rules) (syntax-match default-ellipsis literals rules input-form)) @@ -628,7 +628,7 @@ (make-macro-transformer (lambda (x) (syntax-case x - ((_ (ident transformer-form) body-form) (when (identifier? ident)) + ((_ (ident transformer-form) body-form) when (identifier? ident) (let* ((transformer (expand-syntax-object transformer-form)) (body (expand-syntax-object (with-binding ident transformer body-form)))) body)) @@ -639,10 +639,10 @@ (syntax-case formals ('() (values '() #f)) - ((var . vars) (when (identifier? var)) + ((var . vars) when (identifier? var) (let-values (((args rest) (split-args-rest vars))) (values (cons (identifier-name var) args) rest))) - (var (when identifier? var) + (var when (identifier? var) (values '() (identifier-name var))) (_ (raise-syntax-error "unexpected form in split-args-rest" formals)))) diff --git a/csc/match-test.csc b/csc/match-test.csc index c5314ce..d4da153 100644 --- a/csc/match-test.csc +++ b/csc/match-test.csc @@ -73,8 +73,8 @@ 3 (match 'b ((! 'a) 1) - ((! 'b) (when #f) 2) - ((! 'b) (when #t) 3) + ((! 'b) when #f 2) + ((! 'b) when #t 3) (_ 4)))) @@ -82,8 +82,8 @@ (assert-equal 2 (match 10 - (n (when (= 1 n)) 1) - (n (when (= 10 n)) 2) + (n when (= 1 n) 1) + (n when (= 10 n) 2) (_ 3)))) diff --git a/csc/match.csc b/csc/match.csc index f6ed477..c925381 100644 --- a/csc/match.csc +++ b/csc/match.csc @@ -30,7 +30,7 @@ (define-syntax match-pattern (syntax-rules (_ ! when %) - ((match-pattern x pattern (when condition) result result* ...) + ((match-pattern x pattern when condition result result* ...) (match-pattern x pattern (if condition (let () result result* ...) -- cgit v1.3.1