use v5;
use Regexp::Parser::ConvertToSix;

print "# WARNING: This file was mechanically generated by $0\n";

sub bare_trait { "<bare_trait ".join(" ",@_).">" }
sub comma_list { "<comma_list ".join(" ",@_).">" }
sub reassembled_delimited_identifier { "<reassembled_delimited_identifier ".join(" ",@_).">" }
sub verbatimBraces { "<verbatimBraces ".join(" ",@_).">" }
sub verbatimParens { "<verbatimParens ".join(" ",@_).">" }
sub verbatimBrackets { "<verbatimBrackets ".join(" ",@_).">" }
sub maybeParens { "<maybeParens ".join(" ",@_).">" }

sub sym { "<symbol ".join(" ",@_).">" }

sub named {
    my($name,$pat)=@_;
    print "rule $name { $pat }\n";
}
sub nil {'*nil*'}
sub term {
    my($name,$match_on,$pat)=@_;
    print "term $name ".($match_on eq '*nil*' ? "" : "compete(rx{$match_on}) ")."{ $pat }\n";
}
sub nterm {
    my($name,$match_on,$pat)=@_;
    named($name,$pat);
    term($name,$match_on,$pat);
}
sub stmt {
    my($name)=@_;
    print "statement { <$name> }\n";
}

sub sr {
    my($name,@args)=@_;
    "<$name".(join("",map{" $_"}@args)).">";
}
sub srq {
    my($name,@args)=@_;
    "<?$name".(join("",map{" $_"}@args)).">";
}

sub r5 {
    my($pat)=@_;
    my $pat6 = Regexp::Parser->new($pat)->convert_to_six();
#    print STDERR "R5: '$pat'\n";
#    print STDERR "R6: '$pat6'\n";
    $pat6;
}
sub r5s {my($pat)=@_; r5("(?s:$pat)");}
sub r5i {my($pat)=@_; r5("(?i:$pat)");}

sub lit { sym($_[0]) }
sub ques { "[".join("",@_)."]?" }
sub star { "[".join("",@_)."]*" }
sub plus { "[".join("",@_)."]+" }
sub alt {join("|",@_)}
sub seq {join("",@_)}

sub bl { print "\n"; }
sub comment { my($c)=@_;$c =~ s/^/\# /mg; print $c,"\n" }
sub section { my($c)=@_; print "\n";comment($c);print "\n";}


section('-- Arguments -------------------------------------------------------------');

#  named('whiteSpaceLine', seq(r5('(?:(?!\n)\s)*$')));

  named('argument_list', seq(sr('expr')));
bl;
  term('apply_sub_notFolded',sr('sub_name_bare'), seq(sr('sub_name_bare'),r5('(?!\()'),sr('missing_magic')));
bl;
comment('
 missing_magic
        Completely kludge arity, which has become critical. :/

        optional_argument_list = ques(:argument_list)
        optional_expr_above_comma = ques(:expr_above_comma)
        acx = optional_argument_list
        ac1 = seq(:expr_above_comma)
        acq = optional_expr_above_comma
        ac0 = seq()

        ac = {:ref=>1,:pi=>0,:shift=>1,:pop=>1,:try=>1}[n]
        case ac
        when nil; rest.push(*acx)
        when :s;  rest.push(*acx)
        when 1;   rest.push(*ac1)
        when :q;  rest.push(*acq)
        when 0;   rest.push(*ac0)
        else fail("assert") end
        args
      }]]
');
bl;
  term('sub_name_term',nil, seq(sr('sub_name_bare'),r5('(?=\()')));
bl;
  named('method_args', seq(ques(alt(seq(r5(':'),sr('argument_list')),
				    seq(r5('\('),optional_argument_list,srq('ws'),r5('\)'))))));
bl;
  named('implicit_invocant', seq(r5('(?=\.)')));
  term('apply_method_term',nil, seq(sr('implicit_invocant'),r5('\.'),sr('qualified_identifier'),sr('method_args')));

