grammar Pheme::AST::Grammar is TGE::Grammar;

transform past (ROOT) :language('PIR') {
    .local pmc result
    result = new ['PAST';'Block']
    result.'namespace'( 'Pheme' )
    result.'hll'('pheme')

    .local pmc lists
    lists = node['pheme_list']

    .local pmc iter
    iter = new 'Iterator', lists

    .local pmc elem

  iter_loop:
    unless iter goto iter_end
    elem = shift iter
    elem = tree.'get'( 'past', elem, 'pheme_list' )

    result.'push'( elem )
    goto iter_loop

  iter_end:
    .return( result )
}

transform past (pheme_list) :language('PIR') {
    .local pmc iter
    $P0 = node.'hash'()
    iter = new 'Iterator', $P0

    .local string key_name
    key_name = shift iter

    .local pmc elem
    elem = node[key_name]

    .local pmc op
    op = new ['PAST';'Op']
    op.'name'( '__list_to_cons' )
    op.'pasttype'( 'call' )

  check_for_atom:
    .local int has_atom
    has_atom = exists elem['atom']
    unless has_atom goto check_for_special

    .local pmc atom
    atom = elem['atom']
    atom = tree.'get'( 'past', atom, 'atom' )
    op.'push'( atom )

  check_for_special:
    .local int has_special
    has_special = exists elem['special']
    unless has_special goto make_cons

    .local pmc special
    special = elem['special']

    .local string special_name
    special_name = special

    special = new ['PAST';'Op']
    special.'name'( special_name )
    op.'push'( special )

  make_cons:
    .local pmc list
    list = elem['list_item']

    .local pmc iter
    iter = new 'Iterator', list

    .local pmc item
  iter_loop:
    unless iter goto iter_end
    item = shift iter
    item = tree.'get'( 'past', item, 'list_item' )
    op.'push'( item )
    goto iter_loop

  iter_end:
    .local pmc result
    result = new ['PAST';'Op']
    result.'name'( '__evaluate' )
    result.'pasttype'( 'call' )
    result.'push'( op )

    .tailcall tree.'get'( key_name, result )
}

transform past (list_item) :language('PIR') {
    .local pmc iter
    $P0 = node.'hash'()
    iter = new 'Iterator', $P0

    .local string key_name
    key_name = shift iter

    .local pmc    elem
    elem     = node[key_name]

    .tailcall tree.'get'( 'past', elem, key_name )
}

transform special_form (PAST;Op) :language('PIR') {
    .local pmc make_cons
    make_cons = node[0]

    .local pmc cons_iter
    cons_iter = make_cons.'iterator'()

    .local pmc form_op
    form_op = shift cons_iter

    .local string form_name
    form_name = form_op.'name'()

    .tailcall tree.'get'( form_name, make_cons )
}

# this *may* be an application; this is an optimization
transform application (PAST;Op) :language('PIR') {
    .local pmc make_cons
    make_cons = node[0]

    .local pmc cons_iter
    cons_iter = make_cons.'iterator'()

    .local pmc maybe_op
    maybe_op = shift cons_iter

    .local string func_name
    func_name = maybe_op.'name'()

    .local int name_length
    name_length = length func_name

    # strip off the quotes from the atom name
    name_length -= 2
    func_name    = substr func_name, 1, name_length

    .local pmc func_func
    func_func = get_hll_global ['Pheme'], func_name

    .local int have_func
    have_func = defined func_func

    if have_func goto rewrite_to_call
    .return( node )

  rewrite_to_call:
    .local pmc result
    result = new ['PAST';'Op']
    result.'pasttype'( 'call' )
    result.'name'( func_name )

    .local pmc item
  iter_loop:
    unless cons_iter goto iter_end
    item = shift cons_iter
    result.'push'( item )
    goto iter_loop

  iter_end:
    .return( result )
}

transform cons (PAST;Op) :language('PIR') {
    .local pmc make_cons
    make_cons = node[0]
    .return( make_cons )
}

