grammar Perl6::PAST::Grammar is TGE::Grammar;

=over

=cut

transform past (ROOT) :language('PIR') {
    node = node['program']
    .local pmc outerblock, past
    outerblock = get_global '$?BLOCK'
    past = new 'PAST::Block'
    past.'init_perl6'('node'=>node, 'name'=>'anon')
    past.'init_lexicals'()
    set_global '$?BLOCK', past
    .local pmc cnode, cpast
    cnode = node['statement_list']
    cpast = tree.'get'('past', cnode, 'Perl6::Grammar::statement_list')
    past.'push'(cpast)
    set_global '$?BLOCK', outerblock
    .return (past)
}


transform past (Perl6::Grammar::block) :language('PIR') {
    .local pmc outerblock, past
    outerblock = get_global '$?BLOCK'
    past = new 'PAST::Block'
    past.'init_perl6'('node'=>node)
    past.'init_lexicals'()
    set_global '$?BLOCK', past
    .local pmc past, cnode, cpast
    cnode = node['statement_list']
    cpast = tree.'get'('past', cnode, 'Perl6::Grammar::statement_list')
    past.'push'(cpast)
    set_global '$?BLOCK', outerblock
    .return (past)
}


transform past (Perl6::Grammar::statement_list) :language('PIR') {
    .local pmc past
    past = new 'PAST::Stmts'
    past.'init'('node'=>node)

    $P0 = node['statement']
    .local pmc iter
    iter = new .Iterator, $P0
  iter_loop:
    unless iter goto iter_end
    .local pmc cnode, cpast
    cnode = shift iter
    cpast = tree.'get'('past', cnode, 'Perl6::Grammar::statement')
    if null cpast goto iter_loop
    past.'push'(cpast)
    goto iter_loop
  iter_end:
    .return (past)
}


transform past (Perl6::Grammar::statement) :language('PIR') {
    $P0 = node['use_statement']
    unless null $P0 goto use_statement
    $P0 = node['block']
    unless null $P0 goto block
    $P0 = node['statement_control']
    unless null $P0 goto statement_control

  expression:
    $P0 = node['expression']
    .return tree.'get'('past', $P0, 'Perl6::Grammar::expression')

  use_statement:
    null $P0
    .return ($P0)
  block:
    $P1 = tree.'get'('past', $P0, 'Perl6::Grammar::block')
    $P1.'blocktype'('immediate')
    .return ($P1)
  statement_control:
    .return tree.'get'('past', $P0, 'Perl6::Grammar::statement_control')
}


=item Perl6::Grammar::statement_control

Generate the PAST representation of a control statement.
This rule simple redispatches to another rule based on the
control statement type (held in the C<KEY> attribute of the
parse tree node).

=cut

transform past (Perl6::Grammar::statement_control) :language('PIR') {
    .local string key
    key = node['KEY']
    .return tree.'get'(key, node, 'Perl6::Grammar::statement_control')
}


=item if (Perl6::Grammar::statement_control)

=item unless (Perl6::Grammar::statement_control)

Generate the PAST representation of an C<if> or C<unless>
statement, including any C<else> and C<elsif> blocks.
From the grammar we know that there must be an equal
number of expressions and blocks, except if there's an C<else>
clause then there will be an extra block.  So, we just
unwrap the expression+block pairs into conditional PAST::Op
nodes.

=cut

transform if (Perl6::Grammar::statement_control) :language('PIR') {
    .local pmc exprlist, blocklist
    exprlist = node['expression']
    blocklist = node['block']

    ##   do we have an else clause?
    .local pmc elsenode, elsepast
    .local int exprc, blockc
    null elsepast
  else_block:
    exprc = elements exprlist
    blockc = elements blocklist
    if blockc <= exprc goto expr_block_pair
    dec blockc
    elsenode = blocklist[blockc]
    elsepast = tree.'get'('past', elsenode, 'Perl6::Grammar::block')
    elsepast.'blocktype'('immediate')
  
  expr_block_pair:
    ##   each remaining block is paired with an "if" (or "elsif")
    ##   expression, except the first which could be "unless".
    .local pmc exprnode, exprpast, thennode, thenpast
    dec exprc
    exprnode = exprlist[exprc]
    exprpast = tree.'get'('past', exprnode, 'Perl6::Grammar::expression')
    thennode = blocklist[exprc]
    thenpast = tree.'get'('past', thennode, 'Perl6::Grammar::block')
    thenpast.'blocktype'('immediate')
    .local pmc past
    past = new 'PAST::Op'
    past.'init'(exprpast, thenpast, elsepast, 'node'=>node, 'pasttype'=>'if')
    elsepast = past
    if exprc > 0 goto expr_block_pair
    .local string key
    key = node['KEY']
    past.'pasttype'(key)
    .return (past)
}

