grammar TclExpr::PAST::Grammar is TGE::Grammar;

transform past (ROOT) {
    $P0 = node['expr']
    unless null $P0 goto expression
    .return tree.get('dispatch', node, 'TclExpr::Grammar')

expression:
    .return tree.get('expression', node)
} 

transform expression (TclExpr::Grammar) {
    .local pmc past
    past = new 'PAST::Expr'
    
    node = node['expr']
    past['node'] = node

    $P0 = tree.get('dispatch', node, 'TclExpr::Grammar')
    past['value'] = $P0

    .return(past)
}

# Handle generic dispatch (needed at ROOT, and for things with kids.)

transform dispatch (TclExpr::Grammar) {
    .local pmc child

    # Ask the child node for its past.
dispatch:
    $P0 = node['expand']
    unless null $P0 goto expand
    $P0 = node['backslash_substitution']
    unless null $P0 goto constant
    $P0 = node['empty']
    unless null $P0 goto empty
    $P0 = node['chunk']
    unless null $P0 goto chunks
    $P0 = node['substitution']
    unless null $P0 goto substitution
    $P0 = node['boolean']
    unless null $P0 goto boolean
    $P0 = node['braced_word']
    unless null $P0 goto braced_word
    $P0 = node['integer']
    unless null $P0 goto integer
    $P0 = node['float']
    unless null $P0 goto has_float
    $P0 = node['scientific']
    unless null $P0 goto scientific
    $P0 = node['number']
    unless null $P0 goto number
    $P0 = node['quoted_word']
    unless null $P0 goto quoted_word
    $P0 = node['mathfunc']
    unless null $P0 goto mathfunc
    $P0 = node['command']
    unless null $P0 goto program
    $P0 = node['subcommand']
    unless null $P0 goto program
    $P0 = node['variable_substitution']
    unless null $P0 goto variable_substitution
    $P0 = node['command_substitution']
    unless null $P0 goto command_substitution
    $P0 = node['nested']
    unless null $P0 goto nested
    $P0 = node['type']
    unless null $P0 goto operator

    say "Didn't know how to handle node:"
    .dumper(node)
    end

program:
    .return tree.get('past', $P0, 'program')

empty:
    $P0 = new 'PAST::Val'
    $P0['value'] = ''
    $P0['class'] = 'TclString'
    .return($P0)

expand:
    .return tree.get('past', node, 'expand')

chunks:
    .return tree.get('past', $P0, 'array')

operator:
    .return tree.get('past', node, 'operator')

mathfunc:
    .return tree.get('past', $P0, 'mathfunc')

quoted_word:
    .return tree.get('past', $P0, 'quoted_word')

braced_word:
    .return tree.get('past', $P0, 'braced_word')

number:
    .return tree.get('past', $P0, 'number')

boolean:
    .return tree.get('past', $P0, 'boolean')

constant:
    .return tree.get('past', $P0, 'constant')

integer:
    .return tree.get('past', $P0, 'integer')

has_float:
    .return tree.get('past', $P0, 'float')

scientific:
    .return tree.get('past', $P0, 'scientific')

substitution:
    node = $P0
    goto dispatch

variable_substitution:
    .return tree.get('past', $P0, 'variable_substitution')

command_substitution:
    node = $P0
    $P0 = node['subcommand']
    unless null $P0 goto program

    # we have an empty command substitution []
    $P0 = new 'PAST::Val'
    $P0['class'] = 'TclString'
    $P0['value'] = ''
    .return($P0)

nested:
    .return tree.get('past', $P0, 'nested')
}

# Go through all the children of an operator and transform them.

transform past (operator) {
    # for each child of this operator, dispatch to get the past,
    # use those as our children.
    .local pmc children, iter, past
    .local string name

    name = node['type']
    if name == 'ternary:? :' goto is_ternary
    if name == 'infix:&&' goto is_and
    if name == 'infix:||' goto is_or

    past = new 'PAST::Op'

    past['opfunc'] = name
    $P0 = node.'get_array'()
    if null $P0 goto iter_end
    iter = new .Iterator, $P0
  iter_loop:
    unless iter goto iter_end
    $P0 = shift iter
    $S0 = $P0
    $P1 = tree.'get'('dispatch', $P0, 'TclExpr::Grammar')
    past.'add_child'($P1)
    goto iter_loop
  iter_end:
    past['children'] = 1
    .return (past)

  is_ternary:
    .return tree.get('ternary', node, 'PAST::Op')
  is_and:
    .return tree.get('logical_and', node, 'PAST::Op')
  is_or:
    .return tree.get('logical_or', node, 'PAST::Op')
}

