conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

* making more changes

This commit is contained in:
Abdulaziz Ghuloum 2007-05-02 23:56:46 -04:00
parent d83bff5f5e
commit d6958c99a0
2 changed files with 10 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
src/ikarus.boot
View File

Binary file not shown.

21
src/libcompile.ss
View File

@ -5150,12 +5150,9 @@
)) ))
)))) ))))
(define (compile-expr expr) (define (compile-core-expr->code p)
(let* ([p (parameterize ([assembler-output #f]) (let* ([p (recordize p)]
(expand expr))]
[p (recordize p)]
[p (optimize-direct-calls p)] [p (optimize-direct-calls p)]
;[p^ (analyze-cwv p)]
[p (optimize-letrec p)] [p (optimize-letrec p)]
[p (uncover-assigned/referenced p)] [p (uncover-assigned/referenced p)]
[p (copy-propagate p)] [p (copy-propagate p)]
@ -5163,8 +5160,6 @@
[p (optimize-for-direct-jumps p)] [p (optimize-for-direct-jumps p)]
[p (convert-closures p)] [p (convert-closures p)]
[p (optimize-closures/lift-codes p)] [p (optimize-closures/lift-codes p)]
;[p^ (new-cogen p)]
[p (introduce-primcalls p)] [p (introduce-primcalls p)]
[p (simplify-operands p)] [p (simplify-operands p)]
[p (insert-stack-overflow-checks p)] [p (insert-stack-overflow-checks p)]
@ -5192,6 +5187,11 @@
ls*)]) ls*)])
(car code*))))) (car code*)))))
(define (compile-expr->code x)
(compile-core-expr->code
(parameterize ([assembler-output #f])
(expand x))))
;(include "libaltcogen.ss") ;(include "libaltcogen.ss")
(define alt-cogen (define alt-cogen
@ -5235,8 +5235,7 @@
(define compile-core-expr-to-port (define compile-core-expr-to-port
(lambda (expr port) (lambda (expr port)
(parameterize ([current-expand (lambda (x) x)]) (fasl-write (compile-core-expr->code expr) port)))
(fasl-write (compile-expr expr) port))))
(define compile-file (define compile-file
(lambda (input-file output-file . rest) (lambda (input-file output-file . rest)
@ -5245,7 +5244,7 @@
(let f () (let f ()
(let ([x (read ip)]) (let ([x (read ip)])
(unless (eof-object? x) (unless (eof-object? x)
(fasl-write (compile-expr x) op) (fasl-write (compile-expr->code x) op)
(f)))) (f))))
(close-input-port ip) (close-input-port ip)
(close-output-port op)))) (close-output-port op))))
@ -5273,7 +5272,7 @@
(let ([code (let ([code
(if (code? x) (if (code? x)
x x
(compile-expr x))]) (compile-expr->code x))])
(let ([proc ($code->closure code)]) (let ([proc ($code->closure code)])
(proc))))) (proc)))))