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)
(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

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

@ -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)