Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100755 161 lines (137 sloc) 5.005 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 if (defined($4)) { $debugtoggle = $4; }
66 $line = "$1(* $2 *)$5\n";
67 }
68
69 # Old ppdebug style
70 if ($line =~ /#<>/) {
71 if ($ppdebug) { $line =~ s/(#<>)/(* $1 *)/; }
72 else { $line =~ s/(#<>.*)/(* $1 *)/; }
73 return $line;
74 }
75 elsif ($line =~ /#<</) {
76 if ($ppdebug) { $line =~ s/(#<<)(.*?)(>>#\s*;?)/(* $1 *)$2(* $3 *)/g; }
77 else { $line =~ s/(#<<.*?>>#\s*;?)/(* $1 *)/g; }
78 return $line;
79 }
80
81 # New advanced ppdebug style
82 elsif ($line =~ /^(.*)(#<(Debug|Ifstatic:\s*(.*?))>)(.*)$/) {
83 my $enable;
84 my $linebeg = "$1(* $2 *)";
85 my $lineend = "$5";
86 if ($3 eq "Debug") {
87 $enable = $ppdebug;
88 } else {
89 $4 =~ /^([A-Z0-9_]+)\s+(.*?)\s*$/ || die "Bad Ifstatic syntax";
90 $enable = defined($ENV{$1}) && ($ENV{$1} =~ /^$2$/);
91 }
92 $lineend =~ s/^([^ ])/ $1/;
93 print $linebeg.($enable ? " " : "(* ");
94 $_ = "$lineend\n";
95
96 nextline until /^(.*?)(#<(Else|End)>)(.*)$/;
97 $linebeg = $1.($enable ? "" : "*)")."(* $2 *)";
98 $lineend = $4;
99 if ($3 eq "Else") {
100 $lineend =~ s/^([^ ])/ $1/;
101 print "$linebeg".($enable ? "(* " : " ");
102 $_ = "$lineend\n";
103 nextline until /^(.*)(#<End>)(.*)$/;
104 $line = $1.($enable ? "*)" : "")."(* $2 *)$3\n";
105 }
106 else {
107 $line = "$linebeg$lineend\n";
108 }
109 print $line;
110 return filterline($rec);
111 }
112 elsif ($line =~ /^(.*)(#<If(:([A-Z0-9_]+))?((\s+|\$).*?)?>)(.*)$/) {
113 my $linebeg = "$1(* $2 *)";
114 my $lineend = "$7";
115 my ($var,$toggle) = ($4, $5);
116 $lineend =~ s/^([^ ])/ $1/;
117 $var = $debugvar unless defined($var);
118 if (defined($debugvar)) {
119 if ($var eq $debugvar) { $toggle = $debugtoggle unless defined($toggle);}}
120
121 die "Error: undefined debug var in $file, line ${.}. Use either #<If:VAR> or #<Debugvar:VAR>\n"
122 unless defined($var);
123 $var = lc($var);
124
125 if (defined($toggle)) { $toggle =~ s/\$/${debugmodule}./g; }
126 else { $toggle = "${debugmodule}.default"; }
127
128 print $linebeg.($release ? "(* " : " ")."if ($toggle) ${debugmodule}.$var then begin";
129 $_ = "$lineend\n";
130
131 nextline until /^(.*?)(#<(Else|End)>)(.*)$/;
132 $linebeg = $1."(* $2 *) end else".($release ? " *)" : "")." begin";
133 $lineend = $4;
134
135 if ($3 eq "Else") {
136 print $linebeg;
137 $lineend =~ s/^([^ ])/ $1/;
138 $_ = "$lineend\n";
139 nextline until /^(.*)#<End>(.*)/;
140 $linebeg = $1;
141 $lineend = $2;
142 $lineend =~ s/^([^ ])/ $1/;
143 $line = "$linebeg(* #<End> *) end$lineend\n";
144 } else {
145 $lineend =~ s/^([^ ])/ $1/;
146 $line = "$linebeg () end$lineend\n";
147 }
148 print $line;
149 return filterline($rec);
150 }
151 elsif ($line =~ /(#<(.*?)>)/ && $2 !~ /^Debugvar:[A-Z0-9_]+(\$.*?)?$/ && (!$rec || $2 !~ /^(Else|End)$/)) {
152 die "Error: non-parsed ppdebug directive $1 in $file, line ${.}.\n";
153 }
154 else {
155 return ($line);
156 }
157 }
158
159 print "#1 \"$file\" (* -*- tuareg -*- *)\n";
160 print while (defined ($_ = filterline));
Something went wrong with that request. Please try again.