make posn a struct field

If it's an attribute, then we have to first duplicate the attrs hash (because otherwise these objects are shared). This will result in a ton of extra memory allocation & GC just for one field

quad2/draw.rkt

@@ -17,7 +17,7 @@
          (for/list ([q (in-list qs)])
                    (cond
                      [(quad? q)
-                      (list ($move (quad-posn q)) ($text (char->integer (quad-char q))))]
+                      (list ($move (quad-posn q)) ($text (char->integer (car (string->list (car (quad-elems q)))))))]
                      [else (error 'render-unknown-thing)]))
          ($page 'end) ($doc 'end))))
 

quad2/layout.rkt

@@ -16,8 +16,6 @@
   (quad? . -> . $size?)
   ($size 1 0))
 
-
-
 (define (min-x rect) ($point-x ($rect-origin rect)))
 (define (width rect) ($size-width ($rect-size rect)))
 (define (max-x rect) (+ (min-x rect) (width rect)))

quad2/linearize.rkt

@@ -50,9 +50,7 @@
           [(null? head) e0]
           [else
            (define qs-to-merge (cons e0 head))
-           (make-quad #:tag (quad-tag e0)
-                      #:attrs (quad-attrs e0)
-                      #:elems (list (string-join (append-map quad-elems qs-to-merge) "")))])
+           (struct-copy quad e0 [elems (list (string-join (append-map quad-elems qs-to-merge) ""))])])
         (merge tail))])))
 
 (module+ test
@@ -69,17 +67,26 @@
          (for/list ([q (in-list qs)])
                    (match (quad-elems q)
                      [(list (? string? str))
-                      (define tag (quad-tag q))
-                      (define attrs (quad-attrs q))
                       ;; the "gaps" (parts that don't match pattern) are guaranteed to be at even indexes
                       ;; If string starts with a "gap", a zero-length separator is appended to the start.
                       ;; so we just ignore those.
                       (for/list ([(substr idx) (in-indexed (regexp-match* whitespace-pat str #:gap-select? #t))]
                                  #:unless (zero? (string-length substr)))
-                                (make-quad #:tag tag
-                                           #:attrs attrs
-                                           #:elems (list (if (even? idx) substr word-space))))]
+                                (struct-copy quad q [elems (list (if (even? idx) substr word-space))]))]
                      [_ (list q)]))))
                                        
 (module+ test
-  (split-whitespace mlqs))
+  (define smlqs (split-whitespace mlqs)))
+
+(define-pass (mark-text-runs qs)
+  #:pre (list-of simple-quad?)
+  #:post (list-of simple-quad?)
+  (for ([q (in-list qs)]
+        #:when (match (quad-elems q)
+                 [(list (? string?) ..1) #t]
+                 [_ #false]))
+       (set-quad-tag! q 'text-run))
+  qs)
+
+(module+ test
+  (mark-text-runs smlqs))

quad2/main.rkt

@@ -6,10 +6,11 @@
          "linearize.rkt"
          "layout.rkt"
          "draw.rkt"
+         "struct.rkt"
          racket/string
          racket/match)
 
-(define-pass (bootstrap x)
+(define-pass (bootstrap-input x)
   #:pre values
   #:post quad?
   (match x
@@ -17,37 +18,35 @@
     [(and (list (? quad?) ...) qs) (make-quad #:elems qs)]
     [other (make-quad #:elems (list other))]))
 
-(define-pass (make-weirdo-char-quads qs)
+(define-pass (single-char-quads qs)
   #:pre (list-of simple-quad?)
   #:post (list-of simple-quad?)
   (apply append
          (for/list ([q (in-list qs)])
                    (match q
-                     [(quad _ _ (list (? string? str)))
+                     [(quad _ _ (list (? string? str)) _)
                       (for/list ([c (in-string str)])
-                                (define new-attrs (make-hasheq (cons (cons 'char c) (hash->list (quad-attrs q)))))
-                                (make-quad #:tag (quad-tag q)
-                                           #:attrs new-attrs
-                                           #:elems null))]
+                                (struct-copy quad q [elems (list (string c))]))]
                      [_ (list q)]))))
 
 (define quad-compile (make-pipeline (list
-                                     bootstrap
+                                     bootstrap-input
                                      linearize
+                                     mark-text-runs
                                      merge-adjacent-strings
                                      split-whitespace
-                                     make-weirdo-char-quads
+                                     single-char-quads
                                      layout
                                      make-drawing-insts
                                      stackify)))
 
-(define drawing-insts (parameterize ([current-wrap-width 13])
+(define insts (parameterize ([current-wrap-width 13])
                         (quad-compile "Hello this is the earth")))
 
-(displayln drawing-insts)
+(displayln insts)
 
-(render drawing-insts #:using text-renderer)
-(render drawing-insts #:using drr-renderer)
-
-#;(render-to-html drawing-insts)
-#;(render-to-pdf drawing-insts)
+(when (string? insts)
+  (render insts #:using text-renderer)
+  (render insts #:using drr-renderer)
+  #;(render-to-html drawing-insts)
+  #;(render-to-pdf drawing-insts))

quad2/quad.rkt

@@ -14,16 +14,16 @@
 
 (define (list-of proc) (λ (x) (and (list? x) (andmap proc x))))
 
-(struct quad (tag attrs elems) #:transparent #:mutable
+(struct quad (tag attrs elems posn) #:transparent #:mutable
   #:constructor-name quad-constructor
-  #:guard (λ (tag attrs elems name)
+  #:guard (λ (tag attrs elems posn name)
             (unless (match (list tag attrs elems)
                       [(list (? quad-tag?)
                              (? quad-attrs?)
                              (? quad-elems?)) #true]
                       [_ #false])
               (error 'no-dice))
-            (values tag attrs elems)))
+            (values tag attrs elems posn)))
              
 (define (quad-tag? x) (match x
                         [(or (? symbol?) #false) #true]
@@ -42,7 +42,7 @@
                             #:attrs [attrs (make-quad-attrs null)]
                             #:elems [elems null])
   (() (#:tag quad-tag? #:attrs quad-attrs? #:elems quad-elems?) . ->* . quad?)
-  (quad-constructor tag attrs elems))
+  (quad-constructor tag attrs elems #false))
 
 (define (quad-ref q key [default-val #false])
   (hash-ref (quad-attrs q) key default-val))
@@ -58,8 +58,7 @@
            (define (GETTER q) (quad-ref q 'FIELD))
            (define (SETTER q val) (quad-set! q 'FIELD val))))]))
 
-(define-quad-field posn)
-(define-quad-field char)
+#;(define-quad-field posn)
 
 (define (has-no-position? q) (not (has-position? q)))
 (define (has-position? q) (quad-posn q))

quad2/render.rkt

@@ -36,7 +36,7 @@
                                     (for/list ([x (in-range xmax)])
                                               (hash-ref char-pos-table (make-rectangular x y) (char->integer #\space)))))) "\n"))
        (set! results (cons str results)))
-     (λ (charint) (hash-set! char-pos-table current-loc charint))
+     (λ (str) (hash-set! char-pos-table current-loc str))
      (λ (x y) (set! current-loc (make-rectangular x y)))
      (λ ()
        (unless (pair? results)