Merge tag 'v7.7' into upstream

leave deleted files deleted.

10 files changed, 235 insertions, 89 deletions

diff --git a/src/schemify/find-definition.rkt b/src/schemify/find-definition.rkt
index 3fb7237aae..4ad086090b 100644
--- a/src/schemify/find-definition.rkt
+++ b/src/schemify/find-definition.rkt
@@ -47,7 +47,7 @@
                                     a-known-constant))]
               [knowns (hash-set knowns
                                 (unwrap s?)
-                                (known-predicate 2 type))]
+                                (known-struct-predicate 2 type struct:s (struct-type-info-authentic? info)))]
               [knowns
                (let* ([immediate-count (struct-type-info-immediate-field-count info)]
                       [parent-count (- (struct-type-info-field-count info)
@@ -87,7 +87,7 @@
                                      a-known-constant))]
                [knowns (hash-set knowns
                                  (unwrap s?)
-                                 (known-predicate 2 type))])
+                                 (known-struct-predicate 2 type struct:s (struct-type-info-authentic? info)))])
           ;; For now, we don't try to track the position-consuming accessor or mutator
           (hash-set knowns (unwrap struct:s) (known-struct-type type
                                                                 (struct-type-info-field-count info)
diff --git a/src/schemify/infer-name.rkt b/src/schemify/infer-name.rkt
index 0cf4898676..7ba4d53646 100644
--- a/src/schemify/infer-name.rkt
+++ b/src/schemify/infer-name.rkt
@@ -30,11 +30,17 @@
      (define (add-property str)
        (wrap-property-set (reannotate orig-s new-s)
                           'inferred-name
-                          ;; Hack: starting with "[" means
-                          ;; "derived from path". This distinction
-                          ;; is used when printing function names
-                          ;; in a stack trace.
-                          (string->symbol (string-append-immutable "[" str))))
+                          ;; Starting with "[" means "derived from
+                          ;; path". This distinction is used when
+                          ;; printing function names in a stack trace.
+                          ;; Furthermore, "!" or "^" after "[" indicates
+                          ;; methodness or not, so add an explicit "^"
+                          ;; if necessary.
+                          (let ([prefix (if (or (char=? (string-ref str 0) #\!)
+                                                (char=? (string-ref str 0) #\^))
+                                            "[^"
+                                            "[")])
+                            (string->symbol (string-append-immutable prefix str)))))
      (cond
        [(and (or (path? src) (string? src)) line col)
         (add-property
@@ -54,7 +60,7 @@
         ;; suppress any other inferred name:
         (wrap-property-set (reannotate orig-s new-s)
                            'inferred-name
-                           ;; Hack: "[" means "no name"
+                           ;; "[" means "no name"
                            '|[|)]
        [else new-s])]))
 
diff --git a/src/schemify/inline.rkt b/src/schemify/inline.rkt
index de193abe7f..e733f70fe8 100644
--- a/src/schemify/inline.rkt
+++ b/src/schemify/inline.rkt
@@ -88,6 +88,8 @@
 
 (define (inline-type-id k im add-import! mutated imports)
   (define type-id (cond
+                    [(known-struct-predicate? k)
+                     (known-struct-predicate-type-id k)]
                     [(known-field-accessor? k)
                      (known-field-accessor-type-id k)]
                     [(known-field-mutator? k)
@@ -99,6 +101,10 @@
     (cond
       [(not type-id) #f]
       [(not im) '()]
+      [(known-struct-predicate/need-imports? k)
+       (needed->env (known-struct-predicate/need-imports-needed k)
+                    add-import!
+                    im)]
       [(known-field-accessor/need-imports? k)
        (needed->env (known-field-accessor/need-imports-needed k)
                     add-import!
@@ -233,6 +239,18 @@
          (known-procedure-arity-mask k)
          (if serializable? (wrap-truncate-paths expr) expr)
          (needed->list needed))])]
+    [(known-struct-predicate? k)
+     (define needed (needed-imports (known-struct-predicate-type-id k) prim-knowns imports exports '() '#hasheq()))
+     (cond
+       [needed
+        (known-struct-predicate/need-imports (known-procedure-arity-mask k)
+                                             (known-predicate-type k)
+                                             (known-struct-predicate-type-id k)
+                                             (known-struct-predicate-authentic? k)
+                                             (needed->list needed))]
+       [else
+        (known-predicate (known-procedure-arity-mask k)
+                         (known-predicate-type k))])]
     [(known-field-accessor? k)
      (define needed (needed-imports (known-field-accessor-type-id k) prim-knowns imports exports '() '#hasheq()))
      (cond
diff --git a/src/schemify/interp-stack.rkt b/src/schemify/interp-stack.rkt
index de6c7da9b4..d1b0c4817e 100644
--- a/src/schemify/interp-stack.rkt
+++ b/src/schemify/interp-stack.rkt
@@ -71,7 +71,7 @@
 ;; Compile-time stack information
 
 (struct stack-info (capture-depth   ; boundary for the enclosing function in compile-time env
-                    closure-map     ; hash table to collect variables byond boundary to capture
+                    closure-map     ; hash table to collect variables beyond boundary to capture
                     [use-map #:mutable] ; table of uses; an entry here means the binding is used later
                     [local-use-map #:mutable] ; subset of `use-map` used to tracked needed merging for branches
                     [non-tail-call-later? #:mutable])) ; non-tail call afterward?
@@ -111,7 +111,7 @@
     [else
      ;; Record the use of this position. If it's the last use (i.e.,
      ;; first from the end), then box the position, which means "clear
-     ;; after retreiving" and implements space safety.
+     ;; after retrieving" and implements space safety.
      (define use-map (stack-info-use-map stk-i))
      (cond
        [(or (not use-map)
diff --git a/src/schemify/interpret.rkt b/src/schemify/interpret.rkt
index 7d35168d65..6bbf11eaf9 100644
--- a/src/schemify/interpret.rkt
+++ b/src/schemify/interpret.rkt
@@ -236,21 +236,37 @@
        (define new-body (add-boxes/remove-unused c-body ids mutated body-env stk-i))
        (define pos (stack->pos stack-depth stk-i #:nonuse? #t))
        (stack-info-forget! stk-i stack-depth pos len)
-       (define new-rhss (list->vector
-                         (compile-list rhss env stack-depth stk-i #f mutated)))
+       (define new-rhss (compile-list rhss env stack-depth stk-i #f mutated))
        (or
         ;; Merge nested `let`s into a `let*` to reduce vector nesting
         (cond
+          [(null? new-rhss) new-body]
           [(vector? new-body)
            (interp-match
             new-body
             [#(let ,pos2 ,rhss2 ,b)
-             (vector 'let* (list pos pos2) (list new-rhss rhss2) b)]
+             (vector 'let* (list pos pos2) (list (list->vector new-rhss) rhss2) b)]
             [#(let* ,poss ,rhsss ,b)
-             (vector 'let* (cons pos poss) (cons new-rhss rhsss) b)]
+             (vector 'let* (cons pos poss) (cons (list->vector new-rhss) rhsss) b)]
+            [#(clear ,poss ,e)
+             ;; Check check the `let`-bounding bindings are immediately cleared,
+             ;; in which case they're unused
+             (let loop ([pos pos] [poss poss] [rhss new-rhss])
+               (cond
+                 [(null? rhss)
+                  ;; bindings are unused
+                  (let ([e (if (null? poss)
+                               e
+                               (vector 'clear poss e))])
+                    ;; Use `beginl` instead of `begin` to encourage further collapsing
+                    (vector 'beginl (append new-rhss (begins->list e))))]
+                 [(null? poss) #f]
+                 [(eqv? pos (car poss))
+                  (loop (add1 pos) (cdr poss) (cdr rhss))]
+                 [else #f]))]
             [#() #f])]
           [else #f])
-        (vector 'let pos new-rhss new-body))]
+        (vector 'let pos (list->vector new-rhss) new-body))]
       [`(letrec . ,_) (compile-letrec e env stack-depth stk-i tail? mutated)]
       [`(letrec* . ,_) (compile-letrec e env stack-depth stk-i tail? mutated)]
       [`(begin . ,vs)
@@ -302,7 +318,7 @@
        (compile-expr `(call-with-values (lambda () ,rhs)
                         (lambda ,gen-ids
                           ,@(if (null? ids)
-                                '((void))
+                                (list (void))
                                 (for/list ([id (in-list ids)]
                                            [gen-id (in-list gen-ids)])
                                   `(set! ,id ,gen-id)))))
@@ -548,7 +564,11 @@
        (define pos (stack->pos (if (boxed? var) (boxed-pos var) var) stk-i)) ; box result means unused
        (cond
          [(box? pos)
-          (vector 'clear (list (unbox pos)) e)]
+          (cond
+            [(and (vector? e) (eq? 'clear (vector-ref e 0)))
+             (vector 'clear (cons (unbox pos) (vector-ref e 1)) (vector-ref e 2))]
+            [else
+             (vector 'clear (list (unbox pos)) e)])]
          [(not (hash-ref mutated u #f))
           e]
          [else
@@ -576,6 +596,28 @@
         (box name)
         name))
 
+  (define (begins->list e)
+    ;; Convert an expression to a list of expressions, trying to
+    ;; flatten `begin`s.
+    (cond
+      [(vector? e)
+       (interp-match
+        e
+        [#(beginl ,es) es]
+        [#(begin)
+         (define len (sub1 (vector*-length e)))
+         (cond
+           [(len . < . 4)
+            (let loop ([i 1])
+              (cond
+                [(= i len)
+                 (begins->list (vector*-ref e i))]
+                [else (cons (vector*-ref e i)
+                            (loop (add1 i)))]))]
+           [else (list e)])]
+        [#() (list e)])]
+      [else (list e)]))
+
   (with-deterministic-gensym
     (start linklet-e)))
 
@@ -778,6 +820,17 @@
                (case-lambda
                  [(new-stack val) (loop (fx+ i 1) new-stack)]
                  [(new-stack . vals) (loop (fx+ i 1) new-stack)]))]))]
+        [#(beginl ,bs)
+         (let loop ([bs bs] [stack stack])
+           (cond
+             [(null? (cdr bs))
+              (interpret (car bs) stack return-mode)]
+             [else
+              (call-with-values
+               (lambda () (interpret (car bs) stack))
+               (case-lambda
+                 [(new-stack val) (loop (cdr bs) new-stack)]
+                 [(new-stack . vals) (loop (cdr bs) new-stack)]))]))]
         [#(begin0 ,b0)
          (define last (fx- (vector*-length b) 1))
          (call-with-values
@@ -907,7 +960,7 @@
               (let loop ([i 3] [captureds captureds] [full-mask 0])
                 (cond
                   [(fx= i n)
-                   ;; We shouldn't get here, because the wrapper shoudl enforce arity,
+                   ;; We shouldn't get here, because the wrapper should enforce arity,
                    ;; but just in case:
                    (apply raise-arity-mask-error '|#<procedure>| full-mask args)]
                   [else
@@ -1032,7 +1085,10 @@
                                                        (let ([z y])
                                                          (vector x z))))
                                            (define g (case-lambda
-                                                       [() no]
+                                                       [() (let ([unused (g)])
+                                                             (let ([also-unused (g)])
+                                                               (begin
+                                                                 (list (g no)))))]
                                                        [ys
                                                         (vector x ys)])))
                                          (define h (lambda (t x y a b)
diff --git a/src/schemify/jitify.rkt b/src/schemify/jitify.rkt
index 1a0b63f511..15e0636abc 100644
--- a/src/schemify/jitify.rkt
+++ b/src/schemify/jitify.rkt
@@ -51,8 +51,7 @@
     (define (extract-id m id)
       (match m
         [`(variable-ref ,var) var]
-        [`(unbox ,var) var]
-        [`(unbox/check-undefined ,var ,_) var]
+        [`(unsafe-unbox* ,var) var]
         [`(self ,m ,orig-id) orig-id]
         [`(self ,m) (extract-id m id)]
         [`,_ id]))
@@ -327,8 +326,7 @@
               [`#:direct (reannotate v `(set! ,var ,new-rhs))]
               [`(self ,m . ,_) (error 'set! "[internal error] self-referenceable ~s" id)]
               [`(variable-ref ,var-id) (reannotate v `(variable-set! ,var-id ,new-rhs))]
-              [`(unbox ,box-id) (reannotate v `(set-box! ,box-id ,new-rhs))]
-              [`(unbox/check-undefined ,box-id ,_) (reannotate v `(set-box!/check-undefined ,box-id ,new-rhs ',var))]))
+              [`(unsafe-unbox* ,box-id) (reannotate v `(set-box*! ,box-id ,new-rhs))]))
           (values new-v newer-free new-lifts)])]
       [`(call-with-values ,proc1 ,proc2)
        (define proc-convert-mode (convert-mode-called convert-mode))
@@ -424,7 +422,7 @@
       [`(,let-form ([,ids ,rhss] ...) . ,body)
        (define rec?
          (and (case (unwrap let-form)
-                [(letrec letrec*) #t]
+                [(letrec letrec*) #t] ; note that schemify has taken care of checking for undefined
                 [else #f])
               ;; Use simpler `let` code if we're not responsible for boxing:
               (convert-mode-box-mutables? convert-mode)))
@@ -432,8 +430,6 @@
        (define rhs-env (if rec?
                            (add-args/unbox env ids mutables
                                            (lambda (var) #t)
-                                           (not (for/and ([rhs (in-list rhss)])
-                                                  (lambda? rhs)))
                                            convert-mode)
                            env))
        (define-values (rev-new-rhss rhs-free rhs-lifts)
@@ -449,7 +445,6 @@
        (define local-env
          (add-args/unbox env ids mutables
                          (lambda (var) (and rec? (hash-ref rhs-free var #f)))
-                         #f
                          convert-mode))
        (define-values (new-body new-free new-lifts)
          (jitify-body body local-env mutables (union-free free rhs-free) rhs-lifts convert-mode name in-name))
@@ -472,13 +467,18 @@
                ;; Using nested `let`s to force left-to-right
                ,(for/fold ([body (body->expr new-body)]) ([id (in-list (reverse ids))]
                                                           [new-rhs (in-list rev-new-rhss)])
-                  `(let (,(cond
-                            [(hash-ref rhs-free (unwrap id) #f)
-                             `[,(deterministic-gensym "ignored") (set-box! ,id ,new-rhs)]]
-                            [(hash-ref mutables (unwrap id) #f)
-                             `[,id (box ,new-rhs)]]
-                            [else `[,id ,new-rhs]]))
-                     ,body)))]))
+                  (cond
+                    [(hash-ref rhs-free (unwrap id) #f)
+                     (let ([e `(set-box*! ,id ,new-rhs)])
+                       (match body
+                         [`(begin . ,es) `(begin ,e . ,es)]
+                         [`,_ `(begin ,e ,body)]))]
+                    [else
+                     `(let (,(cond
+                               [(hash-ref mutables (unwrap id) #f)
+                                `[,id (box ,new-rhs)]]
+                               [else `[,id ,new-rhs]]))
+                        ,body)])))]))
        (values (reannotate v new-v)
                (remove-args new-free ids)
                new-lifts)]))
@@ -526,7 +526,7 @@
       (define u (unwrap id))
       (define val (if (and (convert-mode-box-mutables? convert-mode)
                            (hash-ref mutables u #f))
-                      `(unbox ,id)
+                      `(unsafe-unbox* ,id)
                       '#:direct))
       (hash-set env u val))
     (match args
@@ -537,18 +537,17 @@
 
   ;; Further generalization of `add-args` to add undefined-checking
   ;; variant of unbox:
-  (define (add-args/unbox env args mutables var-rec? maybe-undefined? convert-mode)
+  (define (add-args/unbox env args mutables var-rec? convert-mode)
     (define (add-one id)
       (define var (unwrap id))
       (cond
-        [maybe-undefined? (hash-set env var `(unbox/check-undefined ,id ',id))]
         [(not (or (var-rec? var) (and (convert-mode-box-mutables? convert-mode)
                                       (hash-ref mutables var #f))))
          (hash-set env var '#:direct)]
-        [else (hash-set env var `(unbox ,id))]))
+        [else (hash-set env var `(unsafe-unbox* ,id))]))
     (match args
       [`(,id . ,args)
-       (add-args/unbox (add-one id) args mutables var-rec? maybe-undefined? convert-mode)]
+       (add-args/unbox (add-one id) args mutables var-rec? convert-mode)]
       [`() env]
       [`,id (add-one id)]))
 
@@ -587,10 +586,8 @@
             `(self ,(genself) ,name)]
            [`(self (variable-ref ,orig-id))
             `(self (variable-ref ,orig-id) ,orig-id)]
-           [`(self (unbox ,orig-id))
-            `(self (unbox ,(genself)) ,orig-id)]
-           [`(self (unbox/check-undefined ,orig-id ,sym))
-            `(self (unbox/check-undefined ,(genself) ,sym) ,orig-id)]
+           [`(self (unsafe-unbox* ,orig-id))
+            `(self (unsafe-unbox* ,(genself)) ,orig-id)]
            [`,_ #f]))
        (if new-m
            (hash-set env u new-m)
diff --git a/src/schemify/known.rkt b/src/schemify/known.rkt
index f104283722..669b53dc86 100644
--- a/src/schemify/known.rkt
+++ b/src/schemify/known.rkt
@@ -30,8 +30,10 @@
          known-predicate known-predicate? known-predicate-type
          known-accessor known-accessor? known-accessor-type
          known-mutator known-mutator? known-mutator-type
+         known-struct-predicate known-struct-predicate? known-struct-predicate-type-id known-struct-predicate-authentic?
          known-field-accessor known-field-accessor? known-field-accessor-type-id known-field-accessor-pos
          known-field-mutator known-field-mutator? known-field-mutator-type-id known-field-mutator-pos
+         known-struct-predicate/need-imports known-struct-predicate/need-imports? known-struct-predicate/need-imports-needed
          known-field-accessor/need-imports known-field-accessor/need-imports? known-field-accessor/need-imports-needed
          known-field-mutator/need-imports known-field-mutator/need-imports? known-field-mutator/need-imports-needed
          known-struct-type-property/immediate-guard known-struct-type-property/immediate-guard?
@@ -57,8 +59,7 @@
 (struct known-literal (value) #:prefab #:omit-define-syntaxes #:super struct:known-consistent)
 
 ;; procedure with arity mask; the procedure has to be a procedure from the host
-;; Scheme's perspective --- not an applicable struct or chaperoned procedure, which
-;; means that parameters don't count
+;; Scheme's perspective --- not an applicable struct or chaperoned procedure
 (struct known-procedure (arity-mask) #:prefab #:omit-define-syntaxes #:super struct:known-consistent)
 
 ;; procedure that does not need to run inside a module prompt, which implies that the
@@ -101,8 +102,10 @@
 (struct known-predicate (type) #:prefab #:omit-define-syntaxes #:super struct:known-procedure/pure)
 (struct known-accessor (type) #:prefab #:omit-define-syntaxes #:super struct:known-procedure)
 (struct known-mutator (type) #:prefab #:omit-define-syntaxes #:super struct:known-procedure)
+(struct known-struct-predicate (type-id authentic?) #:prefab #:omit-define-syntaxes #:super struct:known-predicate)
 (struct known-field-accessor (type-id pos) #:prefab #:omit-define-syntaxes #:super struct:known-accessor)
 (struct known-field-mutator (type-id pos) #:prefab #:omit-define-syntaxes #:super struct:known-mutator)
+(struct known-struct-predicate/need-imports (needed) #:prefab #:omit-define-syntaxes #:super struct:known-struct-predicate)
 (struct known-field-accessor/need-imports (needed) #:prefab #:omit-define-syntaxes #:super struct:known-field-accessor)
 (struct known-field-mutator/need-imports (needed) #:prefab #:omit-define-syntaxes #:super struct:known-field-mutator)
 
diff --git a/src/schemify/literal.rkt b/src/schemify/literal.rkt
index a0701ae6d7..35f6ff26a5 100644
--- a/src/schemify/literal.rkt
+++ b/src/schemify/literal.rkt
@@ -43,7 +43,7 @@
   (cond
     [(or (string? x) (bytes? x) (boolean? x) (number? x))
      x]
-    [(void? x) '(void)]
+    [(void? x) `(quote ,(void))]
     [(eof-object? x) 'eof]
     [else
      `(quote ,x)]))
diff --git a/src/schemify/schemify.rkt b/src/schemify/schemify.rkt
index f13dbd43d8..8825c4fb61 100644
--- a/src/schemify/schemify.rkt
+++ b/src/schemify/schemify.rkt
@@ -54,7 +54,7 @@
 ;;   - convert all `letrec` patterns that might involve `call/cc` to
 ;;     ensure that locations are allocated at the right time;
 ;;
-;;   - explicily handle all potential too-early variable uses, so that
+;;   - explicitly handle all potential too-early variable uses, so that
 ;;     the right name and enclosing module are reported;
 ;;
 ;;   - convert `make-struct-type` bindings to a pattern that Chez can
@@ -228,9 +228,32 @@
     (let loop ([l l] [in-mut-l l] [accum-exprs null] [accum-ids null] [knowns knowns])
       (define mut-l (update-mutated-state! l in-mut-l mutated))
       (define (make-set-variables)
-        (for/list ([id (in-list accum-ids)]
-                   #:when (hash-ref exports (unwrap id) #f))
-          (make-set-variable id exports knowns mutated)))
+        ;; Resulting list of assinments will be reversed
+        (cond
+          [(or for-cify? for-interp?)
+           (for/list ([id (in-list accum-ids)]
+                      #:when (hash-ref exports (unwrap id) #f))
+             (make-set-variable id exports knowns mutated))]
+          [else
+           ;; Group 'consistent variables in one `set-consistent-variables!/define` call
+           (let loop ([accum-ids accum-ids] [consistent-ids null])
+             (cond
+               [(null? accum-ids)
+                (make-set-consistent-variables consistent-ids exports knowns mutated)]
+               [else
+                (define id (car accum-ids))
+                (define u-id (unwrap id))
+                (cond
+                  [(hash-ref exports u-id #f)
+                   (cond
+                     [(eq? 'consistent (variable-constance u-id knowns mutated))
+                      (loop (cdr accum-ids) (cons id consistent-ids))]
+                     [else
+                      (append (make-set-consistent-variables consistent-ids exports knowns mutated)
+                              (cons (make-set-variable id exports knowns mutated)
+                                    (loop (cdr accum-ids) '())))])]
+                  [else
+                   (loop (cdr accum-ids) consistent-ids)])]))]))
       (define (make-expr-defns es)
         (if (or for-interp? for-cify?)
             (reverse es)
@@ -373,6 +396,9 @@
                 [`,_ (finish-definition ids)])]
              [else
               (finish-wrapped-definition ids rhs)])]
+          [`(quote ,_) ; useful to drop #<void>s for the interpreter
+           #:guard (or (pair? (cdr l)) (pair? accum-ids))
+           (loop (cdr l) mut-l accum-exprs accum-ids knowns)]
           [`,_
            (match form
              [`(define-values ,ids ,_)
@@ -402,6 +428,16 @@
   (define ex-id (id-to-variable int-id exports knowns mutated extra-variables))
   `(variable-set!/define ,ex-id ,id ',(variable-constance int-id knowns mutated)))
 
+;; returns a list equilanet to a sequence of `variable-set!/define` forms
+(define (make-set-consistent-variables ids exports knowns mutated)
+  (cond
+    [(null? ids) null]
+    [(null? (cdr ids)) (list (make-set-variable (car ids) exports knowns mutated))]
+    [else
+     (define ex-ids (for/list ([id (in-list ids)])
+                      (id-to-variable (unwrap id) exports knowns mutated #f)))
+     `((set-consistent-variables!/define (vector ,@ex-ids) (vector ,@ids)))]))
+
 (define (id-to-variable int-id exports knowns mutated extra-variables)
   (export-id
    (or (hash-ref exports int-id #f)
@@ -481,31 +517,40 @@
            [`(let-values () ,bodys ...)
             (schemify `(begin . ,bodys) wcm-state)]
            [`(let-values ([(,ids) ,rhss] ...) ,bodys ...)
-            (define new-knowns
-              (for/fold ([knowns knowns]) ([id (in-list ids)]
-                                           [rhs (in-list rhss)])
-                (define k (infer-known rhs #f id knowns prim-knowns imports mutated simples unsafe-mode?))
-                (if k
-                    (hash-set knowns (unwrap id) k)
-                    knowns)))
-            (define (merely-a-copy? id)
-              (define u-id (unwrap id))
-              (define k (hash-ref new-knowns u-id #f))
-              (and (or (known-copy? k)
-                       (known-literal? k))
-                   (simple-mutated-state? (hash-ref mutated u-id #f))))
-            (unnest-let
-             (left-to-right/let (for/list ([id (in-list ids)]
-                                           #:unless (merely-a-copy? id))
-                                  id)
-                                (for/list ([id (in-list ids)]
-                                           [rhs (in-list rhss)]
-                                           #:unless (merely-a-copy? id))
-                                  (schemify rhs 'fresh))
-                                (for/list ([body (in-list bodys)])
-                                  (schemify/knowns new-knowns inline-fuel wcm-state body))
-                                prim-knowns knowns imports mutated simples)
-             prim-knowns knowns imports mutated simples)]
+            (cond
+              [(and (pair? ids) (null? (cdr ids))
+                    (pair? bodys) (null? (cdr bodys))
+                    (eq? (unwrap (car ids)) (unwrap (car bodys)))
+                    (lambda? (car rhss)))
+               ;; Simplify by discarding the binding; assume that any
+               ;; needed naming is already reflected in properties
+               (schemify (car rhss) wcm-state)]
+              [else
+               (define new-knowns
+                 (for/fold ([knowns knowns]) ([id (in-list ids)]
+                                              [rhs (in-list rhss)])
+                   (define k (infer-known rhs #f id knowns prim-knowns imports mutated simples unsafe-mode?))
+                   (if k
+                       (hash-set knowns (unwrap id) k)
+                       knowns)))
+               (define (merely-a-copy? id)
+                 (define u-id (unwrap id))
+                 (define k (hash-ref new-knowns u-id #f))
+                 (and (or (known-copy? k)
+                          (known-literal? k))
+                      (simple-mutated-state? (hash-ref mutated u-id #f))))
+               (unnest-let
+                (left-to-right/let (for/list ([id (in-list ids)]
+                                              #:unless (merely-a-copy? id))
+                                     id)
+                                   (for/list ([id (in-list ids)]
+                                              [rhs (in-list rhss)]
+                                              #:unless (merely-a-copy? id))
+                                     (schemify rhs 'fresh))
+                                   (for/list ([body (in-list bodys)])
+                                     (schemify/knowns new-knowns inline-fuel wcm-state body))
+                                   prim-knowns knowns imports mutated simples)
+                prim-knowns knowns imports mutated simples)])]
            [`(let-values ([() (begin ,rhss ... (values))]) ,bodys ...)
             `(begin ,@(schemify-body rhss 'fresh) ,@(schemify-body bodys wcm-state))]
            [`(let-values ([,idss ,rhss] ...) ,bodys ...)
@@ -752,6 +797,21 @@
                   body
                   `(let ([,tmp ,e])
                      ,body)))
+            (define (inline-struct-predicate k s-rator im args)
+              ;; For imported predicates on authentic structure types, it's worth
+              ;; inlining the predicate to enable cptypes optimizations.
+              (define type-id (and im
+                                   (known-struct-predicate-authentic? k)
+                                   (pair? args)
+                                   (null? (cdr args))
+                                   (inline-type-id k im add-import! mutated imports)))
+              (cond
+                [type-id
+                 (define tmp (maybe-tmp (car args) 'v))
+                 (define ques `(unsafe-struct? ,tmp ,(schemify type-id 'fresh)))
+                 (wrap-tmp tmp (car args)
+                           ques)]
+                [else #f]))
             (define (inline-field-access k s-rator im args)
               ;; For imported accessors or for JIT mode, inline the
               ;; selector with an `unsafe-struct?` test plus `unsafe-struct*-ref`.
@@ -801,6 +861,10 @@
                                              #t for-cify?
                                              prim-knowns knowns imports mutated simples))]
                     [(and (not for-cify?)
+                          (known-struct-predicate? k)
+                          (inline-struct-predicate k s-rator im args))
+                     => (lambda (e) e)]
+                    [(and (not for-cify?)
                           (known-field-accessor? k)
                           (inline-field-access k s-rator im args))
                      => (lambda (e) e)]
diff --git a/src/schemify/struct-convert.rkt b/src/schemify/struct-convert.rkt
index bcb5477ac9..be6cb177af 100644
--- a/src/schemify/struct-convert.rkt
+++ b/src/schemify/struct-convert.rkt
@@ -56,20 +56,22 @@
         (define can-impersonate? (not (struct-type-info-authentic? sti)))
         (define raw-s? (if can-impersonate? (deterministic-gensym (unwrap s?)) s?))
         `(begin
-           (define ,struct:s (make-record-type-descriptor ',(struct-type-info-name sti)
-                                                          ,(schemify (struct-type-info-parent sti) knowns)
-                                                          ,(if (not (struct-type-info-prefab-immutables sti))
-                                                               #f
-                                                               `(structure-type-lookup-prefab-uid
-                                                                 ',(struct-type-info-name sti)
-                                                                 ,(schemify (struct-type-info-parent sti) knowns)
-                                                                 ,(struct-type-info-immediate-field-count sti)
-                                                                 0 #f
-                                                                 ',(struct-type-info-prefab-immutables sti)))
-                                                          #f
-                                                          #f
-                                                          ',(for/vector ([i (in-range (struct-type-info-immediate-field-count sti))])
-                                                              `(mutable ,(string->symbol (format "f~a" i))))))
+           (define ,struct:s (make-record-type-descriptor* ',(struct-type-info-name sti)
+                                                           ,(schemify (struct-type-info-parent sti) knowns)
+                                                           ,(if (not (struct-type-info-prefab-immutables sti))
+                                                                #f
+                                                                `(structure-type-lookup-prefab-uid
+                                                                  ',(struct-type-info-name sti)
+                                                                  ,(schemify (struct-type-info-parent sti) knowns)
+                                                                  ,(struct-type-info-immediate-field-count sti)
+                                                                  0 #f
+                                                                  ',(struct-type-info-prefab-immutables sti)))
+                                                           #f
+                                                           #f
+                                                           ,(struct-type-info-immediate-field-count sti)
+                                                           ;; Reporting all as mutable, for now:
+                                                           ,(let ([n (struct-type-info-immediate-field-count sti)])
+                                                              (sub1 (arithmetic-shift 1 n)))))
            ,@(if (null? (struct-type-info-rest sti))
                  null
                  `((define ,(deterministic-gensym "effect")