1# -*- tcl -*- 2# ### ### ### ######### ######### ######### 3 4# Perform reachability analysis on the PE grammar delivered by the 5# frontend. The grammar is in normalized form (reduced to essentials, 6# graph like node-x-references, expression trees). 7 8# This package assumes to be used from within a PAGE plugin. It uses 9# the API commands listed below. These are identical across the major 10# types of PAGE plugins, allowing this package to be used in reader, 11# transform, and writer plugins. It cannot be used in a configuration 12# plugin, and this makes no sense either. 13# 14# To ensure that our assumption is ok we require the relevant pseudo 15# package setup by the PAGE plugin management code. 16# 17# -----------------+-- 18# page_info | Reporting to the user. 19# page_warning | 20# page_error | 21# -----------------+-- 22# page_log_error | Reporting of internals. 23# page_log_warning | 24# page_log_info | 25# -----------------+-- 26 27# ### ### ### ######### ######### ######### 28## Requisites 29 30# @mdgen NODEP: page::plugin 31 32package require page::plugin ; # S.a. pseudo-package. 33package require page::util::flow ; # Dataflow walking. 34package require page::util::peg ; # General utilities. 35 36namespace eval ::page::analysis::peg::reachable { 37 namespace import ::page::util::peg::* 38} 39 40# ### ### ### ######### ######### ######### 41## API 42 43proc ::page::analysis::peg::reachable::compute {t} { 44 45 # Ignore call if already done before 46 if {[$t keyexists root page::analysis::peg::reachable]} return 47 48 # We compute the set of all nodes which are reachable from the 49 # root node of the start expression. This is a simple topdown walk 50 # where the children of all reachable nodes are mode reachable as 51 # well, and invokations of nonterminals symbols are treated as 52 # children as well. At the end of the flow all reachable non- 53 # terminal symbols and their expressions are marked, and none 54 # other. 55 56 # Initialize walking state: 2 arrays, all nodes (except root) are 57 # in or the other array, and their location tells if they are 58 # reachable or not. In the beginning no node is reachable. The 59 # goal array (reach) also serves as minder of which nodes have 60 # been seen, to cut multiple visits short. 61 62 array set unreach {} ; foreach n [$t nodes] {set unreach($n) .} 63 unset unreach(root) 64 array set reach {} 65 66 # A node is visited if it has been determined that it is indeed 67 # reachable. 68 69 page::util::flow [list [$t get root start]] flow n { 70 # Ignore nodes already reached. 71 if {[info exists reach($n)]} continue 72 73 # Reclassify node, has been reached now. 74 unset unreach($n) 75 set reach($n) . 76 77 # Schedule children for visit --> topdown flow. 78 $flow visitl [$t children $n] 79 80 # Treat n-Nodes as special, their definition as indirect 81 # child. But ignore invokations of undefined nonterminal 82 # symbols, or those already marked as reachable. 83 84 if {![$t keyexists $n op]} continue 85 if {[$t get $n op] ne "n"} continue 86 87 set def [$t get $n def] 88 if {$def eq ""} continue 89 if {[info exists reach($def)]} continue 90 $flow visit $def 91 } 92 93 # Store results. This also serves as marker. 94 95 $t set root page::analysis::peg::reachable [array names reach] 96 $t set root page::analysis::peg::unreachable [array names unreach] 97 return 98} 99 100proc ::page::analysis::peg::reachable::remove! {t} { 101 102 # Determine which nonterminal symbols are reachable from the root 103 # of the start expression. 104 105 compute $t 106 107 # Remove all nodes which are not reachable. 108 109 set unreach [$t get root page::analysis::peg::unreachable] 110 foreach n [lsort $unreach] { 111 if {[$t exists $n]} { 112 $t delete $n 113 } 114 } 115 116 # Notify the user of the definitions which were among the removed 117 # nodes. Keep only the still-existing definitions. 118 119 set res {} 120 foreach {sym def} [$t get root definitions] { 121 if {![$t exists $def]} { 122 page_warning " $sym: Unreachable nonterminal symbol, deleting" 123 } else { 124 lappend res $sym $def 125 } 126 } 127 128 # Clear computation results. 129 130 $t unset root page::analysis::peg::reachable 131 $t unset root page::analysis::peg::unreachable 132 133 $t set root definitions $res 134 updateUndefinedDueRemoval $t 135 return 136} 137 138proc ::page::analysis::peg::reachable::reset {t} { 139 # Remove marker, allow recalculation of reachability after 140 # changes. 141 142 $t unset root page::analysis::peg::reachable 143 $t unset root page::analysis::peg::unreachable 144 return 145} 146 147# ### ### ### ######### ######### ######### 148## Ready 149 150package provide page::analysis::peg::reachable 0.1 151