root/misc/STD_red/std.rb

#!/usr/bin/env ruby
# -*- encoding: utf-8 -*-
# A ruby transliteration of src/perl6/STD.pm
# See README.
#
# STD_red issues
#  Some Match ruls are "foo__bar", where bar was a #= comment.  This is wrongish.
#

require 'prelude'

class Perl < Grammar
    attr_accessor :ws_from, :ws_to

    def _TOP; _UNIT( $env_vars[:unitstopper] || "_EOS" ); end

    def_precedence :hyper           ,{ :transparent=>1                         }
    def_precedence :term            ,{ :prec=>"z="                             }
    def_precedence :methodcall      ,{ :prec=>"y="                             }
    def_precedence :autoincrement   ,{ :prec=>"x="                             }
    def_precedence :exponentiation  ,{ :prec=>"w=", :assoc=>:right, :assign=>1 }
    def_precedence :symbolic_unary  ,{ :prec=>"v="                             }
    def_precedence :multiplicative  ,{ :prec=>"u=", :assoc=>:left,  :assign=>1 }
    def_precedence :additive        ,{ :prec=>"t=", :assoc=>:left,  :assign=>1 }
    def_precedence :replication     ,{ :prec=>"s=", :assoc=>:left,  :assign=>1 }
    def_precedence :concatenation   ,{ :prec=>"r=", :assoc=>:left,  :assign=>1 }
    def_precedence :junctive_and    ,{ :prec=>"q=", :assoc=>:list,  :assign=>1 }
    def_precedence :junctive_or     ,{ :prec=>"p=", :assoc=>:list,  :assign=>1 }
    def_precedence :named_unary     ,{ :prec=>"o=",                            }
    def_precedence :nonchaining     ,{ :prec=>"n=", :assoc=>:non               }
    def_precedence :chaining        ,{ :prec=>"m=", :assoc=>:chain, :bool=>1   }
    def_precedence :tight_and       ,{ :prec=>"l=", :assoc=>:left,  :assign=>1 }
    def_precedence :tight_or        ,{ :prec=>"k=", :assoc=>:left,  :assign=>1 }
    def_precedence :conditional     ,{ :prec=>"j=", :assoc=>:right,            }
    def_precedence :item_assignment ,{ :prec=>"i=", :assoc=>:right             }
    def_precedence :loose_unary     ,{ :prec=>"h=",                            }
    def_precedence :comma           ,{ :prec=>"g=", :assoc=>:list,             }
    def_precedence :list_infix      ,{ :prec=>"f=", :assoc=>:list,  :assign=>1 }
    def_precedence :list_assignment ,{ :prec=>"i=", :sub=>"e=", :assoc=>:right }
    def_precedence :list_prefix     ,{ :prec=>"e=",                            }
    def_precedence :loose_and       ,{ :prec=>"d=", :assoc=>:left,  :assign=>1 }
    def_precedence :loose_or        ,{ :prec=>"c=", :assoc=>:left,  :assign=>1 }
    def_precedence :LOOSEST         ,{ :prec=>"a=!",                           }
    def_precedence :terminator      ,{ :prec=>"a=", :assoc=>:list              }
    SLOOSEST = HLOOSEST[:prec]

    #R role PrecOp
    def precop_method(m,defaults)
        if not defaults[:transparent]
            mO = m[:O]
            mO = m[:O] = {} if not mO
            defaults.each{|k,v| mO[k] = v if not mO.key? k }
        end
        return m;
    end
    #R XXX I'm unsure what make() (in expect_term, and elsewhwere) should be doing.
    def make(m,overwrite)
        overwrite.each{|k,v| m[k] = v }
    end

    #R things like "class Term does PrecOp[|%term] {}" are folded into
    #R def_precedence above.

    $env_vars.scope_enter(:endsym,:unitstopper,:endstmt,:endargs)
    $env_vars[:endsym] = "null"
    $env_vars[:unitstopper] = "_EOS"
    $env_vars[:endstmt] = -1
    $env_vars[:endargs] = -1
    #R helper
    def scan_unitstopper
        us = $env_vars[:unitstopper];
        ((if us == '_EOS'; @scanner.eos?
          else; raise "assert: known unitstopper: #{us}"
          end) or
         permit_partial_parse or
         panic("Can't understand next input--giving up"))
    end

    #R XXX TODO - the non-simple constraints are not being applied.
    token_category :category
    token_category :sigil
    token_category :twigil
    token_category :special_variable
    token_category :version
    token_category :module_name
    token_category :term
    token_category :quote, 'nofat'
    token_category :prefix
    token_category :infix
    token_category :postfix
    # def_precedence_alias is what "is defequiv" means.
    def_precedence_alias :prefix,  :symbolic_unary
    def_precedence_alias :infix,   :additive
    def_precedence_alias :postfix, :autoincrement
    token_category :dotty,  'unspacey'
    token_category :circumfix
    token_category :postcircumfix
    token_category :regex_metachar
    token_category :regex_backslash
    token_category :regex_assertion
    token_category :regex_quantifier
    token_category :regex_mod_internal
    token_category :quote_mod
    token_category :q_backslash
    token_category :qq_backslash
    token_category :trait_verb,        'nofat_space'
    token_category :trait_auxiliary,   'nofat_space'
    token_category :type_declarator,      'nofat'
    token_category :scope_declarator,     'nofat'
    token_category :package_declarator,   'nofat'
    token_category :plurality_declarator, 'nofat'
    token_category :routine_declarator,   'nofat'
    token_category :regex_declarator,     'nofat'
    token_category :statement_prefix,     'nofat'
    token_category :statement_control, 'nofat_space'
    token_category :statement_mod_cond,   'nofat'
    token_category :statement_mod_loop,   'nofat'
    token_category :infix_prefix_meta_operator
    token_category :infix_postfix_meta_operator
    token_category :infix_circumfixfix_meta_operator
    token_category :postfix_prefix_meta_operator
    token_category :prefix_postfix_meta_operator
    token_category :prefix_circumfix_meta_operator
    #R categories added:
    token_category :terminator
    token_category :infix_circumfix_meta_operator

    def unspacey; unsp;true end
    def nofat_space
        before(/\s|\#/) and
        nofat #R# before{nofat} # nofat is already a zero-length assertion.
    end

    # Lexical routines

    def nofat
        # make sure we're at end of a non-autoquoted identifier
        # regex nofat { <!before » \h* <.unsp>? '=>' > <!before \w> }
        (not before{ scan(/»/) and scan(/[ \t]*/) and (unsp;true) and scan(/=>/) } and
         not before(/\w/u))
    end


    if RUBY_VERSION =~ /\A(1\.9|2\.)/ # have look-behind
        $have_lookbehind = true
        eval %q{ def wsp__after_and_before_ws; scan(/(?<=\w)(?=\w)/u) end }
    else
        $have_lookbehind = false
        eval %q{ def wsp__after_and_before_ws; scan(/(?=\w)/u) and after(/\w/u)  end }
    end

    #R ws, renamed wsp to make life easier.
    def wsp
        pos == ws_to and return true
        #R# || <?after \w> <?before \w> ::: <!>        # must \s+ between words
        #R# after(/\w/u) and before(/\w/u) and return false
        wsp__after_and_before_ws and return false
        @ws_from = pos
        starTOK{
            unsp or
            let_pos{ vws and heredoc } or
            unv
        }
        @ws_to = pos
        true
    end
    def unsp
        scan(/\\(?=\s|\#)/) and starTOK{ vws or unv }
    end
    def unsp?; (unsp;true); end
    def vws
        scan(/[\r\n\f]/) and (moreinput;true)
    end
    def moreinput
        send($env_vars[:moreinput]) if $env_vars.defined?(:moreinput);
    end

    def unv
        let_pos{
            scan(/[ \t]+/) or
            (@scanner.bol? and pod_comment) or
            let_pos{
               scan(/\#/) and bracketed and
               (not(@scanner.bol?) or panic("Can't use embedded comments in column 1"))
            } or
            (scan(/\#.*/u))
        }
    end

    def ident; scan(/[[:alpha:]_]\w*/u); end
    
    def pod_comment
        @scanner.bol? and scan(/=/) and unsp? and
        (let_pos{
             scan(/begin[ \t]*/) and
             #wsp and #R XXX causes problems with "=begin\n=head...".
             (id= ident;true) and
             scan(/(?:.|\n)*?\n=end\b/u) and #R XXX doesn't accept unsp between '=' and 'end'.
             (not(id) or (wsp and scan(/#{id}.*/u)))
         } or
         scan(/.*/u))
    end

    # Top-level rules
    
    def _UNIT (_unitstopper =nil)
        $env_vars.scope_enter(:unitstopper)
        $env_vars[:unitstopper] = _unitstopper || "_EOS"
        # UNIT: do {
        v = comp_unit()
        $env_vars.scope_leave
        v
    end

    def comp_unit
        $env_vars.scope_enter(:begin_compunit,:endstmt,:endargs)
        $env_vars[:begin_compunit] = 1
        $env_vars[:endstmt] = -1
        $env_vars[:endargs] = -1
        b = pos
        wsp
        _sl = statementlist
        wsp
        scan_unitstopper #R panic() is in scan_unitstopper
        wsp
        $env_vars.scope_leave
        _match_from(b,{:statementlist=>_sl},:comp_unit)
    end

    def pblock
        b = pos
        l=s=nil
        quesTOK{ l= _lambda and s= signature }; bl= block or return false
        h={:block=>bl};_hkv(h,:lambda,l);_hkv(h,:signature,s)
        _match_from(b,h,:pblock)
    end

    def _lambda; scan(/->|<->/); end

    def block
        b=pos
        let_pos{ scan(/\{/) and sl= statementlist and _block_rest and
                 _match_from(b,{:statementlist=>sl},:block) }
    end

    #R QUESTION regexp_block lacks block's \h*.  Intentional?
    def regex_block
        let_pos{
            b = pos
            scan(/\{/) and r= regex('}') and _block_rest and
            _match_from(b,{:regex=>r},:regex_block) }
    end

    def _block_rest
        ( scan(/\}/) or panic("Missing right brace") ) and
          #R QUESTION <?before < ,: >> typo?
          ( let_pos{ scan(/[ \t]*/) and unsp? and before(/[,:]/) } or
            let_pos{
                unv; before(/\n/) and wsp and
                #R XXX BAD should be let
                ($env_vars[:endstmt] = ws_from;true)
            } or
            #R XXX BAD should be let
            ($env_vars[:endargs] = pos) )
    end


    def statementlist
        starRULE{ s= statement and eat_terminator and s }
    end

    def semilist
        starRULE{ s= statement and eat_terminator and s }
    end

    def label
        let_pos{ id = ident and scan(/:(?=\s)/) and wsp and id }
        #R ...missing... bookkeeping - needed?
    end


    def _hkv(h,k,v)
        h[k] = v if v and (v.instance_of?(Array) ? (not v.empty?) : true)
        h
    end

    def statement
        $env_vars.scope_enter(:endstmt)
        $env_vars[:endstmt] = -1;
        (label_ = control_ = expr_ = mod_loop_ = mod_cond_ =
         loopx_ = condx_ = mod_condloop_ = modexpr_ = nil)
        let_pos{
            b = pos
            wsp
            label_= starTOK{ label }
            (begin
                 let_pos{
                     (( control_= statement_control or
                        before(/;/) )
                      )
                 }
             end or
             begin
                 let_pos{
                     b1 = nil
                     endstmt = $env_vars[:endstmt]; endargs = $env_vars[:endargs]
                     expr_= _EXPR and
                     (b1 = pos;true) and
                     (let_pos{
                          before{ stdstopper_no_mod } #R XXX NONSPEC KLUDGE _no_mod - STD.pm bug? workaround.
                      } or
                      let_pos{
                          $env_vars[:endstmt] = endstmt; $env_vars[:endargs] = endargs
                          mod_loop_= statement_mod_loop #R XXX NONSPEC bug? workaround # and loopx= _EXPR
                      } or
                      let_pos{
                          $env_vars[:endstmt] = endstmt; $env_vars[:endargs] = endargs
                          endstmt1 = $env_vars[:endstmt]; endargs1 = $env_vars[:endargs]
                          mod_cond_= statement_mod_cond and #R XXX NONSPEC bug? workaround # condx= _EXPR and
                          (let_pos{
                               before{ stdstopper_no_mod } #R XXX NONSPEC KLUDGE _no_mod - STD.pm bug? workaround.
                           } or
                           let_pos{
                               $env_vars[:endstmt] = endstmt1; $env_vars[:endargs] = endargs1
                               mod_condloop_= statement_mod_loop #R XXX NONSPEC bug? workaround # and loopx= _EXPR
                           } or
                           false)
                      } or
                      false)
                     #R NONSPEC  modexpr missing
                     #R# (modexpr_= b1 != pos ? _match_from(b1,{},:statement__modexpr) : nil; true)
                 }
             end) and
            begin
                h = {}
                _hkv(h,:label,label_)
                _hkv(h,:control,control_)
                _hkv(h,:expr,expr_)
                _hkv(h,:mod_loop,mod_loop_)
                _hkv(h,:mod_cond,mod_cond_)
                _hkv(h,:loopx,loopx_)
                _hkv(h,:condx,condx_)
                _hkv(h,:mod_condloop,mod_condloop_)
                _hkv(h,:modexprp,modexpr_)
                m = _match_from(b,h,:statement)
            end
        } || ($env_vars.scope_leave; false) #R XXX fails to reset endargs
    end

    def eat_terminator
        ( scan(/;/) or
          ($env_vars[:endstmt] == ws_from) or 
          before{ terminator } or
          @scanner.eos? or @scanner.check(/\n/) or
          panic("Statement not terminated properly"))
    end

    def_tokens_rest :statement_control,false,%w{ use no },%q{
      e=nil
      nofat_space and wsp and
      mn = module_name and wsp and (e=_EXPR and wsp;true) and
      (h={:module_name=>mn};_hkv(h,:EXPR,e);_match_from(start,h,:<sym>))
    }
    def_tokens_rest :statement_control,false,%w{ if }, %q{
      nofat_space and wsp and
      e=_EXPR and wsp and pb=pblock and wsp and
      ei=starRULE{ b1=pos; scan(/elsif/) and nofat_space and wsp and
                   e1=_EXPR and wsp and pb1=pblock and wsp and
                   _match_from(b1,{:elsif_expr=>e1,:elsif_block=>pb1},:elsif) } and
      el=quesRULE{ b1=pos; scan(/else/) and nofat_space and wsp and
                   pb1=pblock and wsp and
                   _match_from(b1,{:pblock=>pb1},:if__else) } and
      (h={:if_expr=>e,:if_block=>pb,:elsif=>ei};_hkv(h,:else,el);
       _match_from(start,h,:if))
    }

    def_tokens_rest :statement_control,false,%w{ unless while until  for given when },%q{
      nofat_space and wsp and
      e=_EXPR and wsp and pb=pblock and wsp and
      _match_from(start,{:expr=>e,:block=>pb},:<sym>)
    }
    def_tokens_rest :statement_control,false,%w{ repeat },%q{
      nofat_space and wsp and
      ((wu= scan(/while|until/) and wsp and e=_EXPR and wsp and bk=block and wsp and
        _match_from(start,{'0'=>wu,:wu_expr=>e,:wu_block=>bk},:repeat)) or
       (bk=block and wsp and wu=scan(/while|until/) and wsp and e=_EXPR and wsp and
        _match_from(start,{'0'=>wu,:expr_wu=>e,:block_wu=>bk},:repeat)))
    }
    def_tokens_rest :statement_control,false,%w{ loop },%q{
      nofat_space and wsp and
      ((scan(/\(/) and wsp and
        e1= _EXPR and wsp and scan(/;/) and wsp and
        e2= _EXPR and wsp and scan(/;/) and wsp and
        e3= _EXPR and wsp and scan(/\)/) and wsp and
        (h={};_hkv(h,:loop_e1,e1);_hkv(h,:loop_e2,e2);_hkv(h,:loop_e3,e3);
         eee= _match_from(start,h,:loop__eee)
       );true) and
       bk= block and wsp and
       (h={:loop_block=>bk};_hkv(h,:loop_eee,eee);
        _match_from(start,h,:loop)))
    }

    def_tokens_rest :statement_control,false,%w{
      default BEGIN CHECK INIT END START ENTER LEAVE KEEP UNDO FIRST NEXT LAST
      PRE POST CATCH CONTROL },
      %q{
        nofat_space and wsp and
        bk=block and wsp and
        _match_from(start,{:block=>bk},:<sym>)
      }

    def_tokens_rest :term,false,%w{
      BEGIN CHECK INIT START ENTER FIRST },
      %q{
        wsp and
        bk=block and wsp and
        _match_from(start,{:block=>bk},:<sym>)
      }

    def modifier_expr; wsp and e=_EXPR and wsp and e; end
    def_tokens_rest :statement_mod_cond,false,%w{ if unless when },%q{
      nofat and wsp and
      me=modifier_expr and wsp and
      _match_from(start,{:modifier_expr=>me},:<sym>) #R NONSPEC normalized name, ignored #= name.
    }
    def_tokens_rest :statement_mod_loop,false,%w{ while until for given },%q{
      nofat and wsp and
      me=modifier_expr and wsp and
      _match_from(start,{:modifier_expr=>me},:<sym>) #R NONSPEC normalized name, ignored #= name.
    }
    
    def role_name
        b=pos
        pc=nil
        (mn= module_name and (before(/\[/) and pc= postcircumfix;true) and
         (h={:module_name=>mn};_hkv(h,:postcircumfix,pc);
          _match_from(b,h,:role_name)))
    end

    #R reordered.  depreciated needs to come first.
    def_token_full :module_name,false,'depreciated',/(?=v6-alpha)/,%q{
      scan(/v6-alpha/) and
       _match_from(start,{},:depreciated)
    }
    def_token_full :module_name,false,'normal',/(?=\w)/u,%q{
      (n=name and na= starTOK{ colonpair }) and
      (h={:name=>n};_hkv(h,:colonpair,na)
       _match_from(start,h,:normal))
    }

    def whatever; scan(/\*/); end

    def_tokens_rest :version,false,%w{ v },%q{ scan(/ \d+ ( \. (\d+ | \*) )* \+?/x) }

    ###################################################

    def pre
        precircum_ = prepost_ = nil
        b = pos
        let_pos{
            ((prefix_= prefix) or 
             (precircum_= prefix_circumfix_meta_operator)
             ) and
            (prepost_= starTOK{ prefix_postfix_meta_operator }) and
            wsp and
            (o = (prefix_||precircum_)[:O];
             h={:O=>o};
             _hkv(h,:prefix,prefix_);
             _hkv(h,:precircum,precircum_);
             _hkv(h,:prepost,prepost_);
             _match_from(b,h,:pre))
        }
    end

    def expect_term
        let_pos{
            b = pos
            pre_=adv=nil
            return false if before{ stdstopper } 
            (noun_= noun or
             (pre_= plusTOK{ pre } and noun_= noun)) and
            # also queue up any postfixes, since adverbs could change things
            post_= starTOK{ post } and
            wsp and
            (adv_= adverbs;true) and
            (h={};
             _hkv(h,:noun,noun_)
             _hkv(h,:pre,pre_)
             _hkv(h,:post,post_)
             _hkv(h,:adverbs,adv_)
             _match_from(b,h,:expect_term))
        }
    end

    def adverbs
        b = pos
        colonpair_=nil
        not before{ stdstopper } and
        (plusTOK{ _cp = colonpair and (colonpair_ ||= []; colonpair_.push(_cp);true) and wsp } and
         ( prop = $env_vars[:prevop] or
           panic('No previous operator visible to adverbial pair ('+colonpair_.inspect+')');
           prop.adverb(colonpair_); true ) and
         (h={:colonpair=>colonpair_};_match_from(b,h,:adverbs)))
    end

    def noun
        (fatarrow || package_declarator || scope_declarator || plurality_declarator ||
         routine_declarator || regex_declarator || type_declarator || circumfix ||
         dotty || subcall || variable || value || capterm || sigterm || 
         statement_prefix || term ||  #R NONSPEC out of order
         colonpair)
    end
    
    def fatarrow
        let_pos{
            b = pos
            (key= ident and scan(/[ \t]*/) and
             scan(/\=>/) and wsp and
             val = _EXPR(Hitem_assignment)) and
            _match_from(b,{:key=>key,:val=>val},:fatarrow)
        }
    end

    def colonpair
        b = pos; id1=id2=pc1=pc2=si=tw=dsn=nil
        let_pos{
        (scan(/:/) and b1 = pos and
         (let_pos{ scan(/!/) and id1= ident } or
          ( id2= ident and (unsp; pc1= postcircumfix;true)) or
          pc2= postcircumfix or
          let_pos{ si= sigil and (tw= twigil;true) and dsn= desigilname }) and
         (false_ = id1 ? _match_from(b1,{:ident=>id1},:colonpair__false) : nil;
          value_ = id2 ? _match_from(b1,{:ident=>id2,:postcircumfix=>pc1},:colonpair__value) : nil;
          structural_ = pc2;
          varname_ = si ? _match_from(b1,{:sigil=>si,:twigil=>tw,:desigilname=>dsn},:colonpair__varname) : nil;
          h={};
          _hkv(h,:false,false_)
          _hkv(h,:value,value_)
          _hkv(h,:structural,structural_)
          _hkv(h,:varname,varname_)
          _match_from(b,h,:colonpair)))
        }
    end

    def quotepair
        b = pos; id1=id2=pc1=n=suf=nil
        let_pos{
            scan(/:/) and b1 = pos and
            (let_pos{ scan(/!/) and id1= ident } or
             (id2= ident and (unsp; before(/\(/) and pc1= postcircumfix;true)) or
             #R NONSPEC spec doesn't have n and suffix named, so this is speculative.
             (n= scan(/\d+/) and suf= scan(/[a-z]+/))) and
            (h={}
             _hkv(h,:ident,(id1 || id2))
             _hkv(h,:postcircumfix,pc1)
             _hkv(h,:n,n)
             _hkv(h,:suffix,suf)
             false_ = id1 ? _match_from(b1,h,:quotepair__false) : nil;
             value_ = id2 ? _match_from(b1,h,:quotepair__value) : nil;
             nth_ = suf ? _match_from(b1,h,:quotepair__nth) : nil;
             h={};
             _hkv(h,:false,false_)
             _hkv(h,:value,value_)
             _hkv(h,:nth,nth_)
             _match_from(b,h,:quotepair))
        }
    end

    def expect_tight_infix(loosest)
        let_pos {
            ((not before{ scan(/\{/) or _lambda }) and # presumably a statement control block
             ei= expect_infix and
             #R# { $<O> := $<expect_infix><O> }  #R not required as ei is passed on directly.
             (ei[:O][:prec] > loosest) and
             ei)
        }
    end

    def expect_infix
        b = pos; i=ipost=ipre=icirc=nil; op=nil
        not(before{infixstopper}) and
        ((let_pos{
              i= infix and
              ($env_vars.scope_enter(:opS)   # (used in infix_postfix_meta_operator)
               $env_vars[:opS] = i
               ipost= starTOK{ infix_postfix_meta_operator }) and # may modify $+op
              (op = $env_vars[:opS])
          } or
          (ipre= infix_prefix_meta_operator) or
          (icirc= infix_circumfix_meta_operator)) and
         (h={};
          _hkv(h,:infix,i)
          _hkv(h,:infix_postfix_meta_operator,ipost)
          _hkv(h,:infix_prefix_meta_operator,ipre)
          _hkv(h,:infix_circumfix_meta_operator,icirc)
          h[:O] = op ? op[:O] : (ipre || icirc)[:O]
          h[:sym] = (i || ipre || icirc)[:sym]
          _match_from(b,h,:expect_infix)))
    end

    def_tokens_rest :dotty,:methodcall,%w{ .+ .* .? .= .^ .: .:: .^!},%q{ #R NONSPEC ADDED .::
      unspacey and
      op= methodop and
      _match_from(start,{:sym=>'<sym>',:methodop=>op,:O=>op[:O]},:'<sym>') #R NONSPEC name(s)?
    }
    def_tokens_rest :dotty,:methodcall,%w{ . },%q{
      unspacey and
      op= dottyop
      #R XXX requires an elf update
      #R# _match_from(start,{:sym=>'<sym>',:dottyop=>op,:O=>op[:O]},:'<sym>')
    }
    #R XXX NONSPEC Disabled ! to avoid conflict with prefix:<!> in '!foo()'.
    #def_tokens_rest :dotty,:methodcall,%w{ ! },%q{
    #  unspacey and
    #  op= methodop and
    #  _match_from(start,{:sym=>'<sym>',:methodop=>op,:O=>op[:O]},:'<sym>')
    #}
    def dottyop #R [:O] copying unnecessary as no Match is created.
        methodop or postop
    end

    def post
        let_pos{
            b=pos
            d=postop_=nil;ppmo=[]
            not(before{stdstopper}) and
            # last whitespace didn't end here (or was zero width)
            (pos != ws_to or ws_to == ws_from) and
            before{unspacey} and 
            starTOK{
                let_pos{
                    quesTOK{scan(/\./) and unsp?} and
                    op= postfix_prefix_meta_operator and (ppmo.push op;true) and
                    unsp?
                }
            } and
            (d= dotty or postop_= postop) and
            (h={};
             h[:O] = (d || postop_)[:O]
             _hkv(h,:postfix_prefix_meta_operator,ppmo)
             _hkv(h,:dotty,d)
             _hkv(h,:postop,postop_)
             _match_from(b,h,:post))
        }
    end

    #R XXX TODO I currently don't understand the [LIST] issue.  And so likely dont support it.

    # Note: backtracks, or we'd never get to parse [LIST] on seeing [+ and such.
    # (Also backtracks if on \op when no \op infix exists.)
    def_token_full :prefix_circumfix_meta_operator,false,'reduce',/\[/,%q{
       let_pos{
           b = pos
           scan(/(?=\S*\])/) or return false
           ei=nil
           (let_pos{ ei= expect_infix and scan(/\]/) } or
            let_pos{ scan(/\\\\/) and ei= expect_infix and scan(/\]/) }) and
           (o = ei[:O]
            (not(o[:assoc] == :non) or
             panic("Can't reduce a non-associative operator"))
            (not(o[:prec] == Hconditional[:prec]) or
             panic("Can't reduce a conditional operator"))
            _match_from(b,{:expect_infix=>ei,:O=>o},:reduce))
       }
    }

    def_tokens_simple :prefix_postfix_meta_operator,false,%w{ « }
    def_tokens_simple :prefix_postfix_meta_operator,false,%w{ << }
    def_tokens_simple :postfix_prefix_meta_operator,false,%w{ » }
    def_tokens_simple :postfix_prefix_meta_operator,false,%w{ >> }

    def_tokens_rest :infix_prefix_meta_operator,:chaining,%w{ ! },%q{
      i=nil
      lex1(:negation) and
      let_pos{ (not before(/!/)) and i= infix } and
      (o = i[:O]
       (o[:assoc] == :chain or
        o[:assoc] and o[:bool] or
        panic("Only boolean infix operators may be negated"))
       (o[:hyper] and
        panic("Negation of hyper operator not allowed"))
       _match_from(start,{:infix=>i,:O=>o},:<sym>))
    }

    def lex1(s)
        false and #R XXX UNIMPLEMENTED - STD.pm being refactored
        panic("Nested #{s} metaoperators not allowed")
        true
    end

    def_token_full :infix_circumfix_meta_operator,:list_infix,'X X',/X/,%q{
      lex1(:cross) and let_pos{ i= infix and scan(/X/) } and
      _match_from(start,{:infix=>i,:O=>i[:O]},:'<sym>')
    }

    def_token_full :infix_circumfix_meta_operator,:hyper,'« »',/(?=«|»|<<|>>)/,%q{
      i=nil
      lex1(:hyper) and
      (let_pos{ scan(/«|»/) and i= infix and scan(/«|»/) } or
       let_pos{ scan(/<<|>>/) and i= infix and scan(/<<|>>/) }) and
      _match_from(start,{:infix=>i,:O=>i[:O]},:'<sym>')
    }

    def_tokens_rest :infix_postfix_meta_operator,:item_assignment,%w{ = },%q{
       lex1(:assignment) and
       (op = $env_vars[:opS]
        o = op[:O]
        (o[:prec] > Hitem_assignment[:prec] or
         panic("Can't make assignment op of operator looser than assignment"))
        (not(o[:assoc] == :chain) or
         panic("Can't make assignment op of boolean operator"))
        (not(o[:assoc] == :non) or
         panic("Can't make assignment op of non-associative operator"))
        _match_from(start,{:O=>o},:'<sym>'))
    }
    
    def_tokens_rest :postcircumfix,:methodcall,%w{ ( },%q{ sl=semilist and scan(/\)/) and sl }
    def_tokens_rest :postcircumfix,:methodcall,%w{ [ },%q{ sl=semilist and scan(/\]/) and sl }
    def_tokens_rest :postcircumfix,:methodcall,%w{ \{ },%q[ sl=semilist and scan(/\}/) and sl ]
    def_tokens_rest :postcircumfix,:methodcall,%w{ < },%q{ w=anglewords('>') and scan(/>/) and w }
    def_tokens_rest :postcircumfix,:methodcall,%w{ << },%q{ w=shellwords('>>') and scan(/>>/) and w }
    def_tokens_rest :postcircumfix,:methodcall,%w{ « },%q{ w=shellwords('»') and scan(/»/) and w }
    
    def postop
        #R We pass though, and so don't have to set [:O].
        (( postfix ) or
         ( postcircumfix ))
    end

    def methodop
        b = pos; id=v=q=sl=al=nil
        ((id= ident or
          (before(/\$|\@/) and v= variable) or
          (before(/[\'\"]/) and q= quote and (q =~ /\W/u or panic("Useless use of quotes")))) and
         unsp? and
         (let_pos{ scan(/\./); unsp; scan(/\(/) and sl= semilist and scan(/\)/) } or
          let_pos{ scan(/\:/) and before(/\s/) and (not $env_vars[:inqoute]) and al= arglist } or
          null) and
         (h={};
          _hkv(h,:ident,id)
          _hkv(h,:variable,v)
          _hkv(h,:quote,q)
          _hkv(h,:semilist,sl)
          _hkv(h,:arglist,al)
          _match_from(b,h,:methodop)))
    end

    def arglist
        $env_vars.scope_enter(:endargs)
        $env_vars[:endargs] = false #R ??? XXX "0" or "false"?
        wsp and
        v = _EXPR(Hlist_prefix)
        $env_vars.scope_leave
        v
    end

    def anglewords(stop)
        #wsp and starTOK{ (not before(/#{stop}/u)) and scan(/./u) } # XXX need to split
        wsp and scan(/(?:(?!#{stop}).)*/u) #R# Modified, to get str, not array of char.
    end

    def shellwords(stop)
        wsp and starTOK{ (not before(/#{stop}/)) and scan(/./u) } # XXX need to split
    end

    #R inlined lambda in re
    def_token_full :circumfix,:term,'{ }',/(?=\{|->|<->)/,%q{ pblock }

    def variable_decl
        b = pos
        e1=e2=nil
        (var = variable and # ( xXXX[:sigil] = var[:sigil] ) and
         quesTOK{
             %w{ @ % }.member?(var[:sigil]) and
             wsp and
             before(/[\<\(\[\{]/) and
             postcircumfix
         } and
         t= starTOK{trait} and
         wsp and
         #R XXX only first value is captured.
         #R QUESTION spec rx would seem to not interleave the = and .= ?
         quesTOK{
             ((scan(/\=/) and wsp and e1=_EXPR(var[:sigil] == '$' ? Hitem_assignment : Hlist_prefix)) or
              (scan(/\.\=/) and wsp and e2=_EXPR(Hitem_assignment)))
         }) and
         (h={};
          _hkv(h,:variable,var)
          _hkv(h,:default_value,e1) #R XXX speculative name
          _hkv(h,:default_call,e2) #R XXX speculative name
          _hkv(h,:traits,t)
          _match_from(b,h,:variable_decl))
    end

    def scoped #rule
        regex_declarator or package_declarator or
            #R XXX not backtracking properly - don't know if it needs to yet
            b=pos
            ft=v=sig=ts=pd=rd=td=nil
            (let_pos{
                 ft= starRULE{fulltypename} and wsp and
                 ( v= variable_decl or
                   let_pos{ scan(/\(/) and wsp and sig= signature and wsp and scan(/\)/) and wsp and ts= starRULE{trait} } or
                   pd= plurality_declarator or
                   rd= routine_declarator or
                   td= type_declarator)
             }) and
            (h={};
             _hkv(h,:fulltypename,ft)
             _hkv(h,:variable_decl,v)
             _hkv(h,:signature,sig)
             _hkv(h,:trait,ts)
             _hkv(h,:plurality_declarator,pd)
             _hkv(h,:routine_declarator,rd)
             _hkv(h,:type_declarator,td)
             _match_from(b,h,:scoped))
    end
    def_tokens_rest :scope_declarator,false,%w{ my our state constant has temp },%q{b=pos; s=scoped and _match_from(b,{:scoped=>s},:<sym>) } #R NONSPEC temp added.
    def_tokens_rest :package_declarator,false,%w{ class grammar module role package },%q{b=pos; pd=package_def and _match_from(b,{:package_def=>pd},:<sym>) } #end;end
    def_tokens_rest :package_declarator,false,%w{ require },%q{ module_name and (_EXPR;true) }
    def_tokens_rest :package_declarator,false,%w{ trusts },%q{ module_name }

    #R added a .ws between module_name and block, and before module_name. XXX
    def package_def
        let_pos{
            b = pos
            mn=traits_=bk=nil
            (wsp and
             (mn = quesRULE{ module_name } and wsp and
              traits_= starRULE{ trait } and wsp and
              (let_pos{ $env_vars[:begin_compunit] and
                before(/;/) and # XXX NONSPEC Dont eat the ; , it's needed by the caller.
                (mn.bool or panic("Compilation unit cannot be anonymous")) and
                ($env_vars[:begin_compunit] = false
                 true)
               } or
               (bk= block and wsp)
               ))) and
            (h={};
             _hkv(h,:module_name,mn)
             _hkv(h,:traits,traits_)
             _hkv(h,:block,bk)
             _match_from(b,h,:package_def))
        }
    end

    def pluralized
        let_pos {
            wsp and
            (variable_decl or
             let_pos{
                 scan(/\(/) and wsp and signature and wsp and
                 scan(/\)/) and wsp and
                 ruleSTAR{trait} } or
             package_declarator or
             routine_declarator or
             regex_declarator or
             type_declarator) }
    end

    def_tokens_rest :plurality_declarator,false,%w{ multi proto only },%q{
       if not before{ wsp and scan(/sub\b|method\b/) } #R XXX NONSPEC ADDED
         r= routine_def and _match_from(start,{:routine_def=>r},:<sym>)
       else
         p= pluralized and _match_from(start,{:pluralized=>p},:<sym>)
       end
    }
    def_tokens_rest :routine_declarator,false,%w{ sub },%q{ routine_def }
    def_tokens_rest :routine_declarator,false,%w{ method submethod },%q{ method_def }
    def_tokens_rest :routine_declarator,false,%w{ macro },%q{ macro_def }
    def_tokens_rest :regex_declarator,false,%w{ regex token rule },%q{ regex_def }


    # Most of these special variable rules are there simply to catch old p5 brainos
    #R so most are ignored here.
    #R Ignore most of them for now.

    def_tokens_simple :special_variable,false,%w{ $/ $! $_ }


    # desigilname should only follow a sigil/twigil

    def desigilname
        ((before(/\$/) and variable) or
         (name))
    end
    
    def variable
        b = pos
        (special_variable or
         let_pos{
             sln=dsl=pc=nil
             (si = sigil and (tw = twigil;true) and
              ((si[:sym] == '&' and (sln = sublongname or return false;sln)) or
               dsl= desigilname) and
              ((tw and tw[:sym] == '.' and unsp? and before(/\(/) and pc= postcircumfix) or
               null)) and
             (h={:sigil=>si,:twigil=>tw};
              _hkv(h,:sublongname,sln)
              _hkv(h,:desigilname,dsl)
              _hkv(h,:postcircumfix,pc)
             _match_from(b,h,:variable))
         } or
         let_pos{ si= sigil and d= scan(/\d+/) and
             (h={:sigil=>si};
              _hkv(h,:desigilname,d) #R XXX non-spec
             _match_from(b,h,:variable))
         } or
         # Note: $() can also parse as contextualizer in an expression; should have same effect
         let_pos{ sigil and before(/[<\(]/) and postcircumfix } or
         # Note: any ::() are handled within <name>, and subscript must be final part.
         # A bare ::($foo) is not considered a variable, but ::($foo)::<$bar> is.
         # (The point being that we want a sigil either first or last but not both.)
         #= FOO::<$x>
         let_pos{ name and scan(/::/) and before(/[\<\{«]/) and postcircumfix }
         )
    end

    def_tokens_simple :sigil,false,%w{ $ @@ @ % & :: }
    def_tokens_simple :twigil,false,%w{ . ! ^ : * + ? = }

    def name
        ident_ = morename_ = nil
        b = pos
        (let_pos{ ident_ = ident and nofat and morename_ = starTOK{morename} } or
         morename_ = plusTOK{morename}) or return false
        h = {}
        _hkv(h,:ident,ident_)
        _hkv(h,:morename,morename_)
        _match_from(b,h,:name)
    end

    def morename
        (scan(/::/) and 
         ((ident) or
          (scan(/\(/) and _EXPR and scan(/\)/))))
    end

    def subshortname
        b=pos
        (let_pos{
             c= category and cp= plusTOK{colonpair} and
             _match_from(b,{:category=>c,:colonpair=>cp},:subshortname)
         } or
         (dsn= desigilname and
          _match_from(b,{:desigilname=>dsn},:subshortname))
         )
    end
    def subshortname_variant_for_method_def
        #R# Late hack to parse method postcircumfix. 2008-Sep-25
        b=pos
        (let_pos{
             c= category and cp= plusTOK{colonpair} and
             _match_from(b,{:category=>c,:colonpair=>cp},:subshortname)
         })
    end
    
    def sublongname
        subshortname and (sigterm;true)
    end

    def subcall
        # XXX should this be sublongname?
        let_pos{b=pos; n=subshortname and unsp? and (scan(/\./);true) and scan(/\(/) and l=semilist and scan(/\)/) and _match_from(b,{:subshortname=>n,:semilist=>l},:subcall) }
    end

    def value; quote || number || version || fulltypename; end

    def typename
        b=pos
        let_pos{ n = name and is_type(n.str) and 
            # parametric type?
            unsp? and
            quesTOK{ before(/\[/) and postcircumfix } and
            (h={};
             _hkv(h,:name,n)
             _match_from(b,h,:typename))
        }
    end

    def fulltypename #R regex XXX
        b = pos
        tn= typename and
            #R# quesRX{ wsp and scan(/of/) and wsp and fulltypename }
            rest= quesRULE{ scan(/of/) and wsp and fulltypename } and
            (a=[tn]
             a += rest[0][:typename] if not rest.empty?
             h={:typename=>a};
             _match_from(b,h,:fulltypename))
    end

    def number; dec_number || integer || rad_number; end
    def integer
        _match_pat %r{
            0 ( b [01]+           ( _ [01]+ )*
              | o [0-7]+         ( _ [0-7]+ )*
              | x [0-9a-fA-F]+ ( _ [0-9a-fA-F]+ )*
              | d \d+               ( _ \d+)*
              | \d+(_\d+)*
              )
            | \d+(_\d+)*
        }x,'integer'
    end
    def radint; integer or (let_pos{ r = rad_number and r[:intpart] and not r[:fracpart] }); end
    def dec_number; scan(/\d+(?:_\d+)*
                           (?: (?: \. \d+(?:_\d+)* (?: [Ee] [+\-]? \d+ )?)
                         |                         (?: [Ee] [+\-]? \d+ ))/x); end
    def rad_number
        let_pos{
            b=pos
            radix_=intpart=fracpart=base=exp=pc=nil
            scan(/:/) and radix_ = scan(/\d+/) and unsp? and
            ( ( scan(/</) and
                intpart = scan(/[0-9a-zA-Z_]+/) and #R XXX NONSPEC ADDED _
                (fracpart = scan(/\.[0-9a-zA-Z_]+/);true) and  #R XXX NONSPEC ADDED _
                (scan(/\*/) and base = radint and scan(/\*\*/) and exp = radint;true) and
                scan(/>/)) or
              ( before(/\[/) and pc= postcircumfix ) or
              ( before(/\(/) and pc= postcircumfix )) and
            (h={}
             _hkv(h,:radix,radix_)
             _hkv(h,:intpart,intpart)
             _hkv(h,:fracpart,fracpart)
             _hkv(h,:base,base)
             _hkv(h,:exp,exp)
             _hkv(h,:postcircumfix,pc)
             _match_from(b,h,:rad_number))
        }
    end
    def octint; scan(/[0-7]+/); end
    def hexint; scan(/[0-9a-fA-F]+/); end




    $herestub_queue = []

    def q_herestub(lang)
        (xXXX[:delimstr] = quotesnabber() or  # force raw semantics on /END/ marker
         return false)
        hs = Herestub.new($xXXX[:delimstr][:delimited][:q][:text], # XXX or some such
                          xXXX,
                          lang);
        $herestub_queue.push hs
    end

    class Herestub
        attr_accessor :delim,:orignode,:lang
        def initialize; @delim,@orignode,@lang=delim,orignode,lang; end
    end

    def theredoc
        @scanner.bol? and scan(/[ \t]*?/) and eat($env_vars[:delim]) and scan(/[ \t]*$\n?/)
    end

    # XXX be sure to temporize @herestub_queue on reentry to new line of heredocs

    def heredoc()
        here = self
        while herestub = $herestub_queue.shift
            $env_vars.scope_enter(:delim)
            $env_vars[:delim] = herestub.delim
            lang = herestub.lang
            doc = nil
            wsS = ""
            here = here.q_unbalanced_rule(lang, method(:theredoc)).xMATCHIFY;
            if here.bool
                if wsS != ""
                    wsequiv = wsS;
                    wsequiv.gsub!(/\A( *)\t/,"$1        "); # per spec
                    here[:text][0].sub!(/\A/,"\n"); # so we don't match ^^ after escapes
                    here[:text].each{|s__|
                        s__.gsub!(/\n(#{wsS}||[ \t]*)/){
                            white = $1;
                            if white == wsS
                                '';
                            else
                                white.sub!(/\A(\t+)/){ #R QUESTION shouldn't it be ^ instead of \A?
                                    #R XXX TODO
                                    #R ' ' x ($0.chars * (COMPILING::<$?TABSTOP> // 8))
                                };
                                white.sub!(/\A#{wsequiv}/,'') ? white : '';
                            end
                        }
                    }
                    here[:text][0].sub!(/^\n/,'')
                end
                herestub.orignode[:doc] = here;
            else
                panic("Ending delimiter $delim not found");
            end
            $env_vars.scope_leave
        end
        return here;
    end


    def self.def_quote(name,args)
        left_sym, = name.split(/\s+/)
        def_token_full :quote,false,name,Regexp.new(Regexp.quote(left_sym))," quotesnabber(#{args})"
    end
    #R# XXX NONSPEC last "close" argument to quotesnabber is non-spec.
    def_quote "' '"  ,%q{':q',"'"}
    def_quote '" "'  ,%q{':qq','"'}
    def_quote '« »'  ,%q{':qq',':ww','»'}
    def_quote '<< >>',%q{':qq',':ww','>>'}
    def_quote '< >'  ,%q{':q',':w','>'}
    def_quote '/ /'  ,%q{':regex','/'}

    # handle composite forms like qww
    def_tokens_rest :quote,false,%w{ qq q },%q{ nofat and  qm = quote_mod and quotesnabber(':<sym>',qm) }

    def_tokens_simple :quote_mod,false,%w{ w ww x to s a h f c b }

    def_tokens_rest :quote,false,%w{ rx m },%q{
      nofat and mod= starTOK{ quotepair } and q= quotesnabber(':regex') and
      (h={}
       _hkv(h,:quotepair,mod)
       _hkv(h,:quotesnabber,q)
       _match_from(start,h,:regex))
    }
    def_tokens_rest :quote,false,%w{ mm },%q{ nofat and quotesnabber(':regex', ':s') }
    def_tokens_rest :quote,false,%w{ s },%q{ nofat and pat=quotesnabber(':regex') and finish_subst(pat) }
    def_tokens_rest :quote,false,%w{ ss },%q{ nofat and pat=quotesnabber(':regex', ':s') and finish_subst(pat) }
    def_tokens_rest :quote,false,%w{ tr },%q{ nofat and pat=quotesnabber(':trans') and finish_subst(pat) }

    def finish_subst(pat)
        $env_vars.scope_enter(:thisop)
        u =(
            # bracketed form
            (pat[:delim] == 2 and ((wsp and infix and
                                    ($env_vars[:thisop][:prec] == Hitem_assignment[:prec] or
                                     panic("Bracketed subst must use some form of assignment")) and
                                    repl=_EXPR(Hitem_assignment)) or :failed)) or
            # unbracketed form
            (repl=q_unbalanced(qlang('Q',':qq'), pat[:delim][0])))
        $env_vars.scope_leave
        u = false if u == :failed
        u
    end

    def finish_trans(pat)
        u =(
            # bracketed form
            (pat[:delim] == 2 and ((wsp and 
                                    repl==q_pickdelim(qlang('Q',':tr'))) or :failed)) or
            # unbracketed form
            (repl=q_unbalanced(qlang('Q',':tr'), pat[:delim][0])))
        u
    end

    # The key observation here is that the inside of quoted constructs may
    # be any of a lot of different sublanguages, and we have to parameterize
    # which parse rule to use as well as what options to feed that parse rule.

    $qlang = {}
    def qlang(*pedigreeA)
        pedigreeS = pedigreeA.inspect
        $qlang[pedigreeS] ||= QLang.create(pedigreeA)
    end

    class QLang
        attr_accessor :option,:tweaker,:parser,:escrule
        def initialize(option,tweaker,parser,escrule)
            @option,@tweaker,@parser,@escrule=option,tweaker,parser,escrule
            initialize_escapes
        end
        attr_accessor :escapes
        def initialize_escapes(*a)
            # super(*a)
            @escapes = []
            if @option
                @escapes.push('\\') if @option[:b]
                @escapes.push('$') if @option[:s]
                @escapes.push('@') if @option[:a]
                @escapes.push('%') if @option[:h]
                @escapes.push('&') if @option[:f]
                @escapes.push('{') if @option[:c]
            end
        end
        def escset; @escapes end
        def self.create(pedigree)
            q = QLang.new(nil,nil,nil,nil)
            base = pedigree.shift
            eval("q.init_root_of_#{base}")
            pedigree.each{|mod|
                ma = mod.match(/^:(!)?(\w+)$/u) or raise "bug"
                all,neg,name = ma.to_a
                q.tweak(name => (neg ? false : 1))
            }
            q
        end
        def init_root_of_Q
            @option  = {}
            @tweaker = :the_Q_tweaker
            @parser  = :q_pickdelim
            @escrule = :quote_escapes
        end
        def tweak(opt)
            send(@tweaker,opt)
        end
        
        def the_Q_tweaker(opt)
            k,v = opt.to_a[0]
            ks = k.to_s
            if %w{ q }.member? ks
                v or panic("Can't turn :q back off");
                (not @option.empty?) and panic("Too late for :q");
                @option = {:b=>1, :s=>false, :a=>false, :h=>false, :f=>false, :c=>false};
            elsif %w{ qq }.member? ks
                v or panic("Can't turn :qq back off");
                (not @option.empty?) and panic("Too late for :qq");
                @option = {:b=>1, :s=>1, :a=>1, :h=>1, :f=>1, :c=>1};
            elsif %w{ b s a h f c  x w ww }.member? ks
                @option[k] = v
            elsif %w{ to }.member? ks
                @parser = :q_heredoc
                @option[k] = v
            elsif %w{ regex }.member? ks
                @tweaker = :the_RX_tweaker
                @parser = :rx_pickdelim
                @option = {}
                @escrule = :regex_metachar
            elsif %w{ trans }.member? ks
                @tweaker = :the_TR_tweaker
                @parser = :tr_pickdelim
                @option = {}
                @escrule = :trans_metachar
            elsif %w{ code }.member? ks
                @tweaker = :the_RX_tweaker