transform past (expand) {
    .local pmc past
    past = new 'PAST::Expand'

    delete node['expand']
    $P0 = tree.'get'('dispatch', node, 'TclExpr::Grammar')
    past['value'] = $P0

    .return(past)
}

transform past (program) {
    .local pmc past
    past = new 'PAST::Program'

    .local pmc iter
    iter = new .Iterator, node
loop:
    unless iter goto end
    $P0 = shift iter
    $P0 = tree.'get'('past', $P0, 'command')
    if null $P0 goto loop
    past.'add_child'($P0)
    goto loop
end:

    $P0 = past.'get_children'()
    $I0 = elements $P0
    if $I0 == 0 goto empty

    .return(past)

empty:
    past = new 'PAST::Val'
    past['value'] = ''
    past['class'] = 'TclString'
    .return(past)
}

transform past (mathfunc) {
    .local string function_name
    .local pmc args
    .local int argc
    args = node['expression']
    argc = 0
    unless args goto has_argc
    argc = elements args

has_argc:
    .local pmc past
    past = new 'PAST::MathFunc'
    $P0  = node['unary_function']
    unless null $P0 goto unary
    $P0  = node['nullary_function']
    unless null $P0 goto nullary
    $P0  = node['binary_function']
    unless null $P0 goto binary
    $P0  = node['nary_function']
    unless null $P0 goto nary
 
  # never get here

  nullary:
    if argc > 0 goto too_many
    function_name = node['nullary_function']
    goto arguments

  unary:
    if argc == 0 goto too_few
    if argc > 1  goto too_many
    function_name = node['unary_function']
    $P0 = args[0]
    $P1 = tree.'get'('expression', $P0)
    past.'add_child'($P1)
    goto arguments

  binary:
    if argc < 2 goto too_few
    if argc > 2 goto too_many
    function_name = node['binary_function']

    $P1 = args[0]
    $P2 = tree.'get'('expression', $P1)
    past.'add_child'($P2)

    $P1 = args[1]
    $P2 = tree.'get'('expression', $P1)
    past.'add_child'($P2)
    goto arguments

  nary:
    if argc < 1 goto too_few
    function_name = node['nary_function']

    .local pmc iter
    iter = new .Iterator, args
  nary_loop:
    unless iter goto arguments
    $P0 = shift iter
    $P0 = tree.'get'('expression', $P0)
    past.'add_child'($P0)
    goto nary_loop

  arguments:
    past['mathfunc'] = function_name
    past['children'] = 1
    .return (past)

too_few:
    tcl_error 'too few arguments for math function'

too_many:
    tcl_error 'too many arguments for math function'
}

transform past (boolean) {
    .local pmc past
    past = new 'PAST::Val'
    past.set_node(node)
    
    $S0 = node
    $P0 = new 'TclConst'
    $P0 = $S0
    $S0 = $P0
    past['value'] = $S0
    past['class'] = "TclString"
    .return(past)
}

transform past (constant) {
    .local pmc past
    past = new 'PAST::Val'
    past.set_node(node)
    
    $S0 = node
    $P0 = new 'TclConst'
    $P0 = $S0
    $S0 = $P0
    past['value'] = $S0
    past['class'] = "TclString"
    .return(past)
}

transform past (braced_word) {
    .local pmc past
    past = new 'PAST::Val'
    past.set_node(node)

    $P0 = node['PGE::Text::bracketed']
    $S0 = $P0[0]
    past['value'] = $S0
    past['class'] = "TclString"
    .return(past)
}

transform past (number) {
    $P0 = node['integer']
    unless null $P0 goto integer
    $P0 = node['float']
    unless null $P0 goto have_float
    $P0 = node['scientific']
    unless null $P0 goto scientific
    tcl_error 'invalid number type'

integer:
    .return tree.get('past', $P0, 'integer')

have_float:
    .return tree.get('past', $P0, 'float')

scientific:
    .return tree.get('past', $P0, 'scientific')
}


transform past (nested) :language('PIR') {
    .local pmc past
    $P0  = node['expression'; 'expr']
    past = tree.'get'('dispatch', $P0, 'TclExpr::Grammar')
    .return(past)
}


