File: fix-elif-until.pl

package info (click to toggle)
clisp 1:2.41-1
  • links: PTS
  • area: main
  • in suites: etch, etch-m68k
  • size: 49,804 kB
  • ctags: 16,291
  • sloc: lisp: 75,912; ansic: 49,247; xml: 24,289; asm: 21,993; sh: 11,234; fortran: 6,692; cpp: 2,660; objc: 2,481; makefile: 2,355; perl: 164; sed: 55
file content (36 lines) | stat: -rw-r--r-- 692 bytes parent folder | download | duplicates (7)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
#!/usr/bin/perl -w

use strict;

$/ = undef;

my $text = <>;
$text =~ s/^\s*\#\s*define\s+(until|elif|loop)\b.*$//gm;
$text =~ s/(\s+)elif\b/$1else if/g;
$text =~ s/\bloop\b/while (1)/g;
$text =~ s/^(\#\s*)else if/$1elif/gm;

OUTER:
while ($text =~ m/until\s*/g) {
  my $pos    = pos $text;
  my $end    = length $text;
  my $parens = 0;

  for (my $i = $pos; $i < $end; $i++) {
    my $c = substr($text, $i, 1);
    if ($c eq '(') { $parens++; }
    if ($c eq ')') { $parens--; }
    if ($parens == 0) {
      substr($text, $i, 0, ")");
      substr($text, $pos, 0, "(!");
      $text =~ s/until(\s*)/while$1/;
      pos $text = $i + 3;
      next OUTER;
    }
  }
}

print $text;

__END__