suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

cs: inline non-authentic struct predicate

Browse Source
This commit is contained in:
yjqww6 2021-01-07 04:29:07 +08:00 committed by GitHub
parent f41b180b48
commit e71c217758
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
2 changed files with 91 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

109
racket/src/cs/schemified/schemify.scm
View File

@ -29750,41 +29750,84 @@
args_0) args_0)
(begin (begin
(let ((type-id_0 (let ((type-id_0
(if (known-struct-predicate-authentic? (if (pair?
k_0) args_0)
(if (pair? (if (null?
args_0) (cdr
(if (null? args_0))
(cdr (inline-type-id
args_0)) k_0
(inline-type-id im_0
k_0 add-import!_0
im_0 mutated_0
add-import!_0 imports_0)
mutated_0
imports_0)
#f)
#f) #f)
#f))) #f)))
(if type-id_0 (if (not
(let ((tmp_0 type-id_0)
(maybe-tmp_0 #f
(car (if (known-struct-predicate-authentic?
args_0) k_0)
'v))) (let ((tmp_0
(let ((ques_0 (maybe-tmp_0
(list (car
'unsafe-struct? args_0)
tmp_0 'v)))
(schemify_0 (let ((ques_0
type-id_0 (list
'fresh)))) 'unsafe-struct?
(wrap-tmp_0 tmp_0
tmp_0 (schemify_0
(car type-id_0
args_0) 'fresh))))
ques_0))) (wrap-tmp_0
#f))))))) 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 (let ((inline-field-access_0
(|#%name| (|#%name|
inline-field-access inline-field-access

19
racket/src/schemify/schemify.rkt
View File

@ -838,17 +838,28 @@
prim-knowns knowns imports mutated simples unsafe-mode?)] prim-knowns knowns imports mutated simples unsafe-mode?)]
[else #f])) [else #f]))
(define (inline-struct-predicate k s-rator im args) (define (inline-struct-predicate k s-rator im args)
(define type-id (and (known-struct-predicate-authentic? k) (define type-id (and (pair? args)
(pair? args)
(null? (cdr args)) (null? (cdr args))
(inline-type-id k im add-import! mutated imports))) (inline-type-id k im add-import! mutated imports)))
(cond (cond
[type-id [(not type-id) #f]
[(known-struct-predicate-authentic? k)
(define tmp (maybe-tmp (car args) 'v)) (define tmp (maybe-tmp (car args) 'v))
(define ques `(unsafe-struct? ,tmp ,(schemify type-id 'fresh))) (define ques `(unsafe-struct? ,tmp ,(schemify type-id 'fresh)))
(wrap-tmp tmp (car args) (wrap-tmp tmp (car args)
ques)] 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) (define (inline-field-access k s-rator im args)
;; Inline the selector with an `unsafe-struct?` test plus `unsafe-struct*-ref`. ;; Inline the selector with an `unsafe-struct?` test plus `unsafe-struct*-ref`.
(define type-id (and (pair? args) (define type-id (and (pair? args)