grammar TclExpr::PIR::Grammar is TGE::Grammar;

transform result (ROOT)  {
    $S0 = typeof node
    .return tree.get('pir', node, $S0)
}

transform pir (PAST::Expr) {
    .local pmc pir
    pir = new 'PGE::CodeString'

    .local pmc value
    value = node['value']
    $P0 = tree.get('pir', value)
    pir .= $P0
    $S0 = value['ret']
    node['ret'] = $S0

    .local pmc ret, label
    ret   = node['ret']
    label = pir.unique('expr_is_string')
 
    pir.emit(<<'END_PIR', ret, label)
  .local pmc __number
  __number = get_root_global ['_tcl'], '__number'
  push_eh %1
    %0 = __number(%0)
  clear_eh
%1:
END_PIR

    .return(pir)
}

transform pir (PAST::Program) {
    .local pmc pir
    pir = new 'PGE::CodeString'

    pir.emit(<<'END_PIR')
    .local pmc colons, split, epoch
    colons = get_root_global ['_tcl'], 'colons'
    split  = get_root_global ['parrot'; 'PGE::Util'], 'split'
    epoch = get_root_global ['_tcl'], 'epoch'
END_PIR

    .local pmc iter, child
    iter = node.'child_iter'()
loop:
    unless iter goto end
    child = shift iter
    $P0 = tree.'get'('pir', child)
    $S0 = $P0
    pir .= $S0
    goto loop
end:
    $S0 = child['ret']
    node['ret'] = $S0
    .return(pir)
}

transform pir (PAST::Val) {
    .local pmc pir
    .local pmc ret
    .local pmc class

    pir = new 'PGE::CodeString'
    ret = pir.unique('$P')
    class = node['class']
    pir.emit("    %0 = new '%1'", ret, class)
    $S0 = node['value']
    if class == "TclFloat"  goto assign_float
    if class == "TclString" goto assign_string
    goto assign_val
  assign_float:                                    
    $I0 = index $S0, '.'                     # RT#40690: '.' hack due to
    if $I0 >= 0 goto assign_val              # parrotbug #38896
    $I0 = index $S0, 'E'
    if $I0 >= 0 goto assign_val
    $I0 = index $S0, 'e'
    if $I0 >= 0 goto assign_val
    concat $S0, '.'
    goto assign_val
  assign_string:
    $S0 = pir.escape($S0)
  assign_val:
    pir.emit('    assign %0, %1', ret, $S0)
  end:
    node['ret'] = ret
    node['istemp'] = 1
    .return (pir)
}

transform pir (PAST::Var) {
    .local pmc pir, ret
    pir = new 'PGE::CodeString'
    ret = pir.unique('$P')
    node['ret']    = ret
    node['istemp'] = 1
    
    .local string name
    name = node['name']

    $I0 = exists node['index']
    if $I0 goto array

    pir.emit(<<'END_PIR', ret, name)
  .local pmc __read
  __read = get_root_global ['_tcl'], '__read'
  %0 = __read('%1')
END_PIR
    .return(pir)

array:
    .local pmc    index
    index = node['index']
    
    $P0 = tree.get('pir', index)
    pir .= $P0
    $S0 = index['ret']
    pir.emit(<<'END_PIR', ret, name, $S0)
  .local pmc __read
  __read = get_root_global ['_tcl'], '__read'
  $S0 = %2
  $S0 = '%1(' . $S0
  $S0 = $S0 . ')'
  %0 = __read($S0)
END_PIR
    .return(pir)
}

transform pir (PAST::Op) {
    .local pmc args,iter,pir
    .local pmc return_register
 
    pir = new 'PGE::CodeString'
    args = new .ResizablePMCArray
    iter = node.'child_iter'()
  iter_loop: 
    unless iter goto iter_done
    $P1 = shift iter
    $P0 = tree.get('pir', $P1)
    return_register = $P1['ret']
    push args, return_register
    pir .= $P0
    goto iter_loop
  iter_done:
    # get a result PMC
    .local pmc retval
    retval = pir.unique('$P')
    pir .= retval
    pir .= " = get_hll_global '"
    $S0 = node['opfunc']
    pir .= $S0
    pir .= "'\n"
    pir .= retval
    pir .= " = "
    pir .= retval
    pir .= "("
    $S0 = join ", ", args
    pir .= $S0
    pir .= ")\n" 
    node['ret'] = retval
    .return (pir)
}