transform unless (Perl6::Grammar::statement_control) :language('PIR') {
    .return tree.'get'('if', node, 'Perl6::Grammar::statement_control')
}


transform past (Perl6::Grammar::expression) :language('PIR') {
    $P0 = node['expr']
    .return tree.'get'('past', $P0, 'Perl6::Grammar::expr')
}


transform past (Perl6::Grammar::expr) :language('PIR') {
    .local string type
    type = node['type']
    if type == 'term:' goto past_term

    ##   figure out the pasttype/pirop values for the node
    .local pmc optable, optok
    .local string pasttype, pirop
    .local int islvalue
    optable = get_hll_global [ 'Perl6::Grammar' ], '$optable'
    optok = optable[type]
    pasttype = optok['past']
    pirop = optok['pirop']
    islvalue = optok['lvalue']

    .local pmc past, iter
    past = new 'PAST::Op'
    past.'init'('node'=>node, 'name'=>type, 'pasttype'=>pasttype, 'pirop'=>pirop, 'islvalue'=>islvalue)

    $P0 = node.'get_array'()
    if null $P0 goto iter_end
    iter = new .Iterator, $P0
    unless iter goto iter_end
    $P0[0;'islvalue'] = islvalue
  iter_loop:
    .local pmc cnode, cpast
    cnode = shift iter
    cpast = tree.'get'('past', cnode, 'Perl6::Grammar::expr')
    if null cpast goto iter_loop
    past.'push'(cpast)
    if iter goto iter_loop
  iter_end:
    .return (past)

  past_term:
    .return tree.'get'('past_term', node, 'Perl6::Grammar::expr')
}


transform past_term (Perl6::Grammar::expr) :language('PIR') {
    .local int islvalue
    islvalue = node['islvalue']

    .local pmc kv, cnode
    .local string cname
    $P0 = node.'get_hash'()
    kv = new .Iterator, $P0
  cname_loop:
    cname = shift kv
    if cname == 'postop' goto cname_loop
    cnode = kv[cname]

    .local pmc iter, pnode
    .local string pname
    $P0 = node['postop']
    if null $P0 goto postop_end
    iter = new .Iterator, $P0
  postop_loop:
    unless iter goto postop_end
    pnode = shift iter
    $P0 = pnode.'get_hash'()
    kv = new .Iterator, $P0
    pname = shift kv
    pnode = pnode[pname]
    pnode['cname'] = cname
    pnode['cnode'] = cnode
    cname = pname
    cnode = pnode
    goto postop_loop

  postop_end:
    cnode['islvalue'] = islvalue
    $S0 = concat 'Perl6::Grammar::', cname
    .return tree.'get'('past', cnode, $S0)
}


transform past (Perl6::Grammar::postfix) :language('PIR') {
    .local string cname
    .local pmc cnode, cpast
    cname = node['cname']
    cnode = node['cnode']
    $S0 = concat 'Perl6::Grammar::', cname
    cpast = tree.'get'('past', cnode, $S0)

    .local string key, type
    .local pmc past
    key = node['KEY']
    type = concat 'postfix:', key
    .return cpast.'new'('PAST::Op', cpast, 'node'=>node, 'name'=>type)
}


