boot2

parse.scm (62701B)

---

 ;; cc/parse.scm — recursive-descent + Pratt parser. Minimal scheme1.
 
 (define (make-pstate toks cg)
   (%pstate toks (list '()) (list '()) '() #f '() cg))
 
 (define (peek ps) (car (ps-toks ps)))
 (define (peek2 ps)
   (let ((r (cdr (ps-toks ps))))
     (if (null? r) (car (ps-toks ps)) (car r))))
 (define (advance ps)
   (let ((t (peek ps))) (ps-toks-set! ps (cdr (ps-toks ps))) t))
 (define (at-kw? ps s)
   (let ((t (peek ps)))
     (and (eq? (tok-kind t) 'KW) (eq? (tok-value t) s))))
 (define (at-punct? ps s)
   (let ((t (peek ps)))
     (and (eq? (tok-kind t) 'PUNCT) (eq? (tok-value t) s))))
 (define (expect-kw ps s)
   (let ((t (peek ps)))
     (if (and (eq? (tok-kind t) 'KW) (eq? (tok-value t) s))
         (advance ps) (die (tok-loc t) "expected kw" s))))
 (define (expect-punct ps s)
   (let ((t (peek ps)))
     (if (and (eq? (tok-kind t) 'PUNCT) (eq? (tok-value t) s))
         (advance ps) (die (tok-loc t) "expected punct" s))))
 
 (define (scope-enter! ps)
   (ps-scope-set! ps (cons '() (ps-scope ps)))
   (ps-tags-set!  ps (cons '() (ps-tags ps))))
 (define (scope-leave! ps)
   (ps-scope-set! ps (cdr (ps-scope ps)))
   (ps-tags-set!  ps (cdr (ps-tags ps))))
 (define (scope-bind! ps n s)
   (let* ((f (ps-scope ps)) (top (car f)) (r (cdr f)))
     (if (alist-ref n top) (die #f "dup decl" n)
         (ps-scope-set! ps (cons (alist-set n s top) r)))))
 (define (scope-lookup ps n)
   (let loop ((f (ps-scope ps)))
     (cond ((null? f) #f)
           (else
            (let ((v (alist-ref n (car f))))
              (if v v (loop (cdr f))))))))
 (define (tag-bind! ps n c)
   (let* ((f (ps-tags ps)) (top (car f)) (r (cdr f)))
     (ps-tags-set! ps (cons (alist-set n c top) r))))
 (define (tag-lookup ps n)
   (let loop ((f (ps-tags ps)))
     (cond ((null? f) #f)
           (else (let ((v (alist-ref n (car f))))
                   (if v v (loop (cdr f))))))))
 (define (typedef-add! ps n)
   (ps-typedefs-set! ps (alist-set n #t (ps-typedefs ps))))
 (define (typedef? ps n)
   (if (alist-ref n (ps-typedefs ps)) #t #f))
 
 (define (%mk-ptr p) (%ctype 'ptr 8 8 p))
 (define (%mk-arr e n)
   (%ctype 'arr (if (< n 0) -1 (* n (ctype-size e)))
           (ctype-align e) (cons e n)))
 (define (%mk-fn r p v) (%ctype 'fn -1 -1 (list r p v)))
 (define (ctype-is-ptr? t) (eq? (ctype-kind t) 'ptr))
 (define (ctype-is-fn?  t) (eq? (ctype-kind t) 'fn))
 (define (ctype-is-arr? t) (eq? (ctype-kind t) 'arr))
 
 (define (eat-cv-quals! ps)
   (cond ((or (at-kw? ps 'const) (at-kw? ps 'volatile)
              (at-kw? ps 'restrict))
          (advance ps) (eat-cv-quals! ps))
         (else #t)))
 
 (define (parse-decl-spec ps)
   (let loop ((sto #f) (sn #f) (lg 0) (b #f) (saw #f))
     (let ((t (peek ps)))
       (cond
         ((or (at-kw? ps 'auto) (at-kw? ps 'register))
          (advance ps) (loop sto sn lg b #t))
         ((at-kw? ps 'static)  (advance ps) (loop 'static sn lg b #t))
         ((at-kw? ps 'extern)  (advance ps) (loop 'extern sn lg b #t))
         ((at-kw? ps 'typedef) (advance ps) (loop 'typedef sn lg b #t))
         ((or (at-kw? ps 'const) (at-kw? ps 'volatile)
              (at-kw? ps 'restrict) (at-kw? ps 'inline))
          (advance ps) (loop sto sn lg b #t))
         ((at-kw? ps 'signed)   (advance ps) (loop sto 'signed lg b #t))
         ((at-kw? ps 'unsigned) (advance ps) (loop sto 'unsigned lg b #t))
         ((at-kw? ps 'short) (advance ps) (loop sto sn -1 b #t))
         ((at-kw? ps 'long)  (advance ps) (loop sto sn (+ lg 1) b #t))
         ((at-kw? ps 'void) (advance ps) (loop sto sn lg 'void #t))
         ((at-kw? ps 'char) (advance ps) (loop sto sn lg 'char #t))
         ((at-kw? ps 'int)  (advance ps) (loop sto sn lg 'int #t))
         ((at-kw? ps '_Bool) (advance ps) (loop sto sn lg 'bool #t))
         ((or (at-kw? ps 'float) (at-kw? ps 'double)
              (at-kw? ps '_Complex) (at-kw? ps '_Imaginary))
          (die (tok-loc t) "no float" (tok-value t)))
         ((or (at-kw? ps '_Atomic) (at-kw? ps '_Thread_local)
              (at-kw? ps '_Alignas) (at-kw? ps '_Generic)
              (at-kw? ps '_Alignof) (at-kw? ps '_Static_assert))
          (die (tok-loc t) "rejected" (tok-value t)))
         ((at-kw? ps 'struct)
          (loop sto sn lg (parse-aggregate-spec ps 'struct) #t))
         ((at-kw? ps 'union)
          (loop sto sn lg (parse-aggregate-spec ps 'union) #t))
         ((at-kw? ps 'enum)
          (loop sto sn lg (parse-enum-spec ps) #t))
         ((and (not b) (eq? (tok-kind t) 'IDENT)
               (typedef? ps (tok-value t)))
          (let* ((tk (advance ps)) (sm (scope-lookup ps (tok-value tk))))
            (if (and sm (eq? (sym-kind sm) 'typedef))
                (loop sto sn lg (sym-type sm) #t)
                (die (tok-loc tk) "typedef no sym" (tok-value tk)))))
         (else
          (cond ((not saw) (die (tok-loc t) "expected decl-spec"
                                (tok-value t)))
                (else (cons sto (resolve-base t sn lg b)))))))))
 
 (define (resolve-base loc sn lg b)
   (cond
     ((eq? b 'void)
      (if (or sn (not (zero? lg))) (die loc "void+qual") %t-void))
     ((eq? b 'bool)
      (if (or sn (not (zero? lg))) (die loc "bool+qual") %t-bool))
     ((eq? b 'char)
      (cond ((eq? sn 'unsigned) %t-u8) (else %t-i8)))
     ((or (eq? b 'int) (and (not b) (or sn (not (zero? lg)))))
      (cond ((= lg -1) (if (eq? sn 'unsigned) %t-u16 %t-i16))
            ((= lg 0)  (if (eq? sn 'unsigned) %t-u32 %t-i32))
            (else      (if (eq? sn 'unsigned) %t-u64 %t-i64))))
     ((ctype? b)
      (if (or sn (not (zero? lg))) (die loc "type+qual") b))
     (else (die loc "unknown decl-spec"))))
 
 (define (parse-aggregate-spec ps kind)
   (advance ps)
   (let ((tag (cond ((eq? (tok-kind (peek ps)) 'IDENT)
                     (tok-value (advance ps))) (else #f))))
     (cond
       ((at-punct? ps 'lbrace)
        (advance ps)
        (let* ((ex (and tag (tag-lookup ps tag)))
               (ct (cond ((and ex (eq? (ctype-kind ex) kind)) ex)
                         (else (let ((c (%ctype kind -1 -1
                                               (list (or tag #f) #f '()))))
                                 (if tag (tag-bind! ps tag c)) c))))
               (fields (parse-struct-fields ps)))
          (expect-punct ps 'rbrace)
          (complete-agg! ct kind tag fields) ct))
       (tag (let ((ex (tag-lookup ps tag)))
              (cond (ex ex)
                    (else (let ((c (%ctype kind -1 -1
                                          (list tag #f '()))))
                            (tag-bind! ps tag c) c)))))
       (else (die (tok-loc (peek ps)) "anon agg")))))
 
 (define (parse-struct-fields ps)
   (let loop ((acc '()) (off 0))
     (cond
       ((at-punct? ps 'rbrace) (reverse acc))
       (else
        (let ((spec (parse-decl-spec ps)))
          (let dl ((acc2 acc) (o2 off))
            (let* ((p (parse-declarator ps (cdr spec)))
                   (nm (car p)) (ty (cdr p))
                   (al (max (ctype-align ty) 1))
                   (sz (ctype-size ty))
                   (oa (align-up o2 al)))
              (cond
                ((at-punct? ps 'comma)
                 (advance ps)
                 (dl (cons (list nm ty oa) acc2)
                     (+ oa (max sz 0))))
                ((at-punct? ps 'semi)
                 (advance ps)
                 (loop (cons (list nm ty oa) acc2)
                       (+ oa (max sz 0))))
                (else (die (tok-loc (peek ps)) "field"))))))))))
 
 (define (complete-agg! ct k tag fs)
   (let* ((ma (let m ((xs fs) (a 1))
                (if (null? xs) a
                    (m (cdr xs) (max a (ctype-align (cadr (car xs))))))))
          (last (let l ((xs fs) (e 0))
                  (if (null? xs) e
                      (let* ((f (car xs)) (off (car (cddr f)))
                             (sz (ctype-size (cadr f))))
                        (l (cdr xs) (max e (+ off (max sz 0))))))))
          (sz (cond ((eq? k 'union)
                     (let u ((xs fs) (s 0))
                       (if (null? xs) s
                           (u (cdr xs)
                              (max s (ctype-size (cadr (car xs))))))))
                    (else (align-up last ma)))))
     (ctype-size-set! ct sz)
     (ctype-align-set! ct ma)
     (ctype-ext-set! ct (list tag #t fs))))
 
 (define (parse-enum-spec ps)
   (advance ps)
   (let ((tag (cond ((eq? (tok-kind (peek ps)) 'IDENT)
                     (tok-value (advance ps))) (else #f))))
     (cond
       ((at-punct? ps 'lbrace)
        (advance ps)
        (let ((ct (%ctype 'enum 4 4 (list tag '()))))
          (if tag (tag-bind! ps tag ct))
          (let loop ((vs '()) (nv 0))
            (cond
              ((at-punct? ps 'rbrace)
               (advance ps)
               (ctype-ext-set! ct (list tag (reverse vs))) ct)
              (else
               (let* ((nt (advance ps)) (nm (tok-value nt))
                      (val (cond ((at-punct? ps 'assign)
                                  (advance ps) (parse-const-int ps))
                                 (else nv))))
                 (scope-bind! ps nm
                              (%sym nm 'enum-const #f %t-i32 val))
                 (cond ((at-punct? ps 'comma) (advance ps))
                       ((at-punct? ps 'rbrace) #t)
                       (else (die (tok-loc (peek ps)) "enum")))
                 (loop (cons (cons nm val) vs) (+ val 1))))))))
       (tag (let ((e (tag-lookup ps tag)))
              (cond (e e)
                    (else (let ((c (%ctype 'enum 4 4 (list tag '()))))
                            (tag-bind! ps tag c) c)))))
       (else (die (tok-loc (peek ps)) "enum")))))
 
 (define (parse-const-int ps)
   (let ((t (peek ps)))
     (cond
       ((eq? (tok-kind t) 'INT) (tok-value (advance ps)))
       ((and (eq? (tok-kind t) 'PUNCT) (eq? (tok-value t) 'minus))
        (advance ps) (- 0 (parse-const-int ps)))
       ((and (eq? (tok-kind t) 'PUNCT) (eq? (tok-value t) 'plus))
        (advance ps) (parse-const-int ps))
       ((eq? (tok-kind t) 'IDENT)
        (let ((sm (scope-lookup ps (tok-value t))))
          (cond ((and sm (eq? (sym-kind sm) 'enum-const))
                 (advance ps) (sym-slot sm))
                (else (die (tok-loc t) "const?" (tok-value t))))))
       (else (die (tok-loc t) "const?" (tok-value t))))))
 
 (define (parse-declarator ps base)
   ((cdr (parse-decl-cont ps)) base
    (lambda (n t) (cons n t))))
 
 (define (parse-decl-cont ps)
   (cond
     ((at-punct? ps 'star)
      (advance ps) (eat-cv-quals! ps)
      (let* ((r (parse-decl-cont ps)) (rf (cdr r)))
        (cons (car r) (lambda (b k) (rf (%mk-ptr b) k)))))
     ((and (at-punct? ps 'lparen) (paren-is-group? ps))
      (advance ps)
      (let* ((i (parse-decl-cont ps)) (if- (cdr i)))
        (expect-punct ps 'rparen)
        (let ((s (parse-decl-suf-cont ps)))
          (cons (car i) (lambda (b k) (if- (s b) k))))))
     ((eq? (tok-kind (peek ps)) 'IDENT)
      (let* ((tk (advance ps)) (n (tok-value tk))
             (s (parse-decl-suf-cont ps)))
        (cons n (lambda (b k) (k n (s b))))))
     (else
      (let ((s (parse-decl-suf-cont ps)))
        (cons #f (lambda (b k) (k #f (s b))))))))
 
 (define (parse-decl-suf-cont ps)
   ;; C declarator suffixes apply RIGHT-TO-LEFT (innermost first):
   ;;   int a[2][3]  ⇒  arr (arr int 3) 2     (outer dim 2)
   ;; not arr (arr int 2) 3 (which would treat the leftmost suffix as
   ;; outermost). The recursive structure builds the inner suffix's
   ;; result first, then this level wraps.
   (cond
     ((at-punct? ps 'lbrack)
      (advance ps)
      (let* ((ln (cond ((at-punct? ps 'rbrack) -1)
                       (else (parse-const-int ps))))
             (_ (expect-punct ps 'rbrack))
             (r (parse-decl-suf-cont ps)))
        (lambda (b) (%mk-arr (r b) ln))))
     ((at-punct? ps 'lparen)
      (advance ps)
      (let* ((res (parse-fn-params ps))
             (p (car res)) (v (cdr res)))
        (expect-punct ps 'rparen)
        (let ((r (parse-decl-suf-cont ps)))
          (lambda (b) (%mk-fn (r b) p v)))))
     (else (lambda (b) b))))
 
 (define (paren-is-group? ps)
   (let ((t (peek2 ps)))
     (cond
       ((eq? (tok-kind t) 'KW)
        (let ((v (tok-value t)))
          (cond ((or (eq? v 'void) (eq? v 'char) (eq? v 'short)
                     (eq? v 'int) (eq? v 'long) (eq? v 'signed)
                     (eq? v 'unsigned) (eq? v '_Bool)
                     (eq? v 'struct) (eq? v 'union) (eq? v 'enum)
                     (eq? v 'const) (eq? v 'volatile)
                     (eq? v 'restrict) (eq? v 'static)
                     (eq? v 'extern) (eq? v 'register)) #f)
                (else #t))))
       ((eq? (tok-kind t) 'IDENT)
        (cond ((typedef? ps (tok-value t)) #f) (else #t)))
       ((eq? (tok-kind t) 'PUNCT)
        (let ((v (tok-value t)))
          (cond ((eq? v 'rparen) #f)
                ((or (eq? v 'star) (eq? v 'lparen) (eq? v 'lbrack)) #t)
                (else #f))))
       (else #f))))
 
 (define (parse-fn-params ps)
   (cond
     ((at-punct? ps 'rparen) (cons '() #f))
     ((and (at-kw? ps 'void)
           (eq? (tok-kind (peek2 ps)) 'PUNCT)
           (eq? (tok-value (peek2 ps)) 'rparen))
      (advance ps) (cons '() #f))
     (else
      (let loop ((acc '()))
        (cond
          ((at-punct? ps 'ellipsis)
           (advance ps) (cons (reverse acc) #t))
          (else
           (let* ((sp (parse-decl-spec ps))
                  (p (parse-declarator ps (cdr sp)))
                  (nm (car p)) (ty (cdr p))
                  (ty2 (cond ((ctype-is-arr? ty)
                              (%mk-ptr (car (ctype-ext ty))))
                             ((ctype-is-fn? ty) (%mk-ptr ty))
                             (else ty))))
             (cond
               ((at-punct? ps 'comma)
                (advance ps) (loop (cons (cons nm ty2) acc)))
               ((at-punct? ps 'rparen)
                (cons (reverse (cons (cons nm ty2) acc)) #f))
               (else (die (tok-loc (peek ps)) "param"))))))))))
 
 (define (parse-translation-unit ps)
   (cond
     ((eq? (tok-kind (peek ps)) 'EOF) #t)
     (else (parse-decl-or-fn ps) (parse-translation-unit ps))))
 
 (define (parse-decl-or-fn ps)
   (let* ((sp (parse-decl-spec ps))
          (sto (car sp)) (b (cdr sp)))
     (cond
       ((at-punct? ps 'semi) (advance ps) 'decl)
       (else
        (let* ((p (parse-declarator ps b))
               (n (car p)) (t (cdr p)))
          (cond
            ((and (ctype-is-fn? t) (at-punct? ps 'lbrace))
             (parse-fn-body ps n t) 'fn)
            (else
             (handle-decl ps sto n t)
             (let lp ()
               (cond
                 ((at-punct? ps 'comma)
                  (advance ps)
                  (let* ((p2 (parse-declarator ps b))
                         (n2 (car p2)) (t2 (cdr p2)))
                    (handle-decl ps sto n2 t2) (lp)))
                 (else (expect-punct ps 'semi) 'decl))))))))))
 
 (define (handle-decl ps sto n ty)
   (cond
     ((not n) (die #f "no name"))
     ((eq? sto 'typedef)
      (typedef-add! ps n)
      (scope-bind! ps n (%sym n 'typedef #f ty #f)))
     ((ctype-is-fn? ty)
      (scope-bind! ps n
                   (%sym n 'fn (or sto 'extern) ty
                         (bytevector-append "cc__" n))))
     ;; §I: block-scope `static` routes to a global with a name mangled
     ;; on the enclosing function so two functions can each have their
     ;; own `static int n;` without colliding. The sym's NAME holds the
     ;; mangled form (cg-push-sym / cg-emit-global both prefix "cc__"
     ;; onto sym-name to derive the emitted label); scope-bind!s key
     ;; remains the original identifier for source-level lookup.
     ((and (eq? sto 'static) (ps-fn-ctx ps))
      (let* ((fname (fn-ctx-name (ps-fn-ctx ps)))
             (mangled (bytevector-append fname "__" n))
             (sm (%sym mangled 'var 'static ty
                       (bytevector-append "cc__" mangled))))
        (scope-bind! ps n sm)
        (cond
          ((at-punct? ps 'assign)
           (advance ps)
           (cg-emit-global (ps-cg ps) sm (parse-init-global ps ty)))
          (else (cg-emit-global (ps-cg ps) sm #f)))))
     (else
      (cond
        ((not (ps-fn-ctx ps))
         (let ((sm (%sym n 'var (or sto 'extern) ty
                         (bytevector-append "cc__" n))))
           (scope-bind! ps n sm)
           (cond
             ((at-punct? ps 'assign)
              (advance ps)
              (cg-emit-global (ps-cg ps) sm
                              (parse-init-global ps ty)))
             ((eq? sto 'extern) (cg-emit-extern (ps-cg ps) sm))
             (else (cg-emit-global (ps-cg ps) sm #f)))))
        (else
         (let* ((sz (max (ctype-size ty) 1))
                (al (max (ctype-align ty) 1))
                (sl (cg-alloc-slot (ps-cg ps) sz al))
                (sm (%sym n 'var (or sto 'auto) ty sl)))
           (scope-bind! ps n sm)
           (cond
             ((at-punct? ps 'assign)
              (advance ps)
              (cond
                ;; Aggregate locals get the per-element store treatment.
                ((or (at-punct? ps 'lbrace)
                     (and (eq? (ctype-kind ty) 'arr)
                          (eq? (tok-kind (peek ps)) 'STR)))
                 (parse-init-local-aggregate ps sm ty))
                (else
                 (cg-push-sym (ps-cg ps) sm)
                 (parse-expr-bp ps 4) (rval! ps)
                 (cg-cast (ps-cg ps) ty)
                 (cg-assign (ps-cg ps))
                 (cg-pop (ps-cg ps)))))
             (else #t))))))))
 
 ;; ====================================================================
 ;; Initializers (CC.md §Variable initializers, §E of CC-PUNCHLIST).
 ;;
 ;; parse-init-global ps ty
 ;;   Reads the initializer following `=` for a file-scope or block-scope
 ;;   static var of static-storage type `ty` and returns a list of
 ;;   pieces suitable for cg-emit-global. See cg.scm §cg-emit-global for
 ;;   the piece grammar.
 ;;
 ;; parse-init-local ps sm ty
 ;;   Reads the initializer for an auto-storage variable bound to slot
 ;;   sym `sm` and emits per-element store cg ops. Returns unspecified.
 ;; ====================================================================
 
 (define (%int->le-bv n nbytes)
   ;; N-byte little-endian encoding of integer n into a fresh bv. Bytes
   ;; >= sign-bit are filled by repeated >>8 (works for both signed and
   ;; unsigned because we only keep the low N bytes).
   (let ((out (make-bytevector nbytes 0)))
     (let loop ((i 0) (v n))
       (cond
         ((= i nbytes) out)
         (else
          (bytevector-u8-set! out i (bit-and v 255))
          (loop (+ i 1) (arithmetic-shift v -8)))))))
 
 (define (%const-init-piece ps ty)
   ;; Parse a non-brace initializer expression for scalar type `ty` and
   ;; return a single piece. Recognised forms:
   ;;   - INT (with optional unary +/-)               -> N-byte LE bv
   ;;   - enum-const IDENT                            -> N-byte LE bv
   ;;   - &IDENT (address of a global var/fn)         -> (label-ref . cc__name)
   ;;   - IDENT  (function name; decays to fn ptr)    -> (label-ref . cc__name)
   ;;   - STR    (only for char* targets)             -> (label-ref . string-pool-label)
   (let ((t (peek ps)))
     (cond
       ;; Address initializer: &ident -> label-ref
       ((and (eq? (tok-kind t) 'PUNCT) (eq? (tok-value t) 'amp))
        (advance ps)
        (let ((it (peek ps)))
          (cond
            ((eq? (tok-kind it) 'IDENT)
             (advance ps)
             (let ((sm (scope-lookup ps (tok-value it))))
               (cond
                 ((not sm) (die (tok-loc it) "init: undecl" (tok-value it)))
                 ((or (eq? (sym-kind sm) 'fn)
                      (and (eq? (sym-kind sm) 'var)
                           (or (eq? (sym-storage sm) 'static)
                               (eq? (sym-storage sm) 'extern))))
                  (cons 'label-ref (sym-slot sm)))
                 (else
                  (die (tok-loc it) "init: &x must reference a global"
                       (tok-value it))))))
            (else (die (tok-loc it) "init: &?" (tok-value it))))))
       ;; Function name or array name as a label-ref initializer.
       ;; (Both decay to a pointer when used as a value.)
       ((and (eq? (tok-kind t) 'IDENT)
             (let ((sm (scope-lookup ps (tok-value t))))
               (and sm
                    (or (eq? (sym-kind sm) 'fn)
                        (and (eq? (sym-kind sm) 'var)
                             (eq? (ctype-kind (sym-type sm)) 'arr)
                             (or (eq? (sym-storage sm) 'static)
                                 (eq? (sym-storage sm) 'extern)))))))
        (advance ps)
        (let ((sm (scope-lookup ps (tok-value t))))
          (cons 'label-ref (sym-slot sm))))
       ;; Plain string literal as char* initializer.
       ((eq? (tok-kind t) 'STR)
        (advance ps)
        (let ((lbl (cg-intern-string (ps-cg ps) (tok-value t))))
          (cons 'label-ref lbl)))
       ;; Otherwise it's a const integer.
       (else
        (let ((v (parse-const-int ps)))
          (%int->le-bv v (max (ctype-size ty) 1)))))))
 
 (define (%init-array-elem-type ty)
   (cond ((eq? (ctype-kind ty) 'arr) (car (ctype-ext ty)))
         (else (die #f "init: not an array" ty))))
 
 (define (%init-array-decl-len ty)
   ;; Declared array length (-1 = inferred).
   (cond ((eq? (ctype-kind ty) 'arr) (cdr (ctype-ext ty))) (else -1)))
 
 (define (%init-fix-array-size! ty count)
   ;; Patch an inferred-length array to `count`.
   (let ((elem (car (ctype-ext ty))))
     (ctype-ext-set!  ty (cons elem count))
     (ctype-size-set! ty (* count (ctype-size elem)))))
 
 (define (%init-struct-fields ty)
   ;; Return ((name-bv ctype offset) ...) for a struct/union ctype.
   (let ((ext (ctype-ext ty)))
     (cond ((and (pair? ext) (pair? (cdr ext))) (car (cddr ext)))
           (else (die #f "init: not a struct" ty)))))
 
 (define (%find-field fields nm)
   (cond ((null? fields) #f)
         ((equal? (car (car fields)) nm) (car fields))
         (else (%find-field (cdr fields) nm))))
 
 (define (%pad-piece nbytes)
   (make-bytevector nbytes 0))
 
 ;; ----- Global initializers ---------------------------------------------
 (define (parse-init-global ps ty)
   (cond
     ;; String literal initializer for char[]
     ((and (eq? (ctype-kind ty) 'arr)
           (eq? (tok-kind (peek ps)) 'STR)
           (let ((et (car (ctype-ext ty))))
             (or (eq? et %t-i8) (eq? et %t-u8))))
      (let* ((t (advance ps))
             (s (tok-value t))
             (slen (bytevector-length s))
             (decl (cdr (ctype-ext ty)))
             (final (cond ((< decl 0) (+ slen 1)) (else decl))))
        (cond ((< decl 0) (%init-fix-array-size! ty final)))
        (let ((bv (make-bytevector final 0)))
          (let loop ((i 0))
            (cond
              ((or (= i slen) (>= i final)) (list bv))
              (else
               (bytevector-u8-set! bv i (bytevector-u8-ref s i))
               (loop (+ i 1))))))))
     ;; Brace-form
     ((at-punct? ps 'lbrace)
      (advance ps)
      (cond
        ((eq? (ctype-kind ty) 'arr)
         (%parse-init-array-list ps ty))
        ((or (eq? (ctype-kind ty) 'struct) (eq? (ctype-kind ty) 'union))
         (%parse-init-struct-list ps ty))
        (else
         ;; Brace-wrapped scalar: { expr }
         (let ((piece (%const-init-piece ps ty)))
           (cond ((at-punct? ps 'comma) (advance ps)))
           (expect-punct ps 'rbrace)
           (list piece)))))
     ;; Bare scalar initializer
     (else (list (%const-init-piece ps ty)))))
 
 (define (%parse-init-array-list ps ty)
   ;; Element-list array initializer; assumes `{` already consumed.
   (let* ((elem  (%init-array-elem-type ty))
          (esize (ctype-size elem))
          (decl  (%init-array-decl-len ty)))
     (let lp ((acc '()) (count 0))
       (cond
         ((at-punct? ps 'rbrace)
          (advance ps)
          (cond ((< decl 0) (%init-fix-array-size! ty count)))
          ;; Pad to declared length if longer than count.
          (let* ((final (cond ((< decl 0) count) (else decl)))
                 (pad (- final count)))
            (cond
              ((> pad 0)
               (reverse (cons (%pad-piece (* pad esize)) acc)))
              (else (reverse acc)))))
         (else
          (let ((piece
                 (cond
                   ((at-punct? ps 'lbrace)
                    ;; Nested aggregate: brace-flatten via recursion.
                    (advance ps)
                    ;; element is itself struct/array
                    (cond
                      ((eq? (ctype-kind elem) 'arr)
                       (%parse-init-array-list ps elem))
                      ((or (eq? (ctype-kind elem) 'struct)
                           (eq? (ctype-kind elem) 'union))
                       (%parse-init-struct-list ps elem))
                      (else
                       (let ((p (%const-init-piece ps elem)))
                         (cond ((at-punct? ps 'comma) (advance ps)))
                         (expect-punct ps 'rbrace)
                         (list p)))))
                   (else
                    (list (%const-init-piece ps elem))))))
            (cond ((at-punct? ps 'comma) (advance ps)))
            (lp (append (reverse piece) acc) (+ count 1))))))))
 
 (define (%parse-init-struct-list ps ty)
   ;; Struct/union initializer; assumes `{` already consumed.
   ;; Supports positional and `.field = expr` forms.
   (let* ((fields (%init-struct-fields ty))
          (size   (ctype-size ty)))
     (let lp ((acc '()) (filled 0) (rest fields))
       (cond
         ((at-punct? ps 'rbrace)
          (advance ps)
          (cond
            ((< filled size)
             (reverse (cons (%pad-piece (- size filled)) acc)))
            (else (reverse acc))))
         (else
          (let* ((designated? (at-punct? ps 'dot))
                 (target
                  (cond
                    (designated?
                     (advance ps)
                     (let ((nt (advance ps)))
                       (cond
                         ((not (eq? (tok-kind nt) 'IDENT))
                          (die (tok-loc nt) "init: .field expects ident")))
                       (let ((f (%find-field fields (tok-value nt))))
                         (cond
                           ((not f) (die (tok-loc nt) "init: no such field"
                                         (tok-value nt))))
                         (expect-punct ps 'assign)
                         f)))
                    ((null? rest)
                     (die (tok-loc (peek ps)) "init: too many fields"))
                    (else (car rest))))
                 (fname  (car target))
                 (fty    (car (cdr target)))
                 (foff   (car (cddr target)))
                 (fsize  (ctype-size fty))
                 ;; Pad from `filled` to `foff` if needed.
                 (pad-bytes (- foff filled))
                 (piece-list
                  (cond
                    ((at-punct? ps 'lbrace)
                     (advance ps)
                     (cond
                       ((eq? (ctype-kind fty) 'arr)
                        (%parse-init-array-list ps fty))
                       ((or (eq? (ctype-kind fty) 'struct)
                            (eq? (ctype-kind fty) 'union))
                        (%parse-init-struct-list ps fty))
                       (else
                        (let ((p (%const-init-piece ps fty)))
                          (cond ((at-punct? ps 'comma) (advance ps)))
                          (expect-punct ps 'rbrace)
                          (list p)))))
                    (else
                     (list (%const-init-piece ps fty)))))
                 (acc2 (cond ((> pad-bytes 0)
                              (cons (%pad-piece pad-bytes) acc))
                             (else acc)))
                 (acc3 (append (reverse piece-list) acc2)))
            (cond ((at-punct? ps 'comma) (advance ps)))
            (lp acc3 (+ foff fsize)
                (cond
                  (designated?
                   ;; designated init: drop fields up to and including target
                   (let drop ((xs fields))
                     (cond
                       ((null? xs) '())
                       ((equal? (car (car xs)) fname) (cdr xs))
                       (else (drop (cdr xs))))))
                  (else (cdr rest))))))))))
 
 ;; ----- Local aggregate initializers ------------------------------------
 ;; Emits per-element store sequences via cg ops into the slot of `sm`
 ;; (a 'var sym whose slot is the frame offset). Assumes the assignment
 ;; `=` has already been consumed.
 (define (parse-init-local-aggregate ps sm ty)
   (cond
     ;; Local char[] = "string" — fill from string bytes.
     ((and (eq? (ctype-kind ty) 'arr)
           (eq? (tok-kind (peek ps)) 'STR)
           (let ((et (car (ctype-ext ty))))
             (or (eq? et %t-i8) (eq? et %t-u8))))
      (let* ((t (advance ps))
             (s (tok-value t))
             (slen (bytevector-length s))
             (decl (cdr (ctype-ext ty)))
             (final (cond ((< decl 0) (+ slen 1)) (else decl))))
        (cond ((< decl 0) (%init-fix-array-size! ty final)))
        ;; Emit byte stores for each char in s, plus NUL for the
        ;; trailing slot if final > slen.
        (let loop ((i 0))
          (cond
            ((>= i final) #t)
            (else
             (let ((b (cond ((< i slen) (bytevector-u8-ref s i))
                            (else 0)))
                   (off (+ (sym-slot sm) i)))
               (%push-frame-elem-lval ps off %t-u8)
               (cg-push-imm (ps-cg ps) %t-u8 b)
               (cg-assign (ps-cg ps))
               (cg-pop (ps-cg ps))
               (loop (+ i 1))))))))
     ((at-punct? ps 'lbrace)
      (advance ps)
      (cond
        ((eq? (ctype-kind ty) 'arr)
         (%parse-init-local-array-list ps sm (sym-slot sm) ty))
        ((or (eq? (ctype-kind ty) 'struct) (eq? (ctype-kind ty) 'union))
         (%parse-init-local-struct-list ps sm (sym-slot sm) ty))
        (else (die #f "init local: brace on scalar?"))))
     (else (die (tok-loc (peek ps)) "init local aggregate?"))))
 
 (define (%emit-local-elem-store ps sm rel-off elem-ty piece-or-thunk)
   ;; Emit a single scalar store at slot[base + rel-off]. piece is the
   ;; raw initializer expression — but here we want to actually evaluate
   ;; it via parse-expr to allow non-const expressions for autos.
   ;; Caller handles this; this helper handles the store-into-frame ops.
   0)
 
 (define (%push-frame-elem-lval ps base-off ty)
   (cg-push (ps-cg ps) (%opnd 'frame ty base-off #t)))
 
 (define (%parse-init-local-array-list ps sm base-off ty)
   (let* ((elem (%init-array-elem-type ty))
          (esize (ctype-size elem))
          (decl  (%init-array-decl-len ty)))
     (let lp ((i 0))
       (cond
         ((at-punct? ps 'rbrace)
          (advance ps)
          (cond ((< decl 0) (%init-fix-array-size! ty i)))
          ;; Zero out remaining slots if any (declared length > i).
          (let ((final (cond ((< decl 0) i) (else decl))))
            (let zlp ((k i))
              (cond
                ((>= k final) #t)
                (else
                 (let ((off (+ base-off (* k esize))))
                   (cond
                     ((or (eq? (ctype-kind elem) 'arr)
                          (eq? (ctype-kind elem) 'struct)
                          (eq? (ctype-kind elem) 'union))
                      ;; Zero each byte in this aggregate slot.
                      (let zb ((j 0))
                        (cond
                          ((>= j esize) #t)
                          (else
                           (%push-frame-elem-lval ps (+ off j) %t-u8)
                           (cg-push-imm (ps-cg ps) %t-u8 0)
                           (cg-assign (ps-cg ps))
                           (cg-pop (ps-cg ps))
                           (zb (+ j 1))))))
                     (else
                      (%push-frame-elem-lval ps off elem)
                      (cg-push-imm (ps-cg ps) elem 0)
                      (cg-assign (ps-cg ps))
                      (cg-pop (ps-cg ps)))))
                 (zlp (+ k 1)))))))
         (else
          (let ((eoff (+ base-off (* i esize))))
            (cond
              ((at-punct? ps 'lbrace)
               (advance ps)
               (cond
                 ((eq? (ctype-kind elem) 'arr)
                  (%parse-init-local-array-list ps sm eoff elem))
                 ((or (eq? (ctype-kind elem) 'struct)
                      (eq? (ctype-kind elem) 'union))
                  (%parse-init-local-struct-list ps sm eoff elem))
                 (else
                  (%push-frame-elem-lval ps eoff elem)
                  (parse-expr-bp ps 4) (rval! ps)
                  (cg-cast (ps-cg ps) elem)
                  (cg-assign (ps-cg ps)) (cg-pop (ps-cg ps))
                  (cond ((at-punct? ps 'comma) (advance ps)))
                  (expect-punct ps 'rbrace))))
              (else
               (%push-frame-elem-lval ps eoff elem)
               (parse-expr-bp ps 4) (rval! ps)
               (cg-cast (ps-cg ps) elem)
               (cg-assign (ps-cg ps)) (cg-pop (ps-cg ps))))
            (cond ((at-punct? ps 'comma) (advance ps)))
            (lp (+ i 1))))))))
 
 (define (%parse-init-local-struct-list ps sm base-off ty)
   (let ((fields (%init-struct-fields ty)))
     (let lp ((rest fields))
       (cond
         ((at-punct? ps 'rbrace)
          (advance ps)
          ;; Zero any remaining fields.
          (let zlp ((xs rest))
            (cond
              ((null? xs) #t)
              (else
               (let* ((f (car xs)) (fty (car (cdr f)))
                      (foff (car (cddr f))) (fsize (ctype-size fty)))
                 (let zb ((j 0))
                   (cond
                     ((>= j fsize) #t)
                     (else
                      (%push-frame-elem-lval ps (+ base-off foff j) %t-u8)
                      (cg-push-imm (ps-cg ps) %t-u8 0)
                      (cg-assign (ps-cg ps))
                      (cg-pop (ps-cg ps))
                      (zb (+ j 1)))))
                 (zlp (cdr xs)))))))
         (else
          (let* ((designated? (at-punct? ps 'dot))
                 (target
                  (cond
                    (designated?
                     (advance ps)
                     (let ((nt (advance ps)))
                       (let ((f (%find-field fields (tok-value nt))))
                         (cond
                           ((not f) (die (tok-loc nt) "init: no such field"
                                         (tok-value nt))))
                         (expect-punct ps 'assign)
                         f)))
                    ((null? rest)
                     (die (tok-loc (peek ps)) "init: too many fields"))
                    (else (car rest))))
                 (fname (car target))
                 (fty   (car (cdr target)))
                 (foff  (car (cddr target)))
                 (eoff  (+ base-off foff)))
            (cond
              ((at-punct? ps 'lbrace)
               (advance ps)
               (cond
                 ((eq? (ctype-kind fty) 'arr)
                  (%parse-init-local-array-list ps sm eoff fty))
                 ((or (eq? (ctype-kind fty) 'struct)
                      (eq? (ctype-kind fty) 'union))
                  (%parse-init-local-struct-list ps sm eoff fty))
                 (else
                  (%push-frame-elem-lval ps eoff fty)
                  (parse-expr-bp ps 4) (rval! ps)
                  (cg-cast (ps-cg ps) fty)
                  (cg-assign (ps-cg ps)) (cg-pop (ps-cg ps))
                  (cond ((at-punct? ps 'comma) (advance ps)))
                  (expect-punct ps 'rbrace))))
              (else
               (%push-frame-elem-lval ps eoff fty)
               (parse-expr-bp ps 4) (rval! ps)
               (cg-cast (ps-cg ps) fty)
               (cg-assign (ps-cg ps)) (cg-pop (ps-cg ps))))
            (cond ((at-punct? ps 'comma) (advance ps)))
            (lp (cond
                  (designated?
                   (let drop ((xs fields))
                     (cond
                       ((null? xs) '())
                       ((equal? (car (car xs)) fname) (cdr xs))
                       (else (drop (cdr xs))))))
                  (else (cdr rest))))))))))
 
 
 (define (parse-fn-body ps name dt)
   (let* ((e (ctype-ext dt)) (ret (car e))
          (par (cadr e)) (var (car (cddr e))))
     (cond ((not (scope-lookup ps name))
            (scope-bind! ps name
                         (%sym name 'fn 'extern dt
                               (bytevector-append "cc__" name)))))
     (let ((psyms (cg-fn-begin/v (ps-cg ps) name par ret var)))
       (ps-fn-ctx-set! ps
         (%fn-ctx name ret (map cdr psyms) var '()))
       (scope-enter! ps)
       (for-each (lambda (p) (scope-bind! ps (car p) (cdr p)))
                 psyms)
       (expect-punct ps 'lbrace)
       (parse-cstmt-body ps)
       (expect-punct ps 'rbrace)
       (scope-leave! ps)
       (ps-fn-ctx-set! ps #f)
       (cg-fn-end (ps-cg ps)))))
 
 (define (parse-stmt ps)
   (cond
     ((at-punct? ps 'lbrace) (parse-cstmt ps))
     ((at-kw? ps 'if)        (parse-if-stmt ps))
     ((at-kw? ps 'while)     (parse-while-stmt ps))
     ((at-kw? ps 'do)        (parse-do-stmt ps))
     ((at-kw? ps 'for)       (parse-for-stmt ps))
     ((at-kw? ps 'switch)    (parse-switch-stmt ps))
     ((at-kw? ps 'return)    (parse-return-stmt ps))
     ((at-kw? ps 'goto)      (parse-goto-stmt ps))
     ((at-kw? ps 'break)
      (advance ps) (expect-punct ps 'semi) (do-break ps))
     ((at-kw? ps 'continue)
      (advance ps) (expect-punct ps 'semi) (do-continue ps))
     ((at-kw? ps 'case)      (parse-case-stmt ps))
     ((at-kw? ps 'default)   (parse-default-stmt ps))
     ((and (eq? (tok-kind (peek ps)) 'IDENT)
           (eq? (tok-kind (peek2 ps)) 'PUNCT)
           (eq? (tok-value (peek2 ps)) 'colon))
      (parse-labelled-stmt ps))
     ((stmt-starts-decl? ps) (parse-local-decl ps))
     (else (parse-expr-stmt ps))))
 
 (define (stmt-starts-decl? ps)
   (let ((t (peek ps)))
     (cond
       ((eq? (tok-kind t) 'KW)
        (let ((v (tok-value t)))
          (or (eq? v 'auto) (eq? v 'register) (eq? v 'static)
              (eq? v 'extern) (eq? v 'typedef) (eq? v 'const)
              (eq? v 'volatile) (eq? v 'restrict) (eq? v 'inline)
              (eq? v 'void) (eq? v 'char) (eq? v 'short) (eq? v 'int)
              (eq? v 'long) (eq? v 'signed) (eq? v 'unsigned)
              (eq? v '_Bool) (eq? v 'struct) (eq? v 'union)
              (eq? v 'enum))))
       ((eq? (tok-kind t) 'IDENT) (typedef? ps (tok-value t)))
       (else #f))))
 
 (define (parse-local-decl ps)
   (let* ((sp (parse-decl-spec ps))
          (sto (car sp)) (b (cdr sp)))
     (cond
       ((at-punct? ps 'semi) (advance ps) #t)
       (else
        (let lp ()
          (let* ((p (parse-declarator ps b))
                 (n (car p)) (t (cdr p)))
            (handle-decl ps sto n t)
            (cond ((at-punct? ps 'comma) (advance ps) (lp))
                  (else (expect-punct ps 'semi) #t))))))))
 
 (define (parse-cstmt ps)
   (expect-punct ps 'lbrace)
   (scope-enter! ps)
   (parse-cstmt-body ps)
   (scope-leave! ps)
   (expect-punct ps 'rbrace) #t)
 
 (define (parse-cstmt-body ps)
   (cond
     ((at-punct? ps 'rbrace) #t)
     ((eq? (tok-kind (peek ps)) 'EOF)
      (die (tok-loc (peek ps)) "EOF in cstmt"))
     (else (parse-stmt ps) (parse-cstmt-body ps))))
 
 (define (parse-compound-stmt ps) (parse-cstmt ps))
 
 (define (parse-if-stmt ps)
   (expect-kw ps 'if)
   (expect-punct ps 'lparen)
   (parse-expr ps) (rval! ps)
   (expect-punct ps 'rparen)
   (cg-ifelse (ps-cg ps)
              (lambda () (parse-stmt ps))
              (lambda ()
                (cond ((at-kw? ps 'else)
                       (advance ps) (parse-stmt ps))
                      (else #t)))))
 
 ;; cg-loop's body-thunk now receives the tag from cg (CC-CONTRACTS
 ;; §3.3); the parser threads it into break/continue via loop-ctx.
 
 (define (parse-while-stmt ps)
   (expect-kw ps 'while)
   (expect-punct ps 'lparen)
   (cg-loop (ps-cg ps)
            (lambda () (parse-expr ps) (rval! ps))
            (lambda (tag)
              (expect-punct ps 'rparen)
              (push-loop-ctx! ps 'while tag #t)
              (parse-stmt ps)
              (pop-loop-ctx! ps))) #t)
 
 (define (parse-do-stmt ps)
   (expect-kw ps 'do)
   ;; do-while needs its tag known *before* the body parses, so we
   ;; capture it inside the body-thunk and stash it for pop-loop-ctx
   ;; via a side cell.
   (cg-loop (ps-cg ps)
            (lambda () #t)
            (lambda (tag)
              (push-loop-ctx! ps 'do tag #t)
              (parse-stmt ps)
              (pop-loop-ctx! ps)
              (expect-kw ps 'while) (expect-punct ps 'lparen)
              (parse-expr ps) (rval! ps)
              (expect-punct ps 'rparen) (expect-punct ps 'semi)
              (cg-unop (ps-cg ps) 'lnot)
              (cg-if (ps-cg ps)
                     (lambda () (cg-break (ps-cg ps) tag)))))
   #t)
 
 (define (parse-for-stmt ps)
   (expect-kw ps 'for) (expect-punct ps 'lparen)
   (scope-enter! ps)
   (cond
     ((at-punct? ps 'semi) (advance ps))
     ((stmt-starts-decl? ps) (parse-local-decl ps))
     (else (parse-expr ps) (cg-pop (ps-cg ps))
           (expect-punct ps 'semi)))
   (cg-loop (ps-cg ps)
            (lambda ()
              (cond ((at-punct? ps 'semi)
                     (cg-push-imm (ps-cg ps) %t-i32 1))
                    (else (parse-expr ps) (rval! ps)))
              (expect-punct ps 'semi))
            (lambda (tag)
              (let ((stk (collect-til-rparen ps)))
                (expect-punct ps 'rparen)
                (push-loop-ctx! ps 'for tag #t)
                (parse-stmt ps)
                (pop-loop-ctx! ps)
                (cond
                  ((null? stk) #t)
                  (else
                   (let ((sv (ps-toks ps)))
                     (ps-toks-set! ps
                       (append stk (list (make-tok 'EOF #f #f))))
                     (parse-expr ps) (cg-pop (ps-cg ps))
                     (ps-toks-set! ps sv)))))))
   (scope-leave! ps) #t)
 
 (define (collect-til-rparen ps)
   (let loop ((acc '()) (d 0))
     (let ((t (peek ps)))
       (cond
         ((eq? (tok-kind t) 'EOF)
          (die (tok-loc t) "EOF in for-step"))
         ((and (zero? d) (eq? (tok-kind t) 'PUNCT)
               (eq? (tok-value t) 'rparen)) (reverse acc))
         (else
          (let ((nt (advance ps)))
            (loop (cons nt acc)
                  (cond ((not (eq? (tok-kind nt) 'PUNCT)) d)
                        ((eq? (tok-value nt) 'lparen) (+ d 1))
                        ((eq? (tok-value nt) 'rparen) (- d 1))
                        (else d)))))))))
 
 (define (parse-switch-stmt ps)
   (expect-kw ps 'switch) (expect-punct ps 'lparen)
   (parse-expr ps) (rval! ps)
   (expect-punct ps 'rparen)
   ;; Switch's break-target tag is the swctx's end-tag — cg owns it,
   ;; and we read it back so cg-break inside the switch body emits a
   ;; tag cg actually labels.
   (let* ((sw (cg-switch-begin (ps-cg ps)))
          (tg (swctx-end-tag sw)))
     (push-loop-ctx-sw! ps 'switch tg sw)
     (parse-stmt ps)
     (pop-loop-ctx! ps)
     (cg-switch-end (ps-cg ps) sw)))
 
 (define (parse-case-stmt ps)
   (expect-kw ps 'case)
   (let ((v (parse-const-int ps)))
     (expect-punct ps 'colon)
     (cg-switch-case (ps-cg ps) (innermost-sw ps) v)
     (parse-stmt ps)))
 
 (define (parse-default-stmt ps)
   (expect-kw ps 'default) (expect-punct ps 'colon)
   (cg-switch-default (ps-cg ps) (innermost-sw ps))
   (parse-stmt ps))
 
 (define (parse-return-stmt ps)
   (expect-kw ps 'return)
   (cond
     ((at-punct? ps 'semi) (advance ps) (cg-return (ps-cg ps)))
     (else
      (parse-expr ps) (rval! ps)
      (let ((fc (ps-fn-ctx ps)))
        (cond
          ((and fc (not (eq? (ctype-kind (fn-ctx-return-type fc)) 'void)))
           (cg-cast (ps-cg ps) (fn-ctx-return-type fc)))
          (else #t)))
      (cg-return (ps-cg ps))
      (expect-punct ps 'semi))))
 
 (define (parse-goto-stmt ps)
   (expect-kw ps 'goto)
   (let ((t (advance ps)))
     (cond ((eq? (tok-kind t) 'IDENT)
            (cg-goto (ps-cg ps) (tok-value t)))
           (else (die (tok-loc t) "label?"))))
   (expect-punct ps 'semi))
 
 (define (parse-labelled-stmt ps)
   (let ((t (advance ps)))
     (expect-punct ps 'colon)
     (cg-emit-label (ps-cg ps) (tok-value t))
     (parse-stmt ps)))
 
 (define (parse-expr-stmt ps)
   (cond
     ((at-punct? ps 'semi) (advance ps) #t)
     (else (parse-expr ps) (cg-pop (ps-cg ps))
           (expect-punct ps 'semi))))
 
 (define (push-loop-ctx! ps k tg hc)
   (ps-loops-set! ps (cons (%loop-ctx k tg hc) (ps-loops ps))))
 (define (push-loop-ctx-sw! ps k tg sw)
   (ps-loops-set! ps
     (cons (%loop-ctx k (cons tg sw) #f) (ps-loops ps))))
 (define (pop-loop-ctx! ps)
   (ps-loops-set! ps (cdr (ps-loops ps))))
 (define (do-break ps)
   (let ((c (innermost-loop ps)))
     (cond
       ((not c) (die #f "break outside"))
       ((eq? (loop-ctx-kind c) 'switch)
        (cg-break (ps-cg ps) (car (loop-ctx-tag c))))
       (else (cg-break (ps-cg ps) (loop-ctx-tag c))))))
 (define (do-continue ps)
   (let ((c (innermost-cont ps)))
     (cond ((not c) (die #f "cont outside"))
           (else (cg-continue (ps-cg ps) (loop-ctx-tag c))))))
 (define (innermost-loop ps)
   (cond ((null? (ps-loops ps)) #f) (else (car (ps-loops ps)))))
 (define (innermost-cont ps)
   (let lp ((xs (ps-loops ps)))
     (cond ((null? xs) #f)
           ((eq? (loop-ctx-kind (car xs)) 'switch) (lp (cdr xs)))
           (else (car xs)))))
 (define (innermost-sw ps)
   (let lp ((xs (ps-loops ps)))
     (cond ((null? xs) (die #f "case outside switch"))
           ((eq? (loop-ctx-kind (car xs)) 'switch)
            (cdr (loop-ctx-tag (car xs))))
           (else (lp (cdr xs))))))
 
 (define %binop-bp
   (list
     (cons 'comma      (cons 1 2))
     (cons 'assign     (cons 4 3)) (cons 'plus-eq (cons 4 3))
     (cons 'minus-eq   (cons 4 3)) (cons 'star-eq (cons 4 3))
     (cons 'slash-eq   (cons 4 3)) (cons 'pct-eq  (cons 4 3))
     (cons 'shl-eq     (cons 4 3)) (cons 'shr-eq  (cons 4 3))
     (cons 'amp-eq     (cons 4 3)) (cons 'caret-eq (cons 4 3))
     (cons 'bar-eq     (cons 4 3)) (cons 'qmark   (cons 6 5))
     (cons 'lor (cons 10 11)) (cons 'land (cons 20 21))
     (cons 'bar (cons 30 31)) (cons 'caret (cons 40 41))
     (cons 'amp (cons 50 51))
     (cons 'eq2 (cons 60 61)) (cons 'ne (cons 60 61))
     (cons 'lt (cons 70 71)) (cons 'le (cons 70 71))
     (cons 'gt (cons 70 71)) (cons 'ge (cons 70 71))
     (cons 'shl (cons 80 81)) (cons 'shr (cons 80 81))
     (cons 'plus (cons 90 91)) (cons 'minus (cons 90 91))
     (cons 'star (cons 100 101)) (cons 'slash (cons 100 101))
     (cons 'pct (cons 100 101))))
 
 (define (binop-bp-of s) (alist-ref/eq s %binop-bp))
 
 (define (punct-to-cgop s)
   (cond ((eq? s 'plus)  'add) ((eq? s 'minus) 'sub)
         ((eq? s 'star)  'mul) ((eq? s 'slash) 'div)
         ((eq? s 'pct)   'rem) ((eq? s 'amp)   'and)
         ((eq? s 'bar)   'or)  ((eq? s 'caret) 'xor)
         ((eq? s 'shl)   'shl) ((eq? s 'shr)   'shr)
         ((eq? s 'eq2)   'eq)  ((eq? s 'ne)    'ne)
         ((eq? s 'lt)    'lt)  ((eq? s 'le)    'le)
         ((eq? s 'gt)    'gt)  ((eq? s 'ge)    'ge)
         (else (die #f "binop" s))))
 
 (define (compound-op s)
   (cond ((eq? s 'plus-eq)  'add) ((eq? s 'minus-eq) 'sub)
         ((eq? s 'star-eq)  'mul) ((eq? s 'slash-eq) 'div)
         ((eq? s 'pct-eq)   'rem) ((eq? s 'shl-eq)   'shl)
         ((eq? s 'shr-eq)   'shr) ((eq? s 'amp-eq)   'and)
         ((eq? s 'caret-eq) 'xor) ((eq? s 'bar-eq)   'or)
         (else #f)))
 
 (define (parse-expr ps) (parse-expr-bp ps 0))
 
 (define (parse-expr-bp ps mn)
   (parse-unary ps) (parse-binary-rhs ps mn))
 
 (define (parse-binary-rhs ps mn)
   (let ((t (peek ps)))
     (cond
       ((not (eq? (tok-kind t) 'PUNCT)) #t)
       (else
        (let ((bp (binop-bp-of (tok-value t))))
          (cond
            ((not bp) #t)
            ((< (car bp) mn) #t)
            (else
             (let ((op (tok-value t)) (rb (cdr bp)))
               (advance ps)
               (cond
                 ((eq? op 'comma)
                  ;; lhs has been parsed; discard it and evaluate rhs.
                  ;; Result of the comma expr is the rhs's rval.
                  (cg-pop (ps-cg ps))
                  (parse-expr-bp ps rb) (rval! ps))
                 ((eq? op 'assign)
                  (parse-expr-bp ps rb) (rval! ps)
                  (cg-assign (ps-cg ps)))
                 ((compound-op op)
                  (let ((b (compound-op op)))
                    (cg-dup (ps-cg ps))
                    (cg-load (ps-cg ps))
                    (parse-expr-bp ps rb) (rval! ps)
                    (cg-arith-conv (ps-cg ps))
                    (cg-binop (ps-cg ps) b)
                    (cg-assign (ps-cg ps))))
                 ((eq? op 'qmark)
                  (rval! ps)
                  (cg-ifelse-merge (ps-cg ps)
                             (lambda ()
                               (parse-expr-bp ps 0) (rval! ps))
                             (lambda ()
                               (expect-punct ps 'colon)
                               (parse-expr-bp ps rb) (rval! ps))))
                 ((eq? op 'land)
                  (rval! ps)
                  ;; Both branches must push i32 0/1. Right side is
                  ;; coerced via `cg-cast bool` so the merge slot
                  ;; carries i32 (per §H.2).
                  (cg-ifelse-merge (ps-cg ps)
                             (lambda ()
                               (parse-expr-bp ps rb) (rval! ps)
                               (cg-cast (ps-cg ps) %t-bool)
                               (cg-cast (ps-cg ps) %t-i32))
                             (lambda ()
                               (cg-push-imm (ps-cg ps) %t-i32 0))))
                 ((eq? op 'lor)
                  (rval! ps)
                  (cg-ifelse-merge (ps-cg ps)
                             (lambda ()
                               (cg-push-imm (ps-cg ps) %t-i32 1))
                             (lambda ()
                               (parse-expr-bp ps rb) (rval! ps)
                               (cg-cast (ps-cg ps) %t-bool)
                               (cg-cast (ps-cg ps) %t-i32))))
                 (else
                  (rval! ps) (cg-promote (ps-cg ps))
                  (parse-expr-bp ps rb) (rval! ps)
                  (cg-promote (ps-cg ps))
                  (cg-arith-conv (ps-cg ps))
                  (cg-binop (ps-cg ps) (punct-to-cgop op))))
               (parse-binary-rhs ps mn)))))))))
 
 (define (parse-unary ps)
   (let ((t (peek ps)))
     (cond
       ((eq? (tok-kind t) 'PUNCT)
        (let ((v (tok-value t)))
          (cond
            ((eq? v 'amp)
             (advance ps) (parse-unary ps)
             (cg-take-addr (ps-cg ps)))
            ((eq? v 'star)
             (advance ps) (parse-unary ps) (rval! ps)
             (cg-push-deref (ps-cg ps)))
            ((eq? v 'plus)
             (advance ps) (parse-unary ps)
             (rval! ps) (cg-promote (ps-cg ps)))
            ((eq? v 'minus)
             (advance ps) (parse-unary ps)
             (rval! ps) (cg-promote (ps-cg ps))
             (cg-unop (ps-cg ps) 'neg))
            ((eq? v 'tilde)
             (advance ps) (parse-unary ps)
             (rval! ps) (cg-promote (ps-cg ps))
             (cg-unop (ps-cg ps) 'bnot))
            ((eq? v 'bang)
             (advance ps) (parse-unary ps) (rval! ps)
             (cg-unop (ps-cg ps) 'lnot))
            ((eq? v 'inc) (advance ps) (parse-unary ps)
             (cg-dup (ps-cg ps))
             (cg-load (ps-cg ps))
             (cg-push-imm (ps-cg ps) %t-i32 1)
             (cg-binop (ps-cg ps) 'add) (cg-assign (ps-cg ps)))
            ((eq? v 'dec) (advance ps) (parse-unary ps)
             (cg-dup (ps-cg ps))
             (cg-load (ps-cg ps))
             (cg-push-imm (ps-cg ps) %t-i32 1)
             (cg-binop (ps-cg ps) 'sub) (cg-assign (ps-cg ps)))
            ((eq? v 'lparen) (parse-cast-or-unary ps))
            (else (parse-postfix ps)))))
       ((and (eq? (tok-kind t) 'KW) (eq? (tok-value t) 'sizeof))
        (advance ps)
        (cond
          ((at-punct? ps 'lparen)
           (advance ps)
           (cond
             ((token-is-decl? ps)
              (let* ((sp (parse-decl-spec ps))
                     (p (parse-declarator ps (cdr sp)))
                     (ty (cdr p)))
                (expect-punct ps 'rparen)
                (cg-push-imm (ps-cg ps) %t-u64
                             (max (ctype-size ty) 0))))
             (else
              (parse-expr ps) (expect-punct ps 'rparen)
              (let* ((tp (cg-top (ps-cg ps)))
                     (sz (max (ctype-size (opnd-type tp)) 0)))
                (cg-pop (ps-cg ps))
                (cg-push-imm (ps-cg ps) %t-u64 sz)))))
          (else (parse-unary ps)
                (let* ((tp (cg-top (ps-cg ps)))
                       (sz (max (ctype-size (opnd-type tp)) 0)))
                  (cg-pop (ps-cg ps))
                  (cg-push-imm (ps-cg ps) %t-u64 sz)))))
       (else (parse-postfix ps)))))
 
 (define (token-is-decl? ps)
   (let ((t (peek ps)))
     (cond
       ((eq? (tok-kind t) 'KW)
        (let ((v (tok-value t)))
          (or (eq? v 'void) (eq? v 'char) (eq? v 'short) (eq? v 'int)
              (eq? v 'long) (eq? v 'signed) (eq? v 'unsigned)
              (eq? v '_Bool) (eq? v 'struct) (eq? v 'union)
              (eq? v 'enum) (eq? v 'const) (eq? v 'volatile)
              (eq? v 'restrict) (eq? v 'inline))))
       ((eq? (tok-kind t) 'IDENT) (typedef? ps (tok-value t)))
       (else #f))))
 
 (define (parse-cast-or-unary ps)
   (let ((t (peek2 ps)))
     (cond
       ((and (eq? (tok-kind t) 'KW)
             (let ((v (tok-value t)))
               (or (eq? v 'void) (eq? v 'char) (eq? v 'short)
                   (eq? v 'int) (eq? v 'long) (eq? v 'signed)
                   (eq? v 'unsigned) (eq? v '_Bool)
                   (eq? v 'struct) (eq? v 'union) (eq? v 'enum)
                   (eq? v 'const) (eq? v 'volatile)
                   (eq? v 'restrict))))
        (advance ps)
        (let* ((sp (parse-decl-spec ps))
               (p (parse-declarator ps (cdr sp)))
               (ty (cdr p)))
          (expect-punct ps 'rparen)
          (parse-unary ps)
          ;; Cast operand undergoes lvalue conversion first (C semantics):
          ;; arrays decay to pointers, lvals become rvals. cg-cast then
          ;; bit-casts the resulting rval to the target type.
          (rval! ps)
          (cg-cast (ps-cg ps) ty)))
       ((and (eq? (tok-kind t) 'IDENT) (typedef? ps (tok-value t)))
        (advance ps)
        (let* ((sp (parse-decl-spec ps))
               (p (parse-declarator ps (cdr sp)))
               (ty (cdr p)))
          (expect-punct ps 'rparen)
          (parse-unary ps)
          ;; Cast operand undergoes lvalue conversion first (C semantics):
          ;; arrays decay to pointers, lvals become rvals. cg-cast then
          ;; bit-casts the resulting rval to the target type.
          (rval! ps)
          (cg-cast (ps-cg ps) ty)))
       (else (advance ps) (parse-expr ps)
             (expect-punct ps 'rparen)
             (parse-postfix-rest ps)))))
 
 (define (parse-postfix ps)
   (parse-primary ps) (parse-postfix-rest ps))
 
 (define (parse-postfix-rest ps)
   (let lp ()
     (let ((t (peek ps)))
       (cond
         ((not (eq? (tok-kind t) 'PUNCT)) #t)
         (else
          (let ((v (tok-value t)))
            (cond
              ((eq? v 'lbrack)
               (advance ps) (rval! ps)
               (parse-expr ps) (rval! ps)
               (expect-punct ps 'rbrack)
               (cg-binop (ps-cg ps) 'add)
               (cg-push-deref (ps-cg ps)) (lp))
              ((eq? v 'lparen)
               (advance ps) (rval-not-fn! ps)
               (let* ((fn-ty   (call-fn-type (ps-cg ps)))
                      (n (parse-call-args ps fn-ty))
                      ;; has-result? = #f for known void returns. Skips
                      ;; the wasted ST a0 → frame-slot spill that
                      ;; cg-call would otherwise emit for void calls.
                      (has-result?
                       (cond
                         ((not fn-ty) #t)
                         ((eq? (ctype-kind (car (ctype-ext fn-ty))) 'void) #f)
                         (else #t))))
                 (expect-punct ps 'rparen)
                 (cg-call (ps-cg ps) n has-result?)
                 ;; Maintain parse's "one rval per expression" invariant
                 ;; so comma / parse-expr-stmt / for-init/step pop sites
                 ;; stay simple. The placeholder is vstack-only and
                 ;; never materialized (cg-pop is a vstack op, no emit).
                 (cond ((not has-result?)
                        (cg-push-imm (ps-cg ps) %t-i32 0)))
                 (lp)))
              ((eq? v 'dot)
               (advance ps)
               (let ((nt (advance ps)))
                 (cond
                   ((not (eq? (tok-kind nt) 'IDENT))
                    (die (tok-loc nt) "expected field name"))
                   (else
                    (cg-push-field (ps-cg ps) (tok-value nt)) (lp)))))
              ((eq? v 'arrow)
               (advance ps)
               (let ((nt (advance ps)))
                 (cond
                   ((not (eq? (tok-kind nt) 'IDENT))
                    (die (tok-loc nt) "expected field name"))
                   (else
                    ;; ptr -> field: load the pointer to rval, deref to
                    ;; reach the struct lval, then push the field.
                    (rval! ps)
                    (cg-push-deref (ps-cg ps))
                    (cg-push-field (ps-cg ps) (tok-value nt)) (lp)))))
              ((eq? v 'inc)
               (advance ps)
               (cg-postinc (ps-cg ps)) (lp))
              ((eq? v 'dec)
               (advance ps)
               (cg-postdec (ps-cg ps)) (lp))
              (else #t))))))))
 
 ;; call-fn-type cg -> ctype-or-#f
 ;;   The function operand sits at the top of the vstack when
 ;;   parse-call-args runs (just after rval-not-fn!). Its type may be
 ;;   `fn` directly (named callee) or `ptr -> fn` (function pointer).
 ;;   Returns the underlying `fn` ctype, or #f if the operand isn't
 ;;   recognizably callable (callsite still works — no per-arg cast).
 (define (call-fn-type cg)
   (let* ((tp (cg-top cg)))
     (cond
       ((not tp) #f)
       (else
        (let* ((ty (opnd-type tp))
               (k  (ctype-kind ty)))
          (cond
            ((eq? k 'fn) ty)
            ((eq? k 'ptr)
             (let ((pe (ctype-ext ty)))
               (cond ((and pe (eq? (ctype-kind pe) 'fn)) pe)
                     (else #f))))
            (else #f)))))))
 
 ;; param-types-of fn-ty -> (params variadic?)  with a #f fallback.
 (define (call-fn-param-info fn-ty)
   (cond
     ((not fn-ty) (cons '() #f))
     (else
      (let ((ext (ctype-ext fn-ty)))
        (cons (cadr ext) (car (cddr ext)))))))
 
 ;; parse-call-args ps fn-ty -> arg-count
 ;;   Casts each fixed arg to the declared param type (CC.md §K.5).
 ;;   For variadic args (index >= named-arg count, when variadic? = #t)
 ;;   applies cg-promote (CC.md §G.1).
 (define (parse-call-args ps fn-ty)
   (cond
     ((at-punct? ps 'rparen) 0)
     (else
      (let* ((info  (call-fn-param-info fn-ty))
             (params (car info))
             (var?  (cdr info))
             (nfix  (length params)))
        (let lp ((n 0) (rem params))
          (parse-expr-bp ps 4) (rval! ps)
          (cond
            ;; Fixed-arg: cast to declared param type. param entry shape
            ;; is (name . ctype) per cg-fn-begin's contract.
            ((not (null? rem))
             (cg-cast (ps-cg ps) (cdr (car rem))))
            ;; Variadic position (n >= nfix and var? is true): promote.
            (var?
             (cg-promote (ps-cg ps))))
          (let ((m (+ n 1))
                (rest (if (null? rem) '() (cdr rem))))
            (cond ((at-punct? ps 'comma) (advance ps) (lp m rest))
                  (else m))))))))
 
 ;; --------------------------------------------------------------------
 ;; __builtin_va_* (§G.2). va_list / va_start / va_arg / va_end in
 ;; <stdarg.h> alias these. Each is parsed as: name '(' args ')'.
 ;; va_start(ap, last)  — last is parsed and discarded; cg only needs
 ;;   the variadic-first-slot offset, which it already tracks.
 ;; va_arg(ap, T)       — T is a type-name; result rval has that type.
 ;; va_end(ap)          — no-op codegen; just consumes ap.
 ;;
 ;; Pushes a single imm 0 for va_start / va_end so they fit as
 ;; expression statements; va_arg pushes the rval.
 ;; --------------------------------------------------------------------
 (define (parse-builtin-va-start ps)
   (advance ps)                                 ; IDENT
   (expect-punct ps 'lparen)
   (parse-expr-bp ps 4)                         ; ap (must be lval)
   (expect-punct ps 'comma)
   ;; "last" is parsed for syntactic completeness then dropped — cg
   ;; doesn't need it; the variadic-first-slot was determined at
   ;; cg-fn-begin/v time.
   (parse-expr-bp ps 4) (cg-pop (ps-cg ps))
   (expect-punct ps 'rparen)
   (cg-va-start (ps-cg ps))
   ;; Push a placeholder rval so the call expression has a value
   ;; (matches va_start's "void" but our parser expects all
   ;; expressions to leave one rval).
   (cg-push-imm (ps-cg ps) %t-i32 0))
 
 (define (parse-builtin-va-arg ps)
   (advance ps)                                 ; IDENT
   (expect-punct ps 'lparen)
   (parse-expr-bp ps 4)                         ; ap (lval)
   (expect-punct ps 'comma)
   (let* ((sp (parse-decl-spec ps))
          (p  (parse-declarator ps (cdr sp)))
          (ty (cdr p)))
     (expect-punct ps 'rparen)
     (cg-va-arg (ps-cg ps) ty)))
 
 (define (parse-builtin-va-end ps)
   (advance ps)                                 ; IDENT
   (expect-punct ps 'lparen)
   (parse-expr-bp ps 4)                         ; ap
   (expect-punct ps 'rparen)
   (cg-va-end (ps-cg ps))
   (cg-push-imm (ps-cg ps) %t-i32 0))
 
 (define (parse-primary ps)
   (let ((t (peek ps)))
     (cond
       ((eq? (tok-kind t) 'INT)
        (advance ps)
        (cg-push-imm (ps-cg ps) %t-i32 (tok-value t)))
       ((eq? (tok-kind t) 'CHAR)
        (advance ps)
        (cg-push-imm (ps-cg ps) %t-i8 (tok-value t)))
       ((eq? (tok-kind t) 'STR)
        (advance ps)
        (cg-push-string (ps-cg ps) (tok-value t)))
       ((eq? (tok-kind t) 'IDENT)
        (cond
          ((bv= (tok-value t) "__builtin_va_start")
           (parse-builtin-va-start ps))
          ((bv= (tok-value t) "__builtin_va_arg")
           (parse-builtin-va-arg ps))
          ((bv= (tok-value t) "__builtin_va_end")
           (parse-builtin-va-end ps))
          (else
           (let ((sm (scope-lookup ps (tok-value t))))
             (advance ps)
             (cond
               ((not sm) (die (tok-loc t) "undecl" (tok-value t)))
               ((eq? (sym-kind sm) 'enum-const)
                (cg-push-imm (ps-cg ps) %t-i32 (sym-slot sm)))
               (else (cg-push-sym (ps-cg ps) sm)))))))
       ((eq? (tok-kind t) 'PUNCT)
        (cond
          ((eq? (tok-value t) 'lparen)
           (advance ps) (parse-expr ps) (expect-punct ps 'rparen))
          (else (die (tok-loc t) "unexp" (tok-value t)))))
       (else (die (tok-loc t) "unexp" (tok-value t))))))
 
 (define (rval! ps)
   (let ((tp (cg-top (ps-cg ps))))
     (cond ((and tp (opnd? tp) (opnd-lval? tp))
            (cg-load (ps-cg ps)))
           (else #t))))
 
 (define (rval-not-fn! ps)
   (let ((tp (cg-top (ps-cg ps))))
     (cond ((and tp (opnd? tp) (opnd-lval? tp)
                 (not (ctype-is-fn? (opnd-type tp))))
            (cg-load (ps-cg ps)))
           (else #t))))