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

more cptypes

Browse Source 
original commit: e04430806fc16e411dae8f8c9288f56e6e55a426
This commit is contained in:
Gustavo Massaccesi 2018-07-29 19:58:15 -03:00
parent 6ff9e9ecd5
commit ecc310106d
2 changed files with 13 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
s/cprep.ss
View File

@ -212,6 +212,10 @@
(if (eq? (subset-mode) 'system)
($system-environment)
(interaction-environment)))
(define (cptypes x)
(if (enable-type-recovery)
($cptypes x)
x))
(define e/o
(lambda (who cte? x env)
(define (go x)
@ -222,9 +226,9 @@
(let ([x ((run-cp0)
(lambda (x)
(set! cpletrec-ran? #t)
($cpletrec ($cptypes ($cp0 x $compiler-is-loaded?))))
($cpletrec (cptypes ($cp0 x $compiler-is-loaded?))))
($cpvalid x))])
(if cpletrec-ran? x ($cpletrec x))))))))
(if cpletrec-ran? x ($cpletrec (cptypes 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

9
s/interpret.ss
View File

@ -645,6 +645,11 @@
(c-var-index-set! (car vars) i)
(loop (cdr vars) regs (fx+ i 1))])))))
(define (cptypes x)
(if (enable-type-recovery)
($cptypes x))
x)
(define-pass interpret-Lexpand : Lexpand (ir situation for-import? ofn eoo) -> * (val)
(definitions
(define (ibeval x1)
@ -654,9 +659,9 @@
(let ([x ((run-cp0)
(lambda (x)
(set! cpletrec-ran? #t)
($cpletrec ($cptypes ($cp0 x #f))))
($cpletrec (cptypes ($cp0 x #f))))
x2)])
(if cpletrec-ran? x ($cpletrec x))))]
(if cpletrec-ran? x ($cpletrec (cptypes x)))))]
[x2b ($cpcheck x2a)]
[x2b ($cpcommonize x2b)])
(when eoo (pretty-print ($uncprep x2b) eoo))