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

flush expand-output and expand/optimize-output ports

Browse Source 
original commit: 39a1aa4034dc11e808146e5a3ed44acfc1f0f99b
This commit is contained in:
Oscar Waddell 2018-05-24 18:48:29 -04:00
parent 61df2f25f7
commit 75bce2810b
2 changed files with 10 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
LOG
View File

@ -997,3 +997,5 @@
whose base and/or index is a local save. whose base and/or index is a local save.
cpnanopass.ss, cpnanopass.ss,
misc.ms misc.ms
- flush expand-output and expand/optimize-output ports
compile.ss

12
s/compile.ss
View File

@ -635,7 +635,8 @@
(when (expand-output) (when (expand-output)
(when source-info-string (when source-info-string
(fprintf (expand-output) "~%;; expand output for ~a\n" source-info-string)) (fprintf (expand-output) "~%;; expand output for ~a\n" source-info-string))
(pretty-print ($uncprep x1) (expand-output))) (pretty-print ($uncprep x1) (expand-output))
(flush-output-port (expand-output)))
(let loop ([chunk* (expand-Lexpand x1)] [rx2b* '()] [rfinal* '()]) (let loop ([chunk* (expand-Lexpand x1)] [rx2b* '()] [rfinal* '()])
(define finish-compile (define finish-compile
(lambda (x1 f) (lambda (x1 f)
@ -683,7 +684,8 @@
[else (sorry! who "unrecognized stuff ~s" x2b)]) [else (sorry! who "unrecognized stuff ~s" x2b)])
(finish x2b))) (finish x2b)))
rx2b*)]) rx2b*)])
(pretty-print (if (fx= (length e*) 1) (car e*) `(begin ,@(reverse e*))) (expand/optimize-output)))) (pretty-print (if (fx= (length e*) 1) (car e*) `(begin ,@(reverse e*))) (expand/optimize-output))
(flush-output-port (expand/optimize-output))))
($pass-time 'pfasl (lambda () (c-print-fasl `(group ,@(reverse rfinal*)) op)))) ($pass-time 'pfasl (lambda () (c-print-fasl `(group ,@(reverse rfinal*)) op))))
(let ([x1 (car chunk*)]) (let ([x1 (car chunk*)])
(cond (cond
@ -1479,7 +1481,8 @@
(let* ([x1 (expand-Lexpand ($pass-time 'expand (lambda () (expand x0 env-spec #t))))] (let* ([x1 (expand-Lexpand ($pass-time 'expand (lambda () (expand x0 env-spec #t))))]
[waste ($uncprep x1 #t)] ; populate preinfo sexpr fields [waste ($uncprep x1 #t)] ; populate preinfo sexpr fields
[waste (when (and (expand-output) (not ($noexpand? x0))) [waste (when (and (expand-output) (not ($noexpand? x0)))
(pretty-print ($uncprep x1) (expand-output)))] (pretty-print ($uncprep x1) (expand-output))
(flush-output-port (expand-output)))]
[x2 ($pass-time 'cpvalid (lambda () ($cpvalid x1)))] [x2 ($pass-time 'cpvalid (lambda () ($cpvalid x1)))]
[x2a (let ([cpletrec-ran? #f]) [x2a (let ([cpletrec-ran? #f])
(let ([x ((run-cp0) (let ([x ((run-cp0)
@ -1492,7 +1495,8 @@
[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)))
(pretty-print ($uncprep x2b) (expand/optimize-output))) (pretty-print ($uncprep x2b) (expand/optimize-output))
(flush-output-port (expand/optimize-output)))
(if (and (compile-interpret-simple) (if (and (compile-interpret-simple)
(not ($assembly-output)) (not ($assembly-output))
(cheat? x2b)) (cheat? x2b))