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

Alternative version of enable-type-recovery

Browse Source 
Don't run cptypes, when cp0 is disabled, for example with
(run-cp0 (lamba (cp0 x) x)

This is easier to understand because run-cp0 is a single point to control
all the cp reductions. The reductions in cptypes can be independently disable
using enable-type-recovery.

original commit: b23645e669fbf02806a261a2d87160fdbe06db93
This commit is contained in:
Gustavo Massaccesi 2019-02-17 17:41:34 -03:00
parent 30beb65af3
commit b8508e5170
3 changed files with 8 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
mats/cptypes.ms
View File

@ -27,31 +27,17 @@
(expand/optimize y)))])) (expand/optimize y)))]))
(define-syntax cptypes/nocp0-equivalent-expansion? (define-syntax cptypes/nocp0-equivalent-expansion?
; When run-cp0 is call, use #3%$cptypes insted of the cp0 function provided.
; This disables the reductions in cp0.ss, so it's posible to see
; the isolated effect of the reduction in cptypes.ss.
(syntax-rules () (syntax-rules ()
[(_ x y) [(_ x y)
(equivalent-expansion? (equivalent-expansion?
(parameterize ([enable-cp0 #f] (parameterize ([run-cp0 (lambda (cp0 c) (#3%$cptypes c))]
[#%$suppress-primitive-inlining #f] [#%$suppress-primitive-inlining #f]
#;[optimize-level (max (optimize-level) 2)]) #;[optimize-level (max (optimize-level) 2)])
(expand/optimize x)) (expand/optimize x))
(parameterize ([enable-cp0 #f] (parameterize ([run-cp0 (lambda (cp0 c) (#3%$cptypes c))]
[#%$suppress-primitive-inlining #f]
#;[optimize-level (max (optimize-level) 2)])
(expand/optimize y)))]))
(define-syntax cptypes/nocp0/alternative-equivalent-expansion?
(syntax-rules ()
[(_ x y)
(equivalent-expansion?
(parameterize ([enable-cp0 #f]
[enable-type-recovery #f]
[run-cp0 (lambda (cp0 c) (#3%$cptypes c))]
[#%$suppress-primitive-inlining #f]
#;[optimize-level (max (optimize-level) 2)])
(expand/optimize x))
(parameterize ([enable-cp0 #f]
[enable-type-recovery #f]
[run-cp0 (lambda (cp0 c) (#3%$cptypes c))]
[#%$suppress-primitive-inlining #f] [#%$suppress-primitive-inlining #f]
#;[optimize-level (max (optimize-level) 2)]) #;[optimize-level (max (optimize-level) 2)])
(expand/optimize y)))])) (expand/optimize y)))]))
@ -680,18 +666,3 @@
'((lambda (x . r) (null? r)) 1 2) '((lambda (x . r) (null? r)) 1 2)
'((lambda (x . r) #f) 1 2)) '((lambda (x . r) #f) 1 2))
) )
(mat cptypes-rest-argument/alternative
(cptypes/nocp0/alternative-equivalent-expansion?
'((lambda (x . r) (pair? r)) 1)
'((lambda (x . r) #f) 1))
(cptypes/nocp0/alternative-equivalent-expansion?
'((lambda (x . r) (null? r)) 1)
'((lambda (x . r) #t) 1))
(cptypes/nocp0/alternative-equivalent-expansion?
'((lambda (x . r) (pair? r)) 1 2)
'((lambda (x . r) #t) 1 2))
(cptypes/nocp0/alternative-equivalent-expansion?
'((lambda (x . r) (null? r)) 1 2)
'((lambda (x . r) #f) 1 2))
)

7
s/compile.ss
View File

@ -667,9 +667,7 @@
x2)]) x2)])
(if cpletrec-ran? (if cpletrec-ran?
x x
(let* ([x (cptypes x)] (let* ([x ($pass-time 'cpletrec (lambda () (do-trace $cpletrec x)))]
[waste (check-prelex-flags x 'cptypes)]
[x ($pass-time 'cpletrec (lambda () (do-trace $cpletrec x)))]
[waste (check-prelex-flags x 'cpletrec)]) [waste (check-prelex-flags x 'cpletrec)])
x))))] x))))]
[x2b ($pass-time 'cpcheck (lambda () (do-trace $cpcheck x2a)))] [x2b ($pass-time 'cpcheck (lambda () (do-trace $cpcheck x2a)))]
@ -1578,8 +1576,7 @@
($pass-time 'cpletrec (lambda () ($cpletrec x))))) ($pass-time 'cpletrec (lambda () ($cpletrec x)))))
x2)]) x2)])
(if cpletrec-ran? x (if cpletrec-ran? x
(let ([x (cptypes x)]) ($pass-time 'cpletrec (lambda () ($cpletrec x))))))]
($pass-time 'cpletrec (lambda () ($cpletrec x)))))))]
[x2b ($pass-time 'cpcheck (lambda () ($cpcheck x2a)))] [x2b ($pass-time 'cpcheck (lambda () ($cpcheck x2a)))]
[x2b ($pass-time 'cpcommonize (lambda () ($cpcommonize x2b)))]) [x2b ($pass-time 'cpcommonize (lambda () ($cpcommonize x2b)))])
(when (and (expand/optimize-output) (not ($noexpand? x0))) (when (and (expand/optimize-output) (not ($noexpand? x0)))

2
s/cprep.ss
View File

@ -237,7 +237,7 @@
(set! cpletrec-ran? #t) (set! cpletrec-ran? #t)
($cpletrec (cptypes ($cp0 x $compiler-is-loaded?)))) ($cpletrec (cptypes ($cp0 x $compiler-is-loaded?))))
($cpvalid x))]) ($cpvalid x))])
(if cpletrec-ran? x ($cpletrec (cptypes x))))))))) (if cpletrec-ran? x ($cpletrec x))))))))
(unless (environment? env) (unless (environment? env)
($oops who "~s is not an environment" env)) ($oops who "~s is not an environment" env))
; claim compiling-a-file to get cte as well as run-time code ; claim compiling-a-file to get cte as well as run-time code