1# 2# Module Parse::Yapp::Grammar 3# 4# (c) Copyright 1998-2001 Francois Desarmenien, all rights reserved. 5# (see the pod text in Parse::Yapp module for use and distribution rights) 6# 7package Parse::Yapp::Grammar; 8@ISA=qw( Parse::Yapp::Options ); 9 10require 5.004; 11 12use Carp; 13use strict; 14use Parse::Yapp::Options; 15use Parse::Yapp::Parse; 16 17############### 18# Constructor # 19############### 20sub new { 21 my($class)=shift; 22 my($values); 23 24 my($self)=$class->SUPER::new(@_); 25 26 my($parser)=new Parse::Yapp::Parse; 27 28 defined($self->Option('input')) 29 or croak "No input grammar"; 30 31 $values = $parser->Parse($self->Option('input')); 32 33 undef($parser); 34 35 $$self{GRAMMAR}=_ReduceGrammar($values); 36 37 ref($class) 38 and $class=ref($class); 39 40 bless($self, $class); 41} 42 43########### 44# Methods # 45########### 46########################## 47# Method To View Grammar # 48########################## 49sub ShowRules { 50 my($self)=shift; 51 my($rules)=$$self{GRAMMAR}{RULES}; 52 my($ruleno)=-1; 53 my($text); 54 55 for (@$rules) { 56 my($lhs,$rhs)=@$_; 57 58 $text.=++$ruleno.":\t".$lhs." -> "; 59 if(@$rhs) { 60 $text.=join(' ',map { $_ eq chr(0) ? '$end' : $_ } @$rhs); 61 } 62 else { 63 $text.="/* empty */"; 64 } 65 $text.="\n"; 66 } 67 $text; 68} 69 70########################### 71# Method To View Warnings # 72########################### 73sub Warnings { 74 my($self)=shift; 75 my($text); 76 my($grammar)=$$self{GRAMMAR}; 77 78 exists($$grammar{UUTERM}) 79 and do { 80 $text="Unused terminals:\n\n"; 81 for (@{$$grammar{UUTERM}}) { 82 $text.="\t$$_[0], declared line $$_[1]\n"; 83 } 84 $text.="\n"; 85 }; 86 exists($$grammar{UUNTERM}) 87 and do { 88 $text.="Useless non-terminals:\n\n"; 89 for (@{$$grammar{UUNTERM}}) { 90 $text.="\t$$_[0], declared line $$_[1]\n"; 91 } 92 $text.="\n"; 93 }; 94 exists($$grammar{UURULES}) 95 and do { 96 $text.="Useless rules:\n\n"; 97 for (@{$$grammar{UURULES}}) { 98 $text.="\t$$_[0] -> ".join(' ',@{$$_[1]})."\n"; 99 } 100 $text.="\n"; 101 }; 102 $text; 103} 104 105###################################### 106# Method to get summary about parser # 107###################################### 108sub Summary { 109 my($self)=shift; 110 my($text); 111 112 $text ="Number of rules : ". 113 scalar(@{$$self{GRAMMAR}{RULES}})."\n"; 114 $text.="Number of terminals : ". 115 scalar(keys(%{$$self{GRAMMAR}{TERM}}))."\n"; 116 $text.="Number of non-terminals : ". 117 scalar(keys(%{$$self{GRAMMAR}{NTERM}}))."\n"; 118 $text; 119} 120 121############################### 122# Method to Ouput rules table # 123############################### 124sub RulesTable { 125 my($self)=shift; 126 my($inputfile)=$self->Option('inputfile'); 127 my($linenums)=$self->Option('linenumbers'); 128 my($rules)=$$self{GRAMMAR}{RULES}; 129 my($ruleno); 130 my($text); 131 132 defined($inputfile) 133 or $inputfile = 'unkown'; 134 135 $text="[\n\t"; 136 137 $text.=join(",\n\t", 138 map { 139 my($lhs,$rhs,$code)=@$_[0,1,3]; 140 my($len)=scalar(@$rhs); 141 my($text); 142 143 $text.="[#Rule ".$ruleno++."\n\t\t '$lhs', $len,"; 144 if($code) { 145 $text.= "\nsub". 146 ( $linenums 147 ? qq(\n#line $$code[1] "$inputfile"\n) 148 : " "). 149 "{$$code[0]}"; 150 } 151 else { 152 $text.=' undef'; 153 } 154 $text.="\n\t]"; 155 156 $text; 157 } @$rules); 158 159 $text.="\n]"; 160 161 $text; 162} 163 164################################ 165# Methods to get HEAD and TAIL # 166################################ 167sub Head { 168 my($self)=shift; 169 my($inputfile)=$self->Option('inputfile'); 170 my($linenums)=$self->Option('linenumbers'); 171 my($text); 172 173 $$self{GRAMMAR}{HEAD}[0] 174 or return ''; 175 176 defined($inputfile) 177 or $inputfile = 'unkown'; 178 179 for (@{$$self{GRAMMAR}{HEAD}}) { 180 $linenums 181 and $text.=qq(#line $$_[1] "$inputfile"\n); 182 $text.=$$_[0]; 183 } 184 $text 185} 186 187sub Tail { 188 my($self)=shift; 189 my($inputfile)=$self->Option('inputfile'); 190 my($linenums)=$self->Option('linenumbers'); 191 my($text); 192 193 $$self{GRAMMAR}{TAIL}[0] 194 or return ''; 195 196 defined($inputfile) 197 or $inputfile = 'unkown'; 198 199 $linenums 200 and $text=qq(#line $$self{GRAMMAR}{TAIL}[1] "$inputfile"\n); 201 $text.=$$self{GRAMMAR}{TAIL}[0]; 202 203 $text 204} 205 206 207################# 208# Private Stuff # 209################# 210 211sub _UsefulRules { 212 my($rules,$nterm) = @_; 213 my($ufrules,$ufnterm); 214 my($done); 215 216 $ufrules=pack('b'.@$rules); 217 $ufnterm={}; 218 219 vec($ufrules,0,1)=1; #start rules IS always useful 220 221 RULE: 222 for (1..$#$rules) { # Ignore start rule 223 for my $sym (@{$$rules[$_][1]}) { 224 exists($$nterm{$sym}) 225 and next RULE; 226 } 227 vec($ufrules,$_,1)=1; 228 ++$$ufnterm{$$rules[$_][0]}; 229 } 230 231 do { 232 $done=1; 233 234 RULE: 235 for (grep { vec($ufrules,$_,1) == 0 } 1..$#$rules) { 236 for my $sym (@{$$rules[$_][1]}) { 237 exists($$nterm{$sym}) 238 and not exists($$ufnterm{$sym}) 239 and next RULE; 240 } 241 vec($ufrules,$_,1)=1; 242 exists($$ufnterm{$$rules[$_][0]}) 243 or do { 244 $done=0; 245 ++$$ufnterm{$$rules[$_][0]}; 246 }; 247 } 248 249 }until($done); 250 251 ($ufrules,$ufnterm) 252 253}#_UsefulRules 254 255sub _Reachable { 256 my($rules,$nterm,$term,$ufrules,$ufnterm)=@_; 257 my($reachable); 258 my(@fifo)=( 0 ); 259 260 $reachable={ '$start' => 1 }; #$start is always reachable 261 262 while(@fifo) { 263 my($ruleno)=shift(@fifo); 264 265 for my $sym (@{$$rules[$ruleno][1]}) { 266 267 exists($$term{$sym}) 268 and do { 269 ++$$reachable{$sym}; 270 next; 271 }; 272 273 ( not exists($$ufnterm{$sym}) 274 or exists($$reachable{$sym}) ) 275 and next; 276 277 ++$$reachable{$sym}; 278 push(@fifo, grep { vec($ufrules,$_,1) } @{$$nterm{$sym}}); 279 } 280 } 281 282 $reachable 283 284}#_Reachable 285 286sub _SetNullable { 287 my($rules,$term,$nullable) = @_; 288 my(@nrules); 289 my($done); 290 291 RULE: 292 for (@$rules) { 293 my($lhs,$rhs)=@$_; 294 295 exists($$nullable{$lhs}) 296 and next; 297 298 for (@$rhs) { 299 exists($$term{$_}) 300 and next RULE; 301 } 302 push(@nrules,[$lhs,$rhs]); 303 } 304 305 do { 306 $done=1; 307 308 RULE: 309 for (@nrules) { 310 my($lhs,$rhs)=@$_; 311 312 exists($$nullable{$lhs}) 313 and next; 314 315 for (@$rhs) { 316 exists($$nullable{$_}) 317 or next RULE; 318 } 319 $done=0; 320 ++$$nullable{$lhs}; 321 } 322 323 }until($done); 324} 325 326sub _ReduceGrammar { 327 my($values)=@_; 328 my($ufrules,$ufnterm,$reachable); 329 my($grammar)={ HEAD => $values->{HEAD}, 330 TAIL => $values->{TAIL}, 331 EXPECT => $values->{EXPECT} }; 332 my($rules,$nterm,$term) = @$values {'RULES', 'NTERM', 'TERM'}; 333 334 ($ufrules,$ufnterm) = _UsefulRules($rules,$nterm); 335 336 exists($$ufnterm{$values->{START}}) 337 or die "*Fatal* Start symbol $values->{START} derives nothing, at eof\n"; 338 339 $reachable = _Reachable($rules,$nterm,$term,$ufrules,$ufnterm); 340 341 $$grammar{TERM}{chr(0)}=undef; 342 for my $sym (keys %$term) { 343 ( exists($$reachable{$sym}) 344 or exists($values->{PREC}{$sym}) ) 345 and do { 346 $$grammar{TERM}{$sym} 347 = defined($$term{$sym}[0]) ? $$term{$sym} : undef; 348 next; 349 }; 350 push(@{$$grammar{UUTERM}},[ $sym, $values->{SYMS}{$sym} ]); 351 } 352 353 $$grammar{NTERM}{'$start'}=[]; 354 for my $sym (keys %$nterm) { 355 exists($$reachable{$sym}) 356 and do { 357 exists($values->{NULL}{$sym}) 358 and ++$$grammar{NULLABLE}{$sym}; 359 $$grammar{NTERM}{$sym}=[]; 360 next; 361 }; 362 push(@{$$grammar{UUNTERM}},[ $sym, $values->{SYMS}{$sym} ]); 363 } 364 365 for my $ruleno (0..$#$rules) { 366 vec($ufrules,$ruleno,1) 367 and exists($$grammar{NTERM}{$$rules[$ruleno][0]}) 368 and do { 369 push(@{$$grammar{RULES}},$$rules[$ruleno]); 370 push(@{$$grammar{NTERM}{$$rules[$ruleno][0]}},$#{$$grammar{RULES}}); 371 next; 372 }; 373 push(@{$$grammar{UURULES}},[ @{$$rules[$ruleno]}[0,1] ]); 374 } 375 376 _SetNullable(@$grammar{'RULES', 'TERM', 'NULLABLE'}); 377 378 $grammar; 379}#_ReduceGrammar 380 3811; 382