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)))]))
(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 ()
[(_ x y)
(equivalent-expansion?
(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 x))
(parameterize ([enable-cp0 #f]
[#%$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))]
(parameterize ([run-cp0 (lambda (cp0 c) (#3%$cptypes c))]
[#%$suppress-primitive-inlining #f]
#;[optimize-level (max (optimize-level) 2)])
(expand/optimize y)))]))
@ -680,18 +666,3 @@
'((lambda (x . r) (null? r)) 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)])
(if cpletrec-ran?
x
(let* ([x (cptypes x)]
[waste (check-prelex-flags x 'cptypes)]
[x ($pass-time 'cpletrec (lambda () (do-trace $cpletrec x)))]
(let* ([x ($pass-time 'cpletrec (lambda () (do-trace $cpletrec x)))]
[waste (check-prelex-flags x 'cpletrec)])
x))))]
[x2b ($pass-time 'cpcheck (lambda () (do-trace $cpcheck x2a)))]
@ -1578,8 +1576,7 @@
($pass-time 'cpletrec (lambda () ($cpletrec x)))))
x2)])
(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 'cpcommonize (lambda () ($cpcommonize x2b)))])
(when (and (expand/optimize-output) (not ($noexpand? x0)))

2
s/cprep.ss
View File

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