transform past (Perl6::Grammar::postcircumfix) :language('PIR') {
    ##   Handle islvalue [always zero for postcircumfix:( ) ]
    .local string key
    key = node['KEY']

    .local int islvalue
    islvalue = node['islvalue']

    ##   process the node we're circumfixing
    .local string cname, type
    .local pmc cnode, cpast, past
    cname = node['cname']
    cnode = node['cnode']
    cnode['islvalue'] = islvalue
    $S0 = concat 'Perl6::Grammar::', cname
    cpast = tree.'get'('past', cnode, $S0)

    ##   if we have an expression, let's get that
    .local pmc xnode, xpast, xargs
    null xpast
    xargs = new .Undef
    $P0 = node['expression']
    if null $P0 goto have_xargs
    xnode = $P0[0]
    xpast = tree.'get'('past', xnode, 'Perl6::Grammar::expression')
    $S0 = xpast.'name'()
    if $S0 == 'infix:,' goto comma_args
    xargs = new .ResizablePMCArray
    push xargs, xpast
    goto have_xargs
  comma_args:
    xargs = xpast.'get_array'()
  have_xargs:

    $S0 = node['KEY']
    if $S0 == '(' goto postcfix_paren
    if $S0 == '[' goto postcfix_bracket

  postcfix_brace:
    cpast.'viviself'("'Perl6Hash'")
    .return cpast.'new'('PAST::Var', cpast, xpast, 'node'=>node, 'scope'=>'keyed', 'viviself'=>'.Undef', 'islvalue'=>islvalue)

  postcfix_bracket:
    cpast.'viviself'("'List'")
    .return cpast.'new'('PAST::Var', cpast, xpast, 'node'=>node, 'scope'=>'keyed', 'viviself'=>'.Undef', 'islvalue'=>islvalue)

  postcfix_paren:
    if cname == 'listop' goto add_xargs
    if cname == 'methodop' goto add_xargs
    .return cpast.'new'('PAST::Op', cpast, xargs :flat, 'node'=>node, 'pasttype'=>'call')

    ##  add our expression to the listop
  add_xargs:
    unless xargs goto iter_end
    .local pmc iter
    iter = new .Iterator, xargs
  iter_loop:
    unless iter goto iter_end
    $P0 = shift iter
    cpast.'push'($P0)
    goto iter_loop
  iter_end:
    .return (cpast)
}


transform past (Perl6::Grammar::methodop) :language('PIR') {
    .local string cname
    .local pmc cnode, cpast
    cname = node['cname']
    cnode = node['cnode']
    $S0 = concat 'Perl6::Grammar::', cname
    cpast = tree.'get'('past', cnode, $S0)

    .local pmc past
    .local string name
    name = node['ident']
    past = new 'PAST::Op'
    $P0 = node['listop_expression']
    if null $P0 goto no_args
    .local pmc anode, apast
    anode = $P0[0]
    apast = tree.'get'('past', anode, 'Perl6::Grammar::expression')
    $S0 = apast.'name'()
    if $S0 == 'infix:,' goto comma_args
    past.'init'(cpast, apast, 'node'=>node, 'name'=>name, 'pirop'=>'callmethod')
    .return (past)
  comma_args:
    $P0 = apast.'get_array'()
    past.'init'(cpast, $P0 :flat, 'node'=>node, 'name'=>name, 'pirop'=>'callmethod')
    .return (past)
  no_args:
    past.'init'(cpast, 'node'=>node, 'name'=>name, 'pirop'=>'callmethod')
    .return (past)
}


transform past (Perl6::Grammar::listop) :language('PIR') {
    .local pmc past
    .local string name
    name = node['ident']
    past = new 'PAST::Op'
    $P0 = node['listop_expression']
    if null $P0 goto no_args
    .local pmc cnode, cpast
    cnode = $P0[0]
    cpast = tree.'get'('past', cnode, 'Perl6::Grammar::expression')
    $S0 = cpast.'name'()
    if $S0 == 'infix:,' goto comma_args
    past.'init'(cpast, 'node'=>node, 'name'=>name)
    .return (past)
  comma_args:
    $P0 = cpast.'get_array'()
    past.'init'($P0 :flat, 'node'=>node, 'name'=>name)
  no_args:
    past.'init'('node'=>node, 'name'=>name)
    .return (past)
}