transform pir (PAST::MathFunc) {
    .local pmc args,iter,pir
    .local pmc return_register
 
    pir  = new 'PGE::CodeString'
    args = new .ResizablePMCArray
    iter = node.'child_iter'()
  iter_loop: 
    unless iter goto iter_done
    $P1 = shift iter
    $P0 = tree.get('pir', $P1)
    return_register = $P1['ret']
    push args, return_register
    pir .= $P0
    goto iter_loop
  iter_done:
    # get a result PMC
    .local pmc retval
    retval = pir.unique('$P')
    $S0    = node['mathfunc']
    pir.emit("%0 = get_hll_global ['tcl'; 'mathfunc'], '&%1'", retval, $S0)
    pir .= retval
    pir .= " = "
    pir .= retval
    pir .= "("
    $S0 = join ", ", args
    pir .= $S0
    pir .= ")\n" 
    node['ret'] = retval
    .return (pir)
}

transform pir (PAST::StaticCommand) {
    .local pmc args, children, iter, pir
    .local string reg
    
    pir  = new 'PGE::CodeString'
    args = new .ResizablePMCArray
    children = node.'get_children'()
    iter = new .Iterator, children

    .local string name
    $P0  = shift iter
    name = $P0['value']

    .local int has_expand, pastexpand, pastvar
    has_expand = 0
    pastexpand = find_type 'PAST::Expand'
    pastvar    = find_type 'PAST::Var'

  iter_loop: 
    unless iter goto iter_done
    $P1 = shift iter
    $P0 = tree.get('pir', $P1)
    reg = $P1['ret']
    push args, reg
    pir .= $P0
    $I0 = typeof $P1
    if $I0 == pastexpand  goto iter_expand
    unless $I0 == pastvar goto iter_loop
    pir.emit("    %0 = clone %0", reg)
    goto iter_loop
  iter_expand:
    has_expand = 1
    goto iter_loop
  iter_done:
    .local string retval
    retval = pir.unique('$P')

    .local string invalid_, done_, exec_
    invalid_ = pir.unique('invalid_')
    done_    = pir.unique('done_')
    exec_    = pir.unique('exec_')

    $P0 = shift children
    $S0 = $P0['value']
    if has_expand goto dynamic
    $P1 = get_root_global ['_tcl'; 'builtins'], $S0
    if null $P1 goto dynamic

    $P0 = $P1(retval, children,args)
    if null $P0 goto dynamic

    .local pmc epoch
    epoch = get_root_global ['_tcl'], 'epoch'
    $S0 = pir.unique('dynamic_')
    pir.emit('  if epoch != %0 goto %1', epoch, $S0)
    pir .= $P0
    pir.emit('  goto %0', done_)
    pir.emit('%0:', $S0)

  dynamic:
    .local string ns
    ns  = ''
    $S0 = join ", ", args
    $I0 = index name, "::"
    if $I0 == -1 goto no_ns

    .local pmc split, colons
    split  = get_root_global ['parrot'; 'PGE::Util'], 'split'
    colons = get_root_global ['_tcl'], 'colons'
    $P0    = split(colons, name)
    $S1    = pop $P0

    $S1 = '&' . $S1
    $S1 = pir.escape($S1)

    $S2 = $P0[0]
    if $S2 == "" goto root_ns

    ns = join "'; '", $P0
    ns = "['" . ns
    ns = ns . "'], "

    .local string root_
    root_ = pir.unique('root_')
    pir.emit(<<'END_PIR', retval, ns, $S1, root_, exec_)
    %0 = get_global %1 %2
    if null %0 goto %3
    goto %4
%3:
END_PIR
    unshift $P0, ""

  root_ns:
    $S2 = shift $P0
    $I0 = elements $P0
    if $I0 == 0 goto root_ns_emit

    ns = join "'; '", $P0
    ns = "['" . ns
    ns = ns . "'], "

  root_ns_emit:
    pir.emit(<<'END_PIR', retval, ns, $S1, invalid_, exec_)
    %0 = get_hll_global %1 %2
    if null %0 goto %3
%4:
END_PIR
    goto emit

  no_ns:
    $S1 = '&' . name
    $S1 = pir.escape($S1)
    pir.emit(<<'END_PIR', retval, $S1, invalid_)
    %0 = find_name %1
    if null %0 goto %2
END_PIR

  emit:
    $S3  = pir.escape(name)
    pir.emit(<<'END_PIR', retval, $S3, $S0, invalid_, done_)
    %0 = %0(%2)
    goto %4
%3:
    $S0 = %1
    $S0 = 'invalid command name "' . $S0
    $S0 .= '"'
    tcl_error $S0
%4:
END_PIR
    node['ret'] = retval
    .return(pir)
}