transform past (scientific) {
    .local pmc past
    past = new 'PAST::Val'
    past.set_node(node)
    
    $S0 = node[0]
    $N0 = $S0
    $S0 = node[1]
    $N1 = $S0
    $N1 = 10**$N1
    $N0 *= $N1
    
    $S0 = $N0
    past['value'] = $S0
    past['class'] = "TclFloat"

    .return(past)
}

transform past (integer) {
    .local pmc past
    past = new 'PAST::Val'
    past.set_node(node)

    $P0 = node['binary']
    unless null $P0 goto binary
    $P0 = node['octal']
    unless null $P0 goto octal
    $P0 = node['hex']
    unless null $P0 goto hex

    # XXX (40863): This is a bad hack to make bignums compile
    $S0 = node['decimal']
    $I0 = length $S0
    if $I0 < 10 goto decimal
    if $I0 > 10 goto bignum_hack

    if $S0 >= "2147483647" goto bignum_hack

  decimal:
    $S0 = node
    past['value'] = $S0
    past['class'] = "TclInt"
    .return (past)

  bignum_hack:
    past['value'] = 0
    past['class'] = "TclInt"
    .return(past)

  binary:
    .local int bvalue
    bvalue = 0
    $S0 = $P0[0]
    $I0 = 0
    $I1 = length $S0
  binary_loop:
    if $I0 >= $I1 goto binary_done
    shl bvalue, 1
    $S2 = substr $S0, $I0, 1
    inc $I0
    if $S2 == '0' goto binary_loop
    bvalue += 1
    goto binary_loop
  binary_done:
    past['value'] = bvalue
    past['class'] = "TclInt"
    .return(past)
 
  octal: 
     $S0 = $P0[0]

    .local int octal_value, octal_digit, octal_counter, octal_length
    octal_length  = length $S0
    octal_counter = 0
    octal_value   = 0
    # at this point, string should consist only of digits 0-7
  octal_loop:
    if octal_counter == octal_length goto octal_done # skip first 0
    octal_digit = ord $S0, octal_counter
    octal_digit -= 48 # ascii value of 0
    octal_value *= 8
    octal_value += octal_digit
    inc octal_counter
    goto octal_loop
  
  octal_done:
    past['value'] = octal_value
    past['class'] = "TclInt"
    .return (past)

  hex:
    $S0 = node
    .local int len, digit, hex_value
    len = length $S0
    $I0 = 2 # skip 0x
    hex_value = 0
  hex_loop:
    if $I0 == len goto hex_done
    digit = ord $S0, $I0
    # higher than Z - must be lowercase letter
    if digit > 90 goto hex_lower
    # higher than 9 - must be uppercase letter
    if digit > 57 goto hex_upper
    digit -= 48 # value of 0
    goto hex_next
  hex_lower:
    digit -= 97 # value of a
    digit += 10
    goto hex_next
  hex_upper:
    digit -= 65 # value of A
    digit += 10
    # goto hex_next
  hex_next:
    hex_value *= 16
    hex_value += digit
    inc $I0
    goto hex_loop

  hex_done:
    past['value'] = hex_value
    past['class'] = "TclInt"
    .return(past)

}

transform past (float) {
    .local pmc past
    past = new 'PAST::Val'
    past.set_node(node)

    $S0 = node
    past['value'] = $S0
    past['class'] = "TclFloat"
    .return (past)
}

transform past (quoted_word) {
    .local pmc past
    $P0 = node['chunk']
    if null $P0 goto empty_string

    .return tree.get('past', $P0, 'array')

empty_string:
    past = new 'PAST::Val'
    past['node']  = node
    past['class'] = 'TclString'
    past['value'] = ''

    .return(past)
}

transform past (array) {
    .local pmc past
    .local pmc iter
    iter = new .Iterator, node
    null past
  iter_loop:
    unless iter goto iter_end
    .local pmc cnode, cpast
    cnode = shift iter
    $I0 = exists cnode['substitution']
    unless $I0 goto cpast_str
    cnode = cnode['substitution']
    cpast = tree.'get'('dispatch', cnode, 'TclExpr::Grammar')
    goto cpast_add
  cpast_str:
    $S0 = cnode
    $P0 = new 'TclConst'
    $P0 = $S0
    $S0 = $P0
    cpast = new 'PAST::Val'
    cpast['node'] = node
    cpast['class'] = 'TclString'
    cpast['value'] = $S0
  cpast_add:
    unless null past goto cpast_concat
    past = cpast
    goto iter_loop
  cpast_concat:
    $P0 = new 'PAST::Op'
    $P0.add_child(past)
    $P0.add_child(cpast)
    $P0['node'] = node
    $P0['opfunc'] = 'infix:concat'
    past = $P0
    goto iter_loop
  iter_end:
    .return(past)
}