transform past (Perl6::Grammar::circumfix) :language('PIR') {
    .local pmc cnode
    cnode = node['expression';0]
    .return tree.'get'('past', cnode, 'Perl6::Grammar::expression')
}


transform past (Perl6::Grammar::integer) :language('PIR') {
    $S0 = node
    $P0 = new .Perl6Str
    $P0 = $S0
    $I0 = $P0
    .local pmc past
    past = new 'PAST::Val'
    past.'init'('node'=>node, 'vtype'=>'.Integer', 'name'=>$I0, 'ctype'=>'i+')
    .return (past)
}


transform past (Perl6::Grammar::number) :language('PIR') {
    .local pmc past
    $S0 = node
    past = new 'PAST::Val'
    past.'init'('node'=>node, 'vtype'=>'.Float', 'name'=>$S0, 'ctype'=>'n+')
    .return (past)
}


transform past (Perl6::Grammar::quote_term) :language('PIR') {
    .local pmc past, cnode
    .local string ctype
    cnode = node['quote_expression']
    ctype = cnode['type']
    .return tree.'get'(ctype, cnode, 'Perl6::Grammar::quote_expression')
}


transform quote_literal (Perl6::Grammar::quote_expression) :language('PIR') {
    .local pmc cpast
    $S0 = node
    cpast = new 'PAST::Val'
    cpast.'init'('node'=>node, 'vtype'=>'.Perl6Str', 'name'=>$S0, 'ctype'=>'s~')
    .return (cpast)
}


transform quote_concat (Perl6::Grammar::quote_expression) :language('PIR') {
    .local pmc iter
    $P0 = node.'get_array'()
    iter = new .Iterator, $P0
    .local pmc past, cnode, cpast
    .local string ctype
    cnode = shift iter
    ctype = cnode['type']
    past = tree.'get'(ctype, cnode, 'Perl6::Grammar::quote_expression')
  concat_loop:
    unless iter goto concat_end
    cnode = shift iter
    ctype = cnode['type']
    cpast = tree.'get'(ctype, cnode, 'Perl6::Grammar::quote_expression')
    past = past.'new'('PAST::Op', past, cpast, 'node'=>node, 'name'=>'infix:~')
    goto concat_loop
  concat_end:
    .return (past)
}


transform quote_list (Perl6::Grammar::quote_expression) :language('PIR') {
    .local pmc past, iter
    past = new 'PAST::Op'
    past.'init'('node'=>node, 'name'=>'list')
    $P0 = node.'get_array'()
    iter = new .Iterator, $P0
  iter_loop:
    unless iter goto iter_end
    .local pmc cpast, cnode
    .local string ctype
    cnode = shift iter
    ctype = cnode['type']
    cpast = tree.'get'(ctype, cnode, 'Perl6::Grammar::quote_expression')
    past.'push'(cpast)
    goto iter_loop
  iter_end:
    .return (past)
}


transform quote_interpolation (Perl6::Grammar::quote_expression) :language('PIR') {
    .return tree.'get'('past_term', node, 'Perl6::Grammar::expr')
}


transform past (Perl6::Grammar::scoped_variables) :language('PIR') {
    .local pmc cnode, cpast
    cnode = node['variable']
    .local string name
    name = cnode

    .local string scopedecl, scope
    scope = 'package'
    scopedecl = node['scope_declarator']
    if scopedecl == 'our' goto have_scope
    scope = 'lexical'
  have_scope:

    .local pmc block, symtable, symbol
    block = get_global '$?BLOCK'
    symtable = block.'symtable'()
    symbol = new .Hash
    symbol['scope'] = scope
    symtable[name] = symbol

    .local int islvalue, ismy
    islvalue = node['islvalue']
    ismy = block.'mydecl'(name)
    ismy = not ismy
    cnode['islvalue'] = islvalue
    cpast = tree.'get'('past', cnode, 'Perl6::Grammar::variable')
    cpast.'ismy'(ismy)
    block.'mydecl'(name, 1)
    .return (cpast)
}


