commit 7dde6b430430b92246da73402cd0123b1d1f825c
parent 81cb9889f950173d7045531c6b284a20a240105d
Author: Ryan Sepassi <rsepassi@gmail.com>
Date: Mon, 27 Apr 2026 16:34:10 -0700
cc: use scheme1 multiple-values protocol for tuple returns
Replaces seven pair-as-return-tuple conventions with (values ...) +
let-values:
- bv->fixnum: (values ok? n)
- %const-arith-conv: (values av bv rt) — was nested (cons a (cons b rt))
- parse-fn-params: (values params variadic?)
- %pp-take-line: (values line rest)
- %pp-cx-* family: every #if-expression descent fn
- parse-decl-spec: (values sto base-ty)
- parse-declarator: (values name ty)
Pair-as-record types (e.g. const-fold's (value . ctype) flowing through
%const-promote, parse-decl-cont's (name . k)) stay as cons — they are
data structures, not return protocols.
03-bv-fixnum.scm reworked to test the values-based contract.
Diffstat:
2 files changed, 140 insertions(+), 157 deletions(-)
diff --git a/cc/cc.scm b/cc/cc.scm
@@ -43,11 +43,10 @@
(apply bytevector-append lst-of-bv))
(define (bv->fixnum bv radix)
- ;; (ok . val) per CC-INTERNALS: (#t . val) on parse, (#f . #f) on fail.
- ;; string->number is pure and returns #f on parse failure (not the
- ;; (ok . val) convention, since it's not a syscall).
+ ;; (values ok? val) — #t/n on parse, #f/#f on fail.
+ ;; string->number is pure and returns #f on parse failure.
(let ((n (string->number bv radix)))
- (if n (cons #t n) (cons #f #f))))
+ (if n (values #t n) (values #f #f))))
(define (fixnum->bv n radix) (number->string n radix))
@@ -1568,13 +1567,11 @@
(%pp-merge-adjacent-strs (buf-list-flush out)))))
((%pp-nl? (car toks)) (loop (cdr toks)))
((%pp-hash? (car toks))
- (let* ((lr (%pp-take-line (cdr toks)))
- (line (car lr)) (rest (cdr lr)))
+ (let-values (((line rest) (%pp-take-line (cdr toks))))
(%pp-dispatch-directive (car toks) line state out)
(loop rest)))
(else
- (let* ((lr (%pp-take-line toks))
- (line (car lr)) (rest (cdr lr)))
+ (let-values (((line rest) (%pp-take-line toks)))
(cond ((%pp-active? state)
(%pp-emit-expanded line state out))
(else #t))
@@ -1582,12 +1579,13 @@
;; Take tokens up to (not including) the next NL or EOF. NL is consumed;
;; EOF is left in the stream so the driver sees it next.
+;; Returns (values line rest).
(define (%pp-take-line toks)
(let loop ((toks toks) (acc '()))
(cond
- ((null? toks) (cons (reverse acc) toks))
- ((%pp-eof? (car toks)) (cons (reverse acc) toks))
- ((%pp-nl? (car toks)) (cons (reverse acc) (cdr toks)))
+ ((null? toks) (values (reverse acc) toks))
+ ((%pp-eof? (car toks)) (values (reverse acc) toks))
+ ((%pp-nl? (car toks)) (values (reverse acc) (cdr toks)))
(else (loop (cdr toks) (cons (car toks) acc))))))
;; --- directive dispatch ---
@@ -2046,13 +2044,13 @@
(%tok 'IDENT (bytevector-append (tok-value lhs) (fixnum->bv (tok-value rhs) 10))
(tok-loc lhs) (%pp-bv-union (tok-hide lhs) (tok-hide rhs))))
((and (eq? lk 'INT) (eq? rk 'INT))
- (let* ((s (bytevector-append (fixnum->bv (tok-value lhs) 10)
- (fixnum->bv (tok-value rhs) 10)))
- (pr (bv->fixnum s 10)))
- (cond
- ((not (car pr)) (die (tok-loc lhs) "paste: cannot reparse as integer" s))
- (else (%tok 'INT (cdr pr) (tok-loc lhs)
- (%pp-bv-union (tok-hide lhs) (tok-hide rhs)))))))
+ (let ((s (bytevector-append (fixnum->bv (tok-value lhs) 10)
+ (fixnum->bv (tok-value rhs) 10))))
+ (let-values (((ok? n) (bv->fixnum s 10)))
+ (cond
+ ((not ok?) (die (tok-loc lhs) "paste: cannot reparse as integer" s))
+ (else (%tok 'INT n (tok-loc lhs)
+ (%pp-bv-union (tok-hide lhs) (tok-hide rhs))))))))
(else (die (tok-loc lhs) "paste: unsupported token kinds" lk rk)))))
(define (%pp-relocate t state)
@@ -2082,8 +2080,7 @@
(s1 (%pp-resolve-defined toks state))
(s2 (%pp-expand-line s1 state))
(s3 (%pp-idents-as-zero s2)))
- (let* ((p (%pp-cx-expr s3))
- (val (car p)) (rest (cdr p)))
+ (let-values (((val rest) (%pp-cx-expr s3)))
(cond
((null? rest) (heap-rewind! mark) val)
(else (die (tok-loc (car rest)) "#if: garbage at end of expression"
@@ -2130,40 +2127,36 @@
toks))
;; --- recursive-descent #if expression parser ---
-;; Returns (value . rest).
+;; Each %pp-cx-* returns (values value rest).
(define (%pp-cx-expr toks) (%pp-cx-cond toks))
(define (%pp-cx-cond toks)
- (let* ((p (%pp-cx-lor toks))
- (v (car p)) (rest (cdr p)))
+ (let-values (((v rest) (%pp-cx-lor toks)))
(cond
((and (not (null? rest)) (%pp-punct? (car rest) 'qmark))
- (let* ((p2 (%pp-cx-expr (cdr rest)))
- (vt (car p2)) (after (cdr p2)))
+ (let-values (((vt after) (%pp-cx-expr (cdr rest))))
(cond
((or (null? after) (not (%pp-punct? (car after) 'colon)))
(die (if (null? after) #f (tok-loc (car after))) "?: missing ':'"))
(else
- (let* ((p3 (%pp-cx-cond (cdr after)))
- (vf (car p3)) (rest3 (cdr p3)))
- (cons (if (not (= v 0)) vt vf) rest3))))))
- (else (cons v rest)))))
+ (let-values (((vf rest3) (%pp-cx-cond (cdr after))))
+ (values (if (not (= v 0)) vt vf) rest3))))))
+ (else (values v rest)))))
(define (%pp-cx-binl next ops toks)
- (let loop ((p (next toks)))
- (let ((v (car p)) (rest (cdr p)))
+ (let-values (((v rest) (next toks)))
+ (let loop ((v v) (rest rest))
(cond
- ((null? rest) p)
+ ((null? rest) (values v rest))
(else
(let* ((tt (car rest))
(hit (and (eq? (tok-kind tt) 'PUNCT)
(alist-ref/eq (tok-value tt) ops))))
(cond
- ((not hit) p)
+ ((not hit) (values v rest))
(else
- (let* ((p2 (next (cdr rest)))
- (v2 (car p2)) (rest2 (cdr p2)))
- (loop (cons (hit v v2) rest2)))))))))))
+ (let-values (((v2 rest2) (next (cdr rest))))
+ (loop (hit v v2) rest2))))))))))
(define (%pp-cx-lor toks)
(%pp-cx-binl %pp-cx-land
@@ -2205,28 +2198,28 @@
((null? toks) (die #f "#if: unexpected end of expression"))
((%pp-punct? (car toks) 'plus) (%pp-cx-unary (cdr toks)))
((%pp-punct? (car toks) 'minus)
- (let* ((p (%pp-cx-unary (cdr toks))) (v (car p)) (r (cdr p)))
- (cons (- 0 v) r)))
+ (let-values (((v r) (%pp-cx-unary (cdr toks))))
+ (values (- 0 v) r)))
((%pp-punct? (car toks) 'bang)
- (let* ((p (%pp-cx-unary (cdr toks))) (v (car p)) (r (cdr p)))
- (cons (if (= v 0) 1 0) r)))
+ (let-values (((v r) (%pp-cx-unary (cdr toks))))
+ (values (if (= v 0) 1 0) r)))
((%pp-punct? (car toks) 'tilde)
- (let* ((p (%pp-cx-unary (cdr toks))) (v (car p)) (r (cdr p)))
- (cons (bit-not v) r)))
+ (let-values (((v r) (%pp-cx-unary (cdr toks))))
+ (values (bit-not v) r)))
(else (%pp-cx-primary toks))))
(define (%pp-cx-primary toks)
(cond
((null? toks) (die #f "#if: expected expression"))
- ((%pp-int? (car toks)) (cons (tok-value (car toks)) (cdr toks)))
+ ((%pp-int? (car toks)) (values (tok-value (car toks)) (cdr toks)))
((eq? (tok-kind (car toks)) 'CHAR)
- (cons (tok-value (car toks)) (cdr toks)))
+ (values (tok-value (car toks)) (cdr toks)))
((%pp-punct? (car toks) 'lparen)
- (let* ((p (%pp-cx-expr (cdr toks))) (v (car p)) (r (cdr p)))
+ (let-values (((v r) (%pp-cx-expr (cdr toks))))
(cond
((or (null? r) (not (%pp-punct? (car r) 'rparen)))
(die (if (null? r) #f (tok-loc (car r))) "#if: missing ')'"))
- (else (cons v (cdr r))))))
+ (else (values v (cdr r))))))
(else (die (tok-loc (car toks)) "#if: unexpected token" (tok-kind (car toks))))))
;; cc/cg.scm — codegen state and emission API.
;; Realization of docs/CC-INTERNALS.md §cg.scm.
@@ -3742,7 +3735,7 @@
(else
(cond ((not saw) (die (tok-loc t) "expected decl-spec"
(tok-value t)))
- (else (cons sto (resolve-base t sn lg b)))))))))
+ (else (values sto (resolve-base t sn lg b)))))))))
(define (resolve-base loc sn lg b)
(cond
@@ -3791,22 +3784,21 @@
(cond
((at-punct? ps 'rbrace) (reverse acc))
(else
- (let ((spec (parse-decl-spec ps)))
+ (let-values (((_sto bty) (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 (if struct? (align-up o2 al) 0))
- (next (if struct? (+ oa (max sz 0)) 0)))
- (cond
- ((at-punct? ps 'comma)
- (advance ps)
- (dl (cons (list nm ty oa) acc2) next))
- ((at-punct? ps 'semi)
- (advance ps)
- (loop (cons (list nm ty oa) acc2) next))
- (else (die (tok-loc (peek ps)) "field")))))))))))
+ (let*-values (((nm ty) (parse-declarator ps bty)))
+ (let* ((al (max (ctype-align ty) 1))
+ (sz (ctype-size ty))
+ (oa (if struct? (align-up o2 al) 0))
+ (next (if struct? (+ oa (max sz 0)) 0)))
+ (cond
+ ((at-punct? ps 'comma)
+ (advance ps)
+ (dl (cons (list nm ty oa) acc2) next))
+ ((at-punct? ps 'semi)
+ (advance ps)
+ (loop (cons (list nm ty oa) acc2) next))
+ (else (die (tok-loc (peek ps)) "field"))))))))))))
(define (complete-agg! ct k tag fs)
(let* ((ma (let m ((xs fs) (a 1))
@@ -3908,14 +3900,13 @@
;; Usual arithmetic conversions on (value . ctype) pairs. Both operands
;; have already been integer-promoted (≤ int → int) by the caller.
-;; Returns (cons new-a-value new-b-value-and-result-ctype): we only need
-;; the new values (already truncated) and a single result ctype.
+;; Returns three values: truncated a, truncated b, and the shared result
+;; ctype.
(define (%const-arith-conv ap bp)
(let* ((av (car ap)) (at (cdr ap))
(bv (car bp)) (bt (cdr bp))
(rt (%const-arith-conv-type at bt)))
- (cons (%const-trunc av rt)
- (cons (%const-trunc bv rt) rt))))
+ (values (%const-trunc av rt) (%const-trunc bv rt) rt)))
(define (%const-arith-conv-type at bt)
;; Pick the wider type; tie-break on unsigned. Caller has already
@@ -3982,9 +3973,10 @@
(cond
((at-punct? ps 'bar)
(advance ps)
- (let* ((b (parse-const-bxor ps))
- (r (%const-arith-conv (%const-promote a) (%const-promote b))))
- (lp (cons (bit-or (car r) (car (cdr r))) (cdr (cdr r))))))
+ (let ((b (parse-const-bxor ps)))
+ (let-values (((av bv rt) (%const-arith-conv (%const-promote a)
+ (%const-promote b))))
+ (lp (cons (bit-or av bv) rt)))))
(else a))))
(define (parse-const-bxor ps)
@@ -3992,9 +3984,10 @@
(cond
((at-punct? ps 'caret)
(advance ps)
- (let* ((b (parse-const-band ps))
- (r (%const-arith-conv (%const-promote a) (%const-promote b))))
- (lp (cons (bit-xor (car r) (car (cdr r))) (cdr (cdr r))))))
+ (let ((b (parse-const-band ps)))
+ (let-values (((av bv rt) (%const-arith-conv (%const-promote a)
+ (%const-promote b))))
+ (lp (cons (bit-xor av bv) rt)))))
(else a))))
(define (parse-const-band ps)
@@ -4002,9 +3995,10 @@
(cond
((at-punct? ps 'amp)
(advance ps)
- (let* ((b (parse-const-eq ps))
- (r (%const-arith-conv (%const-promote a) (%const-promote b))))
- (lp (cons (bit-and (car r) (car (cdr r))) (cdr (cdr r))))))
+ (let ((b (parse-const-eq ps)))
+ (let-values (((av bv rt) (%const-arith-conv (%const-promote a)
+ (%const-promote b))))
+ (lp (cons (bit-and av bv) rt)))))
(else a))))
(define (parse-const-eq ps)
@@ -4015,8 +4009,8 @@
(or (eq? (tok-value t) 'eq2) (eq? (tok-value t) 'ne)))
(let ((op (tok-value (advance ps)))
(b (parse-const-rel ps)))
- (let* ((r (%const-arith-conv (%const-promote a) (%const-promote b)))
- (av (car r)) (bv (car (cdr r))))
+ (let-values (((av bv _rt) (%const-arith-conv (%const-promote a)
+ (%const-promote b))))
(lp (cons
(cond ((eq? op 'eq2) (if (= av bv) 1 0))
(else (if (= av bv) 0 1)))
@@ -4032,8 +4026,8 @@
(or (eq? v 'lt) (eq? v 'le) (eq? v 'gt) (eq? v 'ge))))
(let ((op (tok-value (advance ps)))
(b (parse-const-shift ps)))
- (let* ((r (%const-arith-conv (%const-promote a) (%const-promote b)))
- (av (car r)) (bv (car (cdr r))))
+ (let-values (((av bv _rt) (%const-arith-conv (%const-promote a)
+ (%const-promote b))))
(lp (cons
(cond ((eq? op 'lt) (if (< av bv) 1 0))
((eq? op 'le) (if (<= av bv) 1 0))
@@ -4067,12 +4061,12 @@
(cond
((and (eq? (tok-kind t) 'PUNCT)
(or (eq? (tok-value t) 'plus) (eq? (tok-value t) 'minus)))
- (let* ((op (tok-value (advance ps)))
- (b (parse-const-mul ps))
- (r (%const-arith-conv (%const-promote a) (%const-promote b)))
- (av (car r)) (bv (car (cdr r))) (rt (cdr (cdr r)))
- (raw (cond ((eq? op 'plus) (+ av bv)) (else (- av bv)))))
- (lp (cons (%const-trunc raw rt) rt))))
+ (let ((op (tok-value (advance ps)))
+ (b (parse-const-mul ps)))
+ (let-values (((av bv rt) (%const-arith-conv (%const-promote a)
+ (%const-promote b))))
+ (let ((raw (cond ((eq? op 'plus) (+ av bv)) (else (- av bv)))))
+ (lp (cons (%const-trunc raw rt) rt))))))
(else a)))))
(define (parse-const-mul ps)
@@ -4082,17 +4076,17 @@
((and (eq? (tok-kind t) 'PUNCT)
(let ((v (tok-value t)))
(or (eq? v 'star) (eq? v 'slash) (eq? v 'pct))))
- (let* ((op (tok-value (advance ps)))
- (b (parse-const-cast ps))
- (r (%const-arith-conv (%const-promote a) (%const-promote b)))
- (av (car r)) (bv (car (cdr r))) (rt (cdr (cdr r))))
- (cond
- ((and (or (eq? op 'slash) (eq? op 'pct)) (= bv 0))
- (die (tok-loc t) "const-expr: divide by zero")))
- (let ((raw (cond ((eq? op 'star) (* av bv))
- ((eq? op 'slash) (quotient av bv))
- (else (remainder av bv)))))
- (lp (cons (%const-trunc raw rt) rt)))))
+ (let ((op (tok-value (advance ps)))
+ (b (parse-const-cast ps)))
+ (let-values (((av bv rt) (%const-arith-conv (%const-promote a)
+ (%const-promote b))))
+ (cond
+ ((and (or (eq? op 'slash) (eq? op 'pct)) (= bv 0))
+ (die (tok-loc t) "const-expr: divide by zero")))
+ (let ((raw (cond ((eq? op 'star) (* av bv))
+ ((eq? op 'slash) (quotient av bv))
+ (else (remainder av bv)))))
+ (lp (cons (%const-trunc raw rt) rt))))))
(else a)))))
(define (parse-const-cast ps)
@@ -4102,9 +4096,8 @@
(cond
((%const-paren-is-cast? ps)
(advance ps)
- (let* ((sp (parse-decl-spec ps))
- (p (parse-declarator ps (cdr sp)))
- (ty (cdr p)))
+ (let*-values (((_sto bty) (parse-decl-spec ps))
+ ((_n ty) (parse-declarator ps bty)))
(expect-punct ps 'rparen)
(cond
((not (%ctype-int? ty))
@@ -4158,9 +4151,8 @@
(advance ps)
(cond
((%const-tok-is-decl? ps)
- (let* ((sp (parse-decl-spec ps))
- (p (parse-declarator ps (cdr sp)))
- (ty (cdr p)))
+ (let*-values (((_sto bty) (parse-decl-spec ps))
+ ((_n ty) (parse-declarator ps bty)))
(expect-punct ps 'rparen)
(cons (max (ctype-size ty) 0) %t-u64)))
(else (die (tok-loc t)
@@ -4209,8 +4201,9 @@
(define (parse-const-int ps) (car (parse-const-expr ps)))
(define (parse-declarator ps base)
+ ;; Returns (values name type).
((cdr (parse-decl-cont ps)) base
- (lambda (n t) (cons n t))))
+ (lambda (n t) (values n t))))
(define (parse-decl-cont ps)
(pmatch (peek ps)
@@ -4249,8 +4242,7 @@
(lambda (b) (%mk-arr (r b) ln))))
(($ tok? (kind PUNCT) (value lparen))
(advance ps)
- (let* ((res (parse-fn-params ps))
- (p (car res)) (v (cdr res)))
+ (let-values (((p v) (parse-fn-params ps)))
(expect-punct ps 'rparen)
(let ((r (parse-decl-suf-cont ps)))
(lambda (b) (%mk-fn (r b) p v)))))
@@ -4276,31 +4268,31 @@
(else #f)))
(define (parse-fn-params ps)
+ ;; Returns (values params variadic?).
(cond
- ((at-punct? ps 'rparen) (cons '() #f))
+ ((at-punct? ps 'rparen) (values '() #f))
((and (at-kw? ps 'void)
(eq? (tok-kind (peek2 ps)) 'PUNCT)
(eq? (tok-value (peek2 ps)) 'rparen))
- (advance ps) (cons '() #f))
+ (advance ps) (values '() #f))
(else
(let loop ((acc '()))
(cond
((at-punct? ps 'ellipsis)
- (advance ps) (cons (reverse acc) #t))
+ (advance ps) (values (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"))))))))))
+ (let*-values (((_sto bty) (parse-decl-spec ps))
+ ((nm ty) (parse-declarator ps bty)))
+ (let ((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)
+ (values (reverse (cons (cons nm ty2) acc)) #f))
+ (else (die (tok-loc (peek ps)) "param")))))))))))
(define (parse-translation-unit ps)
(cond
@@ -4308,13 +4300,11 @@
(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)))
+ (let-values (((sto b) (parse-decl-spec ps)))
(cond
((at-punct? ps 'semi) (advance ps) 'decl)
(else
- (let* ((p (parse-declarator ps b))
- (n (car p)) (t (cdr p)))
+ (let-values (((n t) (parse-declarator ps b)))
(cond
((and (ctype-is-fn? t) (at-punct? ps 'lbrace))
(parse-fn-body ps n t) 'fn)
@@ -4324,8 +4314,7 @@
(cond
((at-punct? ps 'comma)
(advance ps)
- (let* ((p2 (parse-declarator ps b))
- (n2 (car p2)) (t2 (cdr p2)))
+ (let-values (((n2 t2) (parse-declarator ps b)))
(handle-decl ps sto n2 t2) (lp)))
(else (expect-punct ps 'semi) 'decl))))))))))
@@ -5017,14 +5006,12 @@
(else #f)))
(define (parse-local-decl ps)
- (let* ((sp (parse-decl-spec ps))
- (sto (car sp)) (b (cdr sp)))
+ (let-values (((sto b) (parse-decl-spec ps)))
(cond
((at-punct? ps 'semi) (advance ps) #t)
(else
(let lp ()
- (let* ((p (parse-declarator ps b))
- (n (car p)) (t (cdr p)))
+ (let-values (((n t) (parse-declarator ps b)))
(handle-decl ps sto n t)
(cond ((at-punct? ps 'comma) (advance ps) (lp))
(else (expect-punct ps 'semi) #t))))))))
@@ -5392,9 +5379,8 @@
(advance ps)
(cond
((token-is-decl? ps)
- (let* ((sp (parse-decl-spec ps))
- (p (parse-declarator ps (cdr sp)))
- (ty (cdr p)))
+ (let*-values (((_sto bty) (parse-decl-spec ps))
+ ((_n ty) (parse-declarator ps bty)))
(expect-punct ps 'rparen)
(cg-push-imm (ps-cg ps) %t-u64
(max (ctype-size ty) 0))))
@@ -5441,9 +5427,8 @@
(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)))
+ (let*-values (((_sto bty) (parse-decl-spec ps))
+ ((_n ty) (parse-declarator ps bty)))
(expect-punct ps 'rparen)
(cond
;; (T){ ... } — compound literal (C99 §6.5.2.5). Looks like a
@@ -5461,9 +5446,8 @@
(($ tok? (kind IDENT) (value ,n))
(guard (typedef? ps n))
(advance ps)
- (let* ((sp (parse-decl-spec ps))
- (p (parse-declarator ps (cdr sp)))
- (ty (cdr p)))
+ (let*-values (((_sto bty) (parse-decl-spec ps))
+ ((_n ty) (parse-declarator ps bty)))
(expect-punct ps 'rparen)
(cond
((at-punct? ps 'lbrace)
@@ -5668,9 +5652,8 @@
(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)))
+ (let*-values (((_sto bty) (parse-decl-spec ps))
+ ((_n ty) (parse-declarator ps bty)))
(expect-punct ps 'rparen)
(cg-va-arg (ps-cg ps) ty)))
diff --git a/tests/cc-util/03-bv-fixnum.scm b/tests/cc-util/03-bv-fixnum.scm
@@ -1,5 +1,5 @@
-;; tests/cc-util/03-bv-fixnum.scm — bv->fixnum (ok . val) plumbing
-;; and fixnum->bv round-trip.
+;; tests/cc-util/03-bv-fixnum.scm — bv->fixnum (values ok? val)
+;; plumbing and fixnum->bv round-trip.
;; Assumes cc/util.scm is loaded.
;;
;; NOTE: scheme1's number->string and string->number currently ignore
@@ -8,22 +8,22 @@
;; the radix per LISP.md; once the prim grows hex support these tests
;; will exercise it. For now we only check decimal.
-(define a (bv->fixnum "42" 10))
-(if (car a) 0 (sys-exit 1))
-(if (= (cdr a) 42) 0 (sys-exit 2))
+(let-values (((ok? n) (bv->fixnum "42" 10)))
+ (if ok? 0 (sys-exit 1))
+ (if (= n 42) 0 (sys-exit 2)))
-(define b (bv->fixnum "-7" 10))
-(if (car b) 0 (sys-exit 3))
-(if (= (cdr b) -7) 0 (sys-exit 4))
+(let-values (((ok? n) (bv->fixnum "-7" 10)))
+ (if ok? 0 (sys-exit 3))
+ (if (= n -7) 0 (sys-exit 4)))
-;; parse failure -> (#f . #f)
-(define c (bv->fixnum "nope" 10))
-(if (car c) (sys-exit 5) 0)
-(if (cdr c) (sys-exit 6) 0)
+;; parse failure -> (values #f #f)
+(let-values (((ok? n) (bv->fixnum "nope" 10)))
+ (if ok? (sys-exit 5) 0)
+ (if n (sys-exit 6) 0))
;; empty bv: parse failure
-(define d (bv->fixnum "" 10))
-(if (car d) (sys-exit 7) 0)
+(let-values (((ok? n) (bv->fixnum "" 10)))
+ (if ok? (sys-exit 7) 0))
;; round trip via decimal
(if (bv= (fixnum->bv 42 10) "42") 0 (sys-exit 8))
