grammar ASTGrammar is TGE::Grammar;

transform result (ROOT) :language('PIR') {
	# XXX: transform into a method on the TGE object, when it's possible
	.local pmc specials
	specials = new .Hash
	specials['define'] = 1
	specials['quote']  = 1
	specials['cond']   = 1

	store_global 'specials', specials

	.local pmc result
	result = new 'Node'

	.local pmc match
	match = node['list']

	.local pmc iter
	iter  = new Iterator, match # setup iterator for node
	set iter, 0                 # reset iterator, begin at start

	.local pmc elem
	.local pmc ast_elem

	.local pmc main_sub
	main_sub = new 'PAST::Sub'
	main_sub.'name'( 'main' )

	.local pmc main_statements
	main_statements = new 'PAST::Stmts'

	main_sub.'add_child'( main_statements )

	.local string elem_type

  iter_loop:
	unless iter, iter_end        # while (entries) ...
	shift elem, iter             # get key for next entry
	ast_elem  = tree.get('result', elem, 'list')

	elem_type = typeof ast_elem
	if elem_type == 'PAST::Sub' goto save_elem
	main_statements.'add_child'( ast_elem )
	goto iter_loop

  save_elem:
	result.'add_child'( ast_elem )
	goto iter_loop

  iter_end:
	result.'add_child'( main_sub )

	.return( result )
}

transform result (list) :language('PIR') {
	.local pmc result
	result = new 'PAST::Exp'

	.local pmc match
	match = node['list_item']

	.local pmc iter
	iter  = new Iterator, match # setup iterator for node
	set iter, 0                 # reset iterator, begin at start

	.local pmc children
	children = result.'children'()

	.local pmc child
	child = shift iter
	child = tree.get( 'result', child, 'list_item' )

	.local pmc op
	op    = tree.get( 'maybe_op', child )
	result.'add_child'( op )

  iter_loop:
	unless iter, iter_end        # while (entries) ...
	shift child, iter            # get key for next entry
	child = tree.get( 'result', child, 'list_item' )
	result.'add_child'( child )
	goto iter_loop

  iter_end:
	.local string child_type
	child_type = typeof op
	unless child_type == 'PAST::Op' goto return_result

	result = tree.get( 'handle_specials', result )

  return_result:
	.return( result )
}

# XXX - don't know why I need this, but it prevents ambiguity errors
transform maybe_op (PAST::Exp) :language('PIR') {
	.return( node )
}

transform maybe_op (PAST::Val) :language('PIR') {
	.local string value
	.local string valtype

	value   = node.'value'()
	valtype = node.'valtype'()

	unless valtype goto treat_as_op

	.local pmc val
	val = new 'PAST::Val'
	val.'value'( value )
	val.'valtype'( valtype )

	.return( val )

  treat_as_op:
	.local pmc op
	op = new 'PAST::Op'
	op.'op'( value )

	.return( op )
}

transform handle_specials (PAST::Exp) :language('PIR') {
	.local pmc children
	children = node.'children'()

	.local pmc op
	op = children[0]

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

	.local pmc specials
	specials = find_global 'specials'

	.local int special_exists
	special_exists = exists specials[name]

	unless special_exists goto not_a_special

	node = tree.'get'( name, node )

  not_a_special:
	.return( node )
}