transform past (command) {
    .local pmc past, words, iter
    words = node['word']
    if null words goto empty

    .local pmc command
    command = shift words
    command = tree.'get'('dispatch', command, 'TclExpr::Grammar')

    $I0 = find_type 'PAST::Val'
    $I1 = typeof command
    if $I0 == $I1 goto static

    $I0 = find_type 'PAST::DynamicCommand'
    goto create_node

static:
    $I0 = find_type 'PAST::StaticCommand'
create_node:
    past = new $I0
    past.set_node(node)
    past.'add_child'(command)

    iter = new .Iterator, words
loop2:
    unless iter goto end2
    $P0 = shift iter
    $P1 = tree.'get'('dispatch', $P0, 'TclExpr::Grammar')
    past.'add_child'($P1)
    goto loop2
end2:
    .return(past)

empty:
    null past
    .return(past)
}

transform past (variable_substitution) {
    .local pmc past
    past = new 'PAST::Var'
    past.set_node(node)
    
    $S0 = node[0]
    past['name']  = $S0

    $I0 = exists node['index']
    if $I0 goto array
    .return(past)

array:
    $P0 = node['index']
    $P0 = tree.'get'('past', $P0, 'array')
    past['index'] = $P0
    .return(past)
}

transform ternary (PAST::Op) {
    .local pmc past

    past = new 'PAST::Cond'
    past.set_node(node)

    $P1 = node[0]
    $P2 = tree.'get'('dispatch', $P1, 'TclExpr::Grammar')
    past.'add_child'($P2)
    $P1 = node[1]
    $P2 = tree.'get'('dispatch', $P1, 'TclExpr::Grammar')
    past.'add_child'($P2)
    $P1 = node[2]
    $P2 = tree.'get'('dispatch', $P1, 'TclExpr::Grammar')
    past.'add_child'($P2)
 
    past['conditional'] = 1
 
    .return(past)
}

transform logical_and (PAST::Op) {
    .local pmc past, true, false, A, B
    .local pmc inner

    # Transform A && B into:
    # A ? ( B ? 1 : 0) : 0

    true = new 'PAST::Val'
    true['value'] = 1
    true['class'] = "TclInt"

    false = new 'PAST::Val'
    false['value'] = 0
    false['class'] = "TclInt"

    # Get our A & B trees..
    $P1 = node[0]
    A = tree.'get'('dispatch', $P1, 'TclExpr::Grammar')
    $P1 = node[1]
    B = tree.'get'('dispatch', $P1, 'TclExpr::Grammar')

    # Generate (B ? 1 : 0)
    inner = new 'PAST::Cond'
    inner.'add_child'(B)

    inner.'add_child'(true)
    inner.'add_child'(false)
    inner['conditional'] = 1

    # Generate (A ? (...) : 0)
    past = new 'PAST::Cond'
    past.set_node(node)

    past.'add_child' (A)

    past.'add_child' (inner)
    past.'add_child' (false)
 
    past['conditional'] = 1
 
    .return(past)
}

transform logical_or (PAST::Op) {
    .local pmc past, true, false, A, B
    .local pmc inner

    # Transform A || B into:
    # A ? 1 : ( B ? 1 : 0)

    true = new 'PAST::Val'
    true['value'] = 1
    true['class'] = "TclInt"

    false = new 'PAST::Val'
    false['value'] = 0
    false['class'] = "TclInt"

    # Get our A & B trees..
    $P1 = node[0]
    A = tree.'get'('dispatch', $P1, 'TclExpr::Grammar')
    $P1 = node[1]
    B = tree.'get'('dispatch', $P1, 'TclExpr::Grammar')

    # Generate (B ? 1 : 0)
    inner = new 'PAST::Cond'
    inner.'add_child'(B)

    inner.'add_child'(true)
    inner.'add_child'(false)
    inner['conditional'] = 1

    # Generate (A ? 1 : (...))
    past = new 'PAST::Cond'
    past.set_node(node)

    past.'add_child' (A)

    past.'add_child' (true)
    past.'add_child' (inner)
 
    past['conditional'] = 1
 
    .return(past)
}
