mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-13 23:20:32 +02:00
Code Activity

Limit impact of O(n^2) type analysis by imposing limit

Browse source 
* module/language/cps/types.scm (infer-types): Add #:max-label-count
  argument.

* module/language/cps/type-fold.scm (compute-folded, fold-constants*):
  Disable for big functions.  Perhaps we can relax this if we find an
  O(n log n) way to represent types.
This commit is contained in:
Andy Wingo 2014-05-14 21:42:09 +02:00
parent a77e3a7c8a
commit a7ee377dbe
2 changed files with 14 additions and 9 deletions
Download patch file Download diff file Expand all files Collapse all files

14
module/language/cps/type-fold.scm
View file

@ -134,9 +134,11 @@
((eqv? type &nil) #nil) ((eqv? type &nil) #nil)
((eqv? type &null) '()) ((eqv? type &null) '())
(else (error "unhandled type" type val)))) (else (error "unhandled type" type val))))
(let* ((typev (infer-types fun dfg)) (let* ((typev (infer-types fun dfg #:max-label-count 3000))
(folded? (make-bitvector (/ (vector-length typev) 2) #f)) (folded? (and typev
(folded-values (make-vector (bitvector-length folded?) #f))) (make-bitvector (/ (vector-length typev) 2) #f)))
(folded-values (and typev
(make-vector (bitvector-length folded?) #f))))
(define (label->idx label) (- label min-label)) (define (label->idx label) (- label min-label))
(define (var->idx var) (- var min-var)) (define (var->idx var) (- var min-var))
(define (maybe-fold-value! label name k def) (define (maybe-fold-value! label name k def)
@ -201,9 +203,10 @@
(var->idx arg0) (var->idx arg1))))) (var->idx arg0) (var->idx arg1)))))
(_ #f))) (_ #f)))
(_ #f))) (_ #f)))
(when typev
(match fun (match fun
(($ $cont kfun ($ $kfun src meta self tail clause)) (($ $cont kfun ($ $kfun src meta self tail clause))
(visit-cont clause))) (visit-cont clause))))
(values folded? folded-values))) (values folded? folded-values)))
(define (fold-constants* fun dfg) (define (fold-constants* fun dfg)
@ -232,7 +235,8 @@
(($ $continue k src (and fun ($ $fun))) (($ $continue k src (and fun ($ $fun)))
($continue k src ,(visit-fun fun))) ($continue k src ,(visit-fun fun)))
(($ $continue k src (and primcall ($ $primcall))) (($ $continue k src (and primcall ($ $primcall)))
,(if (bitvector-ref folded? (label->idx label)) ,(if (and folded?
(bitvector-ref folded? (label->idx label)))
(let ((val (vector-ref folded-values (label->idx label)))) (let ((val (vector-ref folded-values (label->idx label))))
;; Uncomment for debugging. ;; Uncomment for debugging.
;; (pk 'folded src primcall val) ;; (pk 'folded src primcall val)

5
module/language/cps/types.scm
View file

@ -1381,7 +1381,7 @@ mapping symbols to types."
;; All done! Return the computed types. ;; All done! Return the computed types.
(else typev))))) (else typev)))))
(define (infer-types fun dfg) (define* (infer-types fun dfg #:key (max-label-count +inf.0))
;; Fun must be renumbered. ;; Fun must be renumbered.
(match fun (match fun
(($ $cont min-label ($ $kfun _ _ min-var)) (($ $cont min-label ($ $kfun _ _ min-var))
@ -1412,7 +1412,8 @@ mapping symbols to types."
(values label-count var-count))))) (values label-count var-count)))))
fun 0 0)) fun 0 0))
(lambda (label-count var-count) (lambda (label-count var-count)
(infer-types* dfg min-label label-count min-var var-count)))))) (and (< label-count max-label-count)
(infer-types* dfg min-label label-count min-var var-count)))))))
(define (lookup-pre-type typev label def) (define (lookup-pre-type typev label def)
(if (< def 0) (if (< def 0)