transform pir (PAST::DynamicCommand) {
    .local pmc args, children, iter, pir, reg
    
    pir  = new 'PGE::CodeString'
    args = new .ResizablePMCArray
    children = node.'get_children'()
    iter = new .Iterator, children
  iter_loop: 
    unless iter goto iter_done
    $P1 = shift iter
    $P0 = tree.get('pir', $P1)
    reg = $P1['ret']
    push args, reg
    pir .= $P0
    pir.emit("%0 = clone %0", reg)
    goto iter_loop
  iter_done:
    .local pmc retval, name
    retval = pir.unique('$P')
    name = shift args
    
    $S1 = pir.unique('invalid_')
    $S2 = pir.unique('done_')

    $P0 = shift children
    $S0 = $P0['value']
    $S0 = join ", ", args
    $S4 = pir.unique('curr_namespace')
    $S5 = pir.unique('root_namespace')
    pir.emit(<<'END_PIR', retval, name, $S0, $S1, $S2, $S4, $S5)
  $S0 = %1
  $P0 = split(colons, $S0)
  $S0 = ""
  $I0 = elements $P0
  if $I0 == 0 goto %5
  $S0 = pop $P0
  if $I0 == 1 goto %5
  $S1 = $P0[0]
  if $S1 != "" goto %5
  $S1 = shift $P0
%6:
  %0 = get_hll_namespace $P0
  if null %0 goto %3
  $S1 = '&' . $S0
  %0  = %0[$S1]
  if null %0 goto %3
  %0  = %0(%2)
  goto %4
%5:
  %0 = get_namespace $P0
  if null %0 goto %6
  $S1 = '&' . $S0
  %0  = %0[$S1]
  if null %0 goto %6 # try the root namespace if it's not in the current
  %0  = %0(%2)
  goto %4
%3:
  $S0 = %1
  $S0 = 'invalid command name "' . $S0
  $S0 .= '"'
  tcl_error $S0
%4:
END_PIR
    node['ret'] = retval
    .return(pir)
}

transform pir (PAST::Expand) {
    .local pmc pir, value
    pir   = new 'PGE::CodeString'
    value = node['value']

    $S0 = tree.get('pir', value)
    pir .= $S0

    $S0 = value['ret']
    $S1 = pir.'unique'('$P')
    $S2 = pir.'unique'('loop_')
    $S3 = pir.'unique'('end_')
    pir.emit(<<'END_PIR', $S0)
  .local pmc __list
  __list = get_root_global ['_tcl'], '__list'
  %0 = __list(%0)
END_PIR

    $S0 .= ' :flat'
    node['ret'] = $S0
    .return(pir)
}

transform pir (PAST::Cond) {
    .local pmc args, pir, ret, label
    .local pmc children, cond, then, else
    .local string cond_result, then_result, else_result

    pir = new 'PGE::CodeString'
    pir.emit('  .local pmc __boolean')
    pir.emit('  __boolean = get_root_global ["_tcl"], "__boolean"')

    # This node has 3 children. generate PIR so that:
    # if node1 then node2 else node3

    # pick a unique register to store our result in.
    ret = pir.unique('$P')

    #  pick a unique number for our labels..
    label = pir.unique('label_')

    children = node.'get_children'()

    cond = children[0] 
    $S0 = tree.get('pir', cond)
    pir .= $S0
    cond_result = cond['ret']

    pir.emit("  %0 = __boolean(%0)",    cond_result)
    pir.emit("  unless %0 goto else_%1", cond_result, label)

    then = children[1] 
    $S0 = tree.get('pir', then)
    pir .= $S0
    then_result = then['ret']

    pir.emit('    %0 = %1', ret, then_result)
    pir.emit("  goto end_if_%0", label)
 
    #set the result register to the answer from this section  
 
   #then jump to custom end label..

    pir.emit("  else_%0:",label)

    else = children[2] 
    $S0 = tree.get('pir', else)
    pir .= $S0
    else_result = else['ret']

    pir.emit('    %0 = %1', ret, else_result)

    #set the result register to the answer from this section  

    pir.emit("  end_if_%0:",label)

    node['ret'] = ret

    .return (pir)
}