transform define (PAST::Exp) :language('PIR') {
	.local pmc children
	children = node.'children'()

	.local pmc op
	op       = children[0]

  return_sub:
	.local pmc sub_name
	sub_name = children[1]

	.local pmc exp
	exp      = children[2]

	.local pmc sub_name_string
	sub_name_string = sub_name.'value'()

	.local pmc result
	result = new 'PAST::Sub'
	result.'name'( sub_name_string )

	.local pmc stmts
	stmts  = new 'PAST::Stmts'
	stmts.'add_child'( exp )

	result.'add_child'( stmts )
	.return( result )
}

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

	# remove this Exp and promote the first sibling
	.local pmc sibling
	sibling  = children[1]
	children = sibling.'children'()

	.local pmc first_child
	first_child = children[0]

	.local string child_type
	child_type = typeof first_child

	unless child_type == 'PAST::Op' goto rewrite_op

	.local string op_name
	op_name = first_child.'op'()

	# if it's an empty list, let it be an empty list
	unless op_name == '__make_empty_cons' goto rewrite_op
	.return( sibling )

  rewrite_op:
	.local pmc val_child
	val_child = new 'PAST::Val'

	# XXX: this might fail unless the first kid is an op
	.local string value
	value   = first_child.'op'()
	val_child.'value'( value )

	children[0] = val_child
	
	.local pmc cons_op
	cons_op = new 'PAST::Op'
	cons_op.'op'( '__list_to_cons' )

	unshift children, cons_op

	.return( sibling )
}

transform cond (PAST::Exp) :language( 'PIR' ) {
	.local pmc result
	result = new 'PAST::Exp'

	# cond takes a list of pairs
	# ( condition to evaluate ) result
	# rewrite so that there are no ops, only vals

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

	.local pmc child
	.local pmc new_child

	# first node is the 'cond' node
	child   = shift iter
	result.'add_child'( child )
	$S0 = child.'op'()

  iter_loop:
	unless iter goto iter_end
	child     = shift iter
	new_child = tree.'get'( 'node_to_val', child )
	result.'add_child'( new_child )
	goto iter_loop
  iter_end:

	.return( result )
}

transform node_to_val (PAST::Exp) :language('PIR') {
	.local pmc result
	result = new 'PAST::Exp'

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

	.local pmc child
	.local pmc new_child

  iter_loop:
	unless iter goto iter_end
	child     = shift iter
	new_child = tree.'get'( 'node_to_val', child )
	result.'add_child'( new_child )
	goto iter_loop
  iter_end:

	.return( result )
}

transform node_to_val (PAST::Op) :language('PIR') {
	.local pmc    result
	.local string value

	result = new 'PAST::Val'
	value  = node.'op'()

	result.'value'( value )
	result.'valtype'( 'literal' )

	.return( result )
}

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

# XXX: almost certainly wrong
transform result (empty_list) :language('PIR') {
	.local pmc result
	result = new 'PAST::Exp'

	.local pmc cons
	cons = new 'PAST::Op'
	cons.'op'( '__make_empty_cons' )

	result.'add_child'( cons )
	.return( result )
}

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

	.local string value
	value    = node

	.local string valtype
	valtype  = ''

	.local int symbol
	symbol = exists node[ 'symbol' ]
	unless symbol goto check_quoted
	valtype = 'symbol'

  check_quoted:
	.local int quote
	.local int value_length
	value_length = length value

	quote = exists node['quote']
	unless quote goto check_double_quoted

	dec value_length
	value   = substr value, 1, value_length
	valtype = 'literal'
	goto unquoted

  check_double_quoted:
	quote = exists node['quoted_string']
	unless quote goto unquoted

	sub value_length, 2
	value   = substr value, 1, value_length
	valtype = 'literal'
	goto unquoted

  unquoted:
	result.'value'( value )
	result.'valtype'( valtype )
	.return( result )
}

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

	.local string value
	value  = node

	.local int string_length
	string_length = length value
	sub string_length, 2

	.local string val_type
	val_type = substr value, 0, 1
	if val_type == '"' goto double_quoted
	result.'valtype'( 'single_quoted' )
	goto remove_quotes

  double_quoted:
	result.'valtype'( 'double_quoted' )

  remove_quotes:
	value  = substr value, 1, string_length

	result.'value'( value )
	
	.return( result )
}

transform result (list_item) :language('PIR') {
	.local pmc result
	.local pmc iter

	iter  = new .Iterator, node # setup iterator for node
	set iter, 0                 # reset iterator, begin at start

	.local string key
	.local pmc    value

  iter_loop:
	unless iter, iter_end       # while (entries) ...
	shift key, iter             # get key for next entry
	value  = node[key]
	result = tree.get('result', value, key)

  iter_end:
	.return( result )
}