transform past (Perl6::Grammar::variable) :language('PIR') {
    .local string name, sigil
    .local int islvalue
    name = node
    sigil = node['sigil']
    islvalue = node['islvalue']

    .local string viviself
    if sigil == '@' goto sigil_array
    if sigil == '%' goto sigil_hash
    viviself = '.Undef'
    goto have_viviself
  sigil_array:
    viviself = "'List'"
    goto have_viviself
  sigil_hash:
    viviself = "'Perl6Hash'"
  have_viviself:

    .local pmc block, symtable
    block = get_global '$?BLOCK'
    symtable = block.'symtable'()
    .local string scope
    scope = symtable[name;'scope']

    .local pmc past
    past = new 'PAST::Var'
    past.'init'('node'=>node, 'name'=>name, 'viviself' => viviself, 'islvalue'=>islvalue, 'scope'=>scope)
    .return (past)
}


transform past (Perl6::Grammar::subroutine) :language('PIR') {
    .local pmc outerblock, symtable
    outerblock = get_global '$?BLOCK'

    .local pmc past
    past = new 'PAST::Block'
    past.'init_perl6'('node'=>node, 'blocktype'=>'sub')
    set_global '$?BLOCK', past

    $P0 = node['ident']
    if null $P0 goto have_name
    .local string name
    name = $P0[0]
    past.'name'(name)
  have_name:

    $P0 = node['signature']
    if null $P0 goto done_signature
    unless $P0 goto done_signature
    $P0 = node['signature';0;'paramlist';'parameter']
    .local pmc iter, pnode, ppast, multi
    multi = new .ResizablePMCArray
    iter = new .Iterator, $P0
  param_loop:
    unless iter goto done_signature
    pnode = shift iter
    ppast = tree.'get'('past', pnode, 'Perl6::Grammar::parameter')
    past.'push'(ppast)
    push multi, '_'
    goto param_loop
  done_signature:
    past.'init_lexicals'()

    $P0 = node['routine_modifier']
    if null $P0 goto have_multi
    $S1 = join ',', multi
    $S0 = concat ':multi(', $S1
    concat $S0, ')'
    past.'pragma'($S0)
  have_multi:

    .local pmc cnode, cpast
    cnode = node['block'; 'statement_list']
    cpast = tree.'get'('past', cnode, 'Perl6::Grammar::statement_list')
    past.'push'(cpast)
    set_global '$?BLOCK', outerblock
    .return (past)
}


transform past (Perl6::Grammar::parameter) :language('PIR') {
    .local string name
    name = node['variable']

    .local pmc block, symtable, symbol
    block = get_global '$?BLOCK'
    symtable = block.'symtable'()
    symbol = new .Hash
    symbol['scope'] = 'lexical'
    symtable[name] = symbol
    block.'mydecl'(name, 1)

    .local pmc past
    past = new 'PAST::Var'
    past.'init'('node'=>node, 'name'=>name, 'scope'=>'parameter')
    .return (past)
}


transform past (Perl6::Grammar::regex_term) :language('PIR') {
    .local pmc regex, past
    regex = node['regex']
    past = new 'PAST::Block'
    past.'init'(regex, 'node'=>node, 'compiler'=>'PGE::P6Regex')
    .return (past)
}


transform past (Perl6::Grammar::try_block) :language('PIR') {
    .local pmc cnode, cpast, past
    cnode = node['block']
    cpast = tree.'get'('past', cnode, 'Perl6::Grammar::block')
    cpast.'blocktype'('immediate')
    $P0 = cpast.'new'('PAST::Var', 'name'=>'$!', 'scope'=>'package')
    $P1 = cpast.'new'('PAST::Val', 'vtype'=>'.String', 'name'=>'', 'ctype'=>'s~')
    $P2 = cpast.'new'('PAST::Op', $P0, $P1, 'pasttype'=>'bind')
    past = cpast.'new'('PAST::Stmts', $P2, 'node'=>node)
    past.'push_new'('PAST::Op', cpast, 'node'=>node, 'pasttype'=>'try')
    .return (past)
}

=back

=cut
