# This file automatically generated by /friends/.rakubrew/versions/moar-main/tools/build/gen-cat.nqp #line 1 src/rakudo-debug.nqp use Perl6::Grammar; use Perl6::Actions; use Perl6::Compiler; use Perl6::SysConfig; class Perl6::DebugHooks { has %!hooks; has $!suspended; method set_hook($name, $callback) { $*W.add_object($callback); %!hooks{$name} := $callback; } method has_hook($name) { !$!suspended && nqp::existskey(%!hooks, $name) } method get_hook($name) { %!hooks{$name} } method suspend() { $!suspended := 1 } method unsuspend() { $!suspended := 0 } } sub ps_qast() { QAST::Op.new( :op('callmethod'), :name('new'), QAST::WVal.new( :value($*W.find_single_symbol('PseudoStash')) ) ) } grammar Perl6::HookRegexGrammar is Perl6::RegexGrammar { method nibbler() { my $*RX_TOP_LEVEL_NIBBLER := 0; unless %*RX { %*RX := 1; $*RX_TOP_LEVEL_NIBBLER := 1; } Perl6::RegexGrammar.HOW.find_method(Perl6::RegexGrammar, 'nibbler')(self) } } class Perl6::HookRegexActions is Perl6::RegexActions { method nibbler($/) { if $*RX_TOP_LEVEL_NIBBLER && $*DEBUG_HOOKS.has_hook('regex_region') { my $file := nqp::getlexcaller('$?FILES') // $*ANON_CODE_NAME; $*DEBUG_HOOKS.get_hook('regex_region')($file, $/.from, $/.to); } Perl6::RegexActions.nibbler($/); } method quantified_atom($/) { Perl6::RegexActions.quantified_atom($/); my $qa := $/.ast; if $qa && !(~$/ ~~ /^\s*$/) && $*DEBUG_HOOKS.has_hook('regex_atom') { $/.make(QAST::Regex.new( :rxtype('concat'), QAST::Regex.new( :rxtype('qastnode'), :subtype('declarative'), QAST::Stmts.new( QAST::Op.new( :op('p6store'), QAST::Var.new( :name('$/'), :scope ), QAST::Op.new( QAST::Var.new( :name('$¢'), :scope ), :name('MATCH'), :op('callmethod') ) ), QAST::Op.new( :op('call'), QAST::WVal.new( :value($*DEBUG_HOOKS.get_hook('regex_atom')) ), $*W.add_string_constant(nqp::getlexcaller('$?FILES') // $*ANON_CODE_NAME), ps_qast(), $*W.add_numeric_constant($/, 'Int', $/.from), $*W.add_numeric_constant($/, 'Int', $/.to) ) ) ), $qa )); } } } grammar QRegex::P5Regex::HookGrammar is Perl6::P5RegexGrammar { method nibbler() { my $*RX_TOP_LEVEL_NIBBLER := 0; unless %*RX { %*RX := 1; $*RX_TOP_LEVEL_NIBBLER := 1; } QRegex::P5Regex::Grammar.HOW.find_method(QRegex::P5Regex::Grammar, 'nibbler')(self) } } class QRegex::P5Regex::HookActions is Perl6::P5RegexActions { method nibbler($/) { if $*RX_TOP_LEVEL_NIBBLER && $*DEBUG_HOOKS.has_hook('regex_region') { my $file := nqp::getlexcaller('$?FILES') // $*ANON_CODE_NAME; $*DEBUG_HOOKS.get_hook('regex_region')($file, $/.from, $/.to); } QRegex::P5Regex::Actions.nibbler($/); } method quantified_atom($/) { QRegex::P5Regex::Actions.quantified_atom($/); my $qa := $/.ast; if $qa && !(~$/ ~~ /^\s*$/) && $*DEBUG_HOOKS.has_hook('regex_atom') { $/.make(QAST::Regex.new( :rxtype('concat'), QAST::Regex.new( :rxtype('qastnode'), :subtype('declarative'), QAST::Op.new( :op('call'), QAST::WVal.new( :value($*DEBUG_HOOKS.get_hook('regex_atom')) ), $*W.add_string_constant(nqp::getlexcaller('$?FILES') // $*ANON_CODE_NAME), ps_qast(), $*W.add_numeric_constant($/, 'Int', $/.from), $*W.add_numeric_constant($/, 'Int', $/.to) ) ), $qa )); } } } class Perl6::HookActions is Perl6::Actions { my %uninteresting := nqp::hash( 'package_declarator', 1, 'routine_declarator', 1, 'multi_declarator', 1, 'type_declarator', 1, 'regex_declarator', 1, 'statement_prefix', 1 ); sub interesting_expr($e) { my $accept := 1; for $e.hash { my $key := $_.key; my $value := $_.value; if %uninteresting{$key} { $accept := 0; last; } if $key eq 'scope_declarator' && $value eq 'has' { $accept := 0; last; } if $key eq 'scope_declarator' && ($value eq 'my' || $value eq 'our') { if $value -> $decl { # Skip plain, boring declarations with no assignment. if $decl && !$decl { $accept := 0; last; } } } if $key eq 'circumfix' && $e { $accept := 0; last; } } $accept } method statement($/) { Perl6::Actions.statement($/); if $*ST_DEPTH <= 1 && $ && interesting_expr($) { my $stmt := $/.ast; my $pot_hash := nqp::istype($stmt, QAST::Op) && ($stmt.name eq '&infix:<,>' || $stmt.name eq '&infix:«=>»'); my $nil := nqp::istype($stmt, QAST::Var) && $stmt.name eq 'Nil'; if !$pot_hash && !$nil && $*DEBUG_HOOKS.has_hook('statement_simple') { $/.make(QAST::Stmts.new( QAST::Op.new( :op('call'), QAST::WVal.new( :value($*DEBUG_HOOKS.get_hook('statement_simple')) ), $*W.add_string_constant(nqp::getlexcaller('$?FILES') // $*ANON_CODE_NAME), ps_qast(), $*W.add_numeric_constant($/, 'Int', $/.from), $*W.add_numeric_constant($/, 'Int', $/.to) ), $stmt )); } } } method statement_control:sym($/) { if $*DEBUG_HOOKS.has_hook('statement_cond') { my $from := $[0].from; for $ { my $ast := $_.ast; $ast[0] := QAST::Stmts.new( QAST::Op.new( :op('call'), QAST::WVal.new( :value($*DEBUG_HOOKS.get_hook('statement_cond')) ), $*W.add_string_constant(nqp::getlexcaller('$?FILES') // $*ANON_CODE_NAME), ps_qast(), $*W.add_string_constant('if'), $*W.add_numeric_constant($/, 'Int', $from), $*W.add_numeric_constant($/, 'Int', $_.from - 1) ), $ast[0] ); $from := $_.to + 1; } } Perl6::Actions.statement_control:sym($/); } sub simple_xblock_hook($/) { if $*DEBUG_HOOKS.has_hook('statement_cond') { my $stmt := $/.ast; $stmt[0] := QAST::Stmts.new( QAST::Op.new( :op('call'), QAST::WVal.new( :value($*DEBUG_HOOKS.get_hook('statement_cond')) ), $*W.add_string_constant(nqp::getlexcaller('$?FILES') // $*ANON_CODE_NAME), ps_qast(), $*W.add_string_constant(~$), $*W.add_numeric_constant($/, 'Int', $.from), $*W.add_numeric_constant($/, 'Int', $.from - 1) ), $stmt[0] ); } } method statement_control:sym($/) { Perl6::Actions.statement_control:sym($/); simple_xblock_hook($/); } method statement_control:sym($/) { Perl6::Actions.statement_control:sym($/); simple_xblock_hook($/); } method statement_control:sym($/) { Perl6::Actions.statement_control:sym($/); if $*DEBUG_HOOKS.has_hook('statement_cond') { my $stmt := $/.ast; $stmt[0] := QAST::Stmts.new( QAST::Op.new( :op('call'), QAST::WVal.new( :value($*DEBUG_HOOKS.get_hook('statement_cond')) ), $*W.add_string_constant(nqp::getlexcaller('$?FILES') // $*ANON_CODE_NAME), ps_qast(), $*W.add_string_constant(~$), $*W.add_numeric_constant($/, 'Int', $.from), $*W.add_numeric_constant($/, 'Int', $ ?? $.from - 1 !! $/.to) ), $stmt[0] ); } } method statement_control:sym($/) { if $*DEBUG_HOOKS.has_hook('statement_cond') { for -> $expr { if $/{$expr} -> $m { $m[0].make(QAST::Stmts.new( QAST::Op.new( :op('call'), QAST::WVal.new( :value($*DEBUG_HOOKS.get_hook('statement_cond')) ), $*W.add_string_constant(nqp::getlexcaller('$?FILES') // $*ANON_CODE_NAME), ps_qast(), $*W.add_string_constant('loop'), $*W.add_numeric_constant($/, 'Int', widen_expr_from($m[0])), $*W.add_numeric_constant($/, 'Int', widen_expr_to($m[0])) ), $m[0].ast )); } } } Perl6::Actions.statement_control:sym($/); } sub widen_expr_from($e) { my $from := $e.from; for @($e) { if $_.from < $from { $from := $_.from; } } $from } sub widen_expr_to($e) { my $to := $e.to; for @($e) { if $_.to > $to { $to := $_.to; } } $to } method statement_control:sym($/) { Perl6::Actions.statement_control:sym($/); simple_xblock_hook($/); } method statement_control:sym($/) { Perl6::Actions.statement_control:sym($/); simple_xblock_hook($/); } method statement_control:sym($/) { Perl6::Actions.statement_control:sym($/); simple_xblock_hook($/); } method statement_control:sym($/) { Perl6::Actions.statement_control:sym($/); if $*DEBUG_HOOKS.has_hook('statement_simple') { $/.make(QAST::Stmts.new( QAST::Op.new( :op('call'), QAST::WVal.new( :value($*DEBUG_HOOKS.get_hook('statement_simple')) ), $*W.add_string_constant(nqp::getlexcaller('$?FILES') // $*ANON_CODE_NAME), ps_qast(), $*W.add_numeric_constant($/, 'Int', $/.from), $*W.add_numeric_constant($/, 'Int', $/.to) ), $/.ast )); } } sub routine_hook($/, $body, $type, $name) { if $*DEBUG_HOOKS.has_hook('routine_region') { my $file := nqp::getlexcaller('$?FILES') // $*ANON_CODE_NAME; $*DEBUG_HOOKS.get_hook('routine_region')($file, $/.from, $/.to, $type, $name); } } method routine_declarator:sym($/) { Perl6::Actions.routine_declarator:sym($/); routine_hook($/, $, 'sub', $ ?? ~$[0] !! ''); } method routine_declarator:sym($/) { Perl6::Actions.routine_declarator:sym($/); routine_hook($/, $, 'method', $ ?? ~$ !! ''); } method routine_declarator:sym($/) { Perl6::Actions.routine_declarator:sym($/); routine_hook($/, $, 'submethod', $ ?? ~$ !! ''); } method routine_declarator:sym($/) { #Perl6::Actions.routine_declarator:sym($/); routine_hook($/, $, 'macro', $ ?? ~$[0] !! ''); } } class Perl6::HookGrammar is Perl6::Grammar { my %seen_files; method statementlist($*statement_level = 0) { my $file := nqp::getlexcaller('$?FILES') // $*ANON_CODE_NAME; unless nqp::existskey(%*SEEN_FILES, $file) { if $*DEBUG_HOOKS.has_hook('new_file') { # First time we've seen this file; register it. $*DEBUG_HOOKS.get_hook('new_file')($file, self.MATCH.orig); } %*SEEN_FILES{$file} := 1; } my $cur_st_depth := $*ST_DEPTH; { my $*ST_DEPTH := $cur_st_depth + 1; Perl6::Grammar.HOW.find_method(Perl6::Grammar, 'statementlist')(self, $*statement_level) } } method comp_unit() { my $*ST_DEPTH := 0; my %*SEEN_FILES; # Fiddle the %*LANG for the appropriate actions. %*LANG := Perl6::HookRegexGrammar; %*LANG := Perl6::HookRegexActions; %*LANG := QRegex::P5Regex::HookGrammar; %*LANG := QRegex::P5Regex::HookActions; %*LANG
:= Perl6::HookGrammar; %*LANG := Perl6::HookActions; Perl6::Grammar.HOW.find_method(Perl6::Grammar, 'comp_unit')(self) } method blockoid() { my $*ST_DEPTH := 0; Perl6::Grammar.HOW.find_method(Perl6::Grammar, 'blockoid')(self) } method semilist() { my $cur_st_depth := $*ST_DEPTH; { my $*ST_DEPTH := $cur_st_depth + 1; Perl6::Grammar.HOW.find_method(Perl6::Grammar, 'semilist')(self) } } method comment:sym<#>() { my $c := Perl6::Grammar.HOW.find_method(Perl6::Grammar, 'comment:sym<#>')(self); if $c { my $comment := $c.MATCH.Str; if $comment ~~ /'#?BREAK'/ { if $*DEBUG_HOOKS.has_hook('new_breakpoint') { my $file := nqp::getlexcaller('$?FILES') // $*ANON_CODE_NAME; $*DEBUG_HOOKS.get_hook('new_breakpoint')($file, $c.MATCH().from()); } } } $c } } class Perl6::Debugger is Perl6::Compiler { my $repl_code := 1; method eval(*@pos, *%named) { my $*ANON_CODE_NAME := ""; if $*DEBUG_HOOKS.has_hook('reset') { $*DEBUG_HOOKS.get_hook('reset')(); } nqp::findmethod(Perl6::Compiler, 'eval')(self, |@pos, |%named) } } sub MAIN(*@ARGS) { # XXX Parrot compat hack. if nqp::islist(@ARGS[0]) { @ARGS := @ARGS[0]; } # Initialize dynops. nqp::p6init(); my %rakudo-build-config := nqp::hash(); hll-config(%rakudo-build-config); nqp::bindhllsym('default', 'SysConfig', Perl6::SysConfig.new(%rakudo-build-config)); # Create and configure compiler object. my $comp := Perl6::Debugger.new(); $comp.language('Raku'); $comp.parsegrammar(Perl6::HookGrammar); $comp.parseactions(Perl6::HookActions); $comp.addstage('syntaxcheck', :before); $comp.addstage('optimize', :after); # Add extra command line options. my @clo := $comp.commandline_options(); @clo.push('setting=s'); @clo.push('c'); @clo.push('I=s'); @clo.push('M=s'); # Set up module loading trace my @*MODULES := []; # Set up END block list, which we'll run at exit. nqp::bindhllsym('Raku', '@END_PHASERS', []); # Force loading of the debugger module. my $debugger; my $i := 1; while @ARGS[$i] ~~ /^\-/ { if @ARGS[$i] ~~ /^\-D/ { $debugger := "-M" ~ nqp::substr(@ARGS[$i], 2); nqp::splice(@ARGS, [], $i, 1); last; } $i++; } if !(nqp::defined($debugger)) { $debugger := '-MDebugger::UI::CommandLine'; } my $pname := @ARGS.shift(); @ARGS.unshift('-Ilib'); @ARGS.unshift($debugger); @ARGS.unshift($pname); # Set up debug hooks object. my $*DEBUG_HOOKS := Perl6::DebugHooks.new(); # Enter the compiler. $comp.command_line(@ARGS, :encoding('utf8')); # Run any END blocks before exiting. for nqp::gethllsym('Raku', '@END_PHASERS') { my $result := $_(); nqp::isfalse(nqp::isnull($result)) && nqp::can($result, 'sink') && $result.sink; } } #line 1 gen/moar/main-version.nqp sub hll-config($config) { ############################################################################################## # Included from /friends/.rakubrew/versions/moar-main/tools/templates/main-version-common.in # ############################################################################################## ### Language $config := 'Rakudo'; $config := '2023.10-100-g37fbee11d'; $config := ''; $config := ''; $config := 2; # Though language-revisions key provides more information # can-language-versions is used for speeding up and ordering # Perl6::Compiler.can_langauge_versions method $config := nqp::list('1', '2', '2.PREVIEW', '2.TEST', '2.TESTDEPR', '3', '3.PREVIEW', ); $config := nqp::hash( 1, nqp::hash( 'mods', nqp::hash( ), ), # revision 1 2, nqp::hash( 'mods', nqp::hash( 'PREVIEW', nqp::hash( ), # modificator PREVIEW 'TEST', nqp::hash( ), # modificator TEST 'TESTDEPR', nqp::hash( 'deprecate', 1, ), # modificator TESTDEPR ), ), # revision 2 3, nqp::hash( 'require', 'PREVIEW', 'mods', nqp::hash( 'PREVIEW', nqp::hash( 'require', 1, ), # modificator PREVIEW ), ), # revision 3 ); # This mapping is for quick-transforming of core setting name $config := nqp::hash( 'NULL.c', 'NULL.c', 'CORE.c', 'CORE.c', 'NULL.d', 'CORE.c', 'CORE.d', 'CORE.d', 'NULL.e', 'CORE.d', 'CORE.e', 'CORE.e', ); ### Location $config := '/friends/.rakubrew/versions/moar-main/install'; $config := '/friends/.rakubrew/versions/moar-main/install/share/perl6'; $config := '185f1ddba3bd3405b752874f2063524bd2434639'; ############################################################################################################# # End of section included from /friends/.rakubrew/versions/moar-main/tools/templates/main-version-common.in # ############################################################################################################# $config := '/friends/.rakubrew/versions/moar-main/install/share/nqp'; } # vim: set ft=perl6 nomodifiable :