diff options
| author | Andy Wingo <wingo@pobox.com> | 2014-06-30 15:30:39 +0200 |
|---|---|---|
| committer | Andy Wingo <wingo@pobox.com> | 2014-06-30 15:30:39 +0200 |
| commit | 0ad455ca6b8058a08fc88d911c3814b06275fe4e (patch) | |
| tree | a26249c59e6720db0af2aacf320c4cf490a4c66e | |
| parent | e21dae43fcd63b0e261e76d78e7eaf4aed10a190 (diff) | |
Remove size limit in elide-type-checks
* module/language/cps/dce.scm (elide-type-checks!): Remove limit on
label-count, now that complexity is under control.
| -rw-r--r-- | module/language/cps/dce.scm | 49 |
1 files changed, 24 insertions, 25 deletions
diff --git a/module/language/cps/dce.scm b/module/language/cps/dce.scm index 2f34c387b..b3dba097c 100644 --- a/module/language/cps/dce.scm +++ b/module/language/cps/dce.scm @@ -80,31 +80,30 @@ defs)) (define (elide-type-checks! fun dfg effects min-label label-count) - (when (< label-count 2000) - (match fun - (($ $cont kfun ($ $kfun src meta min-var)) - (let ((typev (infer-types fun dfg))) - (define (idx->label idx) (+ idx min-label)) - (define (var->idx var) (- var min-var)) - (define (visit-primcall lidx fx name args) - (when (primcall-types-check? typev (idx->label lidx) name args) - (vector-set! effects lidx - (logand fx (lognot &type-check))))) - (let lp ((lidx 0)) - (when (< lidx label-count) - (let ((fx (vector-ref effects lidx))) - (unless (causes-all-effects? fx) - (when (causes-effect? fx &type-check) - (match (lookup-cont (idx->label lidx) dfg) - (($ $kargs _ _ term) - (match (find-call term) - (($ $continue k src ($ $primcall name args)) - (visit-primcall lidx fx name args)) - (($ $continue k src ($ $branch _ ($primcall name args))) - (visit-primcall lidx fx name args)) - (_ #f))) - (_ #f))))) - (lp (1+ lidx))))))))) + (match fun + (($ $cont kfun ($ $kfun src meta min-var)) + (let ((typev (infer-types fun dfg))) + (define (idx->label idx) (+ idx min-label)) + (define (var->idx var) (- var min-var)) + (define (visit-primcall lidx fx name args) + (when (primcall-types-check? typev (idx->label lidx) name args) + (vector-set! effects lidx + (logand fx (lognot &type-check))))) + (let lp ((lidx 0)) + (when (< lidx label-count) + (let ((fx (vector-ref effects lidx))) + (unless (causes-all-effects? fx) + (when (causes-effect? fx &type-check) + (match (lookup-cont (idx->label lidx) dfg) + (($ $kargs _ _ term) + (match (find-call term) + (($ $continue k src ($ $primcall name args)) + (visit-primcall lidx fx name args)) + (($ $continue k src ($ $branch _ ($primcall name args))) + (visit-primcall lidx fx name args)) + (_ #f))) + (_ #f))))) + (lp (1+ lidx)))))))) (define (compute-live-code fun) (let* ((fun-data-table (make-hash-table)) |