Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 378 lines (336 sloc) 12.427 kb
917ef47 @jnthn Create a new frontend for Rakudo in order to build a debugger. Also stub...
authored
1 use Perl6::Grammar;
2 use Perl6::Actions;
3 use Perl6::Compiler;
4
6217bb5 @jnthn Add hook installation mechanism.
authored
5 class Perl6::DebugHooks {
6 has %!hooks;
df37410 @jnthn Provide a way to get at things in scope and say them.
authored
7 has $!suspended;
6217bb5 @jnthn Add hook installation mechanism.
authored
8
9 method set_hook($name, $callback) {
10 $*W.add_object($callback);
11 %!hooks{$name} := $callback;
12 }
13
14 method has_hook($name) {
df37410 @jnthn Provide a way to get at things in scope and say them.
authored
15 !$!suspended && nqp::existskey(%!hooks, $name)
6217bb5 @jnthn Add hook installation mechanism.
authored
16 }
17
18 method get_hook($name) {
19 %!hooks{$name}
20 }
df37410 @jnthn Provide a way to get at things in scope and say them.
authored
21
22 method suspend() {
23 $!suspended := 1
24 }
25
26 method unsuspend() {
27 $!suspended := 0
28 }
29 }
30
31 sub ps_qast() {
32 QAST::Op.new(
33 :op('callmethod'), :name('new'),
34 QAST::WVal.new( :value($*W.find_symbol(['PseudoStash'])) )
35 )
6217bb5 @jnthn Add hook installation mechanism.
authored
36 }
37
fbc95e1 @jnthn Implement stepping through regexes, with view of current match state. So...
authored
38 grammar Perl6::HookRegexGrammar is Perl6::RegexGrammar {
39 method nibbler() {
40 my $*RX_TOP_LEVEL_NIBBLER := 0;
41 unless %*RX<DEBUGGER_SEEN> {
42 %*RX<DEBUGGER_SEEN> := 1;
43 $*RX_TOP_LEVEL_NIBBLER := 1;
44 }
45 Perl6::RegexGrammar.HOW.find_method(Perl6::RegexGrammar, 'nibbler')(self)
46 }
47 }
48
49 class Perl6::HookRegexActions is Perl6::RegexActions {
50 method nibbler($/) {
51 if $*RX_TOP_LEVEL_NIBBLER && $*DEBUG_HOOKS.has_hook('regex_region') {
52 my $file := pir::find_caller_lex__Ps('$?FILES') // '<unknown>';
53 $*DEBUG_HOOKS.get_hook('regex_region')($file, $/.from, $/.to);
54 }
55 Perl6::RegexActions.nibbler($/);
56 }
57
58 method quantified_atom($/) {
59 Perl6::RegexActions.quantified_atom($/);
60 my $qa := $/.ast;
61 if $qa && $*DEBUG_HOOKS.has_hook('regex_atom') {
62 $/.'!make'(QAST::Regex.new(
63 :rxtype('concat'),
64 QAST::Regex.new(
65 :rxtype('qastnode'),
66 :subtype('declarative'),
67 QAST::Op.new(
68 :op('call'),
69 QAST::WVal.new( :value($*DEBUG_HOOKS.get_hook('regex_atom')) ),
8d54157 @jnthn Fix some pir:: signatures.
authored
70 $*W.add_string_constant(pir::find_caller_lex__Ps('$?FILES') // '<unknown>'),
fbc95e1 @jnthn Implement stepping through regexes, with view of current match state. So...
authored
71 ps_qast(),
72 $*W.add_numeric_constant('Int', $/.from),
73 $*W.add_numeric_constant('Int', $/.to)
74 )
75 ),
76 $qa
77 ));
78 }
79 }
80 }
81
9e50e69 @jnthn Add a way to hook loading of new files.
authored
82 class Perl6::HookActions is Perl6::Actions {
94fc923 @jnthn Do a little more filtering so module and package declarations don't coun...
authored
83 my %uninteresting := nqp::hash(
84 'package_declarator', 1,
85 'routine_declarator', 1,
e4f2325 @jnthn Tweak interesting expression analysis.
authored
86 'multi_declarator', 1,
6ef747f @jnthn Statement prefixes aren't too exciting to break on immediately, as the s...
authored
87 'type_declarator', 1,
4791845 @jnthn Don't step through regex declarations. Makes debugging things with gramm...
authored
88 'regex_declarator', 1,
6ef747f @jnthn Statement prefixes aren't too exciting to break on immediately, as the s...
authored
89 'statement_prefix', 1
94fc923 @jnthn Do a little more filtering so module and package declarations don't coun...
authored
90 );
91 sub interesting_expr($e) {
92 my $accept := 1;
93 for $e.hash {
94 if %uninteresting{$_.key} {
95 $accept := 0;
96 last;
97 }
d5fd0dd @jnthn Don't break on has declarations.
authored
98 if $_.key eq 'scope_declarator' && $_.value<sym> eq 'has' {
99 $accept := 0;
100 last;
101 }
e4f2325 @jnthn Tweak interesting expression analysis.
authored
102 if $_.key eq 'circumfix' && $e<circumfix><pblock> {
32a5fa9 @jnthn Not much use in stepping on type_declarator.
authored
103 $accept := 0;
104 last;
105 }
94fc923 @jnthn Do a little more filtering so module and package declarations don't coun...
authored
106 }
107 $accept
108 }
109
6217bb5 @jnthn Add hook installation mechanism.
authored
110 method statement($/) {
111 Perl6::Actions.statement($/);
872d3cd @jnthn Be smarter about what statements we hit as we single step; those in a se...
authored
112 if $*ST_DEPTH <= 1 && $<EXPR> && interesting_expr($<EXPR>) {
e6bf59e @jnthn Provide hooks for various conditional statements, and implement stepping...
authored
113 my $stmt := $/.ast;
94fc923 @jnthn Do a little more filtering so module and package declarations don't coun...
authored
114 my $pot_hash := nqp::istype($stmt, QAST::Op) &&
115 ($stmt.name eq '&infix:<,>' || $stmt.name eq '&infix:<=>>');
eee670d @jnthn Ignore Nil statements.
authored
116 my $nil := nqp::istype($stmt, QAST::Var) && $stmt.name eq 'Nil';
117 if !$pot_hash && !$nil && $*DEBUG_HOOKS.has_hook('statement_simple') {
2016ab2 @jnthn Start being a bit more fine-grained about statements; for now we just ha...
authored
118 $/.'!make'(QAST::Stmts.new(
119 QAST::Op.new(
120 :op('call'),
e6bf59e @jnthn Provide hooks for various conditional statements, and implement stepping...
authored
121 QAST::WVal.new( :value($*DEBUG_HOOKS.get_hook('statement_simple')) ),
8d54157 @jnthn Fix some pir:: signatures.
authored
122 $*W.add_string_constant(pir::find_caller_lex__Ps('$?FILES') // '<unknown>'),
df37410 @jnthn Provide a way to get at things in scope and say them.
authored
123 ps_qast(),
2016ab2 @jnthn Start being a bit more fine-grained about statements; for now we just ha...
authored
124 $*W.add_numeric_constant('Int', $/.from),
125 $*W.add_numeric_constant('Int', $/.to)
126 ),
127 $stmt
128 ));
129 }
6217bb5 @jnthn Add hook installation mechanism.
authored
130 }
131 }
e6bf59e @jnthn Provide hooks for various conditional statements, and implement stepping...
authored
132
133 method statement_control:sym<if>($/) {
134 if $*DEBUG_HOOKS.has_hook('statement_cond') {
ca70077 @jnthn Handle elsif properly.
authored
135 my $from := $<sym>.from;
136 for $<xblock> {
137 my $ast := $_.ast;
138 $ast[0] := QAST::Stmts.new(
139 QAST::Op.new(
140 :op('call'),
141 QAST::WVal.new( :value($*DEBUG_HOOKS.get_hook('statement_cond')) ),
8d54157 @jnthn Fix some pir:: signatures.
authored
142 $*W.add_string_constant(pir::find_caller_lex__Ps('$?FILES') // '<unknown>'),
ca70077 @jnthn Handle elsif properly.
authored
143 ps_qast(),
144 $*W.add_string_constant('if'),
145 $*W.add_numeric_constant('Int', $from),
146 $*W.add_numeric_constant('Int', $_<pblock>.from - 1)
147 ),
148 $ast[0]
149 );
150 $from := $_<pblock>.to + 1;
151 }
e6bf59e @jnthn Provide hooks for various conditional statements, and implement stepping...
authored
152 }
ca70077 @jnthn Handle elsif properly.
authored
153 Perl6::Actions.statement_control:sym<if>($/);
e6bf59e @jnthn Provide hooks for various conditional statements, and implement stepping...
authored
154 }
155
156 sub simple_xblock_hook($/) {
157 if $*DEBUG_HOOKS.has_hook('statement_cond') {
547335e @jnthn Better handling of loop constructs so we show the condition being evalua...
authored
158 my $stmt := $/.ast;
159 $stmt[0] := QAST::Stmts.new(
e6bf59e @jnthn Provide hooks for various conditional statements, and implement stepping...
authored
160 QAST::Op.new(
161 :op('call'),
162 QAST::WVal.new( :value($*DEBUG_HOOKS.get_hook('statement_cond')) ),
8d54157 @jnthn Fix some pir:: signatures.
authored
163 $*W.add_string_constant(pir::find_caller_lex__Ps('$?FILES') // '<unknown>'),
df37410 @jnthn Provide a way to get at things in scope and say them.
authored
164 ps_qast(),
e6bf59e @jnthn Provide hooks for various conditional statements, and implement stepping...
authored
165 $*W.add_string_constant(~$<sym>),
90c9a50 @jnthn Big re-work of rendering the current position. Gets much more accurate d...
authored
166 $*W.add_numeric_constant('Int', $<sym>.from),
167 $*W.add_numeric_constant('Int', $<xblock><pblock>.from - 1)
e6bf59e @jnthn Provide hooks for various conditional statements, and implement stepping...
authored
168 ),
547335e @jnthn Better handling of loop constructs so we show the condition being evalua...
authored
169 $stmt[0]
170 );
e6bf59e @jnthn Provide hooks for various conditional statements, and implement stepping...
authored
171 }
172 }
173
174 method statement_control:sym<unless>($/) {
175 Perl6::Actions.statement_control:sym<unless>($/);
176 simple_xblock_hook($/);
177 }
178
179 method statement_control:sym<while>($/) {
180 Perl6::Actions.statement_control:sym<while>($/);
181 simple_xblock_hook($/);
182 }
183
547335e @jnthn Better handling of loop constructs so we show the condition being evalua...
authored
184 method statement_control:sym<repeat>($/) {
185 Perl6::Actions.statement_control:sym<repeat>($/);
186 if $*DEBUG_HOOKS.has_hook('statement_cond') {
187 my $stmt := $/.ast;
188 $stmt[0] := QAST::Stmts.new(
189 QAST::Op.new(
190 :op('call'),
191 QAST::WVal.new( :value($*DEBUG_HOOKS.get_hook('statement_cond')) ),
8d54157 @jnthn Fix some pir:: signatures.
authored
192 $*W.add_string_constant(pir::find_caller_lex__Ps('$?FILES') // '<unknown>'),
547335e @jnthn Better handling of loop constructs so we show the condition being evalua...
authored
193 ps_qast(),
194 $*W.add_string_constant(~$<wu>),
195 $*W.add_numeric_constant('Int', $<wu>.from),
196 $*W.add_numeric_constant('Int', $<xblock>
197 ?? $<xblock><pblock>.from - 1
198 !! $/.to)
199 ),
200 $stmt[0]
201 );
202 }
203 }
204
9d8e698 @jnthn Handle loop construct properly.
authored
205 method statement_control:sym<loop>($/) {
206 if $*DEBUG_HOOKS.has_hook('statement_cond') {
207 for <e1 e2 e3> -> $expr {
208 if $/{$expr} -> $m {
209 $m[0].'!make'(QAST::Stmts.new(
210 QAST::Op.new(
211 :op('call'),
212 QAST::WVal.new( :value($*DEBUG_HOOKS.get_hook('statement_cond')) ),
8d54157 @jnthn Fix some pir:: signatures.
authored
213 $*W.add_string_constant(pir::find_caller_lex__Ps('$?FILES') // '<unknown>'),
9d8e698 @jnthn Handle loop construct properly.
authored
214 ps_qast(),
215 $*W.add_string_constant('loop'),
216 $*W.add_numeric_constant('Int', widen_expr_from($m[0])),
217 $*W.add_numeric_constant('Int', widen_expr_to($m[0]))
218 ),
219 $m[0].ast
220 ));
221 }
222 }
223 }
224 Perl6::Actions.statement_control:sym<loop>($/);
225 }
226
227 sub widen_expr_from($e) {
228 my $from := $e.from;
229 for @($e) {
230 if $_.from < $from {
231 $from := $_.from;
232 }
233 }
234 $from
235 }
236
237 sub widen_expr_to($e) {
238 my $to := $e.to;
239 for @($e) {
240 if $_.to > $to {
241 $to := $_.to;
242 }
243 }
244 $to
245 }
246
e6bf59e @jnthn Provide hooks for various conditional statements, and implement stepping...
authored
247 method statement_control:sym<for>($/) {
248 Perl6::Actions.statement_control:sym<for>($/);
249 simple_xblock_hook($/);
250 }
251
252 method statement_control:sym<given>($/) {
253 Perl6::Actions.statement_control:sym<given>($/);
254 simple_xblock_hook($/);
255 }
256
257 method statement_control:sym<when>($/) {
258 Perl6::Actions.statement_control:sym<when>($/);
259 simple_xblock_hook($/);
260 }
90b9a6e @jnthn Allow require to be stepped through.
authored
261
262 method statement_control:sym<require>($/) {
263 Perl6::Actions.statement_control:sym<require>($/);
264 if $*DEBUG_HOOKS.has_hook('statement_simple') {
265 $/.'!make'(QAST::Stmts.new(
266 QAST::Op.new(
267 :op('call'),
268 QAST::WVal.new( :value($*DEBUG_HOOKS.get_hook('statement_simple')) ),
8d54157 @jnthn Fix some pir:: signatures.
authored
269 $*W.add_string_constant(pir::find_caller_lex__Ps('$?FILES') // '<unknown>'),
90b9a6e @jnthn Allow require to be stepped through.
authored
270 ps_qast(),
271 $*W.add_numeric_constant('Int', $/.from),
272 $*W.add_numeric_constant('Int', $/.to)
273 ),
274 $/.ast
275 ));
276 }
277 }
6217bb5 @jnthn Add hook installation mechanism.
authored
278 }
279
70c9c91 @jnthn Allow debugging of code blocks inside of regexes by not losing the hook ...
authored
280 class Perl6::HookGrammar is Perl6::Grammar {
281 my %seen_files;
282
283 method statementlist() {
284 my $file := pir::find_caller_lex__Ps('$?FILES') // '<unknown>';
285 unless nqp::existskey(%*SEEN_FILES, $file) {
286 if $*DEBUG_HOOKS.has_hook('new_file') {
287 # First time we've seen this file; register it.
288 $*DEBUG_HOOKS.get_hook('new_file')($file, self.MATCH.orig);
289
290 # Also fiddle the %*LANG for the appropriate actions.
fbc95e1 @jnthn Implement stepping through regexes, with view of current match state. So...
authored
291 %*LANG<Regex> := Perl6::HookRegexGrammar;
292 %*LANG<Regex-actions> := Perl6::HookRegexActions;
70c9c91 @jnthn Allow debugging of code blocks inside of regexes by not losing the hook ...
authored
293 %*LANG<MAIN> := Perl6::HookGrammar;
294 %*LANG<MAIN-actions> := Perl6::HookActions;
295 }
296 %*SEEN_FILES{$file} := 1;
297 }
298 my $cur_st_depth := $*ST_DEPTH;
299 {
300 my $*ST_DEPTH := $cur_st_depth + 1;
301 Perl6::Grammar.HOW.find_method(Perl6::Grammar, 'statementlist')(self)
302 }
303 }
304
305 method comp_unit() {
306 my $*ST_DEPTH := 0;
307 my %*SEEN_FILES;
308 Perl6::Grammar.HOW.find_method(Perl6::Grammar, 'comp_unit')(self)
309 }
310
311 method blockoid() {
312 my $*ST_DEPTH := 0;
313 Perl6::Grammar.HOW.find_method(Perl6::Grammar, 'blockoid')(self)
314 }
315
316 method semilist() {
317 my $cur_st_depth := $*ST_DEPTH;
318 {
319 my $*ST_DEPTH := $cur_st_depth + 1;
320 Perl6::Grammar.HOW.find_method(Perl6::Grammar, 'semilist')(self)
321 }
322 }
323 }
324
917ef47 @jnthn Create a new frontend for Rakudo in order to build a debugger. Also stub...
authored
325 sub hll-config($config) {
326 $config<name> := 'rakudo';
327 $config<version> := '';
328 $config<release-number> := '';
329 $config<codename> := '';
330 $config<build-date> := '2012-08-05T16:57:45Z';
331 }
332
333 sub MAIN(@ARGS) {
334 # Initialize dynops.
335 pir::rakudo_dynop_setup__v();
336
337 # Bump up Parrot's recursion limit
338 pir::getinterp__P().recursion_limit(100000);
339
340 # Create and configure compiler object.
341 my $comp := Perl6::Compiler.new();
342 $comp.language('perl6');
9e50e69 @jnthn Add a way to hook loading of new files.
authored
343 $comp.parsegrammar(Perl6::HookGrammar);
344 $comp.parseactions(Perl6::HookActions);
917ef47 @jnthn Create a new frontend for Rakudo in order to build a debugger. Also stub...
authored
345 $comp.addstage('syntaxcheck', :before<past>);
346 $comp.addstage('optimize', :before<post>);
347 hll-config($comp.config);
348 my $COMPILER_CONFIG := $comp.config;
349
350 # Add extra command line options.
351 my @clo := $comp.commandline_options();
352 @clo.push('setting=s');
353 @clo.push('c');
354 @clo.push('I=s');
355 @clo.push('M=s');
356
357 # Set up module loading trace
358 my @*MODULES := [];
359
360 # Set up END block list, which we'll run at exit.
361 my @*END_PHASERS := [];
6217bb5 @jnthn Add hook installation mechanism.
authored
362
363 # Force loading of the debugger module.
364 my $pname := @ARGS.shift();
365 @ARGS.unshift('-Ilib');
366 @ARGS.unshift('-MDebugger::UI::CommandLine');
367 @ARGS.unshift($pname);
368
369 # Set up debug hooks object.
370 my $*DEBUG_HOOKS := Perl6::DebugHooks.new();
917ef47 @jnthn Create a new frontend for Rakudo in order to build a debugger. Also stub...
authored
371
372 # Enter the compiler.
373 $comp.command_line(@ARGS, :encoding('utf8'), :transcode('ascii iso-8859-1'));
374
375 # Run any END blocks before exiting.
376 for @*END_PHASERS { $_() }
377 }
Something went wrong with that request. Please try again.