section('-- Declarations ------------------------------------------------');

  named('scope', seq(alt(lit('state'),lit('my'),lit('our'),lit('let'),lit('temp'),lit('env'))));
  named('type', seq(r5('(?:\w|::)[\w:&|?]*')));  comment("related to sr('type_var') and/or sr('type_literal')?");
  named('trait', seq(alt(lit('is'),lit('does')),ques(r5('::')),sr('qualified_identifier'),ques(r5('\([^\)]*\)'))));
  named('block', seq(srq('ws'),r5('\{'),sr('statement_list'),srq('ws'),r5('\}')));
  term('code_block',r5('\{'), seq(sr('block'),ques(sr('whiteSpaceLine'))));
comment('');
  named('sub_declaration', seq(ques(sr('scope'),ques(sr('identifier'))),sr('sub_head'),
			       ques(lit('handles'),sr('expr')),
			       ques(bare_trait(lit('returns'))),
			       ques(sr('sub_parameters__ParensMandatory')),
			       ques(bare_trait(lit('returns'))),
			       star(sr('trait')),
			       sr('block')));
  named('sub_head', seq(alt(seq(ques(lit('multi')),
				alt(lit('sub'),lit('coro'),lit('submethod'),lit('method'),lit('macro'))),
			    lit('multi')),
			sr('sub_name_no_amp')));
  named('sub_parameters__ParensMandatory', seq(lit('('),ques(comma_list(sr('formal_param'))),lit(')')));
  named('sub_parameters__ParensOptional', seq(ques(comma_list(sr('formal_param')))));
  named('param_name', seq(alt(seq(r5('\&'),sr('sub_name_no_amp')),seq(alt(r5('[\$\@\%]'),r5('::')),sr('twigil_opt'),r5('\w+')))));
  named('formal_param', seq(ques(sr('type'),sr('ws')),ques(r5('\\\\')),
			    ques(sr('param_foretaste')),
			    sr('param_name'),
			    ques(sr('param_optness')),
			    star(sr('trait')),
			    ques(sr('param_default')),
			    ques(lit('-->'),sr('param_list__ParensOptional'),alt(sr('formal_param'),sr('type')))));
  named('param_default', seq(lit('='),sr('expr_above_comma')));
  named('param_foretaste', seq(r5('\:|\*')));
  named('param_optness', seq(r5('\?|\!')));
  
comment('');
  named('trusts_declaration', seq(lit('trusts'), sr('qualified_identifier')));
  named('trait_declaration', seq(sr('trait'), sr('ws'),r5('\z|(?=[;}])')));
  named('member_declaration', seq(lit('has'),ques(sr('qualified_identifier')),sr('var_name'),
				  star(sr('trait')),ques(lit('handles'),sr('expr')),
				  ques(lit('='),sr('expr'))));
comment('');
  named('rule_declaration', seq(lit('rule'),sr('identifier'),sr('adverb_hash'),sr('balanced',r5('{'))));
comment('');
  named('var_declaration', seq(sr('scope'),ques(sr('qualified_identifier')),
			       alt(sr('var_name'),
				   seq(r5('\('),comma_list(alt(sr('var_name'),sr('undef_literal'))),r5('\)'))),
			       star(sr('trait')),
			       ques(alt(lit('='),lit('.='),lit(':='),lit('::=')), srq('ws'),
				    alt(sr('var_declaration'),sr('expr')))));
comment('');
  named('package_block_declaration', seq(sr('package_head'),sr('block')));
  named('package_declaration', seq(sr('package_head')));
  named('package_head', seq(ques(sr('scope')),
			    alt(lit('package'),lit('module'),lit('class'),lit('role'),lit('grammar')),
			    sr('qualified_identifier'),
			    ques(sr('version_part'),ques(sr('author_part'))),sr('ws'),star(sr('trait'))));
