Permalink
Cannot retrieve contributors at this time
Name already in use
A tag already exists with the provided branch name. Many Git commands accept both tag and branch names, so creating this branch may cause unexpected behavior. Are you sure you want to create this branch?
std/STD_P5.pm6
Go to fileThis commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
2738 lines (2204 sloc)
67.1 KB
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| # STD_P5.pm | |
| # | |
| # Copyright 2009-2010, Larry Wall | |
| # | |
| # You may copy this software under the terms of the Artistic License, | |
| # version 2.0 or later. | |
| grammar STD5 is STD; | |
| use DEBUG; | |
| method TOP ($STOP?) { | |
| if defined $STOP { | |
| my $*GOAL ::= $STOP; | |
| self.unitstop($STOP).comp_unit; | |
| } | |
| else { | |
| self.comp_unit; | |
| } | |
| } | |
| ############## | |
| # Precedence # | |
| ############## | |
| # The internal precedence levels are *not* part of the public interface. | |
| # The current values are mere implementation; they may change at any time. | |
| # Users should specify precedence only in relation to existing levels. | |
| constant %term = (:dba('term') , :prec<z=>); | |
| constant %methodcall = (:dba('methodcall') , :prec<y=>, :assoc<unary>, :uassoc<left>, :fiddly); | |
| constant %autoincrement = (:dba('autoincrement') , :prec<x=>, :assoc<unary>, :uassoc<non>); | |
| constant %exponentiation = (:dba('exponentiation') , :prec<w=>, :assoc<right>); | |
| constant %symbolic_unary = (:dba('symbolic unary') , :prec<v=>, :assoc<unary>, :uassoc<left>); | |
| constant %binding = (:dba('binding') , :prec<u=>, :assoc<non>); | |
| constant %multiplicative = (:dba('multiplicative') , :prec<t=>, :assoc<left>); | |
| constant %additive = (:dba('additive') , :prec<s=>, :assoc<left>); | |
| constant %shift = (:dba('shift') , :prec<r=>, :assoc<left>); | |
| constant %named_unary = (:dba('named unary') , :prec<q=>, :assoc<unary>, :uassoc<left>); | |
| constant %comparison = (:dba('comparison') , :prec<p=>, :assoc<non>, :diffy); | |
| constant %equality = (:dba('equality') , :prec<o=>, :assoc<chain>, :diffy, :iffy); | |
| constant %bitwise_and = (:dba('bitwise and') , :prec<n=>, :assoc<left>); | |
| constant %bitwise_or = (:dba('bitwise or') , :prec<m=>, :assoc<left>); | |
| constant %tight_and = (:dba('tight and') , :prec<l=>, :assoc<left>); | |
| constant %tight_or = (:dba('tight or') , :prec<k=>, :assoc<left>); | |
| constant %range = (:dba('range') , :prec<j=>, :assoc<right>, :fiddly); | |
| constant %conditional = (:dba('conditional') , :prec<i=>, :assoc<right>, :fiddly); | |
| constant %assignment = (:dba('assignment') , :prec<h=>, :assoc<right>); | |
| constant %comma = (:dba('comma operator') , :prec<g=>, :assoc<left>, :nextterm<nulltermish>, :fiddly); | |
| constant %listop = (:dba('list operator') , :prec<f=>, :assoc<unary>, :uassoc<left>); | |
| constant %loose_not = (:dba('not operator') , :prec<e=>, :assoc<unary>, :uassoc<left>); | |
| constant %loose_and = (:dba('loose and') , :prec<d=>, :assoc<left>); | |
| constant %loose_or = (:dba('loose or') , :prec<c=>, :assoc<left>); | |
| constant %LOOSEST = (:dba('LOOSEST') , :prec<a=!>); | |
| constant %terminator = (:dba('terminator') , :prec<a=>, :assoc<list>); | |
| # "epsilon" tighter than terminator | |
| #constant $LOOSEST = %LOOSEST<prec>; | |
| constant $LOOSEST = "a=!"; # XXX preceding line is busted | |
| ############## | |
| # Categories # | |
| ############## | |
| # Categories are designed to be easily extensible in derived grammars | |
| # by merely adding more rules in the same category. The rules within | |
| # a given category start with the category name followed by a differentiating | |
| # adverbial qualifier to serve (along with the category) as the longer name. | |
| # The endsym context, if specified, says what to implicitly check for in each | |
| # rule right after the initial <sym>. Normally this is used to make sure | |
| # there's appropriate whitespace. # Note that endsym isn't called if <sym> | |
| # isn't called. | |
| my $*endsym = "null"; | |
| proto token category {*} | |
| token category:category { <sym> } | |
| token category:p5sigil { <sym> } | |
| proto token p5sigil {*} | |
| token category:p5special_variable { <sym> } | |
| proto token p5special_variable {*} | |
| token category:p5comment { <sym> } | |
| proto token p5comment {*} | |
| token category:p5module_name { <sym> } | |
| proto token p5module_name {*} | |
| token category:p5value { <sym> } | |
| proto token p5value {*} | |
| token category:p5term { <sym> } | |
| proto token p5term {*} | |
| token category:p5number { <sym> } | |
| proto token p5number {*} | |
| token category:p5quote { <sym> } | |
| proto token p5quote () {*} | |
| token category:p5prefix { <sym> } | |
| proto token p5prefix is unary is defequiv(%symbolic_unary) {*} | |
| token category:p5infix { <sym> } | |
| proto token p5infix is binary is defequiv(%additive) {*} | |
| token category:p5postfix { <sym> } | |
| proto token p5postfix is unary is defequiv(%autoincrement) {*} | |
| token category:p5dotty { <sym> } | |
| proto token p5dotty (:$*endsym = 'unspacey') {*} | |
| token category:p5circumfix { <sym> } | |
| proto token p5circumfix {*} | |
| token category:p5postcircumfix { <sym> } | |
| proto token p5postcircumfix is unary {*} # unary as far as EXPR knows... | |
| token category:p5type_declarator { <sym> } | |
| proto token p5type_declarator (:$*endsym = 'spacey') {*} | |
| token category:p5scope_declarator { <sym> } | |
| proto token p5scope_declarator (:$*endsym = 'nofun') {*} | |
| token category:p5package_declarator { <sym> } | |
| proto token p5package_declarator (:$*endsym = 'spacey') {*} | |
| token category:p5routine_declarator { <sym> } | |
| proto token p5routine_declarator (:$*endsym = 'nofun') {*} | |
| token category:p5regex_declarator { <sym> } | |
| proto token p5regex_declarator (:$*endsym = 'spacey') {*} | |
| token category:p5statement_prefix { <sym> } | |
| proto rule p5statement_prefix () {*} | |
| token category:p5statement_control { <sym> } | |
| proto rule p5statement_control (:$*endsym = 'spacey') {*} | |
| token category:p5statement_mod_cond { <sym> } | |
| proto rule p5statement_mod_cond (:$*endsym = 'nofun') {*} | |
| token category:p5statement_mod_loop { <sym> } | |
| proto rule p5statement_mod_loop (:$*endsym = 'nofun') {*} | |
| token category:p5terminator { <sym> } | |
| proto token p5terminator {*} | |
| token unspacey { <.unsp>? } | |
| token endid { <?before <-[ \- \' \w ]> > } | |
| token spacey { <?before <[ \s \# ]> > } | |
| token nofun { <!before '(' | '->(' | '\\' | '\'' | '-' | "'" | \w > } | |
| ################## | |
| # Lexer routines # | |
| ################## | |
| token ws { | |
| :temp @*STUB = return self if @*MEMOS[self.pos]<ws> :exists; | |
| :my $startpos = self.pos; | |
| :dba('whitespace') | |
| [ | |
| | \h+ <![\#\s\\]> { @*MEMOS[$¢.pos]<ws> = $startpos; } # common case | |
| | <?before \w> <?after \w> ::: | |
| { @*MEMOS[$startpos]<ws> :delete; } | |
| <.panic: "Whitespace is required between alphanumeric tokens"> # must \s+ between words | |
| ] | |
| || | |
| [ | |
| | <.unsp> | |
| | <.vws> <.heredoc> | |
| | <.unv> | |
| | $ { $¢.moreinput } | |
| ]* | |
| {{ | |
| if ($¢.pos == $startpos) { | |
| @*MEMOS[$¢.pos]<ws> :delete; | |
| } | |
| else { | |
| @*MEMOS[$¢.pos]<ws> = $startpos; | |
| @*MEMOS[$¢.pos]<endstmt> = @*MEMOS[$startpos]<endstmt> | |
| if @*MEMOS[$startpos]<endstmt> :exists; | |
| } | |
| }} | |
| } | |
| token unsp { | |
| <!> | |
| } | |
| token vws { | |
| :dba('vertical whitespace') | |
| \v | |
| [ '#DEBUG -1' { say "DEBUG"; $STD::DEBUG = $*DEBUG = -1; } ]? | |
| } | |
| # We provide two mechanisms here: | |
| # 1) define $*moreinput, or | |
| # 2) override moreinput method | |
| method moreinput () { | |
| $*moreinput.() if $*moreinput; | |
| } | |
| token unv { | |
| :dba('horizontal whitespace') | |
| [ | |
| | \h+ | |
| | <?before \h* '=' [ \w | '\\'] > ^^ <.pod_comment> | |
| | \h* <comment=p5comment> | |
| ] | |
| } | |
| token p5comment:sym<#> { | |
| '#' {} \N* | |
| } | |
| token ident { | |
| <.alpha> \w* | |
| } | |
| token identifier { | |
| <.alpha> \w* | |
| } | |
| # XXX We need to parse the pod eventually to support $= variables. | |
| token pod_comment { | |
| ^^ \h* '=' <.unsp>? | |
| [ | |
| | 'begin' \h+ <identifier> :: | |
| [ | |
| || .*? "\n" \h* '=' <.unsp>? 'end' \h+ $<identifier> » \N* | |
| || <?{ $<identifier>.Str eq 'END'}> .* | |
| || { my $id = $<identifier>.Str; self.panic("=begin $id without matching =end $id"); } | |
| ] | |
| | 'begin' » :: \h* [ $$ || '#' || <.panic: "Unrecognized token after =begin"> ] | |
| [ .*? "\n" \h* '=' <.unsp>? 'end' » \N* || { self.panic("=begin without matching =end"); } ] | |
| | 'for' » :: \h* [ <identifier> || $$ || '#' || <.panic: "Unrecognized token after =for"> ] | |
| [.*? ^^ \h* $$ || .*] | |
| | :: .*? ^^ '=cut' » \N* | |
| ] | |
| } | |
| ################### | |
| # Top-level rules # | |
| ################### | |
| # Note: we only check for the stopper. We don't check for ^ because | |
| # we might be embedded in something else. | |
| rule comp_unit { | |
| :my $*begin_compunit = 1; | |
| :my %*LANG; | |
| :my $*PKGDECL ::= ""; | |
| :my $*IN_DECL; | |
| :my $*DECLARAND; | |
| :my $*NEWPKG; | |
| :my $*NEWLEX; | |
| :my $*QSIGIL ::= ''; | |
| :my $*IN_META = 0; | |
| :my $*QUASIMODO; | |
| :my $*SCOPE = ""; | |
| :my $*LEFTSIGIL; | |
| :my %*MYSTERY = (); | |
| :my $*INVOCANT_OK; | |
| :my $*INVOCANT_IS; | |
| :my $*CURLEX; | |
| :my $*MULTINESS = ''; | |
| :my $*CURPKG; | |
| {{ | |
| %*LANG<MAIN> = ::STD5 ; | |
| %*LANG<Q> = ::STD5::Q ; | |
| %*LANG<Regex> = ::STD5::Regex ; | |
| %*LANG<Trans> = ::STD5::Trans ; | |
| @*WORRIES = (); | |
| self.load_setting($*SETTINGNAME); | |
| my $oid = $*SETTING.id; | |
| my $id = 'MY:file<' ~ $*FILE<name> ~ '>'; | |
| $*CURLEX = Stash.new( | |
| 'OUTER::' => [$oid], | |
| '!file' => $*FILE, '!line' => 0, | |
| '!id' => [$id], | |
| ); | |
| $STD::ALL.{$id} = $*CURLEX; | |
| $*UNIT = $*CURLEX; | |
| $STD::ALL.<UNIT> = $*UNIT; | |
| self.finishlex; | |
| }} | |
| <statementlist> | |
| [ <?unitstopper> || <.panic: "Confused"> ] | |
| # "CHECK" time... | |
| {{ | |
| if @*WORRIES { | |
| warn "Potential difficulties:\n " ~ join( "\n ", @*WORRIES) ~ "\n"; | |
| } | |
| my $m = $¢.explain_mystery(); | |
| warn $m if $m; | |
| }} | |
| } | |
| method explain_mystery() { | |
| my %post_types; | |
| my %unk_types; | |
| my %unk_routines; | |
| my $m = ''; | |
| for keys(%*MYSTERY) { | |
| my $p = %*MYSTERY{$_}.<lex>; | |
| if self.is_name($_, $p) { | |
| # types may not be post-declared | |
| %post_types{$_} = %*MYSTERY{$_}; | |
| next; | |
| } | |
| next if self.is_known($_, $p) or self.is_known('&' ~ $_, $p); | |
| # just a guess, but good enough to improve error reporting | |
| if $_ lt 'a' { | |
| %unk_types{$_} = %*MYSTERY{$_}; | |
| } | |
| else { | |
| %unk_routines{$_} = %*MYSTERY{$_}; | |
| } | |
| } | |
| if %post_types { | |
| my @tmp = sort keys(%post_types); | |
| $m ~= "Illegally post-declared type" ~ ('s' x (@tmp != 1)) ~ ":\n"; | |
| for @tmp { | |
| $m ~= "\t$_ used at line " ~ %post_types{$_}.<line> ~ "\n"; | |
| } | |
| } | |
| if %unk_types { | |
| my @tmp = sort keys(%unk_types); | |
| $m ~= "Undeclared name" ~ ('s' x (@tmp != 1)) ~ ":\n"; | |
| for @tmp { | |
| $m ~= "\t$_ used at line " ~ %unk_types{$_}.<line> ~ "\n"; | |
| } | |
| } | |
| if %unk_routines { | |
| my @tmp = sort keys(%unk_routines); | |
| $m ~= "Undeclared routine" ~ ('s' x (@tmp != 1)) ~ ":\n"; | |
| for @tmp { | |
| $m ~= "\t$_ used at line " ~ %unk_routines{$_}.<line> ~ "\n"; | |
| } | |
| } | |
| $m; | |
| } | |
| # Look for an expression followed by a required lambda. | |
| token xblock { | |
| :my $*GOAL ::= '{'; | |
| :dba('block expression') '(' ~ ')' <EXPR> | |
| <.ws> | |
| <sblock> | |
| } | |
| token sblock { | |
| :temp $*CURLEX; | |
| :dba('statement block') | |
| [ <?before '{' > || <.panic: "Missing block"> ] | |
| <.newlex> | |
| <blockoid> | |
| { @*MEMOS[$¢.pos]<endstmt> = 2; } | |
| <.ws> | |
| } | |
| token block { | |
| :temp $*CURLEX; | |
| :dba('scoped block') | |
| [ <?before '{' > || <.panic: "Missing block"> ] | |
| <.newlex> | |
| <blockoid> | |
| <.ws> | |
| } | |
| token blockoid { | |
| # encapsulate braided languages | |
| :temp %*LANG; | |
| <.finishlex> | |
| [ | |
| | :dba('block') '{' ~ '}' <statementlist> | |
| | <?terminator> <.panic: 'Missing block'> | |
| | <?> <.panic: "Malformed block"> | |
| ] | |
| } | |
| # statement semantics | |
| rule statementlist { | |
| :my $*INVOCANT_OK = 0; | |
| :dba('statement list') | |
| '' | |
| [ | |
| | $ | |
| | <?before <[\)\]\}]> > | |
| | [<statement><eat_terminator> ]* | |
| ] | |
| } | |
| # embedded semis, context-dependent semantics | |
| rule semilist { | |
| :my $*INVOCANT_OK = 0; | |
| :dba('semicolon list') | |
| '' | |
| [ | |
| | <?before <[\)\]\}]> > | |
| | [<statement><eat_terminator> ]* | |
| ] | |
| } | |
| token label { | |
| :my $label; | |
| <identifier> ':' <?before \s> <.ws> | |
| [ <?{ $¢.is_name($label = $<identifier>.Str) }> | |
| <.sorry("Illegal redeclaration of '$label'")> | |
| ]? | |
| # add label as a pseudo type | |
| {{ $¢.add_my_name($label); }} | |
| } | |
| token statement { | |
| :my $*QSIGIL ::= 0; | |
| <!before <[\)\]\}]> > | |
| # this could either be a statement that follows a declaration | |
| # or a statement that is within the block of a code declaration | |
| <!!{ $¢ = %*LANG<MAIN>.bless($¢); }> | |
| [ | |
| | <label> <statement> | |
| | <statement_control=p5statement_control> | |
| | <EXPR> | |
| :dba('statement end') | |
| <.ws> | |
| :dba('statement modifier') | |
| [ | |
| | <statement_mod_loop=p5statement_mod_loop> | |
| | <statement_mod_cond=p5statement_mod_cond> | |
| ]? | |
| | <?before ';'> | |
| ] | |
| } | |
| token eat_terminator { | |
| [ | |
| || ';' [ <?before $> { $*ORIG ~~ s/\;$/ /; } ]? | |
| || <?{ @*MEMOS[$¢.pos]<endstmt> }> <.ws> | |
| || <?terminator> | |
| || $ | |
| || {{ if @*MEMOS[$¢.pos]<ws> { $¢.pos = @*MEMOS[$¢.pos]<ws>; } }} # undo any line transition | |
| <.panic: "Confused"> | |
| ] | |
| } | |
| ##################### | |
| # statement control # | |
| ##################### | |
| rule p5statement_control:use { | |
| :my $longname; | |
| :my $*SCOPE = 'use'; | |
| <sym> | |
| [ | |
| || <version=p5versionish> [ | |
| || <?{ substr($<version>[0].Str,0,2) eq 'v5' }> | |
| || <?{ substr($<version>[0].Str,0,2) eq 'v6' }> [ | |
| :my %*LANG; | |
| { | |
| %*LANG<MAIN> = ::STD::P6 ; | |
| %*LANG<Regex> = ::STD::Regex ; | |
| %*LANG<Q> = ::STD::Q ; | |
| %*LANG<Trans> = ::STD::Trans ; | |
| $¢ = %*LANG<MAIN>.bless($¢); | |
| } | |
| <.ws> ';' | |
| [ <statementlist> || <.panic: "Bad P6 code"> ] | |
| ] | |
| ] | |
| || <module_name=p5module_name> | |
| { | |
| $longname = $<module_name><longname>; | |
| } | |
| <version=p5versionish>? | |
| [ | |
| <arglist>? | |
| # { | |
| # $¢.do_use($longname, $<arglist>); | |
| # } | |
| # || { | |
| # $¢.do_use($longname, ''); | |
| # } | |
| ] | |
| ] | |
| } | |
| rule p5statement_control:no { | |
| <sym> | |
| <module_name=p5module_name>[<.spacey><arglist>]? | |
| } | |
| rule p5statement_control:if { | |
| $<sym>=['if'|'unless'] | |
| <xblock> | |
| [ | |
| [ <!before 'else'\s*'if'> || <.panic: "Please use 'elsif'"> ] | |
| 'elsif'<?spacey> <elsif=xblock> | |
| ]* | |
| [ | |
| 'else'<?spacey> <else=sblock> | |
| ]? | |
| } | |
| rule p5statement_control:while { | |
| <sym> <xblock> | |
| } | |
| rule p5statement_control:until { | |
| <sym> <xblock> | |
| } | |
| rule p5statement_control:for { | |
| ['for'|'foreach'] | |
| [ | |
| || '(' | |
| <e1=EXPR>? ';' | |
| <e2=EXPR>? ';' | |
| <e3=EXPR>? | |
| ')' | |
| || ['my'? <variable_declarator>]? '(' ~ ')' <EXPR> | |
| || <.panic: "Malformed loop spec"> | |
| ] | |
| <sblock> | |
| } | |
| rule p5statement_control:given { | |
| <sym> <xblock> | |
| } | |
| rule p5statement_control:when { | |
| <sym> <xblock> | |
| } | |
| rule p5statement_control:default {<sym> <sblock> } | |
| rule p5statement_prefix:BEGIN {<sym> <sblock> } | |
| rule p5statement_prefix:CHECK {<sym> <sblock> } | |
| rule p5statement_prefix:INIT {<sym> <sblock> } | |
| rule p5statement_control:END {<sym> <sblock> } | |
| ####################### | |
| # statement modifiers # | |
| ####################### | |
| rule modifier_expr { <EXPR> } | |
| rule p5statement_mod_cond:if {<sym> <modifier_expr> } | |
| rule p5statement_mod_cond:unless {<sym> <modifier_expr> } | |
| rule p5statement_mod_cond:when {<sym> <modifier_expr> } | |
| rule p5statement_mod_loop:while {<sym> <modifier_expr> } | |
| rule p5statement_mod_loop:until {<sym> <modifier_expr> } | |
| rule p5statement_mod_loop:for {<sym> <modifier_expr> } | |
| rule p5statement_mod_loop:given {<sym> <modifier_expr> } | |
| ################ | |
| # module names # | |
| ################ | |
| token def_module_name { | |
| <longname> | |
| } | |
| token p5module_name:normal { | |
| <longname> | |
| [ <?before '['> :dba('generic role') '[' ~ ']' <arglist> ]? | |
| } | |
| token vnum { | |
| \d+ | |
| } | |
| token p5versionish { | |
| | <p5version> | |
| | <?before \d+'.'\d+> <vnum> +% '.' | |
| } | |
| token p5version { | |
| | 'v' <?before \d+ > :: <vnum> +% '.' | |
| | <?before \d+'.'\d+'.'\d+> <vnum> +% '.' | |
| } | |
| ############### | |
| # Declarators # | |
| ############### | |
| token variable_declarator { | |
| :my $*IN_DECL = 1; | |
| :my $*DECLARAND; | |
| <variable> | |
| { $*IN_DECL = 0; $¢.add_variable($<variable>.Str) } | |
| <.ws> | |
| <trait>* | |
| } | |
| rule scoped($*SCOPE) { | |
| :dba('scoped declarator') | |
| [ | |
| | <declarator> | |
| | <regex_declarator=p5regex_declarator> | |
| | <package_declarator=p5package_declarator> | |
| ] | |
| || <?before <[A..Z]>><longname>{{ | |
| my $t = $<longname>.Str; | |
| if not $¢.is_known($t) { | |
| $¢.sorry("In \"$*SCOPE\" declaration, typename $t must be predeclared (or marked as declarative with :: prefix)"); | |
| } | |
| }} | |
| <!> # drop through | |
| || <.panic: "Malformed $*SCOPE"> | |
| } | |
| rule p5scope_declarator:my { <sym> <scoped('my')> } | |
| rule p5scope_declarator:our { <sym> <scoped('our')> } | |
| rule p5scope_declarator:state { <sym> <scoped('state')> } | |
| rule p5package_declarator:package { | |
| :my $*PKGDECL ::= 'package'; | |
| <sym> <package_def> | |
| } | |
| rule p5package_declarator:require { # here because of declarational aspects | |
| <sym> | |
| [ | |
| || <version=p5versionish> | |
| || <module_name=p5module_name> <EXPR>? | |
| || <EXPR> | |
| ] | |
| } | |
| rule package_def { | |
| :my $longname; | |
| :my $*IN_DECL = 'package'; | |
| :my $*HAS_SELF = ''; | |
| :my $*DECLARAND; | |
| :my $*NEWPKG; | |
| :my $*NEWLEX; | |
| :my $outer = $*CURLEX; | |
| :temp $*CURPKG; | |
| :temp $*CURLEX; | |
| { $*SCOPE ||= 'our'; } | |
| '' # XXX | |
| [ | |
| [ <longname> { $longname = $<longname>[0]; $¢.add_name($longname<name>.Str); } ]? | |
| <.newlex> | |
| <trait>* | |
| <.getdecl> | |
| [ | |
| || <?before '{'> | |
| [ | |
| { | |
| # figure out the actual full package name (nested in outer package) | |
| if $longname and $*NEWPKG { | |
| my $shortname = $longname.<name>.Str; | |
| if $*SCOPE eq 'our' { | |
| $*CURPKG = $*NEWPKG // $*CURPKG.{$shortname ~ '::'}; | |
| self.deb("added our " ~ $*CURPKG.id) if $*DEBUG +& DEBUG::symtab; | |
| } | |
| else { | |
| $*CURPKG = $*NEWPKG // $*CURPKG.{$shortname ~ '::'}; | |
| self.deb("added my " ~ $*CURPKG.id) if $*DEBUG +& DEBUG::symtab; | |
| } | |
| } | |
| $*begin_compunit = 0; | |
| $*UNIT<$?LONGNAME> ||= $longname ?? $longname<name>.Str !! ''; | |
| } | |
| { $*IN_DECL = ''; } | |
| <blockoid> | |
| <.checkyada> | |
| ] | |
| || <?before ';'> | |
| { | |
| $longname orelse $¢.panic("Compilation unit cannot be anonymous"); | |
| my $shortname = $longname.<name>.Str; | |
| $*CURPKG = $*NEWPKG // $*CURPKG.{$shortname ~ '::'}; | |
| $*begin_compunit = 0; | |
| # XXX throws away any role sig above | |
| $*CURLEX = $outer; | |
| $*UNIT<$?LONGNAME> = $longname<name>.Str; | |
| } | |
| { $*IN_DECL = ''; } | |
| <statementlist> # whole rest of file, presumably | |
| || <.panic: "Unable to parse " ~ $*PKGDECL ~ " definition"> | |
| ] | |
| ] || <.panic: "Malformed $*PKGDECL"> | |
| } | |
| token declarator { | |
| [ | |
| | <variable_declarator> | |
| | '(' ~ ')' <signature> <trait>* | |
| | <routine_declarator=p5routine_declarator> | |
| | <regex_declarator=p5regex_declarator> | |
| | <type_declarator=p5type_declarator> | |
| ] | |
| } | |
| token p5multi_declarator:null { | |
| :my $*MULTINESS = ''; | |
| <declarator> | |
| } | |
| rule p5routine_declarator:sub { <sym> <routine_def> } | |
| rule parensig { | |
| :dba('signature') | |
| '(' ~ ')' <signature(1)> | |
| } | |
| method checkyada { | |
| try { | |
| my $startsym = self.<blockoid><statementlist><statement>[0]<EXPR><term><sym> // ''; | |
| if $startsym eq '...' or $startsym eq '!!!' or $startsym eq '???' { | |
| $*DECLARAND<stub> = 1; | |
| } | |
| }; | |
| return self; | |
| } | |
| rule routine_def () { | |
| :temp $*CURLEX; | |
| :my $*IN_DECL = 1; | |
| :my $*DECLARAND; | |
| [ | |
| || <deflongname> | |
| <.newlex(1)> | |
| <parensig>? | |
| <trait>* | |
| <!{ | |
| $*IN_DECL = 0; | |
| }> | |
| <blockoid>:!s | |
| { @*MEMOS[$¢.pos]<endstmt> = 2; } | |
| <.checkyada> | |
| <.getsig> | |
| || <?before \W> | |
| <.newlex(1)> | |
| <parensig>? | |
| <trait>* | |
| <!{ | |
| $*IN_DECL = 0; | |
| }> | |
| <blockoid>:!s | |
| <.checkyada> | |
| <.getsig> | |
| ] || <.panic: "Malformed routine"> | |
| } | |
| rule trait { | |
| :my $*IN_DECL = 0; | |
| ':' <EXPR(item %comma)> | |
| } | |
| ######### | |
| # Nouns # | |
| ######### | |
| # (for when you want to tell EXPR that infix already parsed the term) | |
| token nullterm { | |
| <?> | |
| } | |
| token nulltermish { | |
| :dba('null term') | |
| [ | |
| | <?stdstopper> | |
| | <term=termish> | |
| { | |
| $¢.<PRE> = $<term><PRE>:delete; | |
| $¢.<POST> = $<term><POST>:delete; | |
| $¢.<~CAPS> = $<term><~CAPS>; | |
| } | |
| | <?> | |
| ] | |
| } | |
| token termish { | |
| :my $*SCOPE = ""; | |
| :my $*VAR; | |
| :dba('prefix or term') | |
| [ | |
| | <PRE> [ <!{ my $p = $<PRE>; my @p = @$p; @p[*-1]<O><term> and $<term> = pop @$p }> <PRE> ]* | |
| [ <?{ $<term> }> || <term=p5term> ] | |
| | <term=p5term> | |
| ] | |
| # also queue up any postfixes | |
| :dba('postfix') | |
| [ | |
| || <?{ $*QSIGIL }> | |
| [ <?before '[' | '{' > <POST> ]*! | |
| || <!{ $*QSIGIL }> | |
| <POST>* | |
| ] | |
| { | |
| self.check_variable($*VAR) if $*VAR; | |
| $¢.<~CAPS> = $<term><~CAPS>; | |
| } | |
| } | |
| token p5term:fatkey { <fatkey> } | |
| token p5term:variable { <variable> | |
| [ | |
| || <?{ $<variable><sigil>.Str ne '$' }> | |
| || <?before '['> { $<variable><really> = '@' } | |
| || <?before '{'> { $<variable><really> = '%' } | |
| ]? | |
| { $*VAR ||= $<variable> } | |
| } | |
| token p5term:package_declarator { <package_declarator=p5package_declarator> } | |
| token p5term:scope_declarator { <scope_declarator=p5scope_declarator> } | |
| token p5term:routine_declarator { <routine_declarator=p5routine_declarator> } | |
| token p5term:circumfix { <circumfix=p5circumfix> } | |
| token p5term:dotty { <dotty=p5dotty> } | |
| token p5term:value { <value=p5value> } | |
| token p5term:capterm { <capterm> } | |
| token p5term:statement_prefix { <statement_prefix=p5statement_prefix> } | |
| token fatkey { | |
| '-'?<key=identifier> <?before \h* '=>' > | |
| } | |
| # Most of these special variable rules are there simply to catch old p5 brainos | |
| token p5special_variable:sym<$!> { <sym> <!before \w> } | |
| token p5special_variable:sym<$!{ }> { | |
| '$!{' ~ '}' <EXPR> | |
| } | |
| token p5special_variable:sym<$/> { | |
| <sym> | |
| } | |
| token p5special_variable:sym<$~> { | |
| <sym> | |
| } | |
| token p5special_variable:sym<$`> { | |
| <sym> | |
| } | |
| token p5special_variable:sym<$@> { | |
| <sym> | |
| } | |
| token p5special_variable:sym<$#> { | |
| <sym> | |
| } | |
| token p5special_variable:sym<$$> { | |
| <sym> <!alpha> | |
| } | |
| token p5special_variable:sym<$%> { | |
| <sym> | |
| } | |
| token p5special_variable:sym<$^X> { | |
| <sigil=p5sigil> '^' $<letter> = [<[A..Z]>] <?before \W > | |
| } | |
| token p5special_variable:sym<$^> { | |
| <sym> | |
| } | |
| token p5special_variable:sym<$&> { | |
| <sym> | |
| } | |
| token p5special_variable:sym<$*> { | |
| <sym> | |
| } | |
| token p5special_variable:sym<$)> { | |
| <sym> | |
| } | |
| token p5special_variable:sym<$-> { | |
| <sym> | |
| } | |
| token p5special_variable:sym<$=> { | |
| <sym> | |
| } | |
| token p5special_variable:sym<@+> { | |
| <sym> | |
| } | |
| token p5special_variable:sym<%+> { | |
| <sym> | |
| } | |
| token p5special_variable:sym<$+[ ]> { | |
| '$+[' | |
| } | |
| token p5special_variable:sym<@+[ ]> { | |
| '@+[' | |
| } | |
| token p5special_variable:sym<@+{ }> { | |
| '@+{' | |
| } | |
| token p5special_variable:sym<@-> { | |
| <sym> | |
| } | |
| token p5special_variable:sym<%-> { | |
| <sym> | |
| } | |
| token p5special_variable:sym<$-[ ]> { | |
| '$-[' | |
| } | |
| token p5special_variable:sym<@-[ ]> { | |
| '@-[' | |
| } | |
| token p5special_variable:sym<%-{ }> { | |
| '@-{' | |
| } | |
| token p5special_variable:sym<$+> { | |
| <sym> | |
| } | |
| token p5special_variable:sym<${^ }> { | |
| <sigil=p5sigil> '{^' :: $<text>=[.*?] '}' | |
| } | |
| token p5special_variable:sym<::{ }> { | |
| '::' <?before '{'> | |
| } | |
| token p5special_variable:sym<$[> { | |
| <sym> | |
| } | |
| token p5special_variable:sym<$]> { | |
| <sym> | |
| } | |
| token p5special_variable:sym<$\\> { | |
| <sym> | |
| } | |
| token p5special_variable:sym<$|> { | |
| <sym> | |
| } | |
| token p5special_variable:sym<$:> { | |
| <sym> | |
| } | |
| token p5special_variable:sym<$;> { | |
| <sym> | |
| } | |
| token p5special_variable:sym<$'> { #' | |
| <sym> | |
| } | |
| token p5special_variable:sym<$"> { | |
| <sym> <!{ $*QSIGIL }> | |
| } | |
| token p5special_variable:sym<$,> { | |
| <sym> | |
| } | |
| token p5special_variable:sym['$<'] { | |
| <sym> | |
| } | |
| token p5special_variable:sym«\$>» { | |
| <sym> | |
| } | |
| token p5special_variable:sym<$.> { | |
| <sym> | |
| } | |
| token p5special_variable:sym<$?> { | |
| <sym> | |
| } | |
| # desigilname should only follow a sigil | |
| token desigilname { | |
| [ | |
| | <?before '$' > <variable> { $*VAR = $<variable>; } | |
| | <longname> | |
| ] | |
| } | |
| token variable { | |
| :my $*IN_META = 0; | |
| :my $sigil = ''; | |
| :my $name; | |
| <?before <sigil=p5sigil> { | |
| $sigil = $<sigil>.Str; | |
| }> {} | |
| [ | |
| || '&' | |
| [ | |
| | <subname> { $name = $<subname>.Str } | |
| | :dba('infix noun') '[' ~ ']' <infixish(1)> | |
| ] | |
| || [ | |
| | <sigil=p5sigil> <desigilname> { $name = $<desigilname>.Str } | |
| | <special_variable=p5special_variable> | |
| | <sigil=p5sigil> $<index>=[\d+] | |
| | <sigil=p5sigil> <?before '{'> | |
| [ | |
| | '{' ~ '}' [<name> <postop>?] | |
| | <block> | |
| ] | |
| | <sigil=p5sigil> <?{ $*IN_DECL }> | |
| | <?> {{ | |
| if $*QSIGIL { | |
| return (); | |
| } | |
| else { | |
| $¢.panic("Anonymous variable requires declarator"); | |
| } | |
| }} | |
| ] | |
| ] | |
| } | |
| # Note, don't reduce on a bare sigil unless you don't care what the longest token is. | |
| token p5sigil:sym<$> { <sym> } | |
| token p5sigil:sym<@> { <sym> } | |
| token p5sigil:sym<%> { <sym> } | |
| token p5sigil:sym<&> { <sym> } | |
| token p5sigil:sym<*> { <sym> } | |
| token p5sigil:sym<$#> { <sym> } | |
| token deflongname { | |
| :dba('new name to be defined') | |
| <name> | |
| { $¢.add_routine($<name>.Str) if $*IN_DECL; } | |
| } | |
| token longname { | |
| <name> | |
| } | |
| token name { | |
| [ | |
| | <identifier> <morename>* | |
| | <morename>+ | |
| ] | |
| } | |
| token morename { | |
| '::' <identifier>? | |
| } | |
| token subname { | |
| <desigilname> | |
| } | |
| token p5value:quote { <quote=p5quote> } | |
| token p5value:number { <number=p5number> } | |
| token p5value:version { <version=p5version> } | |
| # Note: call this only to use existing type, not to declare type | |
| token typename { | |
| [ | |
| | '::?'<identifier> # parse ::?CLASS as special case | |
| | <longname> | |
| <?{{ | |
| my $longname = $<longname>.Str; | |
| if substr($longname, 0, 2) eq '::' { | |
| $¢.add_my_name(substr($longname, 2)); | |
| } | |
| else { | |
| $¢.is_name($longname) | |
| } | |
| }}> | |
| ] | |
| # parametric type? | |
| <.unsp>? [ <?before '['> <postcircumfix=p5postcircumfix> ]? | |
| <.ws> [ 'of' <.ws> <typename> ]? | |
| } | |
| token numish { | |
| [ | |
| | <integer> | |
| | <dec_number> | |
| | <rad_number> | |
| | 'NaN' » | |
| | 'Inf' » | |
| | '+Inf' » | |
| | '-Inf' » | |
| ] | |
| } | |
| token p5number:numish { <numish> } | |
| token integer { | |
| [ | |
| | 0 [ b <[01]>+ [ _ <[01]>+ ]* | |
| | x <.xdigit>+ [ _ <.xdigit>+ ]* | |
| | d \d+ [ _ \d+]* | |
| | <[0..7]>+ [ _ <[0..7]>+ ]* | |
| ] | |
| | \d+[_\d+]* | |
| ] | |
| } | |
| token radint { | |
| [ | |
| | <integer> | |
| | <?before ':'> <rad_number> <?{ | |
| defined $<rad_number><intpart> | |
| and | |
| not defined $<rad_number><fracpart> | |
| }> | |
| ] | |
| } | |
| token escale { | |
| <[Ee]> <[+\-]>? \d+[_\d+]* | |
| } | |
| # careful to distinguish from both integer and 42.method | |
| token dec_number { | |
| :dba('decimal number') | |
| [ | |
| | $<coeff> = [ '.' \d+[_\d+]* ] <escale>? | |
| | $<coeff> = [\d+[_\d+]* '.' \d+[_\d+]* ] <escale>? | |
| | $<coeff> = [\d+[_\d+]* ] <escale> | |
| ] | |
| <!!before [ '.' <?before \d> <.panic: "Number contains two decimal points (missing 'v' for version number?)">]? > | |
| } | |
| token octints { [<.ws><octint><.ws>] +% ',' } | |
| token octint { | |
| <[ 0..7 ]>+ [ _ <[ 0..7 ]>+ ]* | |
| } | |
| token hexints { [<.ws><hexint><.ws>] +% ',' } | |
| token hexint { | |
| <.xdigit>+ [ _ <.xdigit>+ ]* | |
| } | |
| ########## | |
| # Quotes # | |
| ########## | |
| our @herestub_queue; | |
| class Herestub { | |
| has Str $.delim; | |
| has $.orignode; | |
| has $.lang; | |
| } # end class | |
| role herestop { | |
| token stopper { ^^ {} $<ws>=(\h*?) $*DELIM \h* <.unv>?? $$ \v? } | |
| } # end role | |
| # XXX be sure to temporize @herestub_queue on reentry to new line of heredocs | |
| method heredoc () { | |
| my $*CTX ::= self.callm if $*DEBUG +& DEBUG::trace_call; | |
| # return if self.peek; | |
| my $here = self; | |
| while my $herestub = shift @herestub_queue { | |
| my $*DELIM = $herestub.delim; | |
| my $lang = $herestub.lang.mixin( ::herestop ); | |
| my $doc; | |
| if ($doc) = $here.nibble($lang) { | |
| $here = $doc.trim_heredoc(); | |
| $herestub.orignode<doc> = $doc; | |
| } | |
| else { | |
| self.panic("Ending delimiter $*DELIM not found"); | |
| } | |
| } | |
| return self.cursor($here.pos); # return to initial type | |
| } | |
| proto token p5backslash {*} | |
| proto token p5escape {*} | |
| token starter { <!> } | |
| token p5escape:none { <!> } | |
| token babble ($l) { | |
| :my $lang = $l; | |
| :my $start; | |
| :my $stop; | |
| \h* | |
| { | |
| ($start,$stop) = $¢.peek_delimiters(); | |
| $lang = $start ne $stop ?? $lang.balanced($start,$stop) | |
| !! $lang.unbalanced($stop); | |
| $<B> = [$lang,$start,$stop]; | |
| } | |
| } | |
| token quibble ($l) { | |
| :my ($lang, $start, $stop); | |
| <babble($l)> | |
| { my $B = $<babble><B>; ($lang,$start,$stop) = @$B; } | |
| $start <nibble($lang)> [ $stop || <.panic: "Couldn't find terminator $stop"> ] | |
| { $lang<_herelang> and $¢.queue_heredoc($<nibble><nibbles>[0]<TEXT>, $lang<_herelang>) } | |
| } | |
| method queue_heredoc($delim, $lang) { | |
| push @herestub_queue, ::Herestub.new( | |
| delim => $delim, | |
| lang => $lang, | |
| orignode => self); | |
| return self; | |
| } | |
| token sibble ($l, $lang2) { | |
| :my ($lang, $start, $stop); | |
| <babble($l)> | |
| { my $B = $<babble><B>; ($lang,$start,$stop) = @$B; } | |
| $start <left=nibble($lang)> [ $stop || <.panic: "Couldn't find terminator $stop"> ] | |
| [ <?{ $start ne $stop }> | |
| <.ws> <quibble($lang2)> | |
| || | |
| { $lang = $lang2.unbalanced($stop); } | |
| <right=nibble($lang)> $stop | |
| ] | |
| } | |
| token tribble ($l) { | |
| :my ($lang, $start, $stop); | |
| :my $*GOAL; | |
| <babble($l)> | |
| { my $B = $<babble>[0]<B>; ($lang,$start,$stop) = @$B; $*GOAL = $stop; } | |
| { say $lang.WHAT } | |
| [ :lang($lang) $start ~ $stop <left=p5cc($lang)> | |
| [ <?{ $start ne $stop }> | |
| <.ws> | |
| <babble($l)> | |
| { my $B = $<babble>[0]<B>; ($lang,$start,$stop) = @$B; $*GOAL = $stop; } | |
| [ :lang($lang) $start ~ $stop <right=p5cc> ] | |
| || | |
| { say $¢.WHAT } | |
| '' ~ $stop <right=p5cc> | |
| ] | |
| ] | |
| } | |
| # note: polymorphic over many quote languages, we hope | |
| token nibbler { | |
| :my $text = ''; | |
| :my $from = self.pos; | |
| :my $to = $from; | |
| :my @nibbles = (); | |
| :my $multiline = 0; | |
| { $<_from> = self.pos; } | |
| [ <!before <stopper> > | |
| [ | |
| || <starter> <nibbler> <stopper> | |
| {{ | |
| push @nibbles, $¢.makestr(TEXT => $text, _from => $from, _pos => $to ) if $from != $to; | |
| my $n = $<nibbler>[*-1]<nibbles>; | |
| my @n = @$n; | |
| push @nibbles, $<starter>; | |
| push @nibbles, @n; | |
| push @nibbles, $<stopper>; | |
| $text = ''; | |
| $to = $from = $¢.pos; | |
| }} | |
| || <escape=p5escape> {{ | |
| push @nibbles, $¢.makestr(TEXT => $text, _from => $from, _pos => $to ) if $from != $to; | |
| push @nibbles, $<escape>[*-1]; | |
| $text = ''; | |
| $to = $from = $¢.pos; | |
| }} | |
| || . | |
| {{ | |
| my $ch = substr($*ORIG, $¢.pos-1, 1); | |
| $text ~= $ch; | |
| $to = $¢.pos; | |
| if $ch ~~ "\n" { | |
| $multiline++; | |
| } | |
| }} | |
| ] | |
| ]* | |
| {{ | |
| push @nibbles, $¢.makestr(TEXT => $text, _from => $from, _pos => $to ) if $from != $to or !@nibbles; | |
| $<nibbles> = \@nibbles; | |
| $<_pos> = $¢.pos; | |
| $<nibbler> :delete; | |
| $<escape> :delete; | |
| $<starter> :delete; | |
| $<stopper> :delete; | |
| $*LAST_NIBBLE = $¢; | |
| $*LAST_NIBBLE_MULTILINE = $¢ if $multiline; | |
| }} | |
| } | |
| # and this is what makes nibbler polymorphic... | |
| method nibble ($lang) { | |
| self.cursor_fresh($lang).nibbler; | |
| } | |
| token p5quote:sym<' '> { "'" <nibble($¢.cursor_fresh( %*LANG<Q> ).tweak(:q).unbalanced("'"))> "'" } | |
| token p5quote:sym<" "> { '"' <nibble($¢.cursor_fresh( %*LANG<Q> ).tweak(:qq).unbalanced('"'))> '"' } | |
| token p5quote:sym« << » { '<<' :: | |
| [ | |
| | <?before '"'> <quibble($¢.cursor_fresh( %*LANG<Q> ).tweak(:qq).cursor_herelang)> | |
| | <?before "'"> <quibble($¢.cursor_fresh( %*LANG<Q> ).tweak(:q).cursor_herelang)> | |
| | <identifier> | |
| <.queue_heredoc( $<identifier>.Str, | |
| $¢.cursor_fresh( %*LANG<Q> ).tweak(:qq) )> | |
| | \\ <identifier> | |
| <.queue_heredoc( $<identifier>.Str, | |
| $¢.cursor_fresh( %*LANG<Q> ).tweak(:q) )> | |
| ] || <.panic: "Couldn't parse heredoc construct"> | |
| } | |
| token p5circumfix:sym«< >» { '<' | |
| <nibble($¢.cursor_fresh( %*LANG<Q> ).tweak(:qq).tweak(:w).balanced('<','>'))> '>' } | |
| token p5quote:sym</ /> { | |
| '/' :: <nibble( $¢.cursor_fresh( %*LANG<Regex> ).unbalanced("/") )> [ '/' || <.panic: "Unable to parse regex; couldn't find final '/'"> ] | |
| <p5rx_mods>? | |
| } | |
| # handle composite forms like qww | |
| token p5quote:qq { | |
| 'qq' <?before \W> <.ws> <quibble($¢.cursor_fresh( %*LANG<Q> ).tweak(:qq))> | |
| } | |
| token p5quote:q { | |
| 'q' <?before \W> <.ws> <quibble($¢.cursor_fresh( %*LANG<Q> ).tweak(:q))> | |
| } | |
| token p5quote:qw { | |
| 'qw' <?before \W> <.ws> <quibble($¢.cursor_fresh( %*LANG<Q> ).tweak(:q))> | |
| } | |
| token p5quote:qr { | |
| <sym> » :: | |
| <quibble( $¢.cursor_fresh( %*LANG<Regex> ) )> | |
| <p5rx_mods>? | |
| } | |
| token p5quote:m { | |
| <sym> » :: | |
| <quibble( $¢.cursor_fresh( %*LANG<Regex> ) )> | |
| <p5rx_mods>? | |
| } | |
| token p5quote:s { | |
| <sym> » :: | |
| <pat=sibble( $¢.cursor_fresh( %*LANG<Regex> ), $¢.cursor_fresh( %*LANG<Q> ).tweak(:qq))> | |
| <p5rx_mods>? | |
| } | |
| token p5quote:tr { | |
| <sym> » :: <pat=tribble( $¢.cursor_fresh( %*LANG<Regex> ))> | |
| <p5tr_mods>? | |
| } | |
| token p5rx_mods { | |
| <!after \s> | |
| (< i g s m x c e >+) | |
| } | |
| token p5tr_mods { | |
| (< c d s ] >+) | |
| } | |
| # assumes whitespace is eaten already | |
| method peek_delimiters { | |
| my $pos = self.pos; | |
| my $startpos = $pos; | |
| my $char = substr($*ORIG,$pos++,1); | |
| if $char ~~ /^\s$/ { | |
| self.panic("Whitespace character is not allowed as delimiter"); # "can't happen" | |
| } | |
| elsif $char ~~ /^\w$/ { | |
| self.panic("Alphanumeric character is not allowed as delimiter"); | |
| } | |
| elsif %STD::close2open{$char} { | |
| self.panic("Use of a closing delimiter for an opener is reserved"); | |
| } | |
| my $rightbrack = %STD::open2close{$char}; | |
| if not defined $rightbrack { | |
| return $char, $char; | |
| } | |
| while substr($*ORIG,$pos,1) eq $char { | |
| $pos++; | |
| } | |
| my $len = $pos - $startpos; | |
| my $start = $char x $len; | |
| my $stop = $rightbrack x $len; | |
| return $start, $stop; | |
| } | |
| role startstop[$start,$stop] { | |
| token starter { $start } | |
| token stopper { $stop } | |
| } # end role | |
| role stop[$stop] { | |
| token starter { <!> } | |
| token stopper { $stop } | |
| } # end role | |
| role unitstop[$stop] { | |
| token unitstopper { $stop } | |
| } # end role | |
| token unitstopper { $ } | |
| method balanced ($start,$stop) { self.mixin( ::startstop[$start,$stop] ); } | |
| method unbalanced ($stop) { self.mixin( ::stop[$stop] ); } | |
| method unitstop ($stop) { self.mixin( ::unitstop[$stop] ); } | |
| token charname { | |
| [ | |
| | <radint> | |
| | <[a..z A..Z]><-[ \] , \# ]>*?<[a..z A..Z ) ]> <?before \s*<[ \] , \# ]>> | |
| ] || <.panic: "Unrecognized character name"> | |
| } | |
| token charnames { [<.ws><charname><.ws>] +% ',' } | |
| token charspec { | |
| [ | |
| | :dba('character name') '[' ~ ']' <charnames> | |
| | \d+ | |
| | <[ ?..Z \\.._ ]> | |
| | <?> <.panic: "Unrecognized \\c character"> | |
| ] | |
| } | |
| method truly ($bool,$opt) { | |
| return self if $bool; | |
| self.panic("Cannot negate $opt adverb"); | |
| } | |
| grammar Q is STD5 { | |
| role b1 { | |
| token p5escape:sym<\\> { <sym> <item=p5backslash> } | |
| token p5backslash:qq { <?before 'q'> { $<quote> = $¢.cursor_fresh(%*LANG<MAIN>).quote(); } } | |
| token p5backslash:sym<\\> { <text=sym> } | |
| token p5backslash:stopper { <text=stopper> } | |
| token p5backslash:a { <sym> } | |
| token p5backslash:b { <sym> } | |
| token p5backslash:c { <sym> <charspec> } | |
| token p5backslash:e { <sym> } | |
| token p5backslash:f { <sym> } | |
| token p5backslash:n { <sym> } | |
| token p5backslash:N { <sym> '{' ~ '}' $<charname>=[.*?] } | |
| token p5backslash:r { <sym> } | |
| token p5backslash:t { <sym> } | |
| token p5backslash:x { :dba('hex character') <sym> [ <.xdigit> <.xdigit>? | '{' ~ '}' <hexints> ] } | |
| # XXX viv doesn't support ** quantifiers yet | |
| token p5backslash:sym<0> { :dba('octal character') <sym> [ [<[0..7]> [<[0..7]> <[0..7]>?]?]? | '{' ~ '}' <octints> ] } | |
| } # end role | |
| role b0 { | |
| token p5escape:sym<\\> { <!> } | |
| } # end role | |
| role c1 { | |
| token p5escape:sym<{ }> { <?before '{'> [ :lang(%*LANG<MAIN>) <block> ] } | |
| } # end role | |
| role c0 { | |
| token p5escape:sym<{ }> { <!> } | |
| } # end role | |
| role s1 { | |
| token p5escape:sym<$> { | |
| :my $*QSIGIL ::= '$'; | |
| <?before '$'> | |
| [ :lang(%*LANG<MAIN>) <termish> ] || <.panic: "Non-variable \$ must be backslashed"> | |
| } | |
| } # end role | |
| role s0 { | |
| token p5escape:sym<$> { <!> } | |
| } # end role | |
| role a1 { | |
| token p5escape:sym<@> { | |
| :my $*QSIGIL ::= '@'; | |
| <?before '@'> | |
| [ :lang(%*LANG<MAIN>) <termish> | <!> ] # trap ABORTBRANCH from variable's :: | |
| } | |
| } # end role | |
| role a0 { | |
| token p5escape:sym<@> { <!> } | |
| } # end role | |
| role h1 { | |
| token p5escape:sym<%> { | |
| :my $*QSIGIL ::= '%'; | |
| <?before '%'> | |
| [ :lang(%*LANG<MAIN>) <termish> | <!> ] | |
| } | |
| } # end role | |
| role h0 { | |
| token p5escape:sym<%> { <!> } | |
| } # end role | |
| role f1 { | |
| token p5escape:sym<&> { | |
| :my $*QSIGIL ::= '&'; | |
| <?before '&'> | |
| [ :lang(%*LANG<MAIN>) <EXPR(item %methodcall)> | <!> ] | |
| } | |
| } # end role | |
| role f0 { | |
| token p5escape:sym<&> { <!> } | |
| } # end role | |
| role w1 { | |
| method postprocess ($s) { $s.words } | |
| } # end role | |
| role w0 { | |
| method postprocess ($s) { $s } | |
| } # end role | |
| role ww1 { | |
| method postprocess ($s) { $s.words } | |
| } # end role | |
| role ww0 { | |
| method postprocess ($s) { $s } | |
| } # end role | |
| role x1 { | |
| method postprocess ($s) { $s.run } | |
| } # end role | |
| role x0 { | |
| method postprocess ($s) { $s } | |
| } # end role | |
| role q { | |
| token stopper { \' } | |
| token p5escape:sym<\\> { <sym> <item=p5backslash> } | |
| token p5backslash:qq { <?before 'q'> { $<quote> = $¢.cursor_fresh(%*LANG<MAIN>).quote(); } } | |
| token p5backslash:sym<\\> { <text=sym> } | |
| token p5backslash:stopper { <text=stopper> } | |
| # in single quotes, keep backslash on random character by default | |
| token p5backslash:misc { {} (.) { $<text> = "\\" ~ $0.Str; } } | |
| # begin tweaks (DO NOT ERASE) | |
| multi method tweak (:single(:$q)!) { self.panic("Too late for :q") } | |
| multi method tweak (:double(:$qq)!) { self.panic("Too late for :qq") } | |
| # end tweaks (DO NOT ERASE) | |
| } # end role | |
| role qq does b1 does s1 does a1 { | |
| token stopper { \" } | |
| # in double quotes, omit backslash on random \W backslash by default | |
| token p5backslash:misc { {} [ (\W) { $<text> = $0.Str; } | $<x>=(\w) <.panic("Unrecognized backslash sequence: '\\" ~ $<x>.Str ~ "'")> ] } | |
| # begin tweaks (DO NOT ERASE) | |
| multi method tweak (:single(:$q)!) { self.panic("Too late for :q") } | |
| multi method tweak (:double(:$qq)!) { self.panic("Too late for :qq") } | |
| # end tweaks (DO NOT ERASE) | |
| } # end role | |
| role p5 { | |
| # begin tweaks (DO NOT ERASE) | |
| multi method tweak (:$g!) { self } | |
| multi method tweak (:$i!) { self } | |
| multi method tweak (:$m!) { self } | |
| multi method tweak (:$s!) { self } | |
| multi method tweak (:$x!) { self } | |
| multi method tweak (:$p!) { self } | |
| multi method tweak (:$c!) { self } | |
| # end tweaks (DO NOT ERASE) | |
| } # end role | |
| # begin tweaks (DO NOT ERASE) | |
| multi method tweak (:single(:$q)!) { self.truly($q,':q'); self.mixin( ::q ); } | |
| multi method tweak (:double(:$qq)!) { self.truly($qq, ':qq'); self.mixin( ::qq ); } | |
| multi method tweak (:backslash(:$b)!) { self.mixin($b ?? ::b1 !! ::b0) } | |
| multi method tweak (:scalar(:$s)!) { self.mixin($s ?? ::s1 !! ::s0) } | |
| multi method tweak (:array(:$a)!) { self.mixin($a ?? ::a1 !! ::a0) } | |
| multi method tweak (:hash(:$h)!) { self.mixin($h ?? ::h1 !! ::h0) } | |
| multi method tweak (:function(:$f)!) { self.mixin($f ?? ::f1 !! ::f0) } | |
| multi method tweak (:closure(:$c)!) { self.mixin($c ?? ::c1 !! ::c0) } | |
| multi method tweak (:exec(:$x)!) { self.mixin($x ?? ::x1 !! ::x0) } | |
| multi method tweak (:words(:$w)!) { self.mixin($w ?? ::w1 !! ::w0) } | |
| multi method tweak (:quotewords(:$ww)!) { self.mixin($ww ?? ::ww1 !! ::ww0) } | |
| multi method tweak (:$regex!) { | |
| return %*LANG<Regex>; | |
| } | |
| multi method tweak (:$trans!) { | |
| return %*LANG<Trans>; | |
| } | |
| multi method tweak (*%x) { | |
| my @k = keys(%x); | |
| self.panic("Unrecognized quote modifier: " ~ join('',@k)); | |
| } | |
| # end tweaks (DO NOT ERASE) | |
| } # end grammar | |
| ########################### | |
| # Captures and Signatures # | |
| ########################### | |
| token capterm { | |
| '\\' | |
| [ | |
| | '(' <capture>? ')' | |
| | <?before \S> <termish> | |
| ] | |
| } | |
| rule capture { | |
| :my $*INVOCANT_OK = 1; | |
| <EXPR> | |
| } | |
| rule param_sep { [','|':'|';'|';;'] } | |
| rule signature () { | |
| <variable_declarator>+ % ',' | |
| } | |
| token type_constraint { | |
| <typename> | |
| <.ws> | |
| } | |
| rule p5statement_prefix:do {<sym> <block> } | |
| rule p5statement_prefix:eval {<sym> <block> } | |
| ######### | |
| # Terms # | |
| ######### | |
| # start playing with the setting stubber | |
| token p5term:sym<undef> { | |
| <sym> » | |
| <O(|%term)> | |
| } | |
| token p5term:sym<continue> | |
| { <sym> » <O(|%term)> } | |
| token p5circumfix:sigil | |
| { :dba('contextualizer') <sigil=p5sigil> '(' ~ ')' <semilist> { $*LEFTSIGIL ||= $<sigil>.Str } <O(|%term)> } | |
| token p5circumfix:sym<( )> | |
| { :dba('parenthesized expression') '(' ~ ')' <semilist> <O(|%term)> } | |
| token p5circumfix:sym<[ ]> | |
| { :dba('array composer') '[' ~ ']' <semilist> <O(|%term)> } | |
| ############# | |
| # Operators # | |
| ############# | |
| token PRE { | |
| :dba('prefix operator') | |
| <prefix=p5prefix> | |
| { $<O> = $<prefix><O>; $<sym> = $<prefix><sym> } | |
| <.ws> | |
| } | |
| token infixish ($in_meta = $*IN_META) { | |
| :my $*IN_META = $in_meta; | |
| <!stdstopper> | |
| <!infixstopper> | |
| :dba('infix or meta-infix') | |
| <infix=p5infix> | |
| { $<O> = $<infix>.<O>; $<sym> = $<infix>.<sym>; } | |
| } | |
| token p5dotty:sym«->» { | |
| <sym> <dottyop> | |
| <O(|%methodcall)> } | |
| token dottyopish { | |
| <term=dottyop> | |
| } | |
| token dottyop { | |
| :dba('dotty method or postfix') | |
| [ | |
| | <methodop> | |
| | <!alpha> <postcircumfix=p5postcircumfix> { $<O> = $<postcircumfix><O>; $<sym> = $<postcircumfix><sym>; } | |
| ] | |
| } | |
| # Note, this rule mustn't do anything irreversible because it's used | |
| # as a lookahead by the quote interpolator. | |
| token POST { | |
| <!stdstopper> | |
| # last whitespace didn't end here | |
| <!{ @*MEMOS[$¢.pos]<ws> }> | |
| :dba('postfix') | |
| [ | |
| | <dotty=p5dotty> { $<O> = $<dotty><O>; $<sym> = $<dotty><sym>; $<~CAPS> = $<dotty><~CAPS>; } | |
| | <postop> { $<O> = $<postop><O>; $<sym> = $<postop><sym>; $<~CAPS> = $<postop><~CAPS>; } | |
| ] | |
| } | |
| token p5postcircumfix:sym<( )> | |
| { :dba('argument list') '(' ~ ')' <semiarglist> <O(|%methodcall)> } | |
| token p5postcircumfix:sym<[ ]> | |
| { :dba('subscript') '[' ~ ']' <semilist> <O(|%methodcall)> } | |
| token p5postcircumfix:sym<{ }> | |
| { :dba('subscript') '{' ~ '}' [<identifier><?before '}'>|<semilist>] <O(|%methodcall)> } | |
| token postop { | |
| | <postfix=p5postfix> { $<O> := $<postfix><O>; $<sym> := $<postfix><sym>; } | |
| | <postcircumfix=p5postcircumfix> { $<O> := $<postcircumfix><O>; $<sym> := $<postcircumfix><sym>; } | |
| } | |
| token methodop { | |
| [ | |
| | <longname> | |
| | <?before '$' | '@' | '&' > <variable> { $*VAR = $<variable> } | |
| ] | |
| :dba('method arguments') | |
| [ | |
| | <?[\\(]> <args> | |
| ]? | |
| } | |
| token semiarglist { | |
| <arglist> +% ';' | |
| <.ws> | |
| } | |
| token arglist { | |
| :my $inv_ok = $*INVOCANT_OK; | |
| :my $*GOAL ::= 'endargs'; | |
| :my $*QSIGIL ::= ''; | |
| <.ws> | |
| :dba('argument list') | |
| [ | |
| | <?stdstopper> | |
| | <EXPR(item %listop)> {{ | |
| my $delims = $<EXPR><delims>; | |
| for @$delims { | |
| if ($_.<sym> // '') eq ':' { | |
| if $inv_ok { | |
| $*INVOCANT_IS = $<EXPR><list>[0]; | |
| } | |
| } | |
| } | |
| }} | |
| ] | |
| } | |
| token p5circumfix:sym<{ }> { | |
| :: <?before '{' > | |
| <block> | |
| <O(|%term)> } | |
| token p5statement_control:sym<{ }> { | |
| <?before '{' > | |
| <sblock> | |
| <O(|%term)> } | |
| ## methodcall | |
| token p5postfix:sym['->'] () | |
| { '->' } | |
| ## autoincrement | |
| token p5postfix:sym<++> | |
| { <sym> <O(|%autoincrement)> } | |
| token p5postfix:sym«--» | |
| { <sym> <O(|%autoincrement)> } | |
| token p5prefix:sym<++> | |
| { <sym> <O(|%autoincrement)> } | |
| token p5prefix:sym«--» | |
| { <sym> <O(|%autoincrement)> } | |
| ## exponentiation | |
| token p5infix:sym<**> | |
| { <sym> <O(|%exponentiation)> } | |
| ## symbolic unary | |
| token p5prefix:sym<!> | |
| { <sym> <O(|%symbolic_unary)> } | |
| token p5prefix:sym<+> | |
| { <sym> <O(|%symbolic_unary)> } | |
| token p5prefix:sym<-> | |
| { <sym> <O(|%symbolic_unary)> } | |
| token p5prefix:sym<~> | |
| { <sym> <O(|%symbolic_unary)> } | |
| token p5prefix:sym<\\> | |
| { <sym> <O(|%symbolic_unary)> } | |
| ## binding | |
| token p5infix:sym<!~> | |
| { <sym> <O(|%binding)> } | |
| token p5infix:sym<=~> | |
| { <sym> <O(|%binding)> } | |
| ## multiplicative | |
| token p5infix:sym<*> | |
| { <sym> <O(|%multiplicative)> } | |
| token p5infix:sym</> | |
| { <sym> <O(|%multiplicative)> } | |
| token p5infix:sym<%> | |
| { <sym> <O(|%multiplicative)> } | |
| token p5infix:sym« << » | |
| { <sym> <O(|%multiplicative)> } | |
| token p5infix:sym« >> » | |
| { <sym> <O(|%multiplicative)> } | |
| token p5infix:sym<x> | |
| { <sym> <O(|%multiplicative)> } | |
| ## additive | |
| token p5infix:sym<.> () | |
| { <sym> <O(|%additive)> } | |
| token p5infix:sym<+> | |
| { <sym> <O(|%additive)> } | |
| token p5infix:sym<-> | |
| { <sym> <O(|%additive)> } | |
| ## bitwise and (all) | |
| token p5infix:sym<&> | |
| { <sym> <O(|%bitwise_and)> } | |
| token p5infix:sym<also> | |
| { <sym> <O(|%bitwise_and)> } | |
| ## bitwise or (any) | |
| token p5infix:sym<|> | |
| { <sym> <O(|%bitwise_or)> } | |
| token p5infix:sym<^> | |
| { <sym> <O(|%bitwise_or)> } | |
| ## named unary examples | |
| # (need \s* to win LTM battle with listops) | |
| token p5term:abs | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:alarm | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:chop | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:chdir | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:close | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:closedir | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:caller | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:chr | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:cos | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:chroot | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:defined | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:delete | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:dbmclose | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:exists | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:int | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:exit | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:try | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:eval | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:eof | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:exp | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:each | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:fileno | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:gmtime | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:getc | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:getpgrp | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:getpbyname | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:getpwnam | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:getpwuid | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:getpeername | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:gethostbyname | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:getnetbyname | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:getsockname | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:getgroupnam | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:getgroupgid | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:hex | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:int | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:keys | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:lc | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:lcfirst | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:length | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:localtime | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:log | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:lock | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:lstat | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:ord | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:oct | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:prototype | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:pop | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:pos | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:quotemeta | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:reset | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:rand | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:rmdir | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:readdir | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:readline | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:backtick | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:rewinddir | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:readlink | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:ref | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:chomp | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:scalar | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:sethostent | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:setnetent | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:setservent | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:setprotoent | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:shift | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:sin | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:sleep | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:sqrt | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:srand | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:stat | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:study | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:tell | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:telldir | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:tied | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:uc | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:ucfirst | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:undef | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:untie | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:values | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:write | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:local | |
| { <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| token p5term:filetest | |
| { '-'<[a..zA..Z]> » <?before \s*> <.ws> <EXPR(item %named_unary)>? } | |
| ## comparisons | |
| token p5infix:sym« <=> » | |
| { <sym> <?{ $<O><returns> = "Order"; }> <O(|%comparison)> } | |
| token p5infix:cmp | |
| { <sym> <?{ $<O><returns> = "Order"; }> <O(|%comparison)> } | |
| token p5infix:sym« < » | |
| { <sym> <O(|%comparison)> } | |
| token p5infix:sym« <= » | |
| { <sym> <O(|%comparison)> } | |
| token p5infix:sym« > » | |
| { <sym> <O(|%comparison)> } | |
| token p5infix:sym« >= » | |
| { <sym> <O(|%comparison)> } | |
| token p5infix:sym<eq> | |
| { <sym> <O(|%equality)> } | |
| token p5infix:sym<ne> | |
| { <sym> <O(|%equality)> } | |
| token p5infix:sym<lt> | |
| { <sym> <O(|%comparison)> } | |
| token p5infix:sym<le> | |
| { <sym> <O(|%comparison)> } | |
| token p5infix:sym<gt> | |
| { <sym> <O(|%comparison)> } | |
| token p5infix:sym<ge> | |
| { <sym> <O(|%comparison)> } | |
| ## equality | |
| token p5infix:sym<==> | |
| { <sym> <!before '=' > <O(|%equality)> } | |
| token p5infix:sym<!=> | |
| { <sym> <?before \s> <O(|%equality)> } | |
| token p5infix:sym<~~> | |
| { <sym> <O(|%equality)> } | |
| token p5infix:sym<!~~> | |
| { <sym> <O(|%equality)> } | |
| ## tight and | |
| token p5infix:sym<&&> | |
| { <sym> <O(|%tight_and)> } | |
| ## tight or | |
| token p5infix:sym<||> | |
| { <sym> <O(|%tight_or)> } | |
| token p5infix:sym<^^> | |
| { <sym> <O(|%tight_or)> } | |
| token p5infix:sym<//> | |
| { <sym> <O(|%tight_or)> } | |
| ## range | |
| token p5infix:sym<..> | |
| { <sym> <O(|%range)> } | |
| token p5infix:sym<...> | |
| { <sym> <O(|%range)> } | |
| ## conditional | |
| token p5infix:sym<? :> { | |
| :my $*GOAL ::= ':'; | |
| '?' | |
| <.ws> | |
| <EXPR(item %assignment)> | |
| [ ':' || | |
| [ | |
| || <?before '='> <.panic: "Assignment not allowed within ?:"> | |
| || <?before '!!'> <.panic: "Please use : rather than !!"> | |
| || <?before <infixish>> # Note: a tight infix would have parsed right | |
| <.panic: "Precedence too loose within ?:; use ?(): instead "> | |
| || <.panic: "Found ? but no :; possible precedence problem"> | |
| ] | |
| ] | |
| { $<O><_reducecheck> = 'raise_middle'; } | |
| <O(|%conditional)> } | |
| method raise_middle { | |
| self.<middle> = self.<infix><EXPR>; | |
| self; | |
| } | |
| token p5infix:sym<=> () | |
| { <sym> <O(|%assignment)> } | |
| ## multiplicative | |
| token p5infix:sym<*=> | |
| { <sym> <O(|%assignment)> } | |
| token p5infix:sym</=> | |
| { <sym> <O(|%assignment)> } | |
| token p5infix:sym<%=> | |
| { <sym> <O(|%assignment)> } | |
| token p5infix:sym« <<= » | |
| { <sym> <O(|%assignment)> } | |
| token p5infix:sym« >>= » | |
| { <sym> <O(|%assignment)> } | |
| token p5infix:sym<x=> | |
| { <sym> <O(|%assignment)> } | |
| ## additive | |
| token p5infix:sym<.=> () | |
| { <sym> <O(|%assignment)> } | |
| token p5infix:sym<+=> | |
| { <sym> <O(|%additive)> } | |
| token p5infix:sym<-=> | |
| { <sym> <O(|%assignment)> } | |
| ## bitwise and (all) | |
| token p5infix:sym<&=> | |
| { <sym> <O(|%assignment)> } | |
| ## bitwise or (any) | |
| token p5infix:sym<|=> | |
| { <sym> <O(|%assignment)> } | |
| token p5infix:sym<^=> | |
| { <sym> <O(|%assignment)> } | |
| ## tight and | |
| token p5infix:sym<&&=> | |
| { <sym> <O(|%assignment)> } | |
| ## tight or | |
| token p5infix:sym<||=> | |
| { <sym> <O(|%assignment)> } | |
| token p5infix:sym<^^=> | |
| { <sym> <O(|%assignment)> } | |
| token p5infix:sym<//=> | |
| { <sym> <O(|%assignment)> } | |
| ## list item separator | |
| token p5infix:sym<,> | |
| { <sym> { $<O><fiddly> = 0; } <O(|%comma)> } | |
| token p5infix:sym« => » | |
| { <sym> { $<O><fiddly> = 0; } <O(|%comma)> } | |
| token p5term:blocklist | |
| { | |
| # :my $name; | |
| # :my $pos; | |
| $<identifier> = ['map'|'grep'|'sort'] <.ws> | |
| [ :my $*IN_SORT = $<identifier>.Str eq 'sort'; <?before '{'> <block> <.ws>]? | |
| <arglist> | |
| # { self.add_mystery($name,$pos,substr($*ORIG,$pos,1)) unless $<args><invocant>; } | |
| <O(|%term)> | |
| } | |
| # force identifier(), identifier.(), etc. to be a function call always | |
| token p5term:identifier | |
| { | |
| :my $name; | |
| :my $pos; | |
| <identifier> :: | |
| { $name = $<identifier>.Str; $pos = $¢.pos; } | |
| [\h+ <?before '('>]? | |
| <args( $¢.is_name($name) )> | |
| # { self.add_mystery($name,$pos,substr($*ORIG,$pos,1)) unless $<args><invocant>; } | |
| <O(|%term)> | |
| } | |
| token args ($istype = 0) { | |
| :my $listopish = 0; | |
| :my $*GOAL ::= ''; | |
| :my $*INVOCANT_OK = 1; | |
| :my $*INVOCANT_IS; | |
| [ | |
| # | :dba('argument list') '.(' ~ ')' <semiarglist> | |
| | :dba('argument list') '(' ~ ')' <semiarglist> | |
| | :dba('argument list') <.unsp> '(' ~ ')' <semiarglist> | |
| | { $listopish = 1 } [<?before \s> <!{ $istype }> <.ws> <!infixstopper> <arglist>]? | |
| ] | |
| { $<invocant> = $*INVOCANT_IS; } | |
| } | |
| # names containing :: may or may not be function calls | |
| # bare identifier without parens also handled here if no other rule parses it | |
| token p5term:name | |
| { | |
| :my $name; | |
| :my $pos; | |
| <longname> :: | |
| { | |
| $name = $<longname>.Str; | |
| $pos = $¢.pos; | |
| } | |
| [\h+ <?before '('>]? | |
| <args> # { self.add_mystery($name,$pos,'termish') unless $<args><invocant>; } | |
| <O(|%term)> | |
| } | |
| ## loose not | |
| token p5prefix:sym<not> | |
| { <sym> <?before \s*> <O(|%loose_not)> } | |
| ## loose and | |
| token p5infix:sym<and> | |
| { <sym> <O(|%loose_and)> } | |
| ## loose or | |
| token p5infix:sym<or> | |
| { <sym> <O(|%loose_or)> } | |
| token p5infix:sym<xor> | |
| { <sym> <O(|%loose_or)> } | |
| ## expression terminator | |
| # Note: must always be called as <?terminator> or <?before ...<p5terminator>...> | |
| token p5terminator:sym<;> | |
| { ';' <O(|%terminator)> } | |
| token p5terminator:sym<if> | |
| { 'if' » <.nofun> <O(|%terminator)> } | |
| token p5terminator:sym<unless> | |
| { 'unless' » <.nofun> <O(|%terminator)> } | |
| token p5terminator:sym<while> | |
| { 'while' » <.nofun> <O(|%terminator)> } | |
| token p5terminator:sym<until> | |
| { 'until' » <.nofun> <O(|%terminator)> } | |
| token p5terminator:sym<for> | |
| { 'for' » <.nofun> <O(|%terminator)> } | |
| token p5terminator:sym<given> | |
| { 'given' » <.nofun> <O(|%terminator)> } | |
| token p5terminator:sym<when> | |
| { 'when' » <.nofun> <O(|%terminator)> } | |
| token p5terminator:sym<)> | |
| { <sym> <O(|%terminator)> } | |
| token p5terminator:sym<]> | |
| { ']' <O(|%terminator)> } | |
| token p5terminator:sym<}> | |
| { '}' <O(|%terminator)> } | |
| token p5terminator:sym<:> | |
| { ':' <?{ $*GOAL eq ':' }> <O(|%terminator)> } | |
| regex infixstopper { | |
| :dba('infix stopper') | |
| [ | |
| | <?before <stopper> > | |
| | <?before ':' > <?{ $*GOAL eq ':' }> | |
| ] | |
| } | |
| # overridden in subgrammars | |
| token stopper { <!> } | |
| # hopefully we can include these tokens in any outer LTM matcher | |
| regex stdstopper { | |
| :temp @*STUB = return self if @*MEMOS[self.pos]<endstmt> :exists; | |
| :dba('standard stopper') | |
| [ | |
| | <?terminator> | |
| | <?unitstopper> | |
| | $ # unlikely, check last (normal LTM behavior) | |
| ] | |
| { @*MEMOS[$¢.pos]<endstmt> ||= 1; } | |
| } | |
| ## vim: expandtab sw=4 ft=perl6 | |
| grammar Regex is STD { | |
| # begin tweaks (DO NOT ERASE) | |
| multi method tweak (:global(:$g)!) { self } | |
| multi method tweak (:ignorecase(:$i)!) { self } | |
| # end tweaks (DO NOT ERASE) | |
| token category:p5metachar { <sym> } | |
| proto token p5metachar {*} | |
| token category:p5backslash { <sym> } | |
| proto token p5backslash {*} | |
| token category:p5assertion { <sym> } | |
| proto token p5assertion {*} | |
| token category:p5quantifier { <sym> } | |
| proto token p5quantifier {*} | |
| token category:p5mod_internal { <sym> } | |
| proto token p5mod_internal {*} | |
| proto token p5regex_infix {*} | |
| # suppress fancy end-of-line checking | |
| token codeblock { | |
| :my $*GOAL ::= '}'; | |
| '{' :: [ :lang($¢.cursor_fresh(%*LANG<MAIN>)) <statementlist> ] | |
| [ '}' || <.panic: "Unable to parse statement list; couldn't find right brace"> ] | |
| } | |
| token ws { | |
| <?{ $*RX<s> }> | |
| || [ <?before \s | '#'> <.nextsame> ]? # still get all the pod goodness, hopefully | |
| } | |
| token nibbler { | |
| :temp $*ignorecase; | |
| <alternation> | |
| } | |
| regex infixstopper { | |
| :dba('infix stopper') | |
| <?before <stopper> > | |
| } | |
| token p5regex_infix:sym<|> { <sym> <O(|%tight_or)> } | |
| token alternation { | |
| <sequence>+ % <p5regex_infix> | |
| } | |
| token sequence { | |
| <quantified_atom>* | |
| } | |
| token quantified_atom { | |
| <!stopper> | |
| <!p5regex_infix> | |
| <atom> | |
| [ <.ws> <quantifier=p5quantifier> | |
| # <?{ $<atom>.max_width }> | |
| # || <.panic: "Cannot quantify zero-width atom"> | |
| ]? | |
| } | |
| token atom { | |
| [ | |
| | \w | |
| | <metachar=p5metachar> | |
| | '\\' :: . | |
| | :: \W | |
| ] | |
| } | |
| # sequence stoppers | |
| token p5metachar:sym<|> { '|' :: <fail> } | |
| token p5metachar:sym<)> { ')' :: <fail> } | |
| token p5metachar:quant { <quantifier=p5quantifier> <.panic: "quantifier quantifies nothing"> } | |
| # "normal" metachars | |
| token p5metachar:sym<[ ]> { | |
| # Unix-style character classes are quite metafiddly. Don't blame me. | |
| '[' ~ ']' [ $<neg> = [ '^' ]? <p5cc> ] | |
| } | |
| token p5cc { | |
| :my $stop = $*GOAL || ']'; | |
| [ | |
| <p5ccelem> | |
| { | |
| given $<p5ccelem>[*-1].Str { | |
| if /\-/ { | |
| for split('-', $_) { | |
| if /\\(d|w|s|D|W|S)/ { | |
| $¢.panic("Illegal use of $_ in range"); | |
| } | |
| } | |
| } | |
| } | |
| } | |
| ]+? <?before $stop> | |
| } | |
| token p5ccelem { | |
| [ \\ <p5ccback> || . ] | |
| [ '-' [ \\ <p5ccback> || <-[ \] ]> ]]? | |
| } | |
| proto token p5ccback {*} | |
| token p5ccback:stopper { <text=.stopper> } | |
| token p5ccback:b { :i <sym> } | |
| token p5ccback:d { :i <sym> } | |
| token p5ccback:e { :i <sym> } | |
| token p5ccback:f { :i <sym> } | |
| token p5ccback:h { :i <sym> } | |
| token p5ccback:n { <sym> } | |
| token p5ccback:N { <sym> '{' ~ '}' $<charname>=[.*?] } | |
| token p5ccback:o { :i :dba('octal character') <sym> [ <octint> | '{' ~ '}' <octints> ] } | |
| token p5ccback:r { :i <sym> } | |
| token p5ccback:s { :i <sym> } | |
| token p5ccback:t { :i <sym> } | |
| token p5ccback:v { :i <sym> } | |
| token p5ccback:w { :i <sym> } | |
| token p5ccback:x { :i :dba('hex character') <sym> [ <.xdigit> <.xdigit>? | '{' ~ '}' <hexints> ] } | |
| token p5ccback:sym<0> { :dba('octal character') <sym> [ [<[0..7]> [<[0..7]> <[0..7]>?]?]? | '{' ~ '}' <octints> ] } | |
| token p5metachar:sym«(? )» { | |
| '(?' {} <assertion=p5assertion> | |
| [ ')' || <.panic: "Perl 5 regex assertion not terminated by parenthesis"> ] | |
| } | |
| token p5metachar:sym<( )> { | |
| '(' {} [:lang(self.unbalanced(')')) <nibbler>]? | |
| [ ')' || <.panic: "Unable to parse Perl 5 regex; couldn't find right parenthesis"> ] | |
| { $/<sym> := <( )> } | |
| } | |
| token p5metachar:sym<\\> { <sym> <backslash=p5backslash> } | |
| token p5metachar:sym<.> { <sym> } | |
| token p5metachar:sym<^> { <sym> } | |
| token p5metachar:sym<$> { | |
| '$' <?before \W | $> | |
| } | |
| token p5metachar:var { | |
| <?before '$'> | |
| <variable> | |
| } | |
| token p5backslash:A { <sym> } | |
| token p5backslash:a { <sym> } | |
| token p5backslash:b { :i <sym> } | |
| token p5backslash:c { :i <sym> | |
| <[ ?.._ ]> || <.panic: "Unrecognized \\c character"> | |
| } | |
| token p5backslash:d { :i <sym> } | |
| token p5backslash:e { :i <sym> } | |
| token p5backslash:f { :i <sym> } | |
| token p5backslash:h { :i <sym> } | |
| token p5backslash:l { :i <sym> } | |
| token p5backslash:n { :i <sym> } | |
| token p5backslash:o { :dba('octal character') '0' [ <octint> | '{' ~ '}' <octints> ] } | |
| token p5backslash:p { :i <sym> '{' <[\w:]>+ '}' } | |
| token p5backslash:Q { <sym> } | |
| token p5backslash:r { :i <sym> } | |
| token p5backslash:s { :i <sym> } | |
| token p5backslash:t { :i <sym> } | |
| token p5backslash:u { :i <sym> } | |
| token p5backslash:v { :i <sym> } | |
| token p5backslash:w { :i <sym> } | |
| token p5backslash:x { :i :dba('hex character') <sym> [ <hexint> | '{' ~ '}' <hexints> ] } | |
| token p5backslash:z { :i <sym> } | |
| token p5backslash:misc { $<litchar>=(\W) | $<number>=(\d+) } | |
| token p5backslash:oops { <.panic: "Unrecognized Perl 5 regex backslash sequence"> } | |
| token p5assertion:sym<?> { <sym> <codeblock> } | |
| token p5assertion:sym<{ }> { <codeblock> } | |
| token p5assertion:sym«<» { <sym> <?before '=' | '!'> <assertion=p5assertion> } | |
| token p5assertion:sym<=> { <sym> [ <?before ')'> | <rx> ] } | |
| token p5assertion:sym<!> { <sym> [ <?before ')'> | <rx> ] } | |
| token p5assertion:sym«>» { <sym> <rx> } | |
| token rx { | |
| # [:lang(self.unbalanced(')')) <nibbler>] | |
| <nibbler> | |
| [ <?before ')'> || <.panic: "Unable to parse Perl 5 regex; couldn't find right parenthesis"> ] | |
| } | |
| #token p5assertion:identifier { <longname> [ # is qq right here? | |
| # | <?before ')' > | |
| # | <.ws> <nibbler> | |
| # ] | |
| # [ ':' <rx> ]? | |
| #} | |
| token p5mod { <[imox]>* } | |
| token p5mods { <on=p5mod> [ '-' <off=p5mod> ]? } | |
| token p5assertion:mod { <mods=p5mods> [ # is qq right here? | |
| | ':' <rx>? | |
| | <?before ')' > | |
| ] | |
| } | |
| token p5assertion:bogus { <.panic: "Unrecognized Perl 5 regex assertion"> } | |
| token p5quantifier:sym<*> { <sym> <quantmod> } | |
| token p5quantifier:sym<+> { <sym> <quantmod> } | |
| token p5quantifier:sym<?> { <sym> <quantmod> } | |
| token p5quantifier:sym<{ }> { '{' \d+ [','\d*]? '}' <quantmod> } | |
| token quantmod { [ '?' | '+' ]? } | |
| } # end grammar | |
| method check_variable ($variable) { | |
| my $name = $variable.Str; | |
| my $here = self.cursor($variable.from); | |
| self.deb("check_variable $name") if $*DEBUG +& DEBUG::symtab; | |
| if $variable<really> { $name = $variable<really> ~ substr($name,1) } | |
| my ($sigil, $first) = $name ~~ /(\$|\@|\%|\&|\*)(.?)/; | |
| return self if $first eq '{'; | |
| my $ok = 0; | |
| $ok ||= $*IN_DECL; | |
| $ok ||= $first lt 'A'; | |
| $ok ||= $sigil eq '*'; | |
| $ok ||= self.is_known($name); | |
| $ok ||= ($*IN_SORT and $name eq '$a' || $name eq '$b'); | |
| if not $ok { | |
| my $id = $name; | |
| $id ~~ s/^\W\W?//; | |
| if $sigil eq '&' { | |
| $here.add_mystery($variable.<sublongname>, self.pos, 'var') | |
| } | |
| elsif $name eq '@_' or $name eq '%_' { | |
| ; | |
| } | |
| else { # guaranteed fail now | |
| if my $scope = @*MEMOS[$variable.from]<declend> { | |
| return $here.sorry("Variable $name is not predeclared (declarators are tighter than comma, so maybe your '$scope' signature needs parens?)"); | |
| } | |
| elsif $id !~~ /\:\:/ { | |
| if self.is_known('@' ~ $id) { | |
| return $here.sorry("Variable $name is not predeclared (did you mean \@$id?)"); | |
| } | |
| elsif self.is_known('%' ~ $id) { | |
| return $here.sorry("Variable $name is not predeclared (did you mean \%$id?)"); | |
| } | |
| } | |
| return $here.sorry("Variable $name is not predeclared"); | |
| } | |
| } | |
| elsif $*CURLEX{$name} { | |
| $*CURLEX{$name}<used>++; | |
| } | |
| self; | |
| } | |