print-pass

quad2/layout.rkt

@@ -53,7 +53,6 @@
   (for/fold ([posn0 ($point 0 0)]
              #:result qs)
             ([q (in-list qs)])
-    #RRR q
     (define first-posn-on-next-line ($point 0 (add1 ($point-y posn0))))
     (define other-possible-posns (list first-posn-on-next-line))
     (define posn1 (for/first ([posn (in-list (cons posn0 other-possible-posns))]

quad2/main.rkt

@@ -15,7 +15,7 @@
          racket/file)
 
 (define quad-compile
-  (make-pipeline (list
+  (make-pipeline
    ;; each pass in the pipeline is at least
    ;; (list-of quad?) -> (list-of quad?)
                   
@@ -45,7 +45,7 @@
    ;; has been absorbed into the attrs
    ;; (e.g., cascading font sizes)
    ;; because once we linearize, that information is gone.
-                  linearize
+   (print-pass linearize)
 
    ;; post-linearization resolutions & parsings =============
    resolve-font-paths
@@ -60,7 +60,7 @@
    insert-fallback-font
    layout
    make-drawing-insts
-                  stackify)))
+   stackify))
 
 (module+ main
   (require "render.rkt")

quad2/pipeline.rkt

@@ -6,7 +6,6 @@
 (provide (all-defined-out))
 
 (struct pipeline (passes)
-  #:constructor-name make-pipeline
   #:guard (λ (procs name)
             (unless ((list-of procedure?) procs)
               (raise-argument-error 'bad-input-to-compiler-constructor "list of procedures" procs))
@@ -22,6 +21,12 @@
             (time (displayln pass) (thunk))
             (thunk))))))
 
+(define (make-pipeline . passes)
+  (pipeline passes))
+
+(define (print-pass . passes)
+  (apply make-pipeline (append passes (list pass-printer))))
+
 (define (compiler-append c passes)
   (make-pipeline (append (pipeline-passes c) passes)))
 
@@ -33,7 +38,6 @@
         EXPRS ...)
      #`(define PASS-NAME
          (make-pipeline
-          (list
           (procedure-rename
            #,(syntax/loc stx
                (λ (ARG)
@@ -51,4 +55,9 @@
                    (when (current-use-postconditions?)
                      (unless (POSTCOND-PROC res)
                        (raise-argument-error 'PASS-NAME (format "~a (as postcondition)" 'POSTCOND-PROC) res))))))
-            'PASS-NAME))))]))
+           'PASS-NAME)))]))
+
+(define-pass (pass-printer qs)
+  #:pre values
+  #:post values
+  (for-each println qs))