From e71c217758f744d3c8dfb30dd152b8c7d08a2735 Mon Sep 17 00:00:00 2001
From: yjqww6 <343519265@qq.com>
Date: Thu, 7 Jan 2021 04:29:07 +0800
Subject: [PATCH] cs: inline non-authentic struct predicate

---
 racket/src/cs/schemified/schemify.scm | 109 ++++++++++++++++++--------
 racket/src/schemify/schemify.rkt      |  19 ++++-
 2 files changed, 91 insertions(+), 37 deletions(-)

diff --git a/racket/src/cs/schemified/schemify.scm b/racket/src/cs/schemified/schemify.scm
index dc825a5666..d7ff05787e 100644
--- a/racket/src/cs/schemified/schemify.scm
+++ b/racket/src/cs/schemified/schemify.scm
@@ -29750,41 +29750,84 @@
                                                                                                                              args_0)
                                                                                                                       (begin
                                                                                                                         (let ((type-id_0
-                                                                                                                               (if (known-struct-predicate-authentic?
-                                                                                                                                    k_0)
-                                                                                                                                 (if (pair?
-                                                                                                                                      args_0)
-                                                                                                                                   (if (null?
-                                                                                                                                        (cdr
-                                                                                                                                         args_0))
-                                                                                                                                     (inline-type-id
-                                                                                                                                      k_0
-                                                                                                                                      im_0
-                                                                                                                                      add-import!_0
-                                                                                                                                      mutated_0
-                                                                                                                                      imports_0)
-                                                                                                                                     #f)
+                                                                                                                               (if (pair?
+                                                                                                                                    args_0)
+                                                                                                                                 (if (null?
+                                                                                                                                      (cdr
+                                                                                                                                       args_0))
+                                                                                                                                   (inline-type-id
+                                                                                                                                    k_0
+                                                                                                                                    im_0
+                                                                                                                                    add-import!_0
+                                                                                                                                    mutated_0
+                                                                                                                                    imports_0)
                                                                                                                                    #f)
                                                                                                                                  #f)))
-                                                                                                                          (if type-id_0
-                                                                                                                            (let ((tmp_0
-                                                                                                                                   (maybe-tmp_0
-                                                                                                                                    (car
-                                                                                                                                     args_0)
-                                                                                                                                    'v)))
-                                                                                                                              (let ((ques_0
-                                                                                                                                     (list
-                                                                                                                                      'unsafe-struct?
-                                                                                                                                      tmp_0
-                                                                                                                                      (schemify_0
-                                                                                                                                       type-id_0
-                                                                                                                                       'fresh))))
-                                                                                                                                (wrap-tmp_0
-                                                                                                                                 tmp_0
-                                                                                                                                 (car
-                                                                                                                                  args_0)
-                                                                                                                                 ques_0)))
-                                                                                                                            #f)))))))
+                                                                                                                          (if (not
+                                                                                                                               type-id_0)
+                                                                                                                            #f
+                                                                                                                            (if (known-struct-predicate-authentic?
+                                                                                                                                 k_0)
+                                                                                                                              (let ((tmp_0
+                                                                                                                                     (maybe-tmp_0
+                                                                                                                                      (car
+                                                                                                                                       args_0)
+                                                                                                                                      'v)))
+                                                                                                                                (let ((ques_0
+                                                                                                                                       (list
+                                                                                                                                        'unsafe-struct?
+                                                                                                                                        tmp_0
+                                                                                                                                        (schemify_0
+                                                                                                                                         type-id_0
+                                                                                                                                         'fresh))))
+                                                                                                                                  (wrap-tmp_0
+                                                                                                                                   tmp_0
+                                                                                                                                   (car
+                                                                                                                                    args_0)
+                                                                                                                                   ques_0)))
+                                                                                                                              (let ((tmp_0
+                                                                                                                                     (maybe-tmp_0
+                                                                                                                                      (car
+                                                                                                                                       args_0)
+                                                                                                                                      'v)))
+                                                                                                                                (let ((schemified-type-id_0
+                                                                                                                                       (schemify_0
+                                                                                                                                        type-id_0
+                                                                                                                                        'fresh)))
+                                                                                                                                  (let ((tmp-type-id_0
+                                                                                                                                         (maybe-tmp_0
+                                                                                                                                          schemified-type-id_0
+                                                                                                                                          'v)))
+                                                                                                                                    (let ((ques_0
+                                                                                                                                           (list
+                                                                                                                                            'if
+                                                                                                                                            (list
+                                                                                                                                             'unsafe-struct?
+                                                                                                                                             tmp_0
+                                                                                                                                             tmp-type-id_0)
+                                                                                                                                            #t
+                                                                                                                                            (list*
+                                                                                                                                             'if
+                                                                                                                                             (list
+                                                                                                                                              'impersonator?
+                                                                                                                                              tmp_0)
+                                                                                                                                             (list
+                                                                                                                                              'unsafe-struct?
+                                                                                                                                              (list
+                                                                                                                                               'impersonator-val
+                                                                                                                                               tmp_0)
+                                                                                                                                              tmp-type-id_0)
+                                                                                                                                             '(#f)))))
+                                                                                                                                      (let ((app_0
+                                                                                                                                             (car
+                                                                                                                                              args_0)))
+                                                                                                                                        (wrap-tmp_0
+                                                                                                                                         tmp_0
+                                                                                                                                         app_0
+                                                                                                                                         (wrap-tmp_0
+                                                                                                                                          tmp-type-id_0
+                                                                                                                                          schemified-type-id_0
+                                                                                                                                          ques_0)))))))))))))))
                                                                                                               (let ((inline-field-access_0
                                                                                                                      (|#%name|
                                                                                                                       inline-field-access
diff --git a/racket/src/schemify/schemify.rkt b/racket/src/schemify/schemify.rkt
index 772e82baa5..1d44b6e012 100644
--- a/racket/src/schemify/schemify.rkt
+++ b/racket/src/schemify/schemify.rkt
@@ -838,17 +838,28 @@
                                     prim-knowns knowns imports mutated simples unsafe-mode?)]
                 [else #f]))
             (define (inline-struct-predicate k s-rator im args)
-              (define type-id (and (known-struct-predicate-authentic? k)
-                                   (pair? args)
+              (define type-id (and (pair? args)
                                    (null? (cdr args))
                                    (inline-type-id k im add-import! mutated imports)))
               (cond
-                [type-id
+                [(not type-id) #f]
+                [(known-struct-predicate-authentic? k)
                  (define tmp (maybe-tmp (car args) 'v))
                  (define ques `(unsafe-struct? ,tmp ,(schemify type-id 'fresh)))
                  (wrap-tmp tmp (car args)
                            ques)]
-                [else #f]))
+                [else
+                 (define tmp (maybe-tmp (car args) 'v))
+                 (define schemified-type-id (schemify type-id 'fresh))
+                 (define tmp-type-id (maybe-tmp schemified-type-id 'v))
+                 (define ques `(if (unsafe-struct? ,tmp ,tmp-type-id)
+                                   #t
+                                   (if (impersonator? ,tmp)
+                                       (unsafe-struct? (impersonator-val ,tmp) ,tmp-type-id)
+                                       #f)))
+                 (wrap-tmp tmp (car args)
+                           (wrap-tmp tmp-type-id schemified-type-id 
+                                     ques))]))
             (define (inline-field-access k s-rator im args)
               ;; Inline the selector with an `unsafe-struct?` test plus `unsafe-struct*-ref`.
               (define type-id (and (pair? args)