comment('');
  named('no_declaration', seq(lit('no'),alt(sr('no_version'),sr('use_package'))));
  named('use_declaration', seq(lit('use'),alt(sr('use_version'),sr('use_package'))));
  named('perl_version', seq(r5('(?:v|Perl-)[\d\.]+'),ques(sr('author_part'))));
  named('use_version', seq(sr('perl_version')));
  named('no_version', seq(sr('perl_version')));
  named('use_package', seq(alt(seq(r5('jsan:(?!:)'),sr('use_JSAN_module')),
			       seq(r5('jsperl5:(?!:)'),sr('use_JSPerl5_module')),
			       seq(ques(sr('identifier'),r5(':(?!:)')),sr('use_perl_package')))));
  named('use_perl_package', seq(sr('package_full_name'),
				ques(alt(seq(r5('\('),sr('ws'),r5('\)')),
					 sr('expr')))));
  named('use_JSAN_module', seq(alt(sr('package_full_name'),
				   reassembled_delimited_identifier(".")),
			       alt(seq(r5('\('),sr('ws'),r5('\)')),
				   ques(sr('expr')))));
  named('use_JSPerl5_module', seq(alt(sr('package_full_name'),
				      reassembled_delimited_identifier("::")),
				  alt(seq(r5('\('),sr('ws'),r5('\)')),
				      ques(sr('expr')))));
  named('package_full_name', seq(reassembled_delimited_identifier("::"),ques(sr('version_part')),ques(sr('author_part'))));
  named('version_part', seq(r5('-[\d\.\(\)]+')));
  named('author_part', seq(r5('-[\w\(\)]+')));
comment('');
  named('inline_declaration', seq(lit('inline'),sr('expr')));
  named('require_declaration', seq(lit('require'),sr('package_full_name')));


section('-- Expressions / Terms ------------------------------------------------');

term('fakestring',r5('\''), seq(r5s('\'(?:[^\'\\\\]|\\\\.)*\'')));comment("'");
  term('fakierstring',r5('\"'), seq(r5s('\"(?:[^\"\\\\]|\\\\.)*\"')));
  term('fakeEND',r5('<<\'_END\''), seq(r5s('<<\'_END\' *\n(.+?)\n_END *\n')));
comment('');
  named('dereference', seq(r5('[\$\@\%\&]'),alt(sr('dereference'),sr('sigiled_var'),verbatimBraces(sr('expr')))));
