guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] 12/12: psyntax: Use new `match' instead of cdadring


From: Andy Wingo
Subject: [Guile-commits] 12/12: psyntax: Use new `match' instead of cdadring
Date: Fri, 15 Nov 2024 10:25:33 -0500 (EST)

wingo pushed a commit to branch main
in repository guile.

commit 2daea40200606a5e2dc14e643e439e891fbd6c5b
Author: Andy Wingo <wingo@pobox.com>
AuthorDate: Fri Nov 15 15:35:10 2024 +0100

    psyntax: Use new `match' instead of cdadring
    
    * module/ice-9/psyntax-pp.scm: Regenerate.
    * module/ice-9/psyntax.scm: Use `match' more.  Also use more first-order
    definitions.  NFC.
---
 module/ice-9/psyntax-pp.scm | 368 +++++++++++++++++++++++++++-----------------
 module/ice-9/psyntax.scm    | 102 ++++++------
 2 files changed, 280 insertions(+), 190 deletions(-)

diff --git a/module/ice-9/psyntax-pp.scm b/module/ice-9/psyntax-pp.scm
index 2f8dcbe3d..efb2ae5c4 100644
--- a/module/ice-9/psyntax-pp.scm
+++ b/module/ice-9/psyntax-pp.scm
@@ -193,24 +193,75 @@
                (let ((props (source-properties datum)))
                  (and (pair? props) (vector (assq-ref props 'filename) 
(assq-ref props 'line) (assq-ref props 'column))))))
             (source-annotation (lambda (x) (if (syntax? x) (syntax-sourcev x) 
(datum-sourcev x))))
+            (binding-type (lambda (x) (car x)))
+            (binding-value (lambda (x) (cdr x)))
+            (null-env '())
             (extend-env
              (lambda (labels bindings r)
-               (if (null? labels)
-                   r
-                   (extend-env (cdr labels) (cdr bindings) (cons (cons (car 
labels) (car bindings)) r)))))
+               (let* ((v labels)
+                      (fk (lambda ()
+                            (let ((fk (lambda () (error "value failed to 
match" v))))
+                              (if (pair? v)
+                                  (let ((vx (car v)) (vy (cdr v)))
+                                    (let* ((label vx)
+                                           (labels vy)
+                                           (v bindings)
+                                           (fk (lambda () (error "value failed 
to match" v))))
+                                      (if (pair? v)
+                                          (let ((vx (car v)) (vy (cdr v)))
+                                            (let* ((binding vx) (bindings vy))
+                                              (extend-env labels bindings 
(acons label binding r))))
+                                          (fk))))
+                                  (fk))))))
+                 (if (null? v) r (fk)))))
             (extend-var-env
              (lambda (labels vars r)
-               (if (null? labels)
-                   r
-                   (extend-var-env (cdr labels) (cdr vars) (cons (cons (car 
labels) (cons 'lexical (car vars))) r)))))
+               (let* ((v labels)
+                      (fk (lambda ()
+                            (let ((fk (lambda () (error "value failed to 
match" v))))
+                              (if (pair? v)
+                                  (let ((vx (car v)) (vy (cdr v)))
+                                    (let* ((label vx)
+                                           (labels vy)
+                                           (v vars)
+                                           (fk (lambda () (error "value failed 
to match" v))))
+                                      (if (pair? v)
+                                          (let ((vx (car v)) (vy (cdr v)))
+                                            (let* ((var vx) (vars vy))
+                                              (extend-var-env labels vars 
(acons label (cons 'lexical var) r))))
+                                          (fk))))
+                                  (fk))))))
+                 (if (null? v) r (fk)))))
             (macros-only-env
              (lambda (r)
-               (if (null? r)
-                   '()
-                   (let ((a (car r)))
-                     (if (memq (cadr a) '(macro syntax-parameter ellipsis))
-                         (cons a (macros-only-env (cdr r)))
-                         (macros-only-env (cdr r)))))))
+               (let* ((v r)
+                      (fk (lambda ()
+                            (let ((fk (lambda () (error "value failed to 
match" v))))
+                              (if (pair? v)
+                                  (let ((vx (car v)) (vy (cdr v)))
+                                    (let* ((a vx)
+                                           (r vy)
+                                           (v a)
+                                           (fk (lambda ()
+                                                 (let ((fk (lambda () (error 
"value failed to match" v))))
+                                                   (macros-only-env r)))))
+                                      (if (pair? v)
+                                          (let ((vx (car v)) (vy (cdr v)))
+                                            (let ((k vx))
+                                              (if (pair? vy)
+                                                  (let ((vx (car vy)) (vy (cdr 
vy)))
+                                                    (let ((tk (lambda () (cons 
a (macros-only-env r)))))
+                                                      (if (eq? vx 'macro)
+                                                          (tk)
+                                                          (let ((tk (lambda () 
(tk))))
+                                                            (if (eq? vx 
'syntax-parameter)
+                                                                (tk)
+                                                                (let ((tk 
(lambda () (tk))))
+                                                                  (if (eq? vx 
'ellipsis) (tk) (fk))))))))
+                                                  (fk))))
+                                          (fk))))
+                                  (fk))))))
+                 (if (null? v) '() (fk)))))
             (global-extend
              (lambda (type sym val) (module-define! (current-module) sym 
(make-syntax-transformer sym type val))))
             (nonsymbol-id? (lambda (x) (and (syntax? x) (symbol? 
(syntax-expression x)))))
@@ -218,15 +269,26 @@
             (id-sym-name&marks
              (lambda (x w)
                (if (syntax? x)
-                   (values (syntax-expression x) (join-marks (car w) (car 
(syntax-wrap x))))
-                   (values x (car w)))))
+                   (values (syntax-expression x) (join-marks (wrap-marks w) 
(wrap-marks (syntax-wrap x))))
+                   (values x (wrap-marks w)))))
+            (make-wrap (lambda (marks subst) (cons marks subst)))
+            (wrap-marks (lambda (wrap) (car wrap)))
+            (wrap-subst (lambda (wrap) (cdr wrap)))
             (gen-unique
              (lambda* (#:optional (module (current-module)))
                (if module
                    (vector (module-name module) (module-generate-unique-id! 
module))
                    (vector '(guile) (gensym "id")))))
             (gen-label (lambda () (gen-unique)))
-            (gen-labels (lambda (ls) (if (null? ls) '() (cons (gen-label) 
(gen-labels (cdr ls))))))
+            (gen-labels
+             (lambda (ls)
+               (let* ((v ls)
+                      (fk (lambda ()
+                            (let ((fk (lambda () (error "value failed to 
match" v))))
+                              (if (pair? v)
+                                  (let ((vx (car v)) (vy (cdr v))) (let ((ls 
vy)) (cons (gen-label) (gen-labels ls))))
+                                  (fk))))))
+                 (if (null? v) '() (fk)))))
             (make-ribcage (lambda (symnames marks labels) (vector 'ribcage 
symnames marks labels)))
             (ribcage-symnames (lambda (ribcage) (vector-ref ribcage 1)))
             (ribcage-marks (lambda (ribcage) (vector-ref ribcage 2)))
@@ -234,37 +296,54 @@
             (set-ribcage-symnames! (lambda (ribcage x) (vector-set! ribcage 1 
x)))
             (set-ribcage-marks! (lambda (ribcage x) (vector-set! ribcage 2 x)))
             (set-ribcage-labels! (lambda (ribcage x) (vector-set! ribcage 3 
x)))
-            (anti-mark (lambda (w) (cons (cons #f (car w)) (cons 'shift (cdr 
w)))))
+            (empty-wrap '(()))
+            (top-wrap '((top)))
+            (the-anti-mark #f)
+            (anti-mark (lambda (w) (make-wrap (cons the-anti-mark (wrap-marks 
w)) (cons 'shift (wrap-subst w)))))
             (new-mark (lambda () (gen-unique)))
             (extend-ribcage!
              (lambda (ribcage id label)
                (set-ribcage-symnames! ribcage (cons (syntax-expression id) 
(ribcage-symnames ribcage)))
-               (set-ribcage-marks! ribcage (cons (car (syntax-wrap id)) 
(ribcage-marks ribcage)))
+               (set-ribcage-marks! ribcage (cons (wrap-marks (syntax-wrap id)) 
(ribcage-marks ribcage)))
                (set-ribcage-labels! ribcage (cons label (ribcage-labels 
ribcage)))))
             (make-binding-wrap
              (lambda (ids labels w)
-               (if (null? ids)
-                   w
-                   (cons (car w)
-                         (cons (let* ((labelvec (list->vector labels)) (n 
(vector-length labelvec)))
-                                 (let ((symnamevec (make-vector n)) (marksvec 
(make-vector n)))
-                                   (let f ((ids ids) (i 0))
-                                     (if (not (null? ids))
-                                         (call-with-values
-                                          (lambda () (id-sym-name&marks (car 
ids) w))
-                                          (lambda (symname marks)
-                                            (vector-set! symnamevec i symname)
-                                            (vector-set! marksvec i marks)
-                                            (f (cdr ids) (#{1+}# i))))))
-                                   (make-ribcage symnamevec marksvec 
labelvec)))
-                               (cdr w))))))
+               (let* ((v ids)
+                      (fk (lambda ()
+                            (let ((fk (lambda () (error "value failed to 
match" v))))
+                              (if (pair? v)
+                                  (let ((vx (car v)) (vy (cdr v)))
+                                    (make-wrap
+                                     (wrap-marks w)
+                                     (cons (let* ((labelvec (list->vector 
labels))
+                                                  (n (vector-length labelvec))
+                                                  (symnamevec (make-vector n))
+                                                  (marksvec (make-vector n)))
+                                             (let f ((ids ids) (i 0))
+                                               (let* ((v ids)
+                                                      (fk (lambda ()
+                                                            (let ((fk (lambda 
() (error "value failed to match" v))))
+                                                              (if (pair? v)
+                                                                  (let ((vx 
(car v)) (vy (cdr v)))
+                                                                    (let* ((id 
vx) (ids vy))
+                                                                      
(call-with-values
+                                                                       (lambda 
() (id-sym-name&marks id w))
+                                                                       (lambda 
(symname marks)
+                                                                         
(vector-set! symnamevec i symname)
+                                                                         
(vector-set! marksvec i marks)
+                                                                         (f 
ids (#{1+}# i))))))
+                                                                  (fk))))))
+                                                 (if (null? v) (make-ribcage 
symnamevec marksvec labelvec) (fk)))))
+                                           (wrap-subst w))))
+                                  (fk))))))
+                 (if (null? v) w (fk)))))
             (smart-append (lambda (m1 m2) (if (null? m2) m1 (append m1 m2))))
             (join-wraps
              (lambda (w1 w2)
-               (let ((m1 (car w1)) (s1 (cdr w1)))
+               (let ((m1 (wrap-marks w1)) (s1 (wrap-subst w1)))
                  (if (null? m1)
-                     (if (null? s1) w2 (cons (car w2) (smart-append s1 (cdr 
w2))))
-                     (cons (smart-append m1 (car w2)) (smart-append s1 (cdr 
w2)))))))
+                     (if (null? s1) w2 (make-wrap (wrap-marks w2) 
(smart-append s1 (wrap-subst w2))))
+                     (make-wrap (smart-append m1 (wrap-marks w2)) 
(smart-append s1 (wrap-subst w2)))))))
             (join-marks (lambda (m1 m2) (smart-append m1 m2)))
             (same-marks?
              (lambda (x y)
@@ -311,13 +390,13 @@
                                          (values n marks))))
                                   (else (f (#{1+}# i)))))))))
                  (cond
-                   ((symbol? id) (or (search id (cdr w) (car w) mod) id))
+                   ((symbol? id) (or (search id (wrap-subst w) (wrap-marks w) 
mod) id))
                    ((syntax? id)
                     (let ((id (syntax-expression id)) (w1 (syntax-wrap id)) 
(mod (or (syntax-module id) mod)))
-                      (let ((marks (join-marks (car w) (car w1))))
+                      (let ((marks (join-marks (wrap-marks w) (wrap-marks 
w1))))
                         (call-with-values
-                         (lambda () (search id (cdr w) marks mod))
-                         (lambda (new-id marks) (or new-id (search id (cdr w1) 
marks mod) id))))))
+                         (lambda () (search id (wrap-subst w) marks mod))
+                         (lambda (new-id marks) (or new-id (search id 
(wrap-subst w1) marks mod) id))))))
                    (else (syntax-violation 'id-var-name "invalid id" id))))))
             (locally-bound-identifiers
              (lambda (w mod)
@@ -338,7 +417,7 @@
                                   (scan (cdr subst) results)
                                   (f (cdr symnames)
                                      (cdr marks)
-                                     (cons (wrap (car symnames) (anti-mark 
(cons (car marks) subst)) mod) results))))))
+                                     (cons (wrap (car symnames) (anti-mark 
(make-wrap (car marks) subst)) mod) results))))))
                          (scan-vector-rib
                           (lambda (subst symnames marks results)
                             (let ((n (vector-length symnames)))
@@ -347,10 +426,10 @@
                                     (scan (cdr subst) results)
                                     (f (#{1+}# i)
                                        (cons (wrap (vector-ref symnames i)
-                                                   (anti-mark (cons 
(vector-ref marks i) subst))
+                                                   (anti-mark (make-wrap 
(vector-ref marks i) subst))
                                                    mod)
                                              results))))))))
-                 (scan (cdr w) '()))))
+                 (scan (wrap-subst w) '()))))
             (resolve-identifier
              (lambda (id w r mod resolve-syntax-parameters?)
                (letrec* ((resolve-global
@@ -367,7 +446,7 @@
                                     (if (eq? type 'syntax-parameter)
                                         (if resolve-syntax-parameters?
                                             (let ((lexical (assq-ref r v)))
-                                              (values 'macro (if lexical (cdr 
lexical) trans) mod))
+                                              (values 'macro (if lexical 
(binding-value lexical) trans) mod))
                                             (values type v mod))
                                         (values type trans mod)))
                                   (values 'global var mod)))))
@@ -375,7 +454,7 @@
                           (lambda (label mod)
                             (let ((b (assq-ref r label)))
                               (if b
-                                  (let ((type (car b)) (value (cdr b)))
+                                  (let ((type (binding-type b)) (value 
(binding-value b)))
                                     (if (eq? type 'syntax-parameter)
                                         (if resolve-syntax-parameters?
                                             (values 'macro value mod)
@@ -402,8 +481,8 @@
              (lambda (i j)
                (let* ((mi (and (syntax? i) (syntax-module i)))
                       (mj (and (syntax? j) (syntax-module j)))
-                      (ni (id-var-name i '(()) mi))
-                      (nj (id-var-name j '(()) mj)))
+                      (ni (id-var-name i empty-wrap mi))
+                      (nj (id-var-name j empty-wrap mj)))
                  (letrec* ((id-module-binding
                             (lambda (id mod)
                               (module-variable
@@ -422,7 +501,7 @@
              (lambda (i j)
                (if (and (syntax? i) (syntax? j))
                    (and (eq? (syntax-expression i) (syntax-expression j))
-                        (same-marks? (car (syntax-wrap i)) (car (syntax-wrap 
j))))
+                        (same-marks? (wrap-marks (syntax-wrap i)) (wrap-marks 
(syntax-wrap j))))
                    (eq? i j))))
             (valid-bound-ids?
              (lambda (ids)
@@ -441,7 +520,7 @@
             (source-wrap
              (lambda (x w s defmod)
                (cond
-                 ((and (null? (car w)) (null? (cdr w)) (not defmod) (not s)) x)
+                 ((and (null? (wrap-marks w)) (null? (wrap-subst w)) (not 
defmod) (not s)) x)
                  ((syntax? x) (wrap-syntax x (join-wraps w (syntax-wrap x)) 
defmod))
                  ((null? x) x)
                  (else (make-syntax x w defmod s)))))
@@ -457,12 +536,13 @@
              (lambda (body r w s m esew mod)
                (let* ((r (cons '("placeholder" placeholder) r))
                       (ribcage (make-ribcage '() '() '()))
-                      (w (cons (car w) (cons ribcage (cdr w)))))
+                      (w (make-wrap (wrap-marks w) (cons ribcage (wrap-subst 
w)))))
                  (letrec* ((record-definition!
                             (lambda (id var)
                               (let ((mod (cons 'hygiene (module-name 
(current-module)))))
-                                (extend-ribcage! ribcage id (cons (or 
(syntax-module id) mod) (wrap var '((top)) mod))))))
-                           (macro-introduced-identifier? (lambda (id) (not 
(equal? (car (syntax-wrap id)) '(top)))))
+                                (extend-ribcage! ribcage id (cons (or 
(syntax-module id) mod) (wrap var top-wrap mod))))))
+                           (macro-introduced-identifier?
+                            (lambda (id) (not (equal? (wrap-marks (syntax-wrap 
id)) '(top)))))
                            (ensure-fresh-name
                             (lambda (var)
                               (letrec* ((ribcage-has-var?
@@ -515,7 +595,7 @@
                                                       (top-level-eval x mod)
                                                       (lambda () x))
                                                     (call-with-values
-                                                     (lambda () 
(resolve-identifier id '(()) r mod #t))
+                                                     (lambda () 
(resolve-identifier id empty-wrap r mod #t))
                                                      (lambda (type* value* 
mod*)
                                                        (if (eq? type* 'macro)
                                                            (top-level-eval
@@ -646,7 +726,7 @@
                          ((memv key '(macro))
                           (if for-car?
                               (values type value e e w s mod)
-                              (syntax-type (expand-macro value e r w s rib 
mod) r '(()) s rib mod #f)))
+                              (syntax-type (expand-macro value e r w s rib 
mod) r empty-wrap s rib mod #f)))
                          ((memv key '(global)) (values type value e value w s 
mod*))
                          (else (values type value e e w s mod)))))))
                  ((pair? e)
@@ -662,7 +742,7 @@
                                 (values 'primitive-call fval e e w s mod)
                                 (values 'global-call (make-syntax fval w fmod 
fs) e e w s mod)))
                            ((memv key '(macro))
-                            (syntax-type (expand-macro fval e r w s rib mod) r 
'(()) s rib mod for-car?))
+                            (syntax-type (expand-macro fval e r w s rib mod) r 
empty-wrap s rib mod for-car?))
                            ((memv key '(module-ref))
                             (call-with-values
                              (lambda () (fval e r w mod))
@@ -688,10 +768,10 @@
                                                   (source-wrap
                                                    (cons (make-syntax 'lambda 
'((top)) '(hygiene guile))
                                                          (wrap (cons args 
(cons e1 e2)) w mod))
-                                                   '(())
+                                                   empty-wrap
                                                    s
                                                    #f)
-                                                  '(())
+                                                  empty-wrap
                                                   s
                                                   mod))
                                                tmp-1)
@@ -703,7 +783,7 @@
                                                         (wrap name w mod)
                                                         (wrap e w mod)
                                                         (list (make-syntax 'if 
'((top)) '(hygiene guile)) #f #f)
-                                                        '(())
+                                                        empty-wrap
                                                         s
                                                         mod))
                                                      tmp-1)
@@ -813,7 +893,7 @@
                      (syntax-violation #f "source expression failed to match 
any pattern" tmp-1)))))
             (expand-macro
              (lambda (p e r w s rib mod)
-               (letrec* ((decorate-source (lambda (x) (source-wrap x '(()) s 
#f)))
+               (letrec* ((decorate-source (lambda (x) (source-wrap x 
empty-wrap s #f)))
                          (map* (lambda (f x)
                                  (cond ((null? x) x) ((pair? x) (cons (f (car 
x)) (map* f (cdr x)))) (else (f x)))))
                          (rebuild-macro-output
@@ -822,12 +902,12 @@
                               ((pair? x) (decorate-source (map* (lambda (x) 
(rebuild-macro-output x m)) x)))
                               ((syntax? x)
                                (let ((w (syntax-wrap x)))
-                                 (let ((ms (car w)) (ss (cdr w)))
-                                   (if (and (pair? ms) (eq? (car ms) #f))
-                                       (wrap-syntax x (cons (cdr ms) (if rib 
(cons rib (cdr ss)) (cdr ss))) mod)
+                                 (let ((ms (wrap-marks w)) (ss (wrap-subst w)))
+                                   (if (and (pair? ms) (eq? (car ms) 
the-anti-mark))
+                                       (wrap-syntax x (make-wrap (cdr ms) (if 
rib (cons rib (cdr ss)) (cdr ss))) mod)
                                        (wrap-syntax
                                         x
-                                        (cons (cons m ms) (if rib (cons rib 
(cons 'shift ss)) (cons 'shift ss)))
+                                        (make-wrap (cons m ms) (if rib (cons 
rib (cons 'shift ss)) (cons 'shift ss)))
                                         mod)))))
                               ((vector? x)
                                (let* ((n (vector-length x)) (v (make-vector 
n)))
@@ -842,20 +922,20 @@
                                (syntax-violation
                                 #f
                                 "encountered raw symbol in macro output"
-                                (source-wrap e w (cdr w) mod)
+                                (source-wrap e w (wrap-subst w) mod)
                                 x))
                               (else (decorate-source x))))))
-                 (let* ((t-680b775fb37a463-f01 transformer-environment)
-                        (t-680b775fb37a463-f02 (lambda (k) (k e r w s rib 
mod))))
+                 (let* ((t-680b775fb37a463-f33 transformer-environment)
+                        (t-680b775fb37a463-f34 (lambda (k) (k e r w s rib 
mod))))
                    (with-fluid*
-                    t-680b775fb37a463-f01
-                    t-680b775fb37a463-f02
+                    t-680b775fb37a463-f33
+                    t-680b775fb37a463-f34
                     (lambda () (rebuild-macro-output (p (source-wrap e 
(anti-mark w) s mod)) (new-mark))))))))
             (expand-body
              (lambda (body outer-form r w mod)
                (let* ((r (cons '("placeholder" placeholder) r))
                       (ribcage (make-ribcage '() '() '()))
-                      (w (cons (car w) (cons ribcage (cdr w)))))
+                      (w (make-wrap (wrap-marks w) (cons ribcage (wrap-subst 
w)))))
                  (let parse ((body (map (lambda (x) (cons r (wrap x w mod))) 
body))
                              (ids '())
                              (labels '())
@@ -890,7 +970,7 @@
                       (parse body ids labels (cons #f var-ids) (cons #f vars) 
(cons expand-tail-expr vals) bindings #f))
                      (else (let ((e (cdar body)) (er (caar body)) (body (cdr 
body)))
                              (call-with-values
-                              (lambda () (syntax-type e er '(()) 
(source-annotation e) ribcage mod #f))
+                              (lambda () (syntax-type e er empty-wrap 
(source-annotation e) ribcage mod #f))
                               (lambda (type value form e w s mod)
                                 (let ((key type))
                                   (cond
@@ -904,7 +984,7 @@
                                                 (cons id var-ids)
                                                 (cons var vars)
                                                 (cons (let ((wrapped 
(source-wrap e w s mod)))
-                                                        (lambda () (expand 
wrapped er '(()) mod)))
+                                                        (lambda () (expand 
wrapped er empty-wrap mod)))
                                                       vals)
                                                 (cons (cons 'lexical var) 
bindings)
                                                 #f))))
@@ -975,7 +1055,7 @@
                                                    vars
                                                    vals
                                                    bindings
-                                                   (lambda () (expand wrapped 
er '(()) mod))))))))))))))))
+                                                   (lambda () (expand wrapped 
er empty-wrap mod))))))))))))))))
             (expand-local-syntax
              (lambda (rec? e r w s mod k)
                (let* ((tmp e) (tmp ($sc-dispatch tmp '(_ #(each (any any)) any 
. each-any))))
@@ -1010,7 +1090,7 @@
                      (lambda ()
                        (resolve-identifier
                         (make-syntax '#{ $sc-ellipsis }# (syntax-wrap e) (or 
(syntax-module e) mod) #f)
-                        '(())
+                        empty-wrap
                         r
                         mod
                         #f))
@@ -1379,11 +1459,11 @@
                                                 s
                                                 mod
                                                 get-formals
-                                                (map (lambda 
(tmp-680b775fb37a463-117d
-                                                              
tmp-680b775fb37a463-117c
-                                                              
tmp-680b775fb37a463-117b)
-                                                       (cons 
tmp-680b775fb37a463-117b
-                                                             (cons 
tmp-680b775fb37a463-117c tmp-680b775fb37a463-117d)))
+                                                (map (lambda 
(tmp-680b775fb37a463-11a1
+                                                              
tmp-680b775fb37a463-11a0
+                                                              
tmp-680b775fb37a463-119f)
+                                                       (cons 
tmp-680b775fb37a463-119f
+                                                             (cons 
tmp-680b775fb37a463-11a0 tmp-680b775fb37a463-11a1)))
                                                      e2*
                                                      e1*
                                                      args*)))
@@ -1408,7 +1488,7 @@
             (gen-var (lambda (id) (let ((id (if (syntax? id) 
(syntax-expression id) id))) (gen-lexical id))))
             (lambda-var-list
              (lambda (vars)
-               (let lvl ((vars vars) (ls '()) (w '(())))
+               (let lvl ((vars vars) (ls '()) (w empty-wrap))
                  (cond
                    ((pair? vars) (lvl (cdr vars) (cons (wrap (car vars) w #f) 
ls) w))
                    ((id? vars) (cons (wrap vars w #f) ls))
@@ -1472,7 +1552,7 @@
                 (lambda (src e r maps ellipsis? mod)
                   (if (id? e)
                       (call-with-values
-                       (lambda () (resolve-identifier e '(()) r mod #f))
+                       (lambda () (resolve-identifier e empty-wrap r mod #f))
                        (lambda (type value mod)
                          (let ((key type))
                            (cond
@@ -1651,8 +1731,8 @@
                (apply (lambda (args e1 e2)
                         (build-it
                          '()
-                         (map (lambda (tmp-680b775fb37a463-2 
tmp-680b775fb37a463-1 tmp-680b775fb37a463)
-                                (cons tmp-680b775fb37a463 (cons 
tmp-680b775fb37a463-1 tmp-680b775fb37a463-2)))
+                         (map (lambda (tmp-680b775fb37a463-6be 
tmp-680b775fb37a463-6bd tmp-680b775fb37a463-6bc)
+                                (cons tmp-680b775fb37a463-6bc (cons 
tmp-680b775fb37a463-6bd tmp-680b775fb37a463-6be)))
                               e2
                               e1
                               args)))
@@ -1662,9 +1742,9 @@
                      (apply (lambda (docstring args e1 e2)
                               (build-it
                                (list (cons 'documentation (syntax->datum 
docstring)))
-                               (map (lambda (tmp-680b775fb37a463-74d 
tmp-680b775fb37a463-74c tmp-680b775fb37a463-74b)
-                                      (cons tmp-680b775fb37a463-74b
-                                            (cons tmp-680b775fb37a463-74c 
tmp-680b775fb37a463-74d)))
+                               (map (lambda (tmp-680b775fb37a463-6d4 
tmp-680b775fb37a463-6d3 tmp-680b775fb37a463-6d2)
+                                      (cons tmp-680b775fb37a463-6d2
+                                            (cons tmp-680b775fb37a463-6d3 
tmp-680b775fb37a463-6d4)))
                                     e2
                                     e1
                                     args)))
@@ -1684,8 +1764,8 @@
                (apply (lambda (args e1 e2)
                         (build-it
                          '()
-                         (map (lambda (tmp-680b775fb37a463-1 
tmp-680b775fb37a463 tmp-680b775fb37a463-6ff)
-                                (cons tmp-680b775fb37a463-6ff (cons 
tmp-680b775fb37a463 tmp-680b775fb37a463-1)))
+                         (map (lambda (tmp-680b775fb37a463-2 
tmp-680b775fb37a463-1 tmp-680b775fb37a463)
+                                (cons tmp-680b775fb37a463 (cons 
tmp-680b775fb37a463-1 tmp-680b775fb37a463-2)))
                               e2
                               e1
                               args)))
@@ -1695,8 +1775,9 @@
                      (apply (lambda (docstring args e1 e2)
                               (build-it
                                (list (cons 'documentation (syntax->datum 
docstring)))
-                               (map (lambda (tmp-680b775fb37a463-2 
tmp-680b775fb37a463-1 tmp-680b775fb37a463)
-                                      (cons tmp-680b775fb37a463 (cons 
tmp-680b775fb37a463-1 tmp-680b775fb37a463-2)))
+                               (map (lambda (tmp-680b775fb37a463-69e 
tmp-680b775fb37a463-69d tmp-680b775fb37a463-69c)
+                                      (cons tmp-680b775fb37a463-69c
+                                            (cons tmp-680b775fb37a463-69d 
tmp-680b775fb37a463-69e)))
                                     e2
                                     e1
                                     args)))
@@ -1807,7 +1888,7 @@
                              ((memv key '(global)) (build-global-assignment s 
value (expand val r w mod) id-mod))
                              ((memv key '(macro))
                               (if (procedure-property value 
'variable-transformer)
-                                  (expand (expand-macro value e r w s #f mod) 
r '(()) mod)
+                                  (expand (expand-macro value e r w s #f mod) 
r empty-wrap mod)
                                   (syntax-violation
                                    'set!
                                    "not a variable transformer"
@@ -1821,7 +1902,7 @@
                (if tmp
                    (apply (lambda (head tail val)
                             (call-with-values
-                             (lambda () (syntax-type head r '(()) #f #f mod 
#t))
+                             (lambda () (syntax-type head r empty-wrap #f #f 
mod #t))
                              (lambda (type value ee* ee ww ss modmod)
                                (let ((key type))
                                  (if (memv key '(module-ref))
@@ -1854,7 +1935,7 @@
                       (values
                        (syntax->datum id)
                        r
-                       '((top))
+                       top-wrap
                        #f
                        (syntax->datum (cons (make-syntax 'public '((top)) 
'(hygiene guile)) mod))))
                     tmp)
@@ -1884,14 +1965,14 @@
                     (apply (lambda (id)
                              (and (id? id) (equal? (cdr (or (and (syntax? id) 
(syntax-module id)) mod)) '(guile))))
                            tmp-1))
-               (apply (lambda (id) (values (syntax->datum id) r '((top)) #f 
'(primitive))) tmp-1)
+               (apply (lambda (id) (values (syntax->datum id) r top-wrap #f 
'(primitive))) tmp-1)
                (let ((tmp-1 ($sc-dispatch tmp '(_ each-any any))))
                  (if (and tmp-1 (apply (lambda (mod id) (and (and-map id? mod) 
(id? id))) tmp-1))
                      (apply (lambda (mod id)
                               (values
                                (syntax->datum id)
                                r
-                               '((top))
+                               top-wrap
                                #f
                                (syntax->datum (cons (make-syntax 'private 
'((top)) '(hygiene guile)) mod))))
                             tmp-1)
@@ -2019,7 +2100,7 @@
                                 labels
                                 (map (lambda (var level) (cons 'syntax (cons 
var level))) new-vars (map cdr pvars))
                                 r)
-                               (make-binding-wrap ids labels '(()))
+                               (make-binding-wrap ids labels empty-wrap)
                                mod))
                              y))))))
                (gen-clause
@@ -2072,7 +2153,7 @@
                                                (lambda (x) (not (free-id=? pat 
x)))
                                                (cons (make-syntax '... 
'((top)) '(hygiene guile)) keys)))
                                          (if (free-id=? pat (make-syntax '_ 
'((top)) '(hygiene guile)))
-                                             (expand exp r '(()) mod)
+                                             (expand exp r empty-wrap mod)
                                              (let ((labels (list (gen-label))) 
(var (gen-var pat)))
                                                (build-call
                                                 #f
@@ -2085,7 +2166,7 @@
                                                  (expand
                                                   exp
                                                   (extend-env labels (list 
(cons 'syntax (cons var 0))) r)
-                                                  (make-binding-wrap (list 
pat) labels '(()))
+                                                  (make-binding-wrap (list 
pat) labels empty-wrap)
                                                   mod))
                                                 (list x))))
                                          (gen-clause x keys (cdr clauses) r 
pat #t exp mod)))
@@ -2111,7 +2192,7 @@
                                 (list x)
                                 '()
                                 (gen-syntax-case (build-lexical-reference 
'value #f 'tmp x) key m r mod))
-                               (list (expand val r '(()) mod))))
+                               (list (expand val r empty-wrap mod))))
                             (syntax-violation 'syntax-case "invalid literals 
list" e)))
                       tmp)
                (syntax-violation #f "source expression failed to match any 
pattern" tmp-1))))))
@@ -2132,8 +2213,8 @@
                              (else (annotate x)))))))
               (expand-top-sequence
                (list (unstrip x))
-               '()
-               '((top))
+               null-env
+               top-wrap
                #f
                m
                esew
@@ -2147,7 +2228,7 @@
                               (vector (assq-ref alist 'filename) (assq-ref 
alist 'line) (assq-ref alist 'column))))))
               (make-syntax
                datum
-               (if id (syntax-wrap id) '(()))
+               (if id (syntax-wrap id) empty-wrap)
                (and id (syntax-module id))
                (cond
                  ((not source) (props->sourcev (source-properties datum)))
@@ -2159,7 +2240,7 @@
           (lambda (ls)
             (let ((x ls)) (if (not (list? x)) (syntax-violation 
'generate-temporaries "invalid argument" x)))
             (let ((mod (cons 'hygiene (module-name (current-module)))))
-              (map (lambda (x) (wrap (gen-var 't) '((top)) mod)) ls))))
+              (map (lambda (x) (wrap (gen-var 't) top-wrap mod)) ls))))
     (set! free-identifier=?
           (lambda (x y)
             (let ((x x)) (if (not (nonsymbol-id? x)) (syntax-violation 
'free-identifier=? "invalid argument" x)))
@@ -2194,10 +2275,10 @@
                   (lambda (e r w s rib mod)
                     (letrec* ((strip-anti-mark
                                (lambda (w)
-                                 (let ((ms (car w)) (s (cdr w)))
-                                   (if (and (pair? ms) (eq? (car ms) #f))
-                                       (cons (cdr ms) (if rib (cons rib (cdr 
s)) (cdr s)))
-                                       (cons ms (if rib (cons rib s) s)))))))
+                                 (let ((ms (wrap-marks w)) (s (wrap-subst w)))
+                                   (if (and (pair? ms) (eq? (car ms) 
the-anti-mark))
+                                       (make-wrap (cdr ms) (if rib (cons rib 
(cdr s)) (cdr s)))
+                                       (make-wrap ms (if rib (cons rib s) 
s)))))))
                       (call-with-values
                        (lambda ()
                          (resolve-identifier
@@ -2318,7 +2399,7 @@
                 ((eq? p 'any) (list e))
                 ((eq? p '_) '())
                 ((syntax? e) (match* (syntax-expression e) p (syntax-wrap e) 
'() (syntax-module e)))
-                (else (match* e p '(()) '() #f))))))))
+                (else (match* e p empty-wrap '() #f))))))))
 
 (define with-syntax
   (let ((make-syntax make-syntax))
@@ -2477,8 +2558,9 @@
                            #f
                            k
                            '()
-                           (map (lambda (tmp-680b775fb37a463-2 
tmp-680b775fb37a463-1 tmp-680b775fb37a463)
-                                  (list (cons tmp-680b775fb37a463 
tmp-680b775fb37a463-1) tmp-680b775fb37a463-2))
+                           (map (lambda (tmp-680b775fb37a463-12bc 
tmp-680b775fb37a463-12bb tmp-680b775fb37a463-12ba)
+                                  (list (cons tmp-680b775fb37a463-12ba 
tmp-680b775fb37a463-12bb)
+                                        tmp-680b775fb37a463-12bc))
                                 template
                                 pattern
                                 keyword)))
@@ -2493,11 +2575,11 @@
                                  #f
                                  k
                                  (list docstring)
-                                 (map (lambda (tmp-680b775fb37a463-12b2
-                                               tmp-680b775fb37a463-12b1
-                                               tmp-680b775fb37a463-12b0)
-                                        (list (cons tmp-680b775fb37a463-12b0 
tmp-680b775fb37a463-12b1)
-                                              tmp-680b775fb37a463-12b2))
+                                 (map (lambda (tmp-680b775fb37a463-12d5
+                                               tmp-680b775fb37a463-12d4
+                                               tmp-680b775fb37a463-12d3)
+                                        (list (cons tmp-680b775fb37a463-12d3 
tmp-680b775fb37a463-12d4)
+                                              tmp-680b775fb37a463-12d5))
                                       template
                                       pattern
                                       keyword)))
@@ -2509,11 +2591,11 @@
                                        dots
                                        k
                                        '()
-                                       (map (lambda (tmp-680b775fb37a463-12cb
-                                                     tmp-680b775fb37a463-12ca
-                                                     tmp-680b775fb37a463-12c9)
-                                              (list (cons 
tmp-680b775fb37a463-12c9 tmp-680b775fb37a463-12ca)
-                                                    tmp-680b775fb37a463-12cb))
+                                       (map (lambda (tmp-680b775fb37a463-12ee
+                                                     tmp-680b775fb37a463-12ed
+                                                     tmp-680b775fb37a463-12ec)
+                                              (list (cons 
tmp-680b775fb37a463-12ec tmp-680b775fb37a463-12ed)
+                                                    tmp-680b775fb37a463-12ee))
                                             template
                                             pattern
                                             keyword)))
@@ -2529,11 +2611,11 @@
                                              dots
                                              k
                                              (list docstring)
-                                             (map (lambda 
(tmp-680b775fb37a463-12ea
-                                                           
tmp-680b775fb37a463-12e9
-                                                           
tmp-680b775fb37a463-12e8)
-                                                    (list (cons 
tmp-680b775fb37a463-12e8 tmp-680b775fb37a463-12e9)
-                                                          
tmp-680b775fb37a463-12ea))
+                                             (map (lambda 
(tmp-680b775fb37a463-130d
+                                                           
tmp-680b775fb37a463-130c
+                                                           
tmp-680b775fb37a463-130b)
+                                                    (list (cons 
tmp-680b775fb37a463-130b tmp-680b775fb37a463-130c)
+                                                          
tmp-680b775fb37a463-130d))
                                                   template
                                                   pattern
                                                   keyword)))
@@ -2661,8 +2743,9 @@
                                                              (apply (lambda (p)
                                                                       (if (= 
lev 0)
                                                                           
(quasilist*
-                                                                           
(map (lambda (tmp-680b775fb37a463)
-                                                                               
   (list "value" tmp-680b775fb37a463))
+                                                                           
(map (lambda (tmp-680b775fb37a463-13ba)
+                                                                               
   (list "value"
+                                                                               
         tmp-680b775fb37a463-13ba))
                                                                                
 p)
                                                                            
(quasi q lev))
                                                                           
(quasicons
@@ -2688,9 +2771,9 @@
                                                                    (apply 
(lambda (p)
                                                                             
(if (= lev 0)
                                                                                
 (quasiappend
-                                                                               
  (map (lambda (tmp-680b775fb37a463-139c)
+                                                                               
  (map (lambda (tmp-680b775fb37a463-13bf)
                                                                                
         (list "value"
-                                                                               
               tmp-680b775fb37a463-139c))
+                                                                               
               tmp-680b775fb37a463-13bf))
                                                                                
       p)
                                                                                
  (quasi q lev))
                                                                                
 (quasicons
@@ -2726,8 +2809,8 @@
                                            (apply (lambda (p)
                                                     (if (= lev 0)
                                                         (quasilist*
-                                                         (map (lambda 
(tmp-680b775fb37a463-13b2)
-                                                                (list "value" 
tmp-680b775fb37a463-13b2))
+                                                         (map (lambda 
(tmp-680b775fb37a463-13d5)
+                                                                (list "value" 
tmp-680b775fb37a463-13d5))
                                                               p)
                                                          (vquasi q lev))
                                                         (quasicons
@@ -2747,8 +2830,8 @@
                                                  (apply (lambda (p)
                                                           (if (= lev 0)
                                                               (quasiappend
-                                                               (map (lambda 
(tmp-680b775fb37a463-13b7)
-                                                                      (list 
"value" tmp-680b775fb37a463-13b7))
+                                                               (map (lambda 
(tmp-680b775fb37a463-13da)
+                                                                      (list 
"value" tmp-680b775fb37a463-13da))
                                                                     p)
                                                                (vquasi q lev))
                                                               (quasicons
@@ -2840,8 +2923,8 @@
                               (let ((tmp-1 ($sc-dispatch tmp '(#(atom "quote") 
each-any))))
                                 (if tmp-1
                                     (apply (lambda (y)
-                                             (k (map (lambda 
(tmp-680b775fb37a463-140c)
-                                                       (list "quote" 
tmp-680b775fb37a463-140c))
+                                             (k (map (lambda 
(tmp-680b775fb37a463-142f)
+                                                       (list "quote" 
tmp-680b775fb37a463-142f))
                                                      y)))
                                            tmp-1)
                                     (let ((tmp-1 ($sc-dispatch tmp '(#(atom 
"list") . each-any))))
@@ -2852,8 +2935,8 @@
                                                 (apply (lambda (y z) (f z 
(lambda (ls) (k (append y ls))))) tmp-1)
                                                 (let ((else tmp))
                                                   (let ((tmp x))
-                                                    (let 
((t-680b775fb37a463-141b tmp))
-                                                      (list "list->vector" 
t-680b775fb37a463-141b)))))))))))))))))
+                                                    (let 
((t-680b775fb37a463-143e tmp))
+                                                      (list "list->vector" 
t-680b775fb37a463-143e)))))))))))))))))
                (emit (lambda (x)
                        (let ((tmp x))
                          (let ((tmp-1 ($sc-dispatch tmp '(#(atom "quote") 
any))))
@@ -2865,9 +2948,9 @@
                                               (let ((tmp-1 (map emit x)))
                                                 (let ((tmp ($sc-dispatch tmp-1 
'each-any)))
                                                   (if tmp
-                                                      (apply (lambda 
(t-680b775fb37a463-142a)
+                                                      (apply (lambda 
(t-680b775fb37a463-144d)
                                                                (cons 
(make-syntax 'list '((top)) '(hygiene guile))
-                                                                     
t-680b775fb37a463-142a))
+                                                                     
t-680b775fb37a463-144d))
                                                              tmp)
                                                       (syntax-violation
                                                        #f
@@ -2883,14 +2966,13 @@
                                                           (let ((tmp-1 (list 
(emit (car x*)) (f (cdr x*)))))
                                                             (let ((tmp 
($sc-dispatch tmp-1 '(any any))))
                                                               (if tmp
-                                                                  (apply 
(lambda (t-680b775fb37a463-143e
-                                                                               
   t-680b775fb37a463-143d)
+                                                                  (apply 
(lambda (t-680b775fb37a463-1 t-680b775fb37a463)
                                                                            
(list (make-syntax
                                                                                
   'cons
                                                                                
   '((top))
                                                                                
   '(hygiene guile))
-                                                                               
  t-680b775fb37a463-143e
-                                                                               
  t-680b775fb37a463-143d))
+                                                                               
  t-680b775fb37a463-1
+                                                                               
  t-680b775fb37a463))
                                                                          tmp)
                                                                   
(syntax-violation
                                                                    #f
@@ -2903,12 +2985,12 @@
                                                           (let ((tmp-1 (map 
emit x)))
                                                             (let ((tmp 
($sc-dispatch tmp-1 'each-any)))
                                                               (if tmp
-                                                                  (apply 
(lambda (t-680b775fb37a463-144a)
+                                                                  (apply 
(lambda (t-680b775fb37a463-146d)
                                                                            
(cons (make-syntax
                                                                                
   'append
                                                                                
   '((top))
                                                                                
   '(hygiene guile))
-                                                                               
  t-680b775fb37a463-144a))
+                                                                               
  t-680b775fb37a463-146d))
                                                                          tmp)
                                                                   
(syntax-violation
                                                                    #f
diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm
index 4bf50103b..bb71dc585 100644
--- a/module/ice-9/psyntax.scm
+++ b/module/ice-9/psyntax.scm
@@ -411,36 +411,40 @@
       ((_ type value) (cons type value))
       ((_ 'type) '(type))
       ((_ type) (cons type '()))))
-  (define-syntax-rule (binding-type x)
-    (car x))
-  (define-syntax-rule (binding-value x)
-    (cdr x))
-
-  (define-syntax null-env (identifier-syntax '()))
+  (define (binding-type x) (car x))
+  (define (binding-value x) (cdr x))
+  (define null-env '())
 
   (define (extend-env labels bindings r)
-    (if (null? labels)
-        r
-        (extend-env (cdr labels) (cdr bindings)
-                    (cons (cons (car labels) (car bindings)) r))))
+    (match labels
+      (() r)
+      ((label . labels)
+       (match bindings
+         ((binding . bindings)
+          (extend-env labels bindings (acons label binding r)))))))
 
   (define (extend-var-env labels vars r)
     ;; variant of extend-env that forms "lexical" binding
-    (if (null? labels)
-        r
-        (extend-var-env (cdr labels) (cdr vars)
-                        (cons (cons (car labels) (make-binding 'lexical (car 
vars))) r))))
+    (match labels
+      (() r)
+      ((label . labels)
+       (match vars
+         ((var . vars)
+          (extend-var-env labels vars
+                          (acons label (make-binding 'lexical var) r)))))))
 
   ;; we use a "macros only" environment in expansion of local macro
   ;; definitions so that their definitions can use local macros without
   ;; attempting to use other lexical identifiers.
   (define (macros-only-env r)
-    (if (null? r)
-        '()
-        (let ((a (car r)))
-          (if (memq (cadr a) '(macro syntax-parameter ellipsis))
-              (cons a (macros-only-env (cdr r)))
-              (macros-only-env (cdr r))))))
+    (match r
+      (() '())
+      ((a . r)
+       (match a
+         ((k . ((or 'macro 'syntax-parameter 'ellipsis) . _))
+          (cons a (macros-only-env r)))
+         (_
+          (macros-only-env r))))))
 
   (define (global-extend type sym val)
     (module-define! (current-module)
@@ -483,9 +487,9 @@
   ;;      <subs> ::= #(ribcage #(<sym> ...) #(<mark> ...) #(<label> ...))
   ;;                 | #(ribcage (<sym> ...) (<mark> ...) (<label> ...))
 
-  (define-syntax make-wrap (identifier-syntax cons))
-  (define-syntax wrap-marks (identifier-syntax car))
-  (define-syntax wrap-subst (identifier-syntax cdr))
+  (define (make-wrap marks subst) (cons marks subst))
+  (define (wrap-marks wrap) (car wrap))
+  (define (wrap-subst wrap) (cdr wrap))
 
   (define* (gen-unique #:optional (module (current-module)))
     ;; Generate a unique value, used as a mark to identify a scope, or
@@ -512,9 +516,9 @@
     (gen-unique))
 
   (define (gen-labels ls)
-    (if (null? ls)
-        '()
-        (cons (gen-label) (gen-labels (cdr ls)))))
+    (match ls
+      (() '())
+      ((_ . ls) (cons (gen-label) (gen-labels ls)))))
 
   (define (make-ribcage symnames marks labels)
     (vector 'ribcage symnames marks labels))
@@ -525,14 +529,14 @@
   (define (set-ribcage-marks! ribcage x) (vector-set! ribcage 2 x))
   (define (set-ribcage-labels! ribcage x) (vector-set! ribcage 3 x))
 
-  (define-syntax empty-wrap (identifier-syntax '(())))
-  (define-syntax top-wrap (identifier-syntax '((top))))
+  (define empty-wrap '(()))
+  (define top-wrap '((top)))
 
   ;; Marks must be comparable with "eq?" and distinct from pairs and
   ;; the symbol top.  We do not use integers so that marks will remain
   ;; unique even across file compiles.
 
-  (define-syntax the-anti-mark (identifier-syntax #f))
+  (define the-anti-mark #f)
 
   (define (anti-mark w)
     (make-wrap (cons the-anti-mark (wrap-marks w))
@@ -559,24 +563,28 @@
 
   ;; make-binding-wrap creates vector-based ribcages
   (define (make-binding-wrap ids labels w)
-    (if (null? ids)
-        w
-        (make-wrap
-         (wrap-marks w)
-         (cons
-          (let ((labelvec (list->vector labels)))
-            (let ((n (vector-length labelvec)))
-              (let ((symnamevec (make-vector n)) (marksvec (make-vector n)))
-                (let f ((ids ids) (i 0))
-                  (if (not (null? ids))
-                      (call-with-values
-                          (lambda () (id-sym-name&marks (car ids) w))
-                        (lambda (symname marks)
-                          (vector-set! symnamevec i symname)
-                          (vector-set! marksvec i marks)
-                          (f (cdr ids) (1+ i))))))
-                (make-ribcage symnamevec marksvec labelvec))))
-          (wrap-subst w)))))
+    (match ids
+      (() w)
+      ((_ . _)
+       (make-wrap
+        (wrap-marks w)
+        (cons
+         (let* ((labelvec (list->vector labels))
+                (n (vector-length labelvec))
+                (symnamevec (make-vector n))
+                (marksvec (make-vector n)))
+           (let f ((ids ids) (i 0))
+             (match ids
+               (()
+                (make-ribcage symnamevec marksvec labelvec))
+               ((id . ids)
+                (call-with-values
+                    (lambda () (id-sym-name&marks id w))
+                  (lambda (symname marks)
+                    (vector-set! symnamevec i symname)
+                    (vector-set! marksvec i marks)
+                    (f ids (1+ i))))))))
+         (wrap-subst w))))))
 
   (define (smart-append m1 m2)
     (if (null? m2)



reply via email to

[Prev in Thread] Current Thread [Next in Thread]