x2p/s2p

   1 #!/bin/perl
   2
   3 $indent = 4;
   4 $shiftwidth = 4;
   5 $l = '{'; $r = '}';
   6 $tempvar = '1';
   7
   8 while ($ARGV[0] =~ '^-') {
   9     $_ = shift;
  10   last if /^--/;
  11     if (/^-D/) {
  12         $debug++;
  13         open(body,'>-');
  14         next;
  15     }
  16     if (/^-n/) {
  17         $assumen++;
  18         next;
  19     }
  20     if (/^-p/) {
  21         $assumep++;
  22         next;
  23     }
  24     die "I don't recognize this switch: $_";
  25 }
  26
  27 unless ($debug) {
  28     open(body,">/tmp/sperl$$") || do Die("Can't open temp file.");
  29 }
  30
  31 if (!$assumen && !$assumep) {
  32     print body
  33 'while ($ARGV[0] =~ /^-/) {
  34     $_ = shift;
  35   last if /^--/;
  36     if (/^-n/) {
  37         $nflag++;
  38         next;
  39     }
  40     die "I don\'t recognize this switch: $_";
  41 }
  42
  43 ';
  44 }
  45
  46 print body '
  47 #ifdef PRINTIT
  48 #ifdef ASSUMEP
  49 $printit++;
  50 #else
  51 $printit++ unless $nflag;
  52 #endif
  53 #endif
  54 line: while (<>) {
  55 ';
  56
  57 line: while (<>) {
  58     s/[ \t]*(.*)\n$/$1/;
  59     if (/^:/) {
  60         s/^:[ \t]*//;
  61         $label = do make_label($_);
  62         if ($. == 1) {
  63             $toplabel = $label;
  64         }
  65         $_ = "$label:";
  66         if ($lastlinewaslabel++) {$_ .= "\t;";}
  67         if ($indent >= 2) {
  68             $indent -= 2;
  69             $indmod = 2;
  70         }
  71         next;
  72     } else {
  73         $lastlinewaslabel = '';
  74     }
  75     $addr1 = '';
  76     $addr2 = '';
  77     if (s/^([0-9]+)//) {
  78         $addr1 = "$1";
  79     }
  80     elsif (s/^\$//) {
  81         $addr1 = 'eof()';
  82     }
  83     elsif (s|^/||) {
  84         $addr1 = '/';
  85         delim: while (s:^([^(|)\\/]*)([(|)\\/])::) {
  86             $prefix = $1;
  87             $delim = $2;
  88             if ($delim eq '\\') {
  89                 s/(.)(.*)/$2/;
  90                 $ch = $1;
  91                 $delim = '' if index("(|)",$ch) >= 0;
  92                 $delim .= $1;
  93             }
  94             elsif ($delim ne '/') {
  95                 $delim = '\\' . $delim;
  96             }
  97             $addr1 .= $prefix;
  98             $addr1 .= $delim;
  99             if ($delim eq '/') {
 100                 last delim;
 101             }
 102         }
 103     }
 104     if (s/^,//) {
 105         if (s/^([0-9]+)//) {
 106             $addr2 = "$1";
 107         } elsif (s/^\$//) {
 108             $addr2 = "eof()";
 109         } elsif (s|^/||) {
 110             $addr2 = '/';
 111             delim: while (s:^([^(|)\\/]*)([(|)\\/])::) {
 112                 $prefix = $1;
 113                 $delim = $2;
 114                 if ($delim eq '\\') {
 115                     s/(.)(.*)/$2/;
 116                     $ch = $1;
 117                     $delim = '' if index("(|)",$ch) >= 0;
 118                     $delim .= $1;
 119                 }
 120                 elsif ($delim ne '/') {
 121                     $delim = '\\' . $delim;
 122                 }
 123                 $addr2 .= $prefix;
 124                 $addr2 .= $delim;
 125                 if ($delim eq '/') {
 126                     last delim;
 127                 }
 128             }
 129         } else {
 130             do Die("Invalid second address at line $.: $_");
 131         }
 132         $addr1 .= " .. $addr2";
 133     }
 134                                         # a { to keep vi happy
 135     if ($_ eq '}') {
 136         $indent -= 4;
 137         next;
 138     }
 139     if (s/^!//) {
 140         $if = 'unless';
 141         $else = "$r else $l\n";
 142     } else {
 143         $if = 'if';
 144         $else = '';
 145     }
 146     if (s/^{//) {       # a } to keep vi happy
 147         $indmod = 4;
 148         $redo = $_;
 149         $_ = '';
 150         $rmaybe = '';
 151     } else {
 152         $rmaybe = "\n$r";
 153         if ($addr2 || $addr1) {
 154             $space = substr('        ',0,$shiftwidth);
 155         } else {
 156             $space = '';
 157         }
 158         $_ = do transmogrify();
 159     }
 160
 161     if ($addr1) {
 162         if ($_ !~ /[\n{}]/ && $rmaybe && !$change &&
 163           $_ !~ / if / && $_ !~ / unless /) {
 164             s/;$/ $if $addr1;/;
 165             $_ = substr($_,$shiftwidth,1000);
 166         } else {
 167             $command = $_;
 168             $_ = "$if ($addr1) $l\n$change$command$rmaybe";
 169         }
 170         $change = '';
 171         next line;
 172     }
 173 } continue {
 174     @lines = split(/\n/,$_);
 175     while ($#lines >= 0) {
 176         $_ = shift(lines);
 177         unless (s/^ *<<--//) {
 178             print body substr("\t\t\t\t\t\t\t\t\t\t\t\t",0,$indent / 8),
 179                 substr('        ',0,$indent % 8);
 180         }
 181         print body $_, "\n";
 182     }
 183     $indent += $indmod;
 184     $indmod = 0;
 185     if ($redo) {
 186         $_ = $redo;
 187         $redo = '';
 188         redo line;
 189     }
 190 }
 191
 192 print body "}\n";
 193 if ($appendseen || $tseen || !$assumen) {
 194     $printit++ if $dseen || (!$assumen && !$assumep);
 195     print body '
 196 continue {
 197 #ifdef PRINTIT
 198 #ifdef DSEEN
 199 #ifdef ASSUMEP
 200     print if $printit++;
 201 #else
 202     if ($printit) { print;} else { $printit++ unless $nflag; }
 203 #endif
 204 #else
 205     print if $printit;
 206 #endif
 207 #else
 208     print;
 209 #endif
 210 #ifdef TSEEN
 211     $tflag = \'\';
 212 #endif
 213 #ifdef APPENDSEEN
 214     if ($atext) { print $atext; $atext = \'\'; }
 215 #endif
 216 }
 217 ';
 218 }
 219
 220 close body;
 221
 222 unless ($debug) {
 223     open(head,">/tmp/sperl2$$") || do Die("Can't open temp file 2.\n");
 224     print head "#define PRINTIT\n" if ($printit);
 225     print head "#define APPENDSEEN\n" if ($appendseen);
 226     print head "#define TSEEN\n" if ($tseen);
 227     print head "#define DSEEN\n" if ($dseen);
 228     print head "#define ASSUMEN\n" if ($assumen);
 229     print head "#define ASSUMEP\n" if ($assumep);
 230     if ($opens) {print head "$opens\n";}
 231     open(body,"/tmp/sperl$$") || do Die("Can't reopen temp file.");
 232     while (<body>) {
 233         print head $_;
 234     }
 235     close head;
 236
 237     print "#!/bin/perl\n\n";
 238     open(body,"cc -E /tmp/sperl2$$ |") ||
 239         do Die("Can't reopen temp file.");
 240     while (<body>) {
 241         /^# [0-9]/ && next;
 242         /^[ \t]*$/ && next;
 243         s/^<><>//;
 244         print;
 245     }
 246 }
 247
 248 `/bin/rm -f /tmp/sperl$$ /tmp/sperl2$$`;
 249
 250 sub Die {
 251     `/bin/rm -f /tmp/sperl$$ /tmp/sperl2$$`;
 252     die $_[0];
 253 }
 254 sub make_filehandle {
 255     $fname = $_ = $_[0];
 256     s/[^a-zA-Z]/_/g;
 257     s/^_*//;
 258     if (/^([a-z])([a-z]*)$/) {
 259         $first = $1;
 260         $rest = $2;
 261         $first =~ y/a-z/A-Z/;
 262         $_ = $first . $rest;
 263     }
 264     if (!$seen{$_}) {
 265         $opens .= "open($_,'>$fname') || die \"Can't create $fname.\";\n";
 266     }
 267     $seen{$_} = $_;
 268 }
 269
 270 sub make_label {
 271     $label = $_[0];
 272     $label =~ s/[^a-zA-Z0-9]/_/g;
 273     if ($label =~ /^[0-9_]/) { $label = 'L' . $label; }
 274     $label = substr($label,0,8);
 275     if ($label =~ /^([a-z])([a-z]*)$/) {
 276         $first = $1;
 277         $rest = $2;
 278         $first =~ y/a-z/A-Z/;
 279         $label = $first . $rest;
 280     }
 281     $label;
 282 }
 283
 284 sub transmogrify {
 285     {   # case
 286         if (/^d/) {
 287             $dseen++;
 288             $_ = '
 289 <<--#ifdef PRINTIT
 290 $printit = \'\';
 291 <<--#endif
 292 next line;';
 293             next;
 294         }
 295
 296         if (/^n/) {
 297             $_ =
 298 '<<--#ifdef PRINTIT
 299 <<--#ifdef DSEEN
 300 <<--#ifdef ASSUMEP
 301 print if $printit++;
 302 <<--#else
 303 if ($printit) { print;} else { $printit++ unless $nflag; }
 304 <<--#endif
 305 <<--#else
 306 print if $printit;
 307 <<--#endif
 308 <<--#else
 309 print;
 310 <<--#endif
 311 <<--#ifdef APPENDSEEN
 312 if ($atext) {print $atext; $atext = \'\';}
 313 <<--#endif
 314 $_ = <>;
 315 <<--#ifdef TSEEN
 316 $tflag = \'\';
 317 <<--#endif';
 318             next;
 319         }
 320
 321         if (/^a/) {
 322             $appendseen++;
 323             $command = $space .  '$atext .=' . "\n<<--'";
 324             $lastline = 0;
 325             while (<>) {
 326                 s/^[ \t]*//;
 327                 s/^[\\]//;
 328                 unless (s|\\$||) { $lastline = 1;}
 329                 s/'/\\'/g;
 330                 s/^([ \t]*\n)/<><>$1/;
 331                 $command .= $_;
 332                 $command .= '<<--';
 333                 last if $lastline;
 334             }
 335             $_ = $command . "';";
 336             last;
 337         }
 338
 339         if (/^[ic]/) {
 340             if (/^c/) { $change = 1; }
 341             $addr1 = '$iter = (' . $addr1 . ')';
 342             $command = $space .  'if ($iter == 1) { print' . "\n<<--'";
 343             $lastline = 0;
 344             while (<>) {
 345                 s/^[ \t]*//;
 346                 s/^[\\]//;
 347                 unless (s/\\$//) { $lastline = 1;}
 348                 s/'/\\'/g;
 349                 s/^([ \t]*\n)/<><>$1/;
 350                 $command .= $_;
 351                 $command .= '<<--';
 352                 last if $lastline;
 353             }
 354             $_ = $command . "';}";
 355             if ($change) {
 356                 $dseen++;
 357                 $change = "$_\n";
 358                 $_ = "
 359 <<--#ifdef PRINTIT
 360 $space\$printit = '';
 361 <<--#endif
 362 ${space}next line;";
 363             }
 364             last;
 365         }
 366
 367         if (/^s/) {
 368             $delim = substr($_,1,1);
 369             $len = length($_);
 370             $repl = $end = 0;
 371             for ($i = 2; $i < $len; $i++) {
 372                 $c = substr($_,$i,1);
 373                 if ($c eq '\\') {
 374                     $i++;
 375                     if ($i >= $len) {
 376                         $_ .= 'n';
 377                         $_ .= <>;
 378                         $len = length($_);
 379                         $_ = substr($_,0,--$len);
 380                     }
 381                     elsif (!$repl && index("(|)",substr($_,$i,1)) >= 0) {
 382                         $i--;
 383                         $len--;
 384                         $_ = substr($_,0,$i) . substr($_,$i+1,10000);
 385                     }
 386                 }
 387                 elsif ($c eq $delim) {
 388                     if ($repl) {
 389                         $end = $i;
 390                         last;
 391                     } else {
 392                         $repl = $i;
 393                     }
 394                 }
 395                 elsif (!$repl && index("(|)",$c) >= 0) {
 396                     $_ = substr($_,0,$i) . '\\' . substr($_,$i,10000);
 397                     $i++;
 398                     $len++;
 399                 }
 400             }
 401             print "repl $repl end $end $_\n";
 402             do Die("Malformed substitution at line $.") unless $end;
 403             $pat = substr($_, 0, $repl + 1);
 404             $repl = substr($_, $repl + 1, $end - $repl - 1);
 405             $end = substr($_, $end + 1, 1000);
 406             $dol = '$';
 407             $repl =~ s'&'$&'g;
 408             $repl =~ s/[\\]([0-9])/$dol$1/g;
 409             $subst = "$pat$repl$delim";
 410             $cmd = '';
 411             while ($end) {
 412                 if ($end =~ s/^g//) { $subst .= 'g'; next; }
 413                 if ($end =~ s/^p//) { $cmd .= ' && (print)'; next; }
 414                 if ($end =~ s/^w[ \t]*//) {
 415                     $fh = do make_filehandle($end);
 416                     $cmd .= " && (print $fh \$_)";
 417                     $end = '';
 418                     next;
 419                 }
 420                 do Die("Unrecognized substitution command ($end) at line $.");
 421             }
 422             $_ = $subst . $cmd . ';';
 423             next;
 424         }
 425
 426         if (/^p/) {
 427             $_ = 'print;';
 428             next;
 429         }
 430
 431         if (/^w/) {
 432             s/^w[ \t]*//;
 433             $fh = do make_filehandle($_);
 434             $_ = "print $fh \$_;";
 435             next;
 436         }
 437
 438         if (/^r/) {
 439             $appendseen++;
 440             s/^r[ \t]*//;
 441             $file = $_;
 442             $_ = "\$atext .= `cat $file 2>/dev/null`;";
 443             next;
 444         }
 445
 446         if (/^P/) {
 447             $_ =
 448 'if (/(^[^\n]*\n)/) {
 449     print $1;
 450 }';
 451             next;
 452         }
 453
 454         if (/^D/) {
 455             $_ =
 456 's/^[^\n]*\n//;
 457 if ($_) {redo line;}
 458 next line;';
 459             next;
 460         }
 461
 462         if (/^N/) {
 463             $_ = '
 464 $_ .= <>;
 465 <<--#ifdef TSEEN
 466 $tflag = \'\';
 467 <<--#endif';
 468             next;
 469         }
 470
 471         if (/^h/) {
 472             $_ = '$hold = $_;';
 473             next;
 474         }
 475
 476         if (/^H/) {
 477             $_ = '$hold .= $_ ? $_ : "\n";';
 478             next;
 479         }
 480
 481         if (/^g/) {
 482             $_ = '$_ = $hold;';
 483             next;
 484         }
 485
 486         if (/^G/) {
 487             $_ = '$_ .= $hold ? $hold : "\n";';
 488             next;
 489         }
 490
 491         if (/^x/) {
 492             $_ = '($_, $hold) = ($hold, $_);';
 493             next;
 494         }
 495
 496         if (/^b$/) {
 497             $_ = 'next line;';
 498             next;
 499         }
 500
 501         if (/^b/) {
 502             s/^b[ \t]*//;
 503             $lab = do make_label($_);
 504             if ($lab eq $toplabel) {
 505                 $_ = 'redo line;';
 506             } else {
 507                 $_ = "goto $lab;";
 508             }
 509             next;
 510         }
 511
 512         if (/^t$/) {
 513             $_ = 'next line if $tflag;';
 514             $tseen++;
 515             next;
 516         }
 517
 518         if (/^t/) {
 519             s/^t[ \t]*//;
 520             $lab = do make_label($_);
 521             if ($lab eq $toplabel) {
 522                 $_ = 'if ($tflag) {$tflag = \'\'; redo line;}';
 523             } else {
 524                 $_ = "if (\$tflag) {\$tflag = ''; goto $lab;}";
 525             }
 526             $tseen++;
 527             next;
 528         }
 529
 530         if (/^=/) {
 531             $_ = 'print "$.\n";';
 532             next;
 533         }
 534
 535         if (/^q/) {
 536             $_ =
 537 'close(ARGV);
 538 @ARGV = ();
 539 next line;';
 540             next;
 541         }
 542     } continue {
 543         if ($space) {
 544             s/^/$space/;
 545             s/(\n)(.)/$1$space$2/g;
 546         }
 547         last;
 548     }
 549     $_;
 550 }
 551