Minimize size of embedded syntax objects in psyntax-pp.scm

* module/ice-9/compile-psyntax.scm: Minimize syntax object literals
  embedded in psyntax-pp.scm.

* module/ice-9/psyntax.scm: Rename a few variables so that syntax
  objects embedded in macros have no lexical bindings, so that their
  minimized syntax objects will have no embedded labels.  These labels
  were the last remaining gensym counters in psyntax-pp.scm.

* module/ice-9/psyntax-pp.scm: Regenerate.  It is now less than one
  quarter of its previous size!  More importantly, this file no longer
  contains any gensym counters, which means that in the future, local
  changes to psyntax.scm will usually result in only local changes to
  psyntax-pp.scm.

module/ice-9/compile-psyntax.scm

@@ -19,9 +19,68 @@
 (use-modules (language tree-il)
              (language tree-il primitives)
              (language tree-il canonicalize)
+             (srfi srfi-1)
              (ice-9 pretty-print)
              (system syntax))
 
+;; Minimize a syntax-object such that it can no longer be used as the
+;; first argument to 'datum->syntax', but is otherwise equivalent.
+(define (squeeze-syntax-object! syn)
+  (define (ensure-list x) (if (vector? x) (vector->list x) x))
+  (let ((x    (vector-ref syn 1))
+        (wrap (vector-ref syn 2))
+        (mod  (vector-ref syn 3)))
+    (let ((marks (car wrap))
+          (subst (cdr wrap)))
+      (define (set-wrap! marks subst)
+        (vector-set! syn 2 (cons marks subst)))
+      (cond
+       ((symbol? x)
+        (let loop ((marks marks) (subst subst))
+          (cond
+           ((null? subst) (set-wrap! marks subst) syn)
+           ((eq? 'shift (car subst)) (loop (cdr marks) (cdr subst)))
+           ((find (lambda (entry) (and (eq? x (car entry))
+                                       (equal? marks (cadr entry))))
+                  (apply map list (map ensure-list
+                                       (cdr (vector->list (car subst))))))
+            => (lambda (entry)
+                 (set-wrap! marks
+                            (list (list->vector
+                                   (cons 'ribcage
+                                         (map vector entry)))))
+                 syn))
+           (else (loop marks (cdr subst))))))
+       ((or (pair? x) (vector? x))
+        syn)
+       (else x)))))
+
+(define (squeeze-constant! x)
+  (define (syntax-object? x)
+    (and (vector? x)
+         (= 4 (vector-length x))
+         (eq? 'syntax-object (vector-ref x 0))))
+  (cond ((syntax-object? x)
+         (squeeze-syntax-object! x))
+        ((pair? x)
+         (set-car! x (squeeze-constant! (car x)))
+         (set-cdr! x (squeeze-constant! (cdr x)))
+         x)
+        ((vector? x)
+         (for-each (lambda (i)
+                     (vector-set! x i (squeeze-constant! (vector-ref x i))))
+                   (iota (vector-length x)))
+         x)
+        (else x)))
+
+(define (squeeze-tree-il! x)
+  (post-order! (lambda (x)
+                 (if (const? x)
+                     (set! (const-exp x)
+                           (squeeze-constant! (const-exp x))))
+                 #f)
+               x))
+
 ;; Avoid gratuitous churn in psyntax-pp.scm due to the marks and labels
 ;; changing session identifiers.
 (set! syntax-session-id (lambda () "*"))
@@ -40,10 +99,11 @@
             (close-port in))
           (begin
             (pretty-print (tree-il->scheme
-                           (canonicalize!
+                           (squeeze-tree-il!
-                            (resolve-primitives!
+                            (canonicalize!
-                             (macroexpand x 'c '(compile load eval))
+                             (resolve-primitives!
-                             (current-module)))
+                              (macroexpand x 'c '(compile load eval))
+                              (current-module))))
                            (current-module)
                            (list #:avoid-lambda? #f
                                  #:use-case? #f

module/ice-9/psyntax.scm

@@ -2775,8 +2775,8 @@
               ((out ...) (let () e1 e2 ...)))))))
 
 (define-syntax syntax-rules
-  (lambda (x)
+  (lambda (xx)
-    (syntax-case x ()
+    (syntax-case xx ()
       ((_ (k ...) ((keyword . pattern) template) ...)
        #'(lambda (x)
            ;; embed patterns as procedure metadata
@@ -3027,8 +3027,8 @@
       (error "variable transformer not a procedure" proc)))
 
 (define-syntax identifier-syntax
-  (lambda (x)
+  (lambda (xx)
-    (syntax-case x (set!)
+    (syntax-case xx (set!)
       ((_ e)
        #'(lambda (x)
            #((macro-type . identifier-syntax))