use QRegex; use NQPP6QRegex; use NQPP5QRegex; use Perl6::Actions; use Perl6::World; use Perl6::Pod; role startstops[$start, $stop1, $stop2] { token starter { $start } token stopper { $stop1 | $stop2 } } role startstop[$start, $stop] { token starter { $start } token stopper { $stop } } role stop[$stop] { token starter { } token stopper { $stop } } # This role captures things that STD factors out from any individual grammar, # but that don't make sense to go in HLL::Grammar. role STD { token opener { <[ \x0028 \x003C \x005B \x007B \x00AB \x0F3A \x0F3C \x169B \x2018 \x201A \x201B \x201C \x201E \x201F \x2039 \x2045 \x207D \x208D \x2208 \x2209 \x220A \x2215 \x223C \x2243 \x2252 \x2254 \x2264 \x2266 \x2268 \x226A \x226E \x2270 \x2272 \x2274 \x2276 \x2278 \x227A \x227C \x227E \x2280 \x2282 \x2284 \x2286 \x2288 \x228A \x228F \x2291 \x2298 \x22A2 \x22A6 \x22A8 \x22A9 \x22AB \x22B0 \x22B2 \x22B4 \x22B6 \x22C9 \x22CB \x22D0 \x22D6 \x22D8 \x22DA \x22DC \x22DE \x22E0 \x22E2 \x22E4 \x22E6 \x22E8 \x22EA \x22EC \x22F0 \x22F2 \x22F3 \x22F4 \x22F6 \x22F7 \x2308 \x230A \x2329 \x23B4 \x2768 \x276A \x276C \x276E \x2770 \x2772 \x2774 \x27C3 \x27C5 \x27D5 \x27DD \x27E2 \x27E4 \x27E6 \x27E8 \x27EA \x2983 \x2985 \x2987 \x2989 \x298B \x298D \x298F \x2991 \x2993 \x2995 \x2997 \x29C0 \x29C4 \x29CF \x29D1 \x29D4 \x29D8 \x29DA \x29F8 \x29FC \x2A2B \x2A2D \x2A34 \x2A3C \x2A64 \x2A79 \x2A7D \x2A7F \x2A81 \x2A83 \x2A8B \x2A91 \x2A93 \x2A95 \x2A97 \x2A99 \x2A9B \x2AA1 \x2AA6 \x2AA8 \x2AAA \x2AAC \x2AAF \x2AB3 \x2ABB \x2ABD \x2ABF \x2AC1 \x2AC3 \x2AC5 \x2ACD \x2ACF \x2AD1 \x2AD3 \x2AD5 \x2AEC \x2AF7 \x2AF9 \x2E02 \x2E04 \x2E09 \x2E0C \x2E1C \x2E20 \x2E28 \x3008 \x300A \x300C \x300E \x3010 \x3014 \x3016 \x3018 \x301A \x301D \xFD3E \xFE17 \xFE35 \xFE37 \xFE39 \xFE3B \xFE3D \xFE3F \xFE41 \xFE43 \xFE47 \xFE59 \xFE5B \xFE5D \xFF08 \xFF1C \xFF3B \xFF5B \xFF5F \xFF62 ]> } method balanced($start, $stop) { if nqp::istype($stop, VMArray) { self.HOW.mixin(self, startstops.HOW.curry(startstops, $start, $stop[0], $stop[1])); } else { self.HOW.mixin(self, startstop.HOW.curry(startstop, $start, $stop)); } } method unbalanced($stop) { self.HOW.mixin(self, stop.HOW.curry(stop, $stop)); } token starter { } token stopper { } my $quote-lang-lock := NQPLock.new; method quote_lang($l, $start, $stop, @base_tweaks?, @extra_tweaks?) { sub lang_key() { my $stopstr := nqp::istype($stop,VMArray) ?? nqp::join(' ',$stop) !! $stop; my @keybits := [ self.HOW.name(self), $l.HOW.name($l), $start, $stopstr ]; for @base_tweaks { @keybits.push($_); } for @extra_tweaks { if $_[0] eq 'to' { return 'NOCACHE'; } @keybits.push($_[0] ~ '=' ~ $_[1]); } nqp::join("\0", @keybits) } sub con_lang() { my $lang := $l.'!cursor_init'(self.orig(), :p(self.pos()), :shared(self.'!shared'())); $lang.clone_braid_from(self); for @base_tweaks { $lang := $lang."tweak_$_"(1); } for @extra_tweaks { my $t := $_[0]; if nqp::can($lang, "tweak_$t") { $lang := $lang."tweak_$t"($_[1]); } else { self.sorry("Unrecognized adverb: :$t"); } } for self.slangs { if nqp::istype($lang, $_.value) { $lang.set_actions(self.slang_actions($_.key)); last; } } $lang.set_pragma("STOPPER",$stop); nqp::istype($stop,VMArray) || $start ne $stop ?? $lang.balanced($start, $stop) !! $lang.unbalanced($stop); } # Get language from cache or derive it. my $key := lang_key(); my %quote_lang_cache := $*W.quote_lang_cache; nqp::lock($quote-lang-lock); my $quote_lang := nqp::existskey(%quote_lang_cache, $key) && $key ne 'NOCACHE' ?? %quote_lang_cache{$key} !! (%quote_lang_cache{$key} := con_lang()); nqp::unlock($quote-lang-lock); $quote_lang.set_package(self.package); $quote_lang; } token babble($l, @base_tweaks?) { :my @extra_tweaks; [ <.ws> { my $kv := $[-1].ast; my $k := $kv.named; if nqp::istype($kv, QAST::Stmts) || nqp::istype($kv, QAST::Stmt) && +@($kv) == 1 { $kv := $kv[0]; } my $v := nqp::istype($kv, QAST::IVal) ?? $kv.value !! $kv.has_compile_time_value ?? $kv.compile_time_value !! self.panic("Invalid adverb value for " ~ $[-1].Str); nqp::push(@extra_tweaks, [$k, $v]); } ]* $=[] { # Work out the delimiters. my $c := $/; my @delims := $c.peek_delimiters($c.target, $c.pos); my $start := @delims[0]; my $stop := @delims[1]; # Get the language. my $lang := self.quote_lang($l, $start, $stop, @base_tweaks, @extra_tweaks); $.make([$lang, $start, $stop]); } } my class Herestub { has $!delim; has $!orignode; has $!grammar; method delim() { $!delim } method orignode() { $!orignode } method grammar() { $!grammar } } role herestop { token starter { } token stopper { ^^ {} $=(\h*) $*DELIM \h* $$ [\r\n | \v]? } method parsing_heredoc() { 1 } } method heredoc () { my $actions := self.actions; my @herestub_queue := $*W.herestub_queue; if @herestub_queue { my $here := self.'!cursor_start_cur'(); $here.'!cursor_pos'(self.pos); while @herestub_queue { my $herestub := nqp::shift(@herestub_queue); my $*DELIM := $herestub.delim; my $lang := $herestub.grammar.HOW.mixin($herestub.grammar, herestop); for self.slangs { if nqp::istype($lang, $_.value) { $lang.set_actions(self.slang_actions($_.key)); last; } } my $doc := $here.nibble($lang); if $doc { # Match stopper. my $stop := $lang.'!cursor_init'(self.orig(), :p($doc.pos), :shared(self.'!shared'())).stopper(); $stop.clone_braid_from(self); unless $stop { self.panic("Ending delimiter $*DELIM not found"); } $here.'!cursor_pos'($stop.pos); # Get it trimmed and AST updated. $actions.trim_heredoc(self, $doc, $stop, $herestub.orignode.MATCH.ast); } else { self.panic("Ending delimiter $*DELIM not found"); } } $here.'!cursor_pass'($here.pos); $here.set_actions($actions); $here } else { self } } token cheat_heredoc { \h* <[ ; } ]> \h* <.ws> } method queue_heredoc($delim, $grammar) { nqp::push($*W.herestub_queue, Herestub.new(:$delim, :$grammar, :orignode(self))); return self; } method fail-terminator ($/, $start, $stop, $line?) { my $message; if $start ne nqp::chr(nqp::ord($start)) { $message := "Starter $start is immediately followed by a combining codepoint. Please use {nqp::chr(nqp::ord($start))} without a combining glyph"; if $line { $message := "$message ($start was at line $line)"; } } else { $message := "Couldn't find terminator $stop"; if $line { $message := "$message (corresponding $start was at line $line)"; } } $/.typed_panic('X::Comp::AdHoc', payload => $message, expected => [$stop] ); } # nibbler for q quoting token quibble($l, *@base_tweaks) { :my $lang; :my $start; :my $stop; { my $B := $.ast; $lang := $B[0]; $start := $B[1]; $stop := $B[2]; } $start [ $stop || { self.fail-terminator($/, $start, $stop, HLL::Compiler.lineof($.orig(), $.from(), :cache(1) )) } ] { nqp::can($lang, 'herelang') && self.queue_heredoc( $*W.nibble_to_str($/, $.ast[1], -> { "Stopper '" ~ $ ~ "' too complex for heredoc" }), $lang.herelang) } } # Note, $lang must carry its own actions by the time we call this. method nibble($lang) { $lang.'!cursor_init'(self.orig(), :p(self.pos()), :shared(self.'!shared'())).nibbler().set_braid_from(self) } token obsbrace { <.obs('curlies around escape argument','square brackets')> } method FAILGOAL($goal, $dba?) { my $stopper; unless $dba { $dba := nqp::getcodename(nqp::callercode()); # Handle special case to conceal variable name leaked by core grammar if ~$goal eq '$stopper ' { my $ch := $dba ~~ /[post]?circumfix\:sym[\<|\«]\S+\s+(\S+)[\>|\»]/; $ch := ~$ch[0]; if nqp::chars($ch) { $stopper := "'" ~ $ch ~ "'"; } } } # core grammar also has a penchant for sending us trailing .ws contents $stopper := $stopper // $goal; $stopper := $stopper ~~ /(.*\S)\s*/; $stopper := ~$stopper[0]; my @line-file := HLL::Compiler.linefileof(self.target(), self.from(), :cache, :directives); self.typed_panic('X::Comp::FailGoal', :$dba, :goal($stopper), :line-real(@line-file[0]), :filename-real(@line-file[1])); } method panic(*@args) { self.typed_panic('X::Comp::AdHoc', payload => nqp::join('', @args)) } method sorry(*@args) { self.typed_sorry('X::Comp::AdHoc', payload => nqp::join('', @args)) } method worry(*@args) { self.typed_worry('X::Comp::AdHoc', payload => nqp::join('', @args)) } method typed_panic($type_str, *%opts) { $*W.throw(self.MATCH(), nqp::split('::', $type_str), |%opts); } method typed_sorry($type_str, *%opts) { if +@*SORROWS + 1 == $*SORRY_LIMIT { $*W.throw(self.MATCH(), nqp::split('::', $type_str), |%opts); } else { @*SORROWS.push($*W.typed_exception(self.MATCH(), nqp::split('::', $type_str), |%opts)); } self } method typed_worry($type_str, *%opts) { if self.pragma('worries') { self.pragma('fatal') ?? self.typed_sorry($type_str, |%opts) !! @*WORRIES.push($*W.typed_exception( self.MATCH(), nqp::split('::', $type_str), |%opts)); } self } method security($payload) { self.typed_panic('X::SecurityPolicy::Eval', :$payload); } method malformed($what) { self.typed_panic('X::Syntax::Malformed', :$what); } method missing_block($borg, $has_mystery) { my $marked := self.MARKED('ws'); my $pos := $marked ?? $marked.from !! self.pos; if $borg { self.'!clear_highwater'(); self.'!cursor_pos'($borg.pos); self.typed_sorry('X::Syntax::BlockGobbled', what => ($borg // '')); self.'!cursor_pos'($pos); self.missing("block (apparently claimed by " ~ ($borg ?? "'" ~ $borg ~ "'" !! "expression") ~ ")"); } elsif $pos > 0 && nqp::eqat(self.orig(), '}', $pos - 1) { self.missing("block (whitespace needed before curlies taken as a hash subscript?)"); } elsif $has_mystery { self.missing("block (taken by some undeclared routine?)"); } else { self.missing("block"); } } method missing($what) { self.typed_panic('X::Syntax::Missing', :$what); } method NYI($feature) { self.typed_panic('X::Comp::NYI', :$feature) } token experimental($feature) { || <.typed_panic('X::Experimental', :$feature)> } method EXPR_nonassoc($cur, $left, $right) { self.typed_panic('X::Syntax::NonAssociative', :left(~$left), :right(~$right)); } method EXPR_nonlistassoc($cur, $left, $right) { self.typed_panic('X::Syntax::NonListAssociative', :left(~$left), :right(~$right)); } # "when" arg assumes more things will become obsolete after Raku comes out... method obs($old, $new, $when = 'in Raku', :$ism = 'p5isms') { unless $*LANG.pragma($ism) { $*W.throw(self.MATCH(), ['X', 'Obsolete'], old => $old, replacement => $new, when => $when, ); } self; } method obsvar($name, $identifier-name?) { unless $*LANG.pragma('p5isms') { $*W.throw(self.MATCH(), ['X', 'Syntax', 'Perl5Var'], :$name, :$identifier-name); } self; } method sorryobs($old, $new, $when = 'in Raku') { unless $*LANG.pragma('p5isms') { $*W.throw(self.MATCH(), ['X', 'Obsolete'], old => $old, replacement => $new, when => $when, ); } self; } method worryobs($old, $new, $when = 'in Raku') { unless $*LANG.pragma('p5isms') { self.typed_worry('X::Obsolete', old => $old, replacement => $new, when => $when, ); } self; } method dupprefix($prefixes) { self.typed_panic('X::Syntax::DuplicatedPrefix', :$prefixes); } method mark_variable_used($name) { my $lex := $*W.cur_lexpad(); my %sym := $lex.symbol($name); if %sym { %sym := 1; } else { # Add mention-only record (used to poison outer # usages and disambiguate hashes/blocks by use of # $_ when $*IMPLICIT is in force). my $au := $lex.ann('also_uses'); $lex.annotate('also_uses', $au := {}) unless $au; $au{$name} := 1; } } method check_variable($var) { my $varast := $var.ast; if nqp::istype($varast, QAST::Op) && $varast.op eq 'ifnull' { $varast := $varast[0]; } if !$*IN_DECL && nqp::istype($varast, QAST::Var) && $varast.scope eq 'lexical' { my $name := $varast.name; if $name ne '%_' && $name ne '@_' && !$*W.is_lexical($name) { my $sigil := $var || nqp::substr($name,0,1); if $sigil ne '&' { if !$*STRICT { $*W.auto_declare_var($var); } else { my @suggestions := $*W.suggest_lexicals($name); my $package := self.package; if nqp::can($package.HOW, 'get_attribute_for_usage') { my $sigil := nqp::substr($name, 0, 1); my $twigil := nqp::concat($sigil, '!'); my $basename := nqp::substr($name, 1, nqp::chars($name) - 1); my $attrname := nqp::concat($twigil, $basename); my $attribute := $package.HOW.get_attribute_for_usage($package, $attrname); nqp::push(@suggestions, $attrname); CATCH {} } $*W.throw($var, ['X', 'Undeclared'], symbol => $name, suggestions => @suggestions, precursor => '1'); } } else { $var.add_mystery($name, $var.to, 'var'); } } else { self.mark_variable_used($name); } } if !$*IN_DECL && nqp::istype($varast, QAST::Op) && $varast.name eq '&DYNAMIC' { my $lex := $*W.cur_lexpad(); if nqp::istype($varast[0], QAST::Want) && nqp::istype($varast[0][2], QAST::SVal) { my $au := $lex.ann('also_uses'); $lex.annotate('also_uses', $au := {}) unless $au; $au{$varast[0][2].value} := 1; } } self } token RESTRICTED { :my $r := $*RESTRICTED || "(not)"; [ [ $ || <.security($*RESTRICTED)> ] ]? } } grammar Perl6::Grammar is HLL::Grammar does STD { #================================================================ # AMBIENT AND POD-COMMON CODE HANDLERS #================================================================ my class SerializationContextId { my $count := 0; my $lock := NQPLock.new; method next-id() { $lock.protect({ $count++ }) } } method TOP() { # Language braid. my $*LANG := self; my $*LEAF := self; # the leaf cursor, workaround for when we can't pass via $/ into world self.define_slang('MAIN', self.WHAT, self.actions); self.define_slang('Quote', Perl6::QGrammar, Perl6::QActions); self.define_slang('Regex', Perl6::RegexGrammar, Perl6::RegexActions); self.define_slang('P5Regex', Perl6::P5RegexGrammar, Perl6::P5RegexActions); self.define_slang('Pod', Perl6::PodGrammar, Perl6::PodActions); # Old language braid, going away eventually # XXX TODO: if these are going out, be sure to make similar change # to src/perl6-debug.nqp and ensure it still works. my %*LANG; %*LANG := Perl6::RegexGrammar; %*LANG := Perl6::RegexActions; %*LANG := Perl6::P5RegexGrammar; %*LANG := Perl6::P5RegexActions; %*LANG := Perl6::QGrammar; %*LANG := Perl6::QActions; %*LANG
:= self.WHAT; %*LANG := self.actions; # We could start out TOP with a fatalizing language in self, conceivably... my $*FATAL := self.pragma('fatal'); # also set if somebody calls 'use fatal' in mainline self.set_pragma('worries', 1); # A cacheable false dynvar value. my $*WANTEDOUTERBLOCK := 0; # Package declarator to meta-package mapping. Starts pretty much empty; # we get the mappings either imported or supplied by the setting. One # issue is that we may have no setting to provide them, e.g. when we # compile the setting, but it still wants some kinda package. We just # fudge in knowhow for that. self.set_how('knowhow', nqp::knowhow()); self.set_how('package', nqp::knowhow()); # Will we use the result of this? (Yes for EVAL and REPL). my $*NEED_RESULT := nqp::existskey(%*COMPILING<%?OPTIONS>, 'outer_ctx') || nqp::existskey(%*COMPILING<%?OPTIONS>, 'need_result'); # Symbol table and serialization context builder - keeps track of # objects that cross the compile-time/run-time boundary that are # associated with this compilation unit. my $file := nqp::getlexdyn('$?FILES'); my $outer_world := nqp::getlexdyn('$*W'); my $is_nested := ( $outer_world && $outer_world.is_precompilation_mode() ); my $source_id := nqp::sha1($file ~ ( $is_nested ?? self.target() ~ SerializationContextId.next-id() !! self.target())); my $*W := $is_nested ?? $outer_world.create_nested() !! nqp::isnull($file) ?? Perl6::World.new(:handle($source_id)) !! Perl6::World.new(:handle($source_id), :description($file)); unless $is_nested { $*W.add_initializations(); } my $cursor := self.comp_unit; $*W.pop_lexpad(); # UNIT $*W.pop_lexpad(); # UNIT_OUTER $cursor; } ## Lexer stuff token apostrophe { <[ ' \- ]> } token identifier { <.ident> [ <.apostrophe> <.ident> ]* } token name { [ | * | + ] } token morename { :my $*QSIGIL := ''; '::' [ || > [ | | :dba('indirect name') '(' ~ ')' [ <.ws> ] ] || <.typed_panic: "X::Syntax::Name::Null"> || $=[<.sigil><.identifier>] { my str $b := $; self.malformed("lookup of ::$b; please use ::('$b'), ::\{'$b'\}, or ::<$b>") } ]? } token longname { {} [ > ]* } token deflongname { :dba('new name to be defined') * } token subshortname { } token sublongname { ? } token deftermnow { } token defterm { # XXX this is probably too general :dba('new term to be defined') [ | + { if $[0] -> $cf { my $category := $.Str; my $opname := $cf ?? $*W.colonpair_nibble_to_str($/, $cf) !! ''; my $canname := $category ~ $*W.canonicalize_pair('sym', $opname); my $termname := $category ~ $*W.canonicalize_pair('', $opname); $/.add_categorical($category, $opname, $canname, $termname, :defterm); } } | ] } token module_name { [ :dba('generic role') '[' ~ ']' ]? } token end_keyword { » || \h* '=>'> } token end_prefix { <.end_keyword> \s* } token spacey { } token kok { <.end_keyword> [ || > <.ws> || ] } token tok { <.end_keyword> } token ENDSTMT { [ | \h* $$ <.ws> | <.unv>? $$ <.ws> ]? } # ws is highly performance sensitive. So, we check if we already marked it # at this point with a simple method, and only if that is not the case do # we bother doing any pattern matching. method ws() { self.MARKED('ws') ?? self !! self._ws() } token _ws { :my $old_highexpect := self.'!fresh_highexpect'(); :dba('whitespace') [ | [\r\n || \v] <.heredoc> | <.unv> | <.unsp> | <.vcs-conflict> ]* :my $stub := self.'!fresh_highexpect'(); } token unsp { \\ :dba('unspace') [ | <.vws> | <.unv> | <.unsp> ]* } token vws { :dba('vertical whitespace') [ [ | \v | <.vcs-conflict> ] ]+ } token vcs-conflict { [ | '<<<<<<<' {} >>>>>>' > <.sorry: 'Found a version control conflict marker'> \V* \v | '=======' {} .*? \v '>>>>>>>' \V* \v # ignore second half ] } token unv { :dba('horizontal whitespace') [ | \h+ | \h* <.comment> | ^^ <.pod_content_toplevel> ] } token install_doc_phaser { } token vnum { \w+ | '*' } token version { ]> 'v' $=[+ % '.' '+'?] # cheat because of LTM fail } ## Top-level rules token comp_unit { # From STD.pm. :my $*LEFTSIGIL; # sigil of LHS for item vs list assignment :my $*SCOPE := ''; # which scope declarator we're under :my $*MULTINESS := ''; # which multi declarator we're under :my $*QSIGIL := ''; # sigil of current interpolation :my $*IN_META := ''; # parsing a metaoperator like [..] :my $*IN_REDUCE := 0; # attempting to parse an [op] construct :my $*IN_DECL; # what declaration we're in :my $*IN_RETURN := 0; # are we in a return? :my $*HAS_SELF := ''; # is 'self' available? (for $.foo style calls) :my $*begin_compunit := 1; # whether we're at start of a compilation unit :my $*DECLARAND; # the current thingy we're declaring, and subject of traits :my $*CODE_OBJECT; # the code object we're currently inside :my $*METHODTYPE; # the current type of method we're in, if any :my $*PKGDECL; # what type of package we're in, if any :my %*MYSTERY; # names we assume may be post-declared functions :my $*BORG := {}; # who gets blamed for a missing block :my $*CCSTATE := ''; :my $*STRICT; :my $*INVOCANT_OK := 0; :my $*INVOCANT; :my $*ARG_FLAT_OK := 0; :my $*WHENEVER_COUNT := -1; # -1 indicates whenever not valid here # Error related. There are three levels: worry (just a warning), sorry # (fatal but not immediately so) and panic (immediately deadly). There # is a limit on the number of sorrows also. Unlike STD, which emits the # textual messages as it goes, we keep track of the exception objects # and, if needed, make a composite exception group. :my @*WORRIES; # exception objects resulting from worry :my @*SORROWS; # exception objects resulting from sorry :my $*SORRY_LIMIT := 10; # when sorrow turns to panic # Extras. :my @*NQP_VIOLATIONS; # nqp::ops per line number :my %*HANDLERS; # block exception handlers :my $*IMPLICIT; # whether we allow an implicit param :my $*HAS_YOU_ARE_HERE := 0; # whether {YOU_ARE_HERE} has shown up :my $*OFTYPE; :my $*VMARGIN := 0; # pod stuff :my $*ALLOW_INLINE_CODE := 0; # pod stuff :my $*POD_IN_CODE_BLOCK := 0; # pod stuff :my $*POD_IN_FORMATTINGCODE := 0; # pod stuff :my $*POD_ALLOW_FCODES := 0b11111111111111111111111111; # allow which fcodes? :my $*POD_ANGLE_COUNT := 0; # pod stuff :my $*IN_REGEX_ASSERTION := 0; :my $*IN_PROTO := 0; # are we inside a proto? :my $*NEXT_STATEMENT_ID := 1; # to give each statement an ID :my $*IN_STMT_MOD := 0; # are we inside a statement modifier? :my $*COMPILING_CORE_SETTING := 0; # are we compiling CORE.setting? :my $*SET_DEFAULT_LANG_VER := 1; :my %*SIG_INFO; # information about recent signature :my $*CAN_LOWER_TOPIC := 1; # true if we optimize the $_ lexical away :my $*MAY_USE_RETURN := 0; # true if the current routine may use return :my $*WANT_RAKUAST := 0; # if `use experimental :rakuast` is in effect # Various interesting scopes we'd like to keep to hand. :my $*GLOBALish; :my $*PACKAGE; :my $*UNIT; :my $*UNIT_OUTER; :my $*EXPORT; # stack of packages, which the 'is export' needs :my @*PACKAGES := []; # A place for Pod :my $*POD_BLOCKS := []; :my $*POD_BLOCKS_SEEN := {}; :my $*POD_PAST; :my $*DECLARATOR_DOCS; :my $*PRECEDING_DECL; # for #= comments :my $*PRECEDING_DECL_LINE := -1; # XXX update this when I see another comment like it? :my $*keep-decl := nqp::existskey(nqp::getenvhash(), 'RAKUDO_POD_DECL_BLOCK_USER_FORMAT'); # TODO use these vars to implement S26 pod data block handling :my $*DATA-BLOCKS := []; :my %*DATA-BLOCKS := {}; # Quasis and unquotes :my $*IN_QUASI := 0; # whether we're currently in a quasi block :my $*MAIN := 'MAIN'; # performance improvement stuff :my $*FAKE_INFIX_FOUND := 0; # for runaway detection :my $*LASTQUOTE := [0,0]; { nqp::getcomp('Raku').reset_language_version(); $*W.comp_unit_stage0($/) } <.bom>? { $*W.comp_unit_stage1($/) } <.finishpad> <.install_doc_phaser> [ $ || <.typed_panic: 'X::Syntax::Confused'> ] <.explain_mystery> <.cry_sorrows> { $*W.mop_up_and_check($/) } } method clonecursor() { my $new := self.'!cursor_init'( self.orig(), :p(self.pos()), :shared(self.'!shared'()), :braid(self."!braid"()."!clone"())); $new; } rule lang-version { :my $comp := nqp::getcomp('Raku'); [ <.ws>? 'use' {} # <-- update $/ so we can grab $ # we parse out the numeral, since we could have "6d" :my $version := nqp::radix(10,$[0],0,0)[0]; [ || { $*W.load-lang-ver: $, $comp } || { $/.typed_panic: 'X::Language::Unsupported', version => ~$ } ] || { # This is the path we take when the user did not # provide any `use v6.blah` lang version statement $*W.load-lang-ver: 'v6', $comp if $*SET_DEFAULT_LANG_VER; } ] } rule statementlist($*statement_level = 0) { :my $*LANG; :my $*LEAF; :my %*LANG := self.shallow_copy(self.slangs); # XXX deprecated :my $*STRICT := nqp::getlexdyn('$*STRICT'); :dba('statement list') # <.check_LANG_oopsies('statementlist')> <.ws> # Define this scope to be a new language. [ | $ | > | [ <.eat_terminator> ]* ] <.set_braid_from(self)> # any language tweaks must not escape } method shallow_copy(%hash) { my %result; for %hash { %result{$_.key} := $_.value; } %result } rule semilist { :dba('list composer') '' [ | > | [<.eat_terminator> ]* ] } rule sequence { :dba('sequence of statements') '' [ | > | [<.eat_terminator> ]* ] } token label { ':' <.ws> { $*LABEL := ~$; if $*W.already_declared('my', self.package, $*W.cur_lexpad(), [$*LABEL]) { $*W.throw($/, ['X', 'Redeclaration'], symbol => $*LABEL); } my str $orig := self.orig(); my int $total := nqp::chars($orig); my int $from := self.MATCH.from(); my int $to := self.MATCH.to() + nqp::chars($*LABEL); my int $line := HLL::Compiler.lineof($orig, self.from(), :cache(1)); my str $prematch := nqp::substr($orig, $from > 20 ?? $from - 20 !! 0, $from > 20 ?? 20 !! $from); my str $postmatch := nqp::substr($orig, $to, 20); my $label := $*W.find_single_symbol_in_setting('Label').new( :name($*LABEL), :$line, :$prematch, :$postmatch ); $*W.add_object_if_no_sc($label); $*W.install_lexical_symbol($*W.cur_lexpad(), $*LABEL, $label); } } token statement($*LABEL = '') { :my $*QSIGIL := ''; :my $*SCOPE := ''; # NOTE: annotations that use STATEMENT_ID often also need IN_STMT_MOD annotation, in order # to correctly migrate QAST::Blocks in constructs inside topics of statement modifiers :my $*STATEMENT_ID := $*NEXT_STATEMENT_ID++; :my $*IN_STMT_MOD := nqp::getlexdyn('$*IN_STMT_MOD'); :my $*ESCAPEBLOCK := 0; :my $actions := self.slang_actions('MAIN'); | $ > [ |