before adding make-once thunks
This commit is contained in:
parent
6c30b75e57
commit
6b2e48efb7
BIN
lib/ikarus.boot
BIN
lib/ikarus.boot
Binary file not shown.
|
@ -1102,7 +1102,8 @@
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
;(define thunk-count 0)
|
||||||
|
;(define total-count 0)
|
||||||
(define (convert-closures prog)
|
(define (convert-closures prog)
|
||||||
(define who 'convert-closures)
|
(define who 'convert-closures)
|
||||||
(define (Expr* x*)
|
(define (Expr* x*)
|
||||||
|
@ -1136,6 +1137,10 @@
|
||||||
cls*)
|
cls*)
|
||||||
(union (difference body-free fml*)
|
(union (difference body-free fml*)
|
||||||
cls*-free)))])]))])
|
cls*-free)))])]))])
|
||||||
|
;(set! total-count (fxadd1 total-count))
|
||||||
|
;(when (null? free)
|
||||||
|
; (set! thunk-count (fxadd1 thunk-count))
|
||||||
|
; (printf "EMPTY CLOSURE ~s/~s\n" thunk-count total-count))
|
||||||
(values (make-closure (make-clambda-code (gensym) cls* free) free)
|
(values (make-closure (make-clambda-code (gensym) cls* free) free)
|
||||||
free))]))
|
free))]))
|
||||||
(define (Expr ex)
|
(define (Expr ex)
|
||||||
|
@ -3623,7 +3628,9 @@
|
||||||
(handle-cases (car cases) (cdr cases)))]))
|
(handle-cases (car cases) (cdr cases)))]))
|
||||||
(record-case x
|
(record-case x
|
||||||
[(codes list body)
|
[(codes list body)
|
||||||
(cons (cons 0 (Tail body '()))
|
(cons (list* 0
|
||||||
|
(label (gensym))
|
||||||
|
(Tail body '()))
|
||||||
(map CodeExpr list))]))
|
(map CodeExpr list))]))
|
||||||
|
|
||||||
|
|
||||||
|
@ -3872,15 +3879,15 @@
|
||||||
[p (insert-stack-overflow-checks p)]
|
[p (insert-stack-overflow-checks p)]
|
||||||
[p (insert-allocation-checks p)]
|
[p (insert-allocation-checks p)]
|
||||||
[p (remove-local-variables p)]
|
[p (remove-local-variables p)]
|
||||||
[p (optimize-ap-check p)]
|
[p (optimize-ap-check p)])
|
||||||
[ls* (generate-code p)]
|
(let ([ls* (generate-code p)])
|
||||||
[f (when (assembler-output)
|
(when (assembler-output)
|
||||||
(for-each
|
(for-each
|
||||||
(lambda (ls)
|
(lambda (ls)
|
||||||
(for-each (lambda (x) (printf " ~s\n" x)) ls))
|
(for-each (lambda (x) (printf " ~s\n" x)) ls))
|
||||||
ls*))]
|
ls*))
|
||||||
[code* (list*->code* ls*)])
|
(let ([code* (list*->code* ls*)])
|
||||||
(car code*)))
|
(car code*)))))
|
||||||
|
|
||||||
(define compile-file
|
(define compile-file
|
||||||
(lambda (input-file output-file . rest)
|
(lambda (input-file output-file . rest)
|
||||||
|
|
Loading…
Reference in New Issue