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

Internal analyze-control-flow refactor

Browse source 
* module/language/cps/dfg.scm (reverse-post-order): Fold-all-conts is
  now a required arg.
  (analyze-control-flow): Reverse CFA adds forward-reachable
  continuations to the numbering.
This commit is contained in:
Andy Wingo 2014-01-09 10:21:17 +01:00
parent 58ef5f0712
commit 6eb0296027
1 changed files with 17 additions and 8 deletions
Download patch file Download diff file Expand all files Collapse all files

25
module/language/cps/dfg.scm
View file

@ -1,6 +1,6 @@
;;; Continuation-passing style (CPS) intermediate language (IL) ;;; Continuation-passing style (CPS) intermediate language (IL)
;; Copyright (C) 2013 Free Software Foundation, Inc. ;; Copyright (C) 2013, 2014 Free Software Foundation, Inc.
;;;; This library is free software; you can redistribute it and/or ;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public ;;;; modify it under the terms of the GNU Lesser General Public
@ -126,9 +126,8 @@
;; that is reachable from some start node. Others need to include nodes ;; that is reachable from some start node. Others need to include nodes
;; that are reachable from an end node as well, or all nodes in a ;; that are reachable from an end node as well, or all nodes in a
;; function. In that case pass an appropriate implementation of ;; function. In that case pass an appropriate implementation of
;; fold-all-conts, as compute-live-variables does. ;; fold-all-conts, as analyze-control-flow does.
(define* (reverse-post-order k0 get-successors #:optional (define (reverse-post-order k0 get-successors fold-all-conts)
(fold-all-conts (lambda (f seed) seed)))
(let ((order '()) (let ((order '())
(visited? (make-hash-table))) (visited? (make-hash-table)))
(let visit ((k k0)) (let visit ((k k0))
@ -190,7 +189,7 @@
(vector-ref (cfa-preds cfa) n)) (vector-ref (cfa-preds cfa) n))
(define* (analyze-control-flow fun dfg #:key reverse?) (define* (analyze-control-flow fun dfg #:key reverse?)
(define (build-cfa kentry block-succs block-preds) (define (build-cfa kentry block-succs block-preds fold-all-conts)
(define (block-accessor accessor) (define (block-accessor accessor)
(lambda (k) (lambda (k)
(accessor (lookup-block k (dfg-blocks dfg))))) (accessor (lookup-block k (dfg-blocks dfg)))))
@ -200,7 +199,9 @@
(lambda (k) (lambda (k)
(filter-map (cut hashq-ref mapping <>) (filter-map (cut hashq-ref mapping <>)
((block-accessor accessor) k)))) ((block-accessor accessor) k))))
(let* ((order (reverse-post-order kentry (block-accessor block-succs))) (let* ((order (reverse-post-order kentry
(block-accessor block-succs)
fold-all-conts))
(k-map (make-block-mapping order)) (k-map (make-block-mapping order))
(preds (convert-predecessors order (preds (convert-predecessors order
(reachable-preds k-map block-preds)))) (reachable-preds k-map block-preds))))
@ -211,8 +212,16 @@
(and entry (and entry
($ $kentry self ($ $cont ktail tail) clauses)))) ($ $kentry self ($ $cont ktail tail) clauses))))
(if reverse? (if reverse?
(build-cfa ktail block-preds block-succs) (build-cfa ktail block-preds block-succs
(build-cfa kentry block-succs block-preds))))) (let ((cfa (analyze-control-flow fun dfg)))
(lambda (f seed)
(let lp ((n (cfa-k-count cfa)) (seed seed))
(if (zero? n)
seed
(lp (1- n)
(f (cfa-k-sym cfa (1- n)) seed)))))))
(build-cfa kentry block-succs block-preds
(lambda (f seed) seed))))))
;; Dominator analysis. ;; Dominator analysis.
(define-record-type $dominator-analysis (define-record-type $dominator-analysis