transform make_cons (list) :language('PIR') {
    .local pmc iter
    $P0 = node.'hash'()
    iter = new 'Iterator', $P0

    .local pmc cons
    cons = new ['PAST';'Op']
    cons.'name'( '__list_to_cons' )
    cons.'pasttype'( 'call' )

    .local pmc child

  iter_loop:
    unless iter, iter_end
    child = shift iter
    child = tree.'get'( 'past', child, 'list_item' )
    cons.'push'( child )
    goto iter_loop

  iter_end:
    .local pmc eval
    eval = new ['PAST';'Op']
    eval.'name'( '__evaluate' )
    eval.'pasttype'( 'call' )
    eval.'push'( cons )

    .return( eval )
}

transform special_form (define) :language('PIR') {
    .local pmc iter
    iter   = node.'iterator'()

    .local pmc op, name, lambda
    op     = shift iter
    name   = shift iter
    lambda = shift iter

    .local pmc name_str
    name_str = name.'name'()

    .local pmc result
    result = new ['PAST';'Block']

    result.'name'( name_str )
    result.'push'( lambda )

    .return( result )
}

transform quote (PAST;Op) :language( 'PIR' ) {
    .local pmc children
    children = node.'list'()

    # first kid is quote op; remove
    .local pmc quote_op
    quote_op = shift children

    .local pmc quoted_item
    quoted_item = children[0]

    .local string name
    name = quoted_item.'name'()
    ne name, '__evaluate', quote_item

    # splice out eval
    quoted_item = quoted_item[0]

  quote_item:
    quoted_item = tree.'get'( 'force_to_val', quoted_item )
    children[0] = quoted_item

    .local int num_kids
    num_kids = children

    if num_kids > 1 goto return_node
    .return( quoted_item )

  return_node:
    .return( node )
}

transform force_to_val (PAST;Op) :language('PIR') {
    .local pmc result
    result = new ['PAST';'Val']

    .local string name
    name = node.'name'()
    ne name, '__make_empty_cons', really_rewrite
    .return( node )

  really_rewrite:
    node.'name'( '__list_to_cons' )
    name  = "'" . name
    name .= "'"
    result.'value'( name )
    result.'returns'( 'Undef' )

    .local pmc children
    children = node.'list'()
    unshift children, result

    .return( node )
}

transform force_to_val (PAST;Val) :language('PIR') {
    .return( node )
}

transform force_to_val (PAST;Var) :language('PIR') {
    .return( node )
}

transform cond (PAST;Op) :language( 'PIR' ) {
    .local pmc result
    result = new ['PAST';'Op']
    result.'pasttype'( 'if' )

    .local pmc iter
    iter = node.'iterator'()

    # throw away first child; it's 'cond'
    .local pmc child
    child = shift iter

    .local pmc parent_if
    parent_if = result

  append_children:
    .local pmc if_op
    if_op = shift iter
    parent_if.'push'( if_op )
    unless iter goto return_result

    .local pmc then_node
    then_node = shift iter
    parent_if.'push'( then_node )
    unless iter goto return_result

    .local int num_children
    num_children = iter
    unless num_children == 1 goto nest_if

    .local pmc else_node
    else_node = shift iter
    parent_if.'push'( else_node )
    goto return_result

  nest_if:
    .local pmc new_if
    new_if = new ['PAST';'Op']
    new_if.'pasttype'( 'if' )
    parent_if.'push'( new_if )
    parent_if = new_if
    goto append_children

  return_result:
    .return( result )
}

