Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100755 148 lines (125 sloc) 4.469 kb
fccc685 Initial open-source release
MLstate authored
1 #!/usr/bin/perl -w
2
3 $debugmodule = "DebugVariables";
4
5 use Getopt::Std;
6 %options=();
7 getopts("drhf:",\%options);
8
9 sub HELP_MESSAGE {
10 print STDERR <<EOF;
11
12 Preprocesses ocaml source files for debug
13
14 File syntax (quick summary):
15 #<Debug> / #<Else> / #<End>
16 Filter according to PPDEBUG mode (-d switch)
17 #<If:VAR TEST> / #<Else> / #<End>
18 Do a run-time check on environment variable VAR (applying function
19 TEST on its value if TEST is present). Disabled in release mode (-r
20 switch). If #<Else> is absent, unit is assumed.
21 If TEST is used, the character \$ can be used as the ppdebug module
22 prefix (${debugmodule}.).
23 #<Ifstatic:VAR REGEXP> / #<Else> / #<End>
24 Do a static check at compile-time on the value of environment
25 variable VAR.
26 #<Debugvar:VAR>
27 Define VAR as the default to test in following #<If> tests.
28
29 See $debugmodule for more information on the syntax.
30
31 Invocation: $0 [-d] [-r] [file]
32 -d enable debug sections
33 -r release mode: comment out dynamic environment checks
34 file file to parse, by default stdin
35
36 The output is put to stdout
37 EOF
38 exit 0;
39 }
40
41 local $SIG{__WARN__} = sub { die $_[0] }; # Exit on anything suspicious
42
43 $file = $ARGV[0];
44 $file = defined($file) ? $file : "/dev/stdin";
45 $ppdebug = $options{d} ? 1 : ($ENV{'MLSTATE_PPDEBUG'});
46 $release = $options{r};
47
48 open F,$file or die "Couldn't open $file";
49
50 sub filterline {
51 my $rec = shift;
52 $line = <F>;
53 return $line unless defined($line);
54
55 sub nextline {
56 print;
57 $_ = filterline(1);
58 die "ppdebug parse error (unclosed block ?) in $file, line ${.}.\n" unless defined($line);
59 return $line = $_;
60 }
61
62 # Default debug variable definition
63 if ($line =~ /^(.*)(#<Debugvar:([A-Z0-9_]+)>)(.*)$/) {
64 $debugvar = $3;
65 $line = "$1/* $2 */$4\n";
66 }
67
68 # Old ppdebug style
69 if ($line =~ /#<>/) {
70 if ($ppdebug) { $line =~ s%(#<>)%/* $1 */%; }
71 else { $line =~ s%(#<>.*)%/* $1 */%; }
72 return $line;
73 }
74 elsif ($line =~ /#<</) {
75 if ($ppdebug) { $line =~ s%(#<<)(.*?)(>>#\s*;?)%/* $1 */$2/* $3 */%g; }
76 else { $line =~ s%(#<<.*?>>#\s*;?)%/* $1 */%g; }
77 return $line;
78 }
79
80 # New advanced ppdebug style
81 elsif ($line =~ /^(.*)(#<(Debug|Ifstatic:\s*(.*?))>)(.*)$/) {
82 my $enable;
83 my $linebeg = "$1/* $2 */";
84 my $lineend = "$5";
85 if ($3 eq "Debug") {
86 $enable = $ppdebug;
87 } else {
88 $4 =~ /^([A-Z0-9_]+)\s+(.*?)\s*$/ || die "Bad Ifstatic syntax";
89 $enable = defined($ENV{$1}) && ($ENV{$1} =~ /^$2$/);
90 }
91 print $linebeg.($enable ? " " : "/* ");
92 $_ = "$lineend\n";
93
94 nextline until /^(.*?)(#<(Else|End)>)(.*)$/;
95 $linebeg = $1.($enable ? "" : "*/")."/* $2 */";
96 $lineend = $4;
97 if ($3 eq "Else") {
98 print "$linebeg".($enable ? "/* " : " ");
99 $_ = "$lineend\n";
100 nextline until /^(.*)(#<End>)(.*)$/;
101 $line = $1.($enable ? "*/" : "")."/* $2 */$3\n";
102 }
103 else {
104 $line = "$linebeg$lineend\n";
105 }
106 print $line;
107 return filterline($rec);
108 }
109 elsif ($line =~ /^(.*)(#<If(:([A-Z0-9_]+))?((\s+|\$).*?)?>)(.*)$/) {
110 my $linebeg = "$1/* $2 */";
111 my $lineend = "$7";
112 my ($var,$toggle) = ($4, $5);
113 $var = $debugvar unless defined($var);
114 $var = lc($var);
115 die "Error: undefined debug var in $file, line ${.}. Use either #<If:VAR> or #<Debugvar:VAR>\n"
116 unless defined($var);
117
118 if (defined($toggle)) { $toggle =~ s%\$%${debugmodule}.%g; }
119 else { $toggle = "${debugmodule}.default"; }
120
121 print $linebeg.($release ? "/* " : " ")."if ($toggle)(${debugmodule}.$var) then ( ";
122 $_ = "$lineend\n";
123
124 nextline until /^(.*?)(#<(Else|End)>)(.*)$/;
125 $linebeg = $1."/* $2 */ ) else".($release ? " */" : "")." ( ";
126 $lineend = $4;
127
128 if ($3 eq "Else") {
129 print $linebeg;
130 $_ = "$lineend\n";
131 nextline until /^(.*)(#<End>)(.*)/;
132 $line = "$1/* $2 */ ) $3\n";
133 } else {
134 $line = "$linebeg () ) $lineend\n";
135 }
136 print $line;
137 return filterline($rec);
138 }
139 elsif ($line =~ /(#<(.*?)>)/ && $2 !~ /^Debugvar:[A-Z0-9_]+$/ && (!$rec || $2 !~ /^(Else|End)$/)) {
140 die "Error: non-parsed ppdebug directive $1 in $file, line ${.}.\n";
141 }
142 else {
143 return ($line);
144 }
145 }
146
147 print while (defined ($_ = filterline));
Something went wrong with that request. Please try again.