comment('');
  nterm('angle_bracket_literal',r5('<<?|\xab'),
	seq(r5('(?sx:
  <<(?:[^>\\\\]|\\\\.|>(?!>))*>>
  |<(?!<)(?:[^>\\\\]|\\\\.)*>
  |\xab(?:[^\xbb\\\\]|\\\\.)*\xbb
  )')));
  named('hash_subscript_qw', seq(sr('angle_bracket_literal')));
  named('hash_subscript_braces', seq(r5('\{'),ques(sr('expr')),r5('\}')));
  named('hash_subscript', seq(alt(sr('hash_subscript_braces'),sr('hash_subscript_qw'))));
  named('fixity', seq(r5('(?x:
    prefix:|postfix:|infix:|circumfix:|coerce:|self:|term:|
    postcircumfix:|rule_modifier:|trait_verb:|trait_auxiliary:|
    scope_declarator:|statement_control:|infix_postfix_meta_operator:|
    postfix_prefix_meta_operator:|prefix_postfix_meta_operator:|
    infix_circumfix_meta_operator:
  )')));
  named('operator_name', seq(sr('fixity'),alt(sr('identifier'),sr('hash_subscript'))));
  named('sub_name_bare', seq(r5('(?![A-Z])(?!(?:sub|coro|macro)\b)(?!(?:do)\b)'),alt(sr('operator_name'),sr('qualified_identifier'))));
  named('sub_name_no_amp', seq(sr('twigil_opt'),alt(sr('operator_name'),sr('qualified_identifier'))));
  named('sub_name_full', seq(r5('\&'),sr('sub_name_no_amp')));
  named('identifier', seq(r5('[a-zA-Z_]\w*')));
  named('qualified_identifier', seq(r5i('[a-z_]\w*(?:\:\:[a-z_]\w*)*')));
  named('twigil_opt', seq(r5('[\^*?\.!+;]?')));
  term('var_symbolic_deref',r5('[\$\@\%\&]'), seq(r5('[\$\@\%\&]'),plus(r5('::'),alt(r5('!|\/'),seq(sr('twigil_opt'),r5('\w+'))))));
  nterm('var_sub',nil, seq(r5('\&'),sr('sub_name_no_amp'))); comment('(nil) else prefix:& wins :/');
  nterm('var_simple',nil, seq(r5('[\$\@\%]'),sr('twigil_opt'),sr('qualified_identifier')));
  term('var_error',r5('\$!'), seq(r5('\$!')));
  term('var_match_numbered',r5('\$\d+'), seq(r5('\$\d+')));
  term('var_match_named',r5('\$<'), seq(r5('\$<[^>]*>')));
  term('var_match',r5('\$\/'), seq(r5('\$\/')));
  named('var_name', seq(alt(sr('var_sub'),sr('var_simple'))));
comment('');
comment('');
  term('do_block',r5('do\b'), seq(lit('do'),alt(sr('block'), sr('statement'))));
comment('');
  nterm('block_formal_pointy',r5('->'),
	seq(r5('->'),srq('ws'),sr('sub_parameters__ParensOptional'),star(sr('trait')),sr('block')));
  nterm('block_formal_standard',r5('(?:sub|coro|macro)\b'),
	seq(sym(sr('sub|coro|macro')),ques(sr('sub_parameters__ParensMandatory')),star(sr('trait')),sr('block')));
comment('');
comment('
  fraction = /\.[\d_]+/
  expo = /[eE][-+]?\d+/
  number_re = /0(?:b[0-1]+|o[0-7]+|d[0-9]+|x[0-9a-fA-F]+)
              |[0-9][0-9_]*#{fraction}?#{expo}?
              |[-+]?(?:Inf|NaN)\b /x  ');
  term('number',number_re, seq(number_re));
comment('');
  term('empty_list_literal',nil, seq(verbatimParens(srq('ws'))));
comment("
  was r5('\('), but that lost to postcircumfix_paren_empty(len 2),
    which needs to be 2 to compete with postcircumfix:( )sr('0')(len 1).");
bl;
comment('');
  nterm('array_literal',r5('\['), seq(verbatimBrackets(ques(sr('expr')))));
comment('');
  nterm('pair_adverb',nil, seq(r5(':'),alt(sr('shortcut_pair'),sr('regular_pair'))));
  named('shortcut_pair', seq(sr('var_name')));
  named('regular_pair_name', seq(r5('\w+')));
  named('regular_pair', seq(sr('regular_pair_name'),ques(alt(sr('valueDot'),sr('noValue'),sr('valueExp')))));
  named('valueDot', seq(sr('ws'),lit('.'),ques(sr('valueExp'))));
  named('noValue', seq(sr('ws')));
  named('valueExp', seq(alt(verbatimParens(sr('expr')),sr('array_literal'),sr('angle_bracket_literal'))));
comment('');
  named('undef_literal', seq(r5('undef\b')));
comment(''); 
  term('yada_literal',r5('\.\.\.|\?\?\?|!!!'), seq(alt(lit('...'),lit('???'),lit('!!!'))));
comment('');
comment('');
  named('adverb_hash', seq(star(sr('pair_adverb'))));
  named('rx_pattern', seq(srq('ws'),alt(r5s('\/(?:[^\/\\\\]|\\\\.)*\/'),
					r5s('\{(?:[^\}\\\\]|\\\\.)*\}'))));
comment('  the \b_dot_ is to win against apply sub.');
  term('rx_literal',r5s('(?:rx|m|rule)\b.'), seq(sym(r5('rx|m|rule')),sr('adverb_hash'),sr('rx_pattern')));
  term('rx_literal_bare',r5('\/'), seq(r5('(?=\/)'),sr('rx_pattern')));
  term('subst_literal',r5('s\b'), seq(lit('s'),sr('adverb_hash'),sr('rx_pattern'),sr('q_literal1')));
comment('');
comment('');
nterm('closure_trait',r5('(?:BEGIN|CHECK|INIT|FIRST|END)\b'), seq(sym(r5('BEGIN|CHECK|INIT|FIRST|END')),sr('block'))); comment('  also stmt?!?');
comment('');
  term('code_quotation',r5('q:code'), seq(r5('q:code'),ques(lit('(:COMPILING)')),sr('block')));
comment('');
  term('type_var',r5('::'), seq(plus(r5('::'),alt(seq(r5('\('),sr('expr'),r5('\)')),
						  seq(sr('twigil_opt'),r5('\w+'))))));
comment('');
  term('type_literal',nil, seq(r5('(?!Inf\b|NaN\b)(?!(?:BEGIN|CHECK|INIT|FIRST|END)\b)[A-Z]\w*(?:\:\:\w+)*')));


section('-- Constructs ------------------------------------------------');

  named('for_construct', seq(lit('for'), maybeParens(sr('expr')),ques(lit(',')),sr('expr')));
  named('loop_construct', seq(lit('loop'),alt(sr('semi_loop_construct'),sr('post_loop_construct'))));
  named('semi_loop_construct', seq(maybeParens(ques(sr('expr')),lit(';'),ques(sr('expr')),lit(';'),ques(sr('expr'))),sr('block')));
  named('post_loop_construct', seq(sr('block'),sym(r5('while|unitl')),sr('expr')));
comment('');
  named('cond_construct', seq(sym(r5('if|unless')),sr('cond_body')));
  named('elsif_construct', seq(lit('elsif'),sr('cond_body')));
  named('else_construct', seq(lit('else'),sr('block')));
  named('cond_body', seq(sr('cond_part'),sr('block'),ques(alt(sr('elsif_construct'),sr('else_construct')))));
  named('cond_part', seq(maybeParens(alt(sr('type_var'),sr('type_literal'),sr('expr')))));
comment('');
  named('while_until_construct', seq(sym(r5('while|until')),sr('cond_part'),sr('block')));
  named('given_construct', seq(lit('given'),sr('cond_part'),sr('block')));
  named('when_construct', seq(lit('when'),sr('cond_part'),sr('block')));
  named('default_construct', seq(lit('default'),sr('block')));

section('-- expr_statement ----------------------------------------');

  named('expr_statement', seq(sr('expr'),ques(alt(sr('post_conditional'),sr('post_loop'),sr('post_iterate')))));
  named('post_conditional', seq(sym(r5('if|unless')),sr('expr')));
  named('post_loop', seq(sym(r5('while|until')),sr('expr')));
  named('post_iterate', seq(lit('for'),sr('expr')));

section('-- Statements ----------------------------------------');

  named('prog', seq(sr('statement_list'),srq('ws')));
  named('statement_list', seq(star(seq(srq('ws'),sr('statement'),star(lit(';'))))));
bl;
comment('  <statement> is a composite:');
bl;
comment('  block_declaration');
  stmt('sub_declaration');
  stmt('closure_trait');
  stmt('rule_declaration');
  stmt('package_block_declaration');
comment('  declaration');
  stmt('package_declaration');
  stmt('var_declaration');
  stmt('member_declaration');
  stmt('trait_declaration');
  stmt('use_declaration');
  stmt('no_declaration');
  stmt('inline_declaration');
  stmt('require_declaration');
  stmt('trusts_declaration');
comment('  construct');
  stmt('for_construct');
  stmt('loop_construct');
  stmt('cond_construct');
  stmt('while_until_construct');
  stmt('given_construct');
  stmt('when_construct');
  stmt('default_construct');
comment('  expr');
  stmt('expr_statement');