transform lambda (PAST;Op) :language('PIR') {
    .local pmc result
    result = new ['PAST';'Block']
    result.'blocktype'( 'declaration' )

    .local pmc child_iter
    child_iter = node.'iterator'()

    # discard first child; it's the lambda op
    .local pmc child
    child = shift child_iter

    .local pmc args
    args = shift child_iter

    .local pmc args_iter
    args_iter = args.'iterator'()

    .local pmc    rewrite_args
    rewrite_args = new 'Hash'

    .local string arg_name
    .local pmc    arg
  args_iter_loop:
    unless args_iter goto args_iter_end
    child    = shift args_iter
    arg      = new ['PAST';'Var']
    arg_name = child.'name'()
    arg.'name'( arg_name )
    arg.'scope'( 'parameter' )
    result.'push'( arg )
    rewrite_args[arg_name] = 1
    goto args_iter_loop
  args_iter_end:
    .local pmc arg_names_stack
    arg_names_stack = get_global 'arg_names_stack'

    .local int have_stack
    have_stack = defined arg_names_stack
    if have_stack goto add_names_to_stack

    arg_names_stack = new 'ResizablePMCArray'
    set_global 'arg_names_stack', arg_names_stack

  add_names_to_stack:
    push arg_names_stack, rewrite_args

  child_iter_loop:
    unless child_iter goto child_iter_end
    child    = shift child_iter
    child    = tree.'get'( 'rewrite_var_name', child )
    result.'push'( child )
    goto child_iter_loop

    # XXX - must rewrite all PAST;Val in children to PAST;Var as appropriate
  child_iter_end:
    rewrite_args = pop arg_names_stack
    .return( result )
}

transform rewrite_var_name (PAST;Op) :language('PIR') {
    .local pmc children
    children = node.'list'()

    .local int elements
    elements = children

    .local int i
    i = 0

    .local pmc child
  start_loop:
    if i == elements goto end_loop
    child       = children[i]
    child       = tree.'get'( 'rewrite_var_name', child )
    children[i] = child
    inc i
    goto start_loop

  end_loop:
    .return( node )
}

transform rewrite_var_name (PAST;Val) :language('PIR') {
    .local pmc arg_names_stack
    arg_names_stack = get_global 'arg_names_stack'

    .local pmc arg_names
    arg_names = arg_names_stack[-1]

    .local string arg_name
    arg_name = node.'name'()

    .local int name_exists
    name_exists = exists arg_names[arg_name]

    if name_exists goto rewrite_to_var
    .return( node )

  rewrite_to_var:
    .local pmc var
    var = new ['PAST';'Var']
    var.'scope'( 'lexical' )
    var.'name'( arg_name )
    .return( var )
}

transform rewrite_var_name (PAST;Var) :language('PIR') {
    .return( node )
}

transform define (PAST;Op) :language('PIR') {
    .local pmc iter
    iter = node.'iterator'()

    # throw away first child; it's the define op
    .local pmc define_op
    define_op = shift iter

    .local pmc name
    name = shift iter

    .local string name_str
    name_str = name.'name'()

    .local pmc lambda
    lambda = shift iter
    lambda.'name'( name_str )

    .return( lambda )
}

# XXX: almost certainly wrong
transform past (empty_list) :language('PIR') {
    .local pmc result

    result = new ['PAST';'Op']
    result.'name'( '__make_empty_cons' )

    .return( result )
}

transform past (atom) :language('PIR') {
    .local pmc result
    result   = new ['PAST';'Val']

    .local string value
    value    = node

    # if this is a quoted atom, strip off the quote; it's meaningless here
    .local int is_quoted
    is_quoted = exists node['quote']
    unless is_quoted goto add_quotes

    value = substr value, 1

  add_quotes:
    .local string quoted_value
    quoted_value  = "'"
    quoted_value .= value
    quoted_value .= "'"

    result.'value'( quoted_value )
    result.'name'( quoted_value )
    result.'returns'( 'Undef' )

    .return( result )
}

transform past (quoted_string) :language('PIR') {
    .local pmc result
    result = new ['PAST';'Val']

    .local string value
    value  = node

    result.'name'( value )
    result.'value'( value )
    result.'returns'( 'Undef' )

    .return( result )
}
