Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

languages/cardinal Initial checkin

Cardinal is a Ruby on Parrot implementation


git-svn-id: https://svn.parrot.org/parrot/trunk/languages/cardinal@13383 d31e2699-5ff4-0310-a27c-f18f2fbe73fe
  • Loading branch information...
commit 272b0b9ef2b3fcf284ef38aa5756d990dc4bfcaf 0 parents
@tewk tewk authored
306 cardinal.pir
@@ -0,0 +1,306 @@
+=head1 NAME
+
+cardinal -- A compiler for Ruby 1.8.4
+
+=head1 SYNOPSIS
+
+ $ ./parrot languages/cardinal/cardinal.pir script.rb
+
+=head1 DESCRIPTION
+
+Ruby is a compiler for Ruby version 1.8, running on Parrot. Its parser is
+a PGE grammar (a subclass of PGE::Grammar). The compilation is a series of
+tree transformations using TGE: from match tree to abstract syntax tree
+(AST), from AST to opcode syntax tree (OST), and finally from OST to
+bytecode (actually to PIR, at first). For more on the ideas behind the
+compiler, see:
+
+=cut
+
+.include "errors.pasm"
+.include "library/dumper.pir"
+
+.sub _main :main
+ .param pmc args
+
+ errorson .PARROT_ERRORS_PARAM_COUNT_FLAG
+
+ load_bytecode "languages/cardinal/src/CardinalGrammar.pbc"
+ load_bytecode 'dumper.pbc'
+ load_bytecode 'PGE/Dumper.pbc'
+ load_bytecode 'PGE/Text.pbc'
+ load_bytecode 'Getopt/Obj.pbc'
+
+ .local pmc getopts, opts
+ .local string arg0
+ arg0 = shift args
+ getopts = new 'Getopt::Obj'
+ getopts.'notOptStop'(1)
+ push getopts, 'target=s'
+ push getopts, 'dump-optable'
+ push getopts, 'dump-pge-parse|p'
+ push getopts, 'dump-tge-AST|a'
+ push getopts, 'dump-tge-OST|o'
+ push getopts, 'dump-tge-PIR|i'
+ push getopts, 'dump-all|x'
+ push getopts, 'dump|d'
+ push getopts, 'help|h'
+ push getopts, 'trace|t'
+ opts = getopts.'get_options'(args)
+
+ $S0 = opts['dump-optable']
+ if $S0 goto dump_optable
+ $S0 = opts['help']
+ if $S0 goto usage
+
+ .local int stopafter
+ stopafter = 0
+ .local string dump
+ dump = opts['dump']
+ .local string target
+ target = opts['target']
+ .local int istrace
+ $S0 = opts['trace']
+ istrace = isne $S0, ''
+
+ .local int dump_pge
+ $S0 = opts['dump-pge-parse']
+ dump_pge = isne $S0, ''
+ unless $S0 goto a1
+ stopafter = 1
+ a1:
+
+ .local int dump_ast
+ $S0 = opts['dump-tge-AST']
+ dump_ast = isne $S0, ''
+ unless $S0 goto a2
+ stopafter = 2
+ a2:
+
+ .local int dump_ost
+ $S0 = opts['dump-tge-OST']
+ dump_ost = isne $S0, ''
+ unless $S0 goto a3
+ stopafter = 3
+ a3:
+
+ .local int dump_pir
+ $S0 = opts['dump-tge-PIR']
+ dump_pir = isne $S0, ''
+ unless $S0 goto a4
+ stopafter = 4
+ a4:
+
+ .local int istrace
+ $S0 = opts['dump-all']
+ if $S0 goto dump_all
+ $S0 = dump
+ unless $S0 goto after_dump_all
+ dump_all:
+ dump_pge = 1
+ dump_ast = 1
+ dump_ost = 1
+ dump_pir = 1
+ stopafter = 0
+ after_dump_all:
+
+ .local pmc cardinal
+ .local string filename
+ cardinal = compreg 'Cardinal'
+
+ .local string source
+
+ $I0 = elements args
+ if $I0 > 0 goto file_arg
+ filename = "STDIN"
+
+ .local pmc stdin
+ stdin = getstdin
+ push stdin, 'utf8'
+ # enable interactive readline if possible
+ $I0 = stdin.'set_readline_interactive'(1)
+
+ stmt_loop:
+ .local string stmt
+ stmt = stdin.'readline'('cardinal> ')
+ unless stmt goto end
+ bsr cardinal_irb_eval
+ goto stmt_loop
+
+ file_arg:
+ filename = args[1]
+ source = _get_source(filename)
+ goto compile_it
+
+ cardinal_irb_eval:
+ $I0 = find_charset 'iso-8859-1' # XXX: Note 2006-04-14
+ trans_charset stmt, $I0
+ #$P0 = perl6(stmt, 'target' => target, 'dump' => dump)
+ null $P0
+ if target == 'PIR' goto dump_pir_output
+ if target goto dump_object
+ trace istrace
+ $P0()
+ trace 0
+ ret
+ dump_pir_output:
+ print $P0
+ ret
+ dump_object:
+ '_dumper'($P0, target)
+ ret
+
+ dump_optable:
+ $P0 = find_global "Cardinal::Grammar", "$optable"
+ "_dumper"($P0, "Cardinal::Grammar::optable")
+ goto end
+
+ usage:
+ print "usage: cardinal.pbc [--dump-optable] [--target=OUT] [file]\n"
+ end
+
+ compile_it:
+ # Match against the source
+ .local pmc match
+ .local pmc start_rule
+ #start_rule = get_namespace [ 'Cardinal'; 'Grammar'; 'program' ]
+ start_rule = get_namespace [ 'Cardinal::Grammar'; 'program' ]
+ match = start_rule(source, 'grammar'=> 'Cardinal::Grammar')
+
+ # Verify the match
+ $I0 = match.__get_bool()
+ unless $I0 goto err_match_fail # if match fails stop
+
+ unless dump_pge goto after_pge_dump
+ print "parse succeeded\n"
+ print "Match tree dump:\n"
+ $P0 = find_global "_dumper"
+ $P0(match, "PGE Dump")
+ after_pge_dump:
+ eq stopafter, 1, end
+
+ # "Traverse" the parse tree
+ load_bytecode "languages/cardinal/src/ASTGrammar.pbc"
+ .local pmc grammar
+ grammar = new 'ASTGrammar'
+
+ # Construct the "AST"
+ load_bytecode "PAST.pbc"
+ .local pmc astbuilder
+ astbuilder = grammar.apply(match)
+ .local pmc ast
+ ast = astbuilder.get('result')
+ $I0 = defined ast
+ unless $I0 goto err_no_ast # if AST fails stop
+
+ unless dump_ast goto after_ast_dump
+ print "\n\nAST tree dump:\n"
+ ast.'dump'()
+ after_ast_dump:
+ eq stopafter, 2, end
+
+ # Compile the abstract syntax tree down to an opcode syntax tree
+ load_bytecode "languages/cardinal/src/POST.pir"
+ load_bytecode 'languages/cardinal/src/CardinalOpLookup.pir'
+ load_bytecode "languages/cardinal/src/OSTGrammar.pbc"
+ .local pmc ostgrammar
+ ostgrammar = new 'OSTGrammar'
+ .local pmc ostbuilder
+ ostbuilder = ostgrammar.apply(ast)
+ .local pmc ost
+ ost = ostbuilder.get('result')
+ $I0 = defined ost
+ unless $I0 goto err_no_ost # if OST fails stop
+
+ unless dump_ost goto after_ost_dump
+ print "\n\nOST tree dump:\n"
+ ost.'dump'()
+ after_ost_dump:
+ eq stopafter, 3, end
+
+ # Compile the OST down to PIR
+ load_bytecode "languages/cardinal/src/PIRGrammar.pbc"
+ .local pmc pirgrammar
+ pirgrammar = new 'PIRGrammar'
+ .local pmc pirbuilder
+ pirbuilder = pirgrammar.apply(ost)
+ .local pmc pir
+ pir = pirbuilder.get('result')
+ unless pir goto err_no_pir # if PIR not generated, stop
+
+ unless dump_ast goto after_pir_dump
+ print "\n\nPIR dump:\n"
+ print pir
+ after_pir_dump:
+ eq stopafter, 4, end
+
+ # Execute
+ .local pmc pir_compiler
+ .local pmc pir_compiled
+ pir_compiler = compreg "PIR"
+ pir_compiled = pir_compiler( pir )
+ pir_compiled()
+ end
+
+ err_match_fail:
+ print "Parse failed on "
+ print filename
+ print "\n"
+ exit -1
+
+ err_no_ast:
+ print "Unable to construct AST.\n"
+ exit -2
+
+ err_no_ost:
+ print "Unable to construct OST.\n"
+ exit -3
+
+ err_no_pir:
+ print "Unable to construct PIR.\n"
+ exit -4
+
+ end:
+ exit 0
+.end
+
+# Read in the source from a file
+.sub _get_source
+ .param string filename
+
+ $S1 = _slurp_file(filename)
+ .return ($S1)
+
+ err_no_file:
+ print "You must supply a Ruby file to parse.\n"
+ end
+.end
+
+.sub _slurp_file
+ .param string filename
+ .local pmc filehandle
+ filehandle = open filename, "<"
+ unless filehandle goto err_no_file
+ $S1 = read filehandle, 65535
+ close filehandle
+ .return ($S1)
+
+ err_no_file:
+ print "Unable to open file "
+ print filename
+ print "\n"
+ end
+.end
+
+=head1 LICENSE
+
+Copyright (c) 2005 The Perl Foundation
+
+This is free software; you may redistribute it and/or modify
+it under the same terms as Parrot.
+
+=head1 AUTHOR
+
+Kevin Tew <kevintew@tewk.com>
+
+=cut
118 config/makefiles/root.in
@@ -0,0 +1,118 @@
+# $Id: pge.in 11999 2006-03-23 22:04:50Z pmichaud $
+
+# Setup some commands
+LN_S = @lns@
+PERL = @perl@
+RM_RF = @rm_rf@
+PARROT = ../../parrot@exe@
+BUILD = $(PERL) @build_dir@/tools/build/dynpmc.pl
+TOOL_DIR = ../..
+PGE_DIR = ../../compilers/pge
+TGE_DIR = ../../compilers/tge
+CAT = $(PERL) -MExtUtils::Command -e cat
+CP = @cp@
+O = @o@
+LOAD_EXT = @load_ext@
+PARROT_DYNEXT = @build_dir@/runtime/parrot/dynext
+
+PMCDIR = src/pmc
+
+# the default target
+all: cardinal.pbc
+
+SOURCES = cardinal.pir \
+ src/cardinal_rules.pg \
+ src/cardinal_optok.pg \
+ src/CardinalGrammar.pir \
+ src/ASTGrammar.tg \
+ src/OSTGrammar.tg \
+ src/PIRGrammar.tg \
+
+PMCS = cardinal_str
+PMC_SOURCES = $(PMCDIR)/cardinal_str.pmc
+
+cardinal.pbc: $(PARROT) $(PGE_DIR)/pgc.pir $(SOURCES) cardinal.pir src/CardinalGrammar.pbc src/ASTGrammar.pbc src/OSTGrammar.pbc src/PIRGrammar.pbc
+ $(PARROT) -o cardinal.pbc --output-pbc cardinal.pir
+
+src/CardinalGrammar.pbc: src/CardinalGrammar.pir src/cardinal_rules.pg src/cardinal_optok.pg
+ $(PARROT) $(PGE_DIR)/pgc.pir --output=src/cardinal_grammar_gen.pir src/cardinal_rules.pg src/cardinal_optok.pg
+ $(PARROT) -o src/cardinal_grammar_gen.pbc --output-pbc src/cardinal_grammar_gen.pir
+ $(PARROT) -o src/CardinalGrammar.pbc --output-pbc src/CardinalGrammar.pir
+
+src/ASTGrammar.pbc: src/ASTGrammar.tg
+ $(PARROT) $(TGE_DIR)/tgc.pir --output=src/ASTGrammar.pir src/ASTGrammar.tg
+ $(PARROT) -o src/ASTGrammar.pbc --output-pbc src/ASTGrammar.pir
+
+src/OSTGrammar.pbc: src/OSTGrammar.tg
+ $(PARROT) $(TGE_DIR)/tgc.pir --output=src/OSTGrammar.pir src/OSTGrammar.tg
+ $(PARROT) -o src/OSTGrammar.pbc --output-pbc src/OSTGrammar.pir
+
+src/PIRGrammar.pbc: src/PIRGrammar.tg
+ $(PARROT) $(TGE_DIR)/tgc.pir --output=src/PIRGrammar.pir src/PIRGrammar.tg
+ $(PARROT) -o src/PIRGrammar.pbc --output-pbc src/PIRGrammar.pir
+
+#$(PMCDIR)/cardinal_group$(LOAD_EXT): $(PARROT) $(PMC_SOURCES)
+# cd $(PMCDIR) && $(BUILD) generate $(PMCS)
+# cd $(PMCDIR) && $(BUILD) compile $(PMCS)
+# cd $(PMCDIR) && $(BUILD) linklibs $(PMCS)
+# cd $(PMCDIR) && $(BUILD) copy --destination=$(PARROT_DYNEXT) $(PMCS)
+
+#src/builtins_gen.pir: src/builtins/*.pir
+# $(CAT) src/builtins/*.pir >src/builtins_gen.pir
+
+
+
+
+# This is a listing of all targets, that are meant to be called by users
+help:
+ @echo ""
+ @echo "Following targets are available for the user:"
+ @echo ""
+ @echo " all: cardinal.pbc"
+ @echo " This is the default."
+ @echo "Testing:"
+ @echo " test: Run the test suite."
+ @echo " testclean: Clean up test results."
+ @echo ""
+ @echo "Cleaning:"
+ @echo " clean: Basic cleaning up."
+ @echo " realclean: Removes also files generated by 'Configure.pl'"
+ @echo " distclean: Removes also anything built, in theory"
+ @echo ""
+ @echo "Misc:"
+ @echo " help: Print this help message."
+ @echo ""
+
+test: all
+ $(PERL) -Isrc -I../../src t/harness
+
+testclean:
+ $(RM_F) "t/*.p1" "t/*.out" "t/*.pir"
+
+CLEANUPS = \
+ src/cardinal_rules.pbc \
+ src/cardinal_optok.pbc \
+ src/cardinal_grammar_gen.pir \
+ src/cardinal_grammar_gen.pbc \
+ src/CardinalGrammar.pbc \
+ src/ASTGrammar.pbc \
+ src/OSTGrammar.pbc \
+ src/PIRGrammar.pbc \
+ src/ASTGrammar.pir \
+ src/OSTGrammar.pir \
+ src/PIRGrammar.pir \
+ $(PMCDIR)/*.h \
+ $(PMCDIR)/*.c \
+ $(PMCDIR)/*.dump \
+ $(PMCDIR)/*$(O) \
+ $(PMCDIR)/*$(LOAD_EXT)
+
+clean:
+ $(RM_RF) $(CLEANUPS)
+
+realclean: clean
+ $(RM_RF) Makefile
+
+distclean: realclean
+
+
54 rit
@@ -0,0 +1,54 @@
+#!/usr/bin/perl -w
+
+# vim: syntax=perl
+use strict;
+use warnings;
+
+my $PARROT = '../../parrot';
+my $CARDINAL = 'cardinal.pbc';
+my $CURRENT_TEST = 'trb/puts.rb';
+my $TRACE_ARGS = "";
+
+if ( @ARGV > 0 )
+{
+ eval($ARGV[0]);
+}
+else
+{
+ execute();
+}
+
+sub trace
+{
+ $TRACE_ARGS = "-t 5";
+ execute();
+}
+
+sub execute
+{
+ execute_cmd( "make ; $PARROT $TRACE_ARGS $CARDINAL $CURRENT_TEST" );
+}
+
+sub debug
+{
+ execute_cmd( "make ; $PARROT $TRACE_ARGS $CARDINAL -d $CURRENT_TEST" );
+}
+
+sub gdb
+{
+ execute_cmd( "echo 'set args $CARDINAL $CURRENT_TEST\n run\n' > .rit_gdb_cmds");
+ exec( "gdb -x .rit_gdb_cmds ../../parrot" );
+}
+
+sub execute_cmd
+{
+my ($cmd) = @_;
+print $cmd . "\n";
+print `$cmd`;
+$$;
+}
+
+sub publish
+{
+ print `cd ..; tar zcf cardinal.tgz cardinal; date; ls -al cardinal.tgz ; scp cardinal.tgz tewk\@tewk.com:www/www ; cd cardinal`;
+}
1,062 src/ASTGrammar.tg
@@ -0,0 +1,1062 @@
+grammar ASTGrammar is TGE::Grammar;
+
+preamble{
+.include 'interpinfo.pasm'
+.macro unless_defined ( x, l )
+ .sym int result
+ .result = defined .x
+ unless .result goto .l
+.endm
+
+.macro kdump ( x )
+ .sym pmc it
+ it = interpinfo .INTERPINFO_NAMESPACE_ROOT
+ it = it[ 'parrot'; '_dumper' ]
+ it(.x)
+.endm
+
+.macro kdump2 ( x, d)
+ .sym pmc it
+ it = interpinfo .INTERPINFO_NAMESPACE_ROOT
+ it = it[ 'parrot'; '_dumper' ]
+ it(.x, .d)
+.endm
+}
+
+transform result (ROOT) :language('PIR') {
+ debug_init
+
+ # Ask the child node for its result
+ .local pmc child
+ $I0 = defined node['compound_statement']
+ unless $I0 goto err_no_tree
+ $P0 = node['compound_statement']
+ child = tree.get('result', $P0, 'Cardinal::Grammar::compound_statement')
+
+ .return (child)
+
+ err_no_tree:
+ print "The top-level node doesn't contain an 'compound_statement' match.\n"
+ end
+}
+
+transform result (Cardinal::Grammar::compound_statement) :language('PIR') {
+ # Ask the child node for its result
+ .local pmc child
+ $I0 = defined node['statements']
+ unless $I0 goto err_no_tree
+ $P0 = node['statements']
+ child = tree.get('result', $P0, 'Cardinal::Grammar::statements')
+
+ .return (child)
+
+ err_no_tree:
+ print "The compound_statement node doesn't contain a 'statements' match.\n"
+ end
+}
+
+transform result (Cardinal::Grammar::statements) :language('PIR') {
+ .local pmc result
+ result = new 'PAST::Stmts'
+ result.'clone'(node)
+
+ # Ask the child node for its result
+ .local pmc child
+ $I0 = defined node['statement']
+ unless $I0 goto err_no_tree
+ $P0 = node['statement']
+
+ .local pmc iter
+ iter = new Iterator, $P0 # setup iterator for node
+ iter = 0
+
+ iter_loop:
+ unless iter, iter_end # while (entries) ...
+ shift $P2, iter
+
+ .local pmc child
+ child = tree.get('result', $P2, 'Cardinal::Grammar::statement')
+
+ result.'add_child'(child)
+
+ goto iter_loop
+ iter_end:
+
+ .return (result)
+
+ err_no_tree:
+ print "The statements node doesn't contain a 'statement' match.\n"
+ end
+}
+
+transform result (Cardinal::Grammar::statement) :language('PIR') {
+ .local pmc result
+ result = new 'PAST::Stmt'
+ result.'clone'(node)
+
+ $I0 = defined node['expression']
+ unless $I0 goto err_no_tree
+ $P0 = node['expression']
+ $P1 = $P0[0]
+ .local pmc child
+ child = tree.get('result', $P1, 'Cardinal::Grammar::expression')
+
+ $P2 = node
+ $I0 = defined $P2['if']
+ $S0 = "if"
+ if $I0 goto cond_op
+ $I0 = defined $P2['unless']
+ $S0 = "unless"
+ if $I0 goto cond_op
+ $I0 = defined $P2['while']
+ $S0 = "while"
+ if $I0 goto cond_op
+ $I0 = defined $P2['rescue']
+ $S0 = "rescue"
+ if $I0 goto cond_op
+
+ result.'add_child'(child)
+ .return (result)
+
+ cond_op:
+ .local pmc op
+ op = new 'PAST::Op'
+ op.'clone'($P2)
+ op.'op'($S0)
+ $P1 = $P0[1]
+ $P3 = tree.get('result', $P1, 'Cardinal::Grammar::expression')
+
+ op.'add_child'(child)
+ op.'add_child'($P3)
+ result.'add_child'(op)
+ .return (result)
+
+ err_no_tree:
+ print "The statement node doesn't contain a 'expression' match.\n"
+ end
+}
+
+transform result (Cardinal::Grammar::expression) :language('PIR') {
+
+ # Ask the child node for its result
+ .local pmc child
+ $I0 = defined node['operator_precedence_parser']
+ unless $I0 goto err_no_tree
+ $P0 = node['operator_precedence_parser']
+ child = tree.get('result', $P0, 'Cardinal::Grammar::operator_precedence_parser')
+
+ .local pmc result
+ result = new 'PAST::Exp'
+ result.'clone'(node)
+ result.'add_child'(child)
+ .return (result)
+
+ err_no_tree:
+ print "The expression node doesn't contain a 'operator_precedence_parser' match.\n"
+ end
+}
+
+transform result (Cardinal::Grammar::operator_precedence_parser) :language('PIR') {
+ .local pmc result
+ result = new 'PAST::Exp'
+ result.'clone'(node)
+
+ .local pmc iter
+ $P1 = node.get_hash()
+ iter = new Iterator, $P1 # setup iterator for node
+ iter = 0
+ iter_loop:
+ unless iter, iter_end # while (entries) ...
+ shift $S1, iter # get the key of the iterator
+ $P2 = iter[$S1]
+ $S0 = 'Cardinal::Grammar::'
+ $S0 .= $S1
+ $P3 = tree.get('result', $P2, $S0)
+ if null $P3 goto iter_loop
+ result.'add_child'($P3)
+ goto iter_loop
+ iter_end:
+
+ .return (result)
+}
+
+transform result (Cardinal::Grammar::expr) :language('PIR') {
+ .local string type
+ type = node["type"]
+ unless node goto error_no_node
+ if type == 'term:' goto transform_term
+ # else
+ $P1 = tree.get('op', node, 'expr')
+ .return($P1)
+ transform_term:
+ $P1 = tree.get('term', node, 'expr')
+ .return($P1)
+ error_no_node:
+ print "error: no node\n"
+ end
+}
+
+
+transform result (Cardinal::Grammar::assignment) :language('PIR') {
+ .local pmc child
+ .local string assign_symbol
+ .local pmc child2
+
+ $I0 = defined node[0]
+ unless $I0 goto other_assignment
+ $S0 = node[0]
+ .kdump($S0)
+ ne_str $S0, "=", na1
+ print "HERE\n"
+ assign_symbol = node[0]
+ goto get_left
+ na1:
+
+ other_assignment:
+ $I0 = defined node['ASSIGN_OP']
+ unless $I0 goto try_command
+ assign_symbol = node['ASSIGN_OP']
+ goto get_left
+
+ get_left:
+ $I0 = defined node['left_hand_side']
+ unless $I0 goto get_left2
+ $P0 = node['left_hand_side']
+ child = tree.get('result', $P0, 'Cardinal::Grammar::left_hand_side')
+ goto get_right
+ get_left2:
+
+
+ get_right:
+ $I0 = defined node['expression']
+ unless $I0 goto err_no_tree
+ $P0 = node['expression']
+ child2 = tree.get('result', $P0, 'Cardinal::Grammar::expression')
+ goto build_assignment
+
+
+
+ try_command:
+ $I0 = defined node['command_call']
+ unless $I0 goto try_primary
+ $P0 = node['command_call']
+ child = tree.get('result', $P0, 'Cardinal::Grammar::command_call')
+ goto single_item
+
+ try_primary:
+ $I0 = defined node['primary']
+ unless $I0 goto err_no_tree
+ $P0 = node['primary']
+ child = tree.get('result', $P0, 'Cardinal::Grammar::primary')
+ goto single_item
+
+
+ get_ast_node:
+ .local pmc identChild
+ $S0 = typeof child
+ unless $S0 == 'PAST::Val' goto err_not_past_val
+ $S0 = child.'valtype'()
+ unless $S0 == 'identifier' goto err_not_past_val
+ identChild = child
+ child = new 'PAST::Var'
+ child.'varname'($S0)
+
+
+ build_assignment:
+ .local pmc result
+ result = new 'PAST::Op'
+ result.'clone'(node)
+ result.'op'(assign_symbol)
+ result.'add_child'(child)
+ result.'add_child'(child2)
+ .return (result)
+
+ single_item:
+ .return (child)
+
+ err_not_past_val:
+ print "Not a Identifier\n"
+ end
+
+ err_no_tree:
+ print "The assignment node doesn't contain a 'postfix' match.\n"
+ .kdump2(node, "Node")
+ end
+ err_no_assign_symbol:
+ print "The assignment node doesn't contain a assignment symbol.\n"
+ end
+ err_no_conditional:
+ print "The assignment node doesn't contain a 'conditional' match.\n"
+ end
+}
+
+transform result (Cardinal::Grammar::command_call) :language('PIR') {
+ .local pmc command
+ $I0 = defined node['command']
+ unless $I0 goto err_no_tree
+ $P1 = node['command']
+ command = tree.get('result', $P1, 'Cardinal::Grammar::command')
+
+ .return (command)
+
+ err_no_tree:
+ print "The command_call node doesn't contain a 'command' match.\n"
+ end
+}
+
+transform result (Cardinal::Grammar::command) :language('PIR') {
+ .local pmc name
+ $I0 = defined node['operation']
+ unless $I0 goto err_no_name
+ $P1 = node['operation']
+ name = tree.get('result', $P1, 'Cardinal::Grammar::operation')
+
+ # Check for args
+ .local pmc args
+ $I0 = defined node['command_args']
+ unless $I0 goto noargs
+ $P1 = node['command_args']
+ args = tree.get('result', $P1, 'Cardinal::Grammar::command_args')
+ if_null args, noargs
+
+ .local pmc result
+ result = new 'PAST::Op'
+ result.'clone'(node)
+ $S0 = name.'value'()
+ result.'op'($S0)
+
+ .local pmc iter
+ iter = new Iterator, args # setup iterator for node
+ iter = 0
+
+ iter_loop:
+ unless iter, iter_end # while (entries) ...
+ shift $P2, iter
+
+ result.'add_child'($P2)
+
+ goto iter_loop
+ iter_end:
+
+ .return (result)
+
+ noargs:
+ .return (name)
+
+ err_no_name:
+ print "The command node doesn't contain a 'operation' match.\n"
+ end
+}
+
+transform result (Cardinal::Grammar::command_args) :language('PIR') {
+ .local pmc args
+ $I0 = defined node['paren_args']
+ unless $I0 goto call_args
+ $P0 = node['paren_args']
+ args = tree.get('result', $P0, 'Cardinal::Grammar::paren_args')
+ .return (args)
+
+ call_args:
+ $I0 = defined node['call_args']
+ unless $I0 goto err_no_tree
+ $P0 = node['call_args']
+ args = tree.get('result', $P0, 'Cardinal::Grammar::call_args')
+ .return (args)
+
+ err_no_tree:
+ print "The command_args node doesn't contain an 'paren_args' or 'call_args' match.\n"
+ end
+}
+
+transform result (Cardinal::Grammar::paren_args) :language('PIR') {
+ .local pmc args
+ $I0 = defined node['call_args']
+ unless $I0 goto no_call_args
+ $P0 = node['call_args']
+ args = tree.get('result', $P0, 'Cardinal::Grammar::call_args')
+ .return (args)
+
+ no_call_args:
+ null args
+ .return (args)
+}
+
+transform result (Cardinal::Grammar::call_args) :language('PIR') {
+ .local pmc result
+ result = new .ResizablePMCArray
+
+ .local pmc iter
+ iter = new Iterator, node # setup iterator for node
+ iter = 0
+
+ iter_loop:
+ unless iter, iter_end # while (entries) ...
+ shift $P2, iter
+
+ .local pmc child
+
+ $I0 = defined $P2['call_args_positional']
+ unless $I0 goto next_1
+ $P3 = $P2['call_args_positional']
+ child = tree.get('result', $P3, 'Cardinal::Grammar::call_args_positional')
+ .return (child)
+ goto add_child
+
+ next_1:
+ goto err_no_tree
+ $I0 = defined $P2['call_args_positional']
+ unless $I0 goto err_no_tree
+ $P3 = $P2['call_args_positional']
+ child = tree.get('result', $P3, 'Cardinal::Grammar::call')
+ goto add_child
+
+ add_child:
+ push result, child
+
+ goto iter_loop
+ iter_end:
+
+ .return (result)
+
+ err_no_tree:
+ print "The call_args node doesn't contain a proper 'argument' match.\n"
+ end
+
+}
+
+transform result (Cardinal::Grammar::call_args_positional) :language('PIR') {
+ .local pmc result
+ result = new .ResizablePMCArray
+
+ $I0 = defined node['expression']
+ unless $I0 goto err_no_tree
+ $P0 = node['expression']
+
+ .local pmc iter
+ iter = new Iterator, $P0 # setup iterator for node
+ iter = 0
+
+ iter_loop:
+ unless iter, iter_end # while (entries) ...
+ shift $P2, iter
+
+ .local pmc child
+ child = tree.get('result', $P2, 'Cardinal::Grammar::expression')
+ push result, child
+
+ goto iter_loop
+ iter_end:
+
+ .return (result)
+
+ err_no_tree:
+ print "The call_args_positional node doesn't contain a proper 'expression' match.\n"
+ end
+}
+
+transform result (Cardinal::Grammar::operation) :language('PIR') {
+ # Get IDENTIFIER or CONSTANT
+ .local pmc name
+ $I0 = defined node['IDENTIFIER']
+ unless $I0 goto test_constant
+ $P0 = node['IDENTIFIER']
+ name = tree.get('result', $P0, 'Cardinal::Grammar::IDENTIFIER')
+ .return (name)
+
+ test_constant:
+ $I0 = defined node['CONSTANT']
+ unless $I0 goto err_no_name
+ $P0 = node['CONSTANT']
+ name = tree.get('result', $P0, 'Cardinal::Grammar::CONSTANT')
+ .return (name)
+
+ err_no_name:
+ print "The PGE operation node doesn't contain a 'IDENTIFIER' or a 'CONSTANT' match.\n"
+ end
+}
+
+transform result (Cardinal::Grammar::IDENTIFIER) :language('PIR') {
+ # Ask the child node for its result
+ .local pmc child
+
+ $I0 = defined node[0]
+ unless $I0 goto err_no_tree
+ $P0 = node[0]
+ .local pmc result
+ result = new 'PAST::Val'
+ result.'clone'(node)
+ $S2 = node
+
+ ne $S2, "true", l1
+ result.'value'("1")
+ result.'valtype'('boolean')
+ goto case_end
+l1:
+ ne $S2, "false", l2
+ result.'value'("0")
+ result.'valtype'('boolean')
+ goto case_end
+l2:
+ result.'value'($S2)
+ result.'valtype'('identifier')
+
+case_end:
+ .return (result)
+
+ err_no_tree:
+ print "The IDENTIFIER node doesn't contain a 'YYY' match.\n"
+ end
+}
+
+transform result (Cardinal::Grammar::CONSTANT) :language('PIR') {
+ # Ask the child node for its result
+ .local pmc child
+ $I0 = defined node[0]
+ unless $I0 goto err_no_tree
+ $P0 = node[0]
+ .local pmc result
+ result = new 'PAST::Val'
+ result.'clone'(node)
+ $S2 = node
+ result.'value'($S2)
+ result.'valtype'('constant')
+ .return (result)
+
+ .return (child)
+
+ err_no_tree:
+ print "The CONSTANT node doesn't contain a 'YYY' match.\n"
+ end
+}
+
+transform result (Cardinal::Grammar::primary) :language('PIR') {
+ # Ask the child node for its result
+ .local pmc child
+ $I0 = defined node['primary2']
+ unless $I0 goto err_no_tree
+ $P0 = node['primary2']
+ child = tree.get('result', $P0, 'Cardinal::Grammar::primary2')
+
+ .return (child)
+
+ err_no_tree:
+ print "The primary node doesn't contain a 'primary2' match.\n"
+ end
+}
+
+transform result (Cardinal::Grammar::primary2) :language('PIR') {
+ # Ask the child node for its result
+ .local pmc child
+ $I0 = defined node['atom']
+ unless $I0 goto err_no_tree
+ $P0 = node['atom']
+ child = tree.get('result', $P0, 'Cardinal::Grammar::atom')
+
+ .return (child)
+
+ err_no_tree:
+ print "The primary2 node doesn't contain a 'atom' match.\n"
+ end
+}
+
+transform result (Cardinal::Grammar::atom) :language('PIR') {
+
+ # Ask the child node for its result
+ .local pmc child
+ $I0 = defined node['literal']
+ unless $I0 goto try_string
+ $P0 = node['literal']
+ child = tree.get('result', $P0, 'Cardinal::Grammar::literal')
+ goto done
+
+ try_string:
+ $I0 = defined node['string']
+ unless $I0 goto try_variable
+ $P0 = node['string']
+ child = tree.get('result', $P0, 'Cardinal::Grammar::string')
+ goto done
+
+ try_variable:
+ $I0 = defined node['variable']
+ unless $I0 goto err_no_tree
+ $P0 = node['variable']
+ child = tree.get('result', $P0, 'Cardinal::Grammar::variable')
+
+ done:
+ .return (child)
+
+ err_no_tree:
+ print "The atom node doesn't contain a 'literal' or a 'string' match.\n"
+ .kdump2(node, "atom")
+ end
+}
+
+transform result (Cardinal::Grammar::string) :language('PIR') {
+
+ # Ask the child node for its result
+ .local pmc child
+ $I0 = defined node['DOUBLE_STRING']
+ unless $I0 goto try_string2
+ $P0 = node['DOUBLE_STRING']
+ child = tree.get('result', $P0, 'Cardinal::Grammar::DOUBLE_STRING')
+ goto done
+
+ try_string2:
+ $I0 = defined node['SINGLE_STRING']
+ unless $I0 goto err_no_tree
+ $P0 = node['SINGLE_STRING']
+ child = tree.get('result', $P0, 'Cardinal::Grammar::SINGLE_STRING')
+
+ done:
+ .return (child)
+
+ err_no_tree:
+ print "The atom node doesn't contain a 'literal' or a 'string' match.\n"
+ end
+}
+
+transform result (Cardinal::Grammar::literal) :language('PIR') {
+ # Ask the child node for its result
+ .local pmc child
+ $I0 = defined node['numeric']
+ unless $I0 goto err_no_tree
+ $P0 = node['numeric']
+ child = tree.get('result', $P0, 'Cardinal::Grammar::numeric')
+ goto done
+
+ done:
+ .return (child)
+
+ err_no_tree:
+ print "The literal node doesn't contain a 'numeric' match.\n"
+ end
+}
+
+transform result (Cardinal::Grammar::numeric) :language('PIR') {
+ # Ask the child node for its result
+ .local pmc child
+ $I0 = defined node['INTEGER']
+ unless $I0 goto try_float
+ $P0 = node['INTEGER']
+ child = tree.get('result', $P0, 'Cardinal::Grammar::INTEGER')
+ goto done
+
+ try_float:
+ $I0 = defined node['FLOAT']
+ unless $I0 goto err_no_tree
+ $P0 = node['FLOAT']
+ child = tree.get('result', $P0, 'Cardinal::Grammar::FLOAT')
+ goto done
+
+ done:
+ .return (child)
+
+ err_no_tree:
+ print "The numeric node doesn't contain a 'INTEGER', or a 'LOAT' match.\n"
+ end
+}
+
+transform result (Cardinal::Grammar::INTEGER) :language('PIR') {
+ # Ask the child node for its result
+ .local pmc child
+ $I0 = defined node['DECIMAL']
+ unless $I0 goto err_no_tree
+ $P0 = node['DECIMAL']
+ child = tree.get('result', $P0, 'Cardinal::Grammar::DECIMAL')
+
+ .return (child)
+
+ err_no_tree:
+ print "The INTEGER node doesn't contain a 'DECIMAL' match.\n"
+ end
+}
+
+transform result (Cardinal::Grammar::DECIMAL) :language('PIR') {
+ # Ask the child node for its result
+ .local pmc child
+ $I0 = defined node[0]
+ unless $I0 goto err_no_tree
+ $P0 = node[0]
+ .local pmc result
+ result = new 'PAST::Val'
+ result.'clone'(node)
+ $S2 = node
+ result.'value'($S2)
+ result.'valtype'('int')
+ .return (result)
+
+ err_no_tree:
+ print "The DECIMAL node doesn't contain a 'YYY' match.\n"
+ end
+}
+
+transform result (Cardinal::Grammar::DOUBLE_STRING) :language('PIR') {
+ .local pmc result
+ result = new 'PAST::Val'
+ result.'clone'(node)
+
+ .local string value
+ # Check if this is a string match
+ $I0 = defined node["PGE::Text::bracketed"]
+ if $I0 goto bracketed_value
+ value = node
+ goto no_bracketed_value
+ bracketed_value:
+ $P1 = node["PGE::Text::bracketed"]
+ $P2 = $P1[0]
+ value = $P2
+ no_bracketed_value:
+
+ result.'value'(value)
+ result.'valtype'('strqq')
+ .return (result)
+
+}
+
+transform result (Cardinal::Grammar::SINGLE_STRING) :language('PIR') {
+ .local pmc result
+ result = new 'PAST::Val'
+ result.'clone'(node)
+
+ .local string value
+ # Check if this is a string match
+ $I0 = defined node["PGE::Text::bracketed"]
+ if $I0 goto bracketed_value
+ value = node
+ goto no_bracketed_value
+ bracketed_value:
+ $P1 = node["PGE::Text::bracketed"]
+ $P2 = $P1[0]
+ value = $P2
+ no_bracketed_value:
+
+ result.'value'(value)
+ result.'valtype'('strqq')
+ .return (result)
+}
+
+transform result (Cardinal::Grammar::left_hand_side) :language('PIR') {
+ # Ask the child node for its result
+ .local pmc child
+ $I0 = defined node['variable']
+ unless $I0 goto err_no_tree
+ $P0 = node['variable']
+ child = tree.get('result', $P0, 'Cardinal::Grammar::variable')
+
+ .return (child)
+
+ err_no_tree:
+ print "The left_hand_side node doesn't contain a 'variable' match.\n"
+ end
+}
+
+transform result (Cardinal::Grammar::variable) :language('PIR') {
+ # Ask the child node for its result
+ .local pmc child
+ $I0 = defined node['IDENTIFIER']
+ unless $I0 goto err_no_tree
+ $P0 = node['IDENTIFIER']
+ child = tree.get('result', $P0, 'Cardinal::Grammar::IDENTIFIER')
+
+ .return (child)
+
+ err_no_tree:
+ print "The variable node doesn't contain a 'IDENTIFIER' match.\n"
+ end
+}
+
+
+transform result (PunieGrammar::expr) :language('PIR') {
+ .local pmc result
+ result = new 'PAST::Exp'
+ result.'clone'(node)
+
+ $P1 = node.get_hash()
+ $P0 = new Iterator, $P1 # setup iterator for node
+ set $P0, 0 # reset iterator, begin at start
+ iter_loop:
+ unless $P0, iter_end # while (entries) ...
+ shift $S2, $P0 # get key for next entry
+ $P2 = $P0[$S2] # get entry at current key
+ $P3 = tree.get('result', $P2, $S2)
+ if null $P3 goto iter_loop
+ result.'add_child'($P3)
+ goto iter_loop
+ iter_end:
+
+ .return (result)
+}
+
+transform result (PunieGrammar::cond) :language('PIR') {
+ .local pmc result
+ result = new 'PAST::Op'
+ result.'clone'(node)
+ $S1 = node[0]
+ result.'op'($S1)
+
+ $P1 = node.get_hash()
+ .local pmc iter
+ iter = new Iterator, $P1 # setup iterator for node
+ set iter, 0 # reset iterator, begin at start
+ iter_loop:
+ unless iter, iter_end # while (entries) ...
+ shift $S2, iter # get key for next entry
+ $P2 = iter[$S2] # get entry at current key
+ $P3 = tree.get('result', $P2, $S2)
+ if null $P3 goto iter_loop
+ result.'add_child'($P3)
+ goto iter_loop
+ iter_end:
+
+ .return (result)
+}
+
+transform result (PunieGrammar::else) :language('PIR') {
+ .local pmc onechild
+ onechild = node[0]
+ unless onechild goto no_child
+ .local pmc result
+ result = new 'PAST::Op'
+ result.'clone'(onechild)
+ $S1 = onechild[0]
+ result.'op'($S1)
+
+ $P1 = onechild.get_hash()
+ .local pmc iter
+ iter = new Iterator, $P1 # setup iterator for node
+ set iter, 0 # reset iterator, begin at start
+ iter_loop:
+ unless iter, iter_end # while (entries) ...
+ shift $S2, iter # get key for next entry
+ $P2 = iter[$S2] # get entry at current key
+ $P3 = tree.get('result', $P2, $S2)
+ if null $P3 goto iter_loop
+ result.'add_child'($P3)
+ goto iter_loop
+ iter_end:
+
+ .return (result)
+ no_child:
+ .return ()
+}
+
+transform result (PunieGrammar::label) :language('PIR') {
+ .return ()
+}
+
+transform result (PunieGrammar::cexpr) :language('PIR') {
+ .local pmc result
+ $I0 = defined node["PunieGrammar::oexpr"]
+ unless $I0 goto err_no_oexpr
+ $P1 = node["PunieGrammar::oexpr"]
+ result = new 'PAST::Op'
+ result.'clone'(node)
+ result.'op'('O_COMMA')
+
+ $P0 = new Iterator, $P1 # setup iterator for node
+ set $P0, 0 # reset iterator, begin at start
+ iter_loop:
+ unless $P0, iter_end # while (entries) ...
+ shift $P2, $P0 # get next entry
+ $P3 = tree.get('result', $P2, 'PunieGrammar::oexpr')
+ if null $P3 goto iter_loop
+ result.'add_child'($P3)
+ goto iter_loop
+ iter_end:
+
+ # If there's only one child node, it's a single element, not a list,
+ # so just return the single element. Otherwise, we have a comma
+ # separated list, so build a comma op node.
+ .local pmc children
+ children = result.'children'()
+ $I0 = elements children
+ unless $I0 > 1 goto no_comma
+ .return (result)
+ no_comma:
+ result = shift children # there's only one result
+ .return (result)
+ err_no_oexpr:
+ print "The cexpr node doesn't contain a 'oexpr' match.\n"
+ end
+}
+
+transform result (PunieGrammar::oexpr) :language('PIR') {
+ .local pmc result
+ result = new 'PAST::Exp'
+ result.'clone'(node)
+
+ .local pmc iter
+ $P1 = node.get_hash()
+ iter = new Iterator, $P1 # setup iterator for node
+ iter = 0
+ iter_loop:
+ unless iter, iter_end # while (entries) ...
+ shift $S1, iter # get the key of the iterator
+ $P2 = iter[$S1]
+ $P3 = tree.get('result', $P2, $S1)
+ if null $P3 goto iter_loop
+ result.'add_child'($P3)
+ goto iter_loop
+ iter_end:
+
+ .return (result)
+}
+
+
+transform result (PunieGrammar::variable) :language('PIR') {
+ .local pmc result
+ result = new 'PAST::Var'
+ result.'clone'(node)
+ .local string sigil
+ .local string name
+ sigil = node['sigil']
+ $S1 = node['word']
+ name = sigil . $S1
+
+ result.'varname'(name)
+ result.'scope'('global')
+
+ unless sigil == '$' goto not_scalar
+ result.'vartype'('scalar')
+ not_scalar:
+
+ .return (result)
+}
+
+transform result (PunieGrammar::number) :language('PIR') {
+ .local pmc result
+ result = new 'PAST::Val'
+ result.'clone'(node)
+ $S2 = node
+ result.'value'($S2)
+ result.'valtype'('num')
+
+ .return (result)
+}
+
+transform result (PunieGrammar::integer) :language('PIR') {
+ .local pmc result
+ result = new 'PAST::Val'
+ result.'clone'(node)
+ $S2 = node
+ result.'value'($S2)
+ result.'valtype'('int')
+ .return (result)
+}
+
+transform result (PunieGrammar::stringdouble) :language('PIR') {
+ .local pmc result
+ result = new 'PAST::Val'
+ result.'clone'(node)
+
+ .local string value
+ # Check if this is a string match
+ $I0 = defined node["PGE::Text::bracketed"]
+ if $I0 goto bracketed_value
+ value = node
+ goto no_bracketed_value
+ bracketed_value:
+ $P1 = node["PGE::Text::bracketed"]
+ $P2 = $P1[0]
+ value = $P2
+ no_bracketed_value:
+
+ result.'value'(value)
+ result.'valtype'('strqq')
+ .return (result)
+}
+
+transform result (PunieGrammar::stringsingle) :language('PIR') {
+ .local pmc result
+ result = new 'PAST::Val'
+ result.'clone'(node)
+
+ .local string value
+ # Check if this is a string match
+ $I0 = defined node["PGE::Text::bracketed"]
+ if $I0 goto bracketed_value
+ value = node
+ goto no_bracketed_value
+ bracketed_value:
+ $P1 = node["PGE::Text::bracketed"]
+ $P2 = $P1[0]
+ value = $P2
+ no_bracketed_value:
+
+ result.'value'(value)
+ result.'valtype'('strq')
+ .return (result)
+}
+
+# The following rules are for the results of the operator precedence
+# parser. These operate very differently than the standard grammar
+# rules, because they give the node type in a "type" hash key inside the
+# node, instead of storing the node as the value of a hash key that
+# is their type.
+
+transform op (expr) :language('PIR') {
+ .local pmc result
+ result = new 'PAST::Op'
+ result.'clone'(node)
+ $S1 = node["type"]
+ result.'op'($S1)
+
+ $P1 = node.get_array()
+ .local pmc iter
+ iter = new Iterator, $P1 # setup iterator for node
+ set iter, 0 # reset iterator, begin at start
+ iter_loop:
+ unless iter, iter_end # while (entries) ...
+ shift $P2, iter # get entry
+ $P3 = tree.get('result', $P2, 'expr')
+ if null $P3 goto iter_loop
+ result.'add_child'($P3)
+ goto iter_loop
+ iter_end:
+
+ .return (result)
+}
+
+transform term (expr) :language('PIR') {
+ .local pmc result
+ .local pmc children
+ children = new .ResizablePMCArray
+ $P1 = node.get_hash()
+ $P0 = new Iterator, $P1 # setup iterator for node
+ set $P0, 0 # reset iterator, begin at start
+ iter_loop:
+ unless $P0, iter_end # while (entries) ...
+ shift $S2, $P0 # get key for next entry
+ # skip 'type' keys added by the operator precedence parser
+ if $S2 == 'type' goto iter_loop
+ $P2 = $P0[$S2] # get entry at current key
+ $S1 = 'Cardinal::Grammar::'
+ $S1 .= $S2
+ $P3 = tree.get('result', $P2, $S1)
+ if null $P3 goto iter_loop
+ push children, $P3
+ goto iter_loop
+ iter_end:
+
+ $I0 = elements children
+ unless $I0 == 1 goto err_too_many
+ result = children[0]
+ .return (result)
+
+ err_too_many:
+ print "error: Currently, 'term' nodes should have only one child.\n"
+ end
+}
+
+=head1 LICENSE
+
+Copyright (C) 2006, The Perl Foundation.
+
+This is free software; you may redistribute it and/or modify
+it under the same terms as Parrot.
+
+=head1 AUTHOR
+
+Kevin Tew <tewk@tewk.com>
+
+=cut
137 src/CardinalBuiltins.pir
@@ -0,0 +1,137 @@
+.sub 'puts'
+ .param pmc a
+ $P0 = a
+ print $P0
+.end
+
+.sub '=='
+ .param pmc a
+ .param pmc b
+ $I1 = a
+ $I2 = b
+ $I3 = iseq $I1, $I2
+ $P1 = new Integer
+ $P1 = $I3
+ .return($P1)
+.end
+
+.sub '!='
+ .param pmc a
+ .param pmc b
+ $I1 = a
+ $I2 = b
+ $I3 = isne $I1, $I2
+ $P1 = new Integer
+ $P1 = $I3
+ .return($P1)
+.end
+
+.sub '<'
+ .param pmc a
+ .param pmc b
+ $I1 = a
+ $I2 = b
+ $I3 = islt $I1, $I2
+ $P1 = new Integer
+ $P1 = $I3
+ .return($P1)
+.end
+
+.sub '>'
+ .param pmc a
+ .param pmc b
+ $I1 = a
+ $I2 = b
+ $I3 = isgt $I1, $I2
+ $P1 = new Integer
+ $P1 = $I3
+ .return($P1)
+.end
+
+.sub '<='
+ .param pmc a
+ .param pmc b
+ $I1 = a
+ $I2 = b
+ $I3 = isle $I1, $I2
+ $P1 = new Integer
+ $P1 = $I3
+ .return($P1)
+.end
+
+.sub '>='
+ .param pmc a
+ .param pmc b
+ $I1 = a
+ $I2 = b
+ $I3 = isge $I1, $I2
+ $P1 = new Integer
+ $P1 = $I3
+ .return($P1)
+.end
+
+.sub 'eq'
+ .param pmc a
+ .param pmc b
+ $S1 = a
+ $S2 = b
+ $I1 = iseq $S1, $S2
+ $P1 = new Integer
+ $P1 = $I1
+ .return($P1)
+.end
+
+.sub 'ne'
+ .param pmc a
+ .param pmc b
+ $S1 = a
+ $S2 = b
+ $I1 = isne $S1, $S2
+ $P1 = new Integer
+ $P1 = $I1
+ .return($P1)
+.end
+
+.sub 'lt'
+ .param pmc a
+ .param pmc b
+ $S1 = a
+ $S2 = b
+ $I1 = islt $S1, $S2
+ $P1 = new Integer
+ $P1 = $I1
+ .return($P1)
+.end
+
+.sub 'gt'
+ .param pmc a
+ .param pmc b
+ $S1 = a
+ $S2 = b
+ $I1 = isgt $S1, $S2
+ $P1 = new Integer
+ $P1 = $I1
+ .return($P1)
+.end
+
+.sub 'le'
+ .param pmc a
+ .param pmc b
+ $S1 = a
+ $S2 = b
+ $I1 = isle $S1, $S2
+ $P1 = new Integer
+ $P1 = $I1
+ .return($P1)
+.end
+
+.sub 'ge'
+ .param pmc a
+ .param pmc b
+ $S1 = a
+ $S2 = b
+ $I1 = isge $S1, $S2
+ $P1 = new Integer
+ $P1 = $I1
+ .return($P1)
+.end
69 src/CardinalGrammar.pir
@@ -0,0 +1,69 @@
+=head1 NAME
+
+Cardinal::Grammar -- A grammar for parsing Ruby 1.8.4
+
+=head1 SYNOPSYS
+
+ .sub _main :main
+ load_bytecode 'CardinalGrammar.pir'
+ .local pmc start_rule
+ .local pmc match
+ .local string source
+
+ # Ruby 1 source code
+ source = 'puts 1;'
+
+ # Retrieve the start rule
+ start_rule = get_namespace [ 'Cardinal'; 'Grammar', 'prog' ]
+
+ # Parse the source and return a match object
+ match = start_rule(source)
+
+ ... # Do something with the parse tree
+
+ end
+ .end
+
+=head1 DESCRIPTION
+
+This is a grammar to parse Cardinal programs. It inherits the behavior
+of the PGE::Grammar class. It parses a string of source code according to
+its hierarchy of rules and returns a PGE::Match object (a parse tree).
+
+=cut
+
+#.namespace [ 'Cardinal'; 'Grammar' ]
+.namespace [ 'Cardinal::Grammar' ]
+
+.sub _load :load
+ load_bytecode 'PGE.pbc'
+ load_bytecode 'PGE/Text.pbc'
+.end
+
+# Pull in the compiled grammar
+
+.include "languages/cardinal/src/cardinal_grammar_gen.pir"
+
+# Operator precedence parsing rule
+.sub "operator_precedence_parser"
+ .param pmc mob
+ .local pmc optable
+ #optable = get_namespace ['Cardinal'; 'Grammar'; '$optable']
+ optable = get_hll_namespace ['Cardinal::Grammar']
+ optable = optable['$optable']
+ $P0 = optable."parse"(mob)
+ .return ($P0)
+.end
+
+=head1 LICENSE
+
+Copyright (c) 2005 The Perl Foundation
+
+This is free software; you may redistribute it and/or modify
+it under the same terms as Parrot.
+
+=head1 AUTHOR
+
+Kevin Tew <kevintew@tewk.com>
+
+=cut
111 src/CardinalOpLookup.pir
@@ -0,0 +1,111 @@
+=head1 NAME
+
+CardinalOpLookup -- A lookup table for opcodes
+
+=head1 SYNOPSYS
+
+ .sub _main :main
+ load_bytecode 'CardinalOpLookup.pir'
+
+ .local pmc oplookup
+ .local string op
+
+ # Retrieve the subroutine
+ oplookup = find_global 'CardinalOpLookup', 'lookup'
+
+ # Translate operator name to PASM opcode name
+ op = oplookup($S1)
+
+ ... # Do something with the opcode name
+
+ end
+ .end
+
+=head1 DESCRIPTION
+
+CardinalOpLookup is a module for looking up the translation between a Cardinal
+operator name (as defined in the operator precedence parser), and the
+equivalent PASM opcode name. Eventually this will be implemented as a
+data file, possibly in YAML.
+
+=cut
+
+.namespace [ 'CardinalOpLookup' ]
+
+.sub _load :load
+ .local pmc lookuptable
+ lookuptable = new .Hash
+ _add_entry(lookuptable, '+', 'add')
+ _add_entry(lookuptable, '-', 'sub')
+ _add_entry(lookuptable, '*', 'mul')
+ _add_entry(lookuptable, '/', 'div')
+ _add_entry(lookuptable, '%', 'mod')
+
+ _add_entry(lookuptable, '<<', 'shl')
+ _add_entry(lookuptable, '>>', 'shr')
+ _add_entry(lookuptable, '&', 'band')
+ _add_entry(lookuptable, '|', 'bor')
+ _add_entry(lookuptable, '^', 'bxor')
+
+ _add_entry(lookuptable, '=', 'set')
+
+ # These look odd, I know, but the logic is actually cleaner when
+ # it's reversed.
+ _add_entry(lookuptable, 'if', 'unless')
+ _add_entry(lookuptable, 'unless', 'if')
+ _add_entry(lookuptable, 'elsif', 'unless')
+ _add_entry(lookuptable, 'infix:+', 'add')
+ _add_entry(lookuptable, 'infix:-', 'sub')
+ _add_entry(lookuptable, 'infix:*', 'mul')
+ _add_entry(lookuptable, 'infix:/', 'div')
+ _add_entry(lookuptable, 'infix:%', 'mod')
+ _add_entry(lookuptable, 'infix:x', 'repeat')
+ _add_entry(lookuptable, 'infix:.', 'concat')
+
+ _add_entry(lookuptable, 'infix:<<', 'shl')
+ _add_entry(lookuptable, 'infix:>>', 'shr')
+ _add_entry(lookuptable, 'infix:&', 'band')
+ _add_entry(lookuptable, 'infix:|', 'bor')
+ _add_entry(lookuptable, 'infix:^', 'bxor')
+
+ _add_entry(lookuptable, 'infix:=', 'set')
+
+ # These look odd, I know, but the logic is actually cleaner when
+ # it's reversed.
+ _add_entry(lookuptable, 'if', 'unless')
+ _add_entry(lookuptable, 'unless', 'if')
+ _add_entry(lookuptable, 'elsif', 'unless')
+
+ store_global 'CardinalOpLookup', 'lookuptable', lookuptable
+.end
+
+.sub lookup
+ .param string opname
+ .local pmc lookuptable
+ lookuptable = find_global 'CardinalOpLookup', 'lookuptable'
+ $S1 = lookuptable[ opname ]
+ .return ($S1)
+.end
+
+.sub _add_entry
+ .param pmc lookuptable
+ .param string key
+ .param string value
+ $P1 = new .String
+ $P1 = value
+ lookuptable[ key ] = $P1
+.end
+
+
+=head1 LICENSE
+
+Copyright (C) 2006, The Perl Foundation.
+
+This is free software; you may redistribute it and/or modify
+it under the same terms as Parrot.
+
+=head1 AUTHOR
+
+Allison Randal <allison@perl.org>
+
+=cut
610 src/OSTGrammar.tg
@@ -0,0 +1,610 @@
+=head1 NAME
+
+OSTGrammar -- A grammar for transforming an abstract syntax tree to an
+opcode syntax tree.
+
+=head1 SYNOPSYS
+
+ .sub _main :main
+ load_bytecode 'OSTGrammar.pir'
+ .local pmc grammar
+ grammar = new 'OSTGrammar'
+
+ # Construct the "OST"
+ load_bytecode "languages/cardinal/src/POST.pir"
+ .local pmc ostbuilder
+ ostbuilder = grammar.apply(match)
+ .local pmc ost
+ ost = ostbuilder.get('result')
+
+ end
+ .end
+
+=head1 DESCRIPTION
+
+
+=cut
+
+grammar OSTGrammar is TGE::Grammar;
+
+transform result (ROOT) :language('PIR') {
+ .local pmc result
+ result = new 'POST::Ops'
+ result.'clone'(node)
+ .local pmc mainsub
+ mainsub = new 'POST::Sub'
+ mainsub.'clone'(node)
+ mainsub.'name'('_main')
+ mainsub.'attribute'('main')
+
+ .local pmc loadop
+ loadop = new 'POST::Call'
+ loadop.'clone'(node)
+ loadop.'name'('__load')
+ mainsub.'add_child'(loadop)
+
+ .local pmc iter
+ iter = node.'child_iter'()
+ iter_loop:
+ unless iter, iter_end # while (entries) ...
+ shift $P2, iter
+ $P3 = tree.get('result', $P2)
+ mainsub.'add_child'($P3)
+ goto iter_loop
+ iter_end:
+
+ result.'add_child'(mainsub)
+
+ $P4 = tree.'get'('symbols', node, 'ROOT')
+
+ result.'add_child'($P4)
+ .return (result)
+}
+
+transform symbols (ROOT) :language('PIR') {
+ .local pmc loadsub
+ loadsub = new 'POST::Sub'
+ loadsub.'clone'(node)
+ loadsub.'name'('__load')
+ loadsub.'attribute'('load')
+
+ # Add an op to load the library of builtin operators
+ .local pmc builtinsop
+ builtinsop = new 'POST::Op'
+ builtinsop.'clone'(node)
+ builtinsop.'op'('load_bytecode')
+ $P3 = new 'POST::Val'
+ $P3.'value'('languages/cardinal/src/CardinalBuiltins.pir')
+ $P3.'valtype'('strq')
+ builtinsop.'add_child'($P3)
+ loadsub.'add_child'(builtinsop)
+
+ .local pmc temp_var
+ .local pmc iter
+ iter = self.'symbol_iter'()
+ iter_loop:
+ unless iter, iter_end # while (entries) ...
+ shift $S2, iter
+ $P1 = iter[$S2]
+
+ # Create a temporary variable from the entry for this symbol
+ temp_var = clone $P1
+ $P2 = temp_var.new_dummy()
+ loadsub.'add_child'($P2)
+
+ # And put it in the global symbol table
+ .local pmc storeop
+ storeop = new 'POST::Op'
+ storeop.'clone'(node)
+ storeop.'op'('store_global')
+
+ $P3 = new 'POST::Val'
+ $S4 = temp_var.'hllname'()
+ $P3.'value'($S4)
+ $P3.'valtype'('strq')
+ storeop.'add_child'($P3)
+
+ $P4 = clone temp_var
+ storeop.'add_child'($P4)
+
+ loadsub.'add_child'(storeop)
+
+ goto iter_loop
+ iter_end:
+ .return (loadsub)
+}
+
+transform result (PAST::Stmts) :language('PIR') {
+ .local pmc result
+ result = new 'POST::Ops'
+ result.'clone'(node)
+
+ .local pmc iter
+ iter = node.'child_iter'()
+ iter_loop:
+ unless iter, iter_end # while (entries) ...
+ shift $P2, iter
+ $P3 = tree.get('result', $P2)
+ result.'add_child'($P3)
+ goto iter_loop
+ iter_end:
+ .return (result)
+}
+
+transform result (PAST::Stmt) :language('PIR') {
+ $P1 = node.children()
+ $P2 = $P1[0]
+ $P3 = tree.get('result', $P2)
+ .return ($P3)
+}
+
+transform result (PAST::Exp) :language('PIR') {
+ $P1 = node.children()
+ $P2 = $P1[0]
+ $P3 = tree.get('result', $P2)
+ .return ($P3)
+}
+
+transform result (PAST::Op) :language('PIR') {
+ .local string opname
+ opname = node.op()
+ if opname == 'infix:=' goto not_nullop
+ $S1 = substr opname, 0, 5
+ if $S1 == 'infix' goto infix
+ if opname == 'print' goto print_op
+ if opname == 'puts' goto puts_op
+ if opname == 'if' goto conditional
+ if opname == 'unless' goto conditional
+ if opname == 'elsif' goto conditional
+ if opname == 'else' goto nullop
+ goto not_nullop
+ infix:
+ $P4 = tree.get('infix', node)
+ .return ($P4)
+ puts_op:
+ $P4 = tree.get('puts_op', node)
+ .return ($P4)
+ print_op:
+ $P4 = tree.get('print_op', node)
+ .return ($P4)
+ conditional:
+ $P4 = tree.get('conditional', node)
+ .return ($P4)
+ nullop:
+ $P4 = tree.get('nullop', node)
+ .return ($P4)
+ not_nullop:
+
+ # Lookup operator name to see if there is a direct PIR translation
+ # for it.
+ .local pmc oplookup
+ oplookup = find_global 'CardinalOpLookup', 'lookup'
+ $S1 = oplookup(opname)
+ unless $S1 goto no_trans
+ opname = $S1
+ no_trans:
+
+ # Iterate through the children of the node, and generate the result
+ # for each child.
+ .local pmc childop
+ childop = new 'POST::Op'
+ childop.'clone'(node)
+ childop.op(opname)
+
+ # Create a node to contain the generated ops.
+ .local pmc newops
+ newops = new 'POST::Ops'
+ .local pmc iter
+ iter = node.'child_iter'()
+ iter_loop:
+ unless iter, iter_end # while (entries) ...
+ shift $P2, iter
+ $P3 = tree.get('result', $P2)
+ $S1 = typeof $P3
+ # Does the argument have setup code?
+ unless $S1 == 'POST::Ops' goto simple_result
+ $P1 = $P3.tmpvar()
+ if null $P1 goto simple_result
+ childop.'add_child'($P1)
+ newops.'add_child'($P3)
+ goto iter_loop
+ simple_result:
+ childop.'add_child'($P3)
+ goto iter_loop
+ iter_end:
+
+ # In the context of an Op node, collapse a child comma op, so the
+ # child's children become the children of the current node.
+# $I0 = elements newchildren
+# if $I0 > 1 goto no_munge
+# $P5 = newchildren[0]
+# $S3 = typeof $P5
+# unless $S3 == 'POST::Op' goto no_munge
+# $S4 = $P5.op()
+# unless $S4 == 'O_COMMA' goto no_munge
+# newchildren = $P5.children()
+
+ no_munge:
+
+ # Check if we had setup code for one of the children. If so, bundle
+ # it up in an Ops node.
+ $I0 = elements newops
+ if $I0 > 0 goto bundle_ops
+ .return (childop)
+ bundle_ops:
+ newops.'add_child'(childop)
+
+ .return (newops)
+}
+
+transform infix (PAST::Op) :language('PIR') {
+ # Create the node to contain all the generated ops.
+ .local pmc newops
+ newops = new 'POST::Ops'
+ newops.'clone'(node)
+
+ # Create the op for the current node
+ .local pmc oplookup
+ .local string opname
+ .local pmc childop
+ oplookup = find_global 'CardinalOpLookup', 'lookup'
+ $S1 = node.op()
+ opname = oplookup($S1)
+ if opname goto op_is_simple
+ childop = new 'POST::Call'
+ $S2 = substr $S1, 6
+ childop.'name'($S2)
+ goto end_op_create
+ op_is_simple:
+ childop = new 'POST::Op'
+ childop.'op'(opname)
+ end_op_create:
+
+ # Create a temporary variable
+ .local pmc temp_var
+ temp_var = new 'POST::Var'
+ temp_var.'clone'(node)
+ $P8 = temp_var.new_dummy()
+ newops.'add_child'($P8)
+
+ # Add the temporary variable as the destination register of the op
+ childop.'add_child'(temp_var)
+
+ .local pmc iter
+ iter = node.'child_iter'()
+ iter_loop:
+ unless iter, iter_end # while (entries) ...
+ shift $P2, iter
+ $P3 = tree.get('result', $P2)
+ $S1 = typeof $P3
+ if $S1 == 'POST::Ops' goto complex_result # the argument has setup
+ if $S1 == 'POST::Val' goto create_tmp # the argument needs setup
+ childop.'add_child'($P3)
+ goto iter_loop
+ create_tmp:
+ # Create a temp variable
+ $P4 = new 'POST::Var'
+ $P4.'clone'(node)
+ $P5 = $P4.new_dummy()
+ newops.'add_child'($P5)
+ childop.'add_child'($P4)
+ # Assign the value node to the variable
+ $P7 = new 'POST::Op'
+ $P7.'clone'(node)
+ $P7.'op'('set')
+ $P7.'add_child'($P4) # the first argument is the variable
+ $P7.'add_child'($P3) # the second argument is the value
+ newops.'add_child'($P7)
+ goto iter_loop
+ complex_result:
+ $P1 = $P3.tmpvar()
+ childop.'add_child'($P1)
+ newops.'add_child'($P3)
+ goto iter_loop
+ iter_end:
+
+ # The childop goes after all the setup code.
+ newops.'add_child'(childop)
+
+ newops.'tmpvar'(temp_var)
+
+ .return (newops)
+}
+
+transform conditional (PAST::Op) :language('PIR') {
+ # Create the node to contain all the generated ops.
+ .local pmc newops
+ newops = new 'POST::Ops'
+
+ .local string opname
+ .local pmc oplookup
+ oplookup = find_global 'CardinalOpLookup', 'lookup'
+ $S1 = node.op()
+ opname = oplookup($S1)
+ .local pmc childop
+ childop = new 'POST::Op'
+ childop.'clone'(node)
+ childop.'op'(opname)
+
+ # Set up to handle children of Op node.
+ .local pmc iter
+ iter = node.'child_iter'()
+
+ # First, handle the condition, which may be a series of statements
+ # resulting in a single value.
+ shift $P2, iter
+ $P3 = tree.get('result', $P2)
+ $S1 = typeof $P3
+ if $S1 == 'POST::Ops' goto complex_result # the argument has setup
+ childop.'add_child'($P3)
+ goto end_condition
+ complex_result:
+ $P1 = $P3.'tmpvar'()
+ childop.'add_child'($P1)
+ newops.'add_child'($P3)
+ end_condition:
+
+ # Second, create the branching op. The first child is the result of
+ # the condition, the second argument is a label.
+ .local pmc falselabel
+ falselabel = new 'POST::Label'
+ falselabel.'new_dummy'('false')
+ childop.'add_child'(falselabel)
+
+ newops.'add_child'(childop)
+
+ # Next handle the conditional body
+ shift $P2, iter
+ $P3 = tree.'get'('result', $P2)
+ newops.'add_child'($P3)
+
+ # When conditional body is selected, skip over any else/elsif
+ .local pmc endlabel
+ endlabel = new 'POST::Label'
+ endlabel.'new_dummy'('endcond')
+ $P4 = new 'POST::Op'
+ $P4.'clone'(node)
+ $P4.'op'('goto')
+ $P4.'add_child'(endlabel)
+ newops.'add_child'($P4)
+
+ # Destination for the branching op
+ $P6 = clone falselabel
+ $P6.dest(1)
+ newops.'add_child'($P6)
+
+ # Finally handle the else/elsif block if it exists
+ unless iter goto no_else_elsif
+ shift $P2, iter
+ $P3 = tree.'get'('result', $P2)
+ newops.'add_child'($P3)
+ no_else_elsif:
+
+ # Destination for the end of the conditional
+ $P6 = clone endlabel
+ $P6.dest(1)
+ newops.'add_child'($P6)
+
+ .return (newops)
+}
+
+transform nullop (PAST::Op) :language('PIR') {
+ $P1 = node.children()
+ $P2 = $P1[0]
+ $P3 = tree.get('result', $P2)
+ .return ($P3)
+}
+
+transform puts_op (PAST::Op) :language('PIR') {
+ # This fairly lengthy bit collapses comma ops, by traversing down
+ # the tree and yanking up the children of the comma op to the
+ # current level.
+
+ $P1 = node.children()
+ $I0 = elements node
+ if $I0 > 1 goto no_munge
+ $P2 = $P1[0]
+ $S3 = typeof $P2
+ unless $S3 == 'PAST::Exp' goto no_munge
+ $P3 = $P2.children()
+ $P4 = $P3[0]
+ $S3 = typeof $P4
+ unless $S3 == 'PAST::Op' goto no_munge
+ $S4 = $P4.op()
+ unless $S4 == 'O_COMMA' goto no_munge
+ $P1 = $P4.'child_iter'()
+ no_munge:
+ # Done collapsing comma ops
+
+ # Create a node to contain the generated ops.
+ .local pmc newops
+ .local string opname
+ newops = new 'POST::Ops'
+ newops.'clone'(node)
+ opname = node.op()
+ opname = 'print'
+
+ # Iterate through the children of the node, and generate the result
+ # for each child.
+ .local pmc iter
+ iter = new Iterator, $P1
+ iter = 0
+ iter_loop:
+ unless iter goto iter_end # while (entries) ...
+ shift $P2, iter
+ $P3 = tree.get('result', $P2)
+ $S1 = typeof $P3
+ $P5 = new 'POST::Op'
+ $P5.'clone'(node)
+ $P5.'op'(opname)
+ $S1 = typeof $P3
+ if $S1 == 'POST::Ops' goto complex_result # the argument has setup
+ # The default case, create a new 'print' op node with the child
+ # as an argument and push it on the list of new ops.
+ $P5.'add_child'($P3)
+ newops.'add_child'($P5)
+ goto iter_loop
+ complex_result:
+ # The complex case, retrieve the temp variable from the Ops
+ # node, and push the Ops node on the list of new ops. Then
+ # create a new 'print' op node with the temp variable as an
+ # argument and push it on the list of new ops.
+ $P1 = $P3.tmpvar()
+ newops.'add_child'($P3)
+ $P5.'add_child'($P1)
+ newops.'add_child'($P5)
+ goto iter_loop
+ iter_end:
+
+ #Add newline at the end
+ $P5 = new 'POST::Op'
+ $P5.'clone'(node)
+ $P5.'op'(opname)
+ $P3 = new 'POST::Val'
+ $P3.'clone'(node)
+ $P3.'value'("\\n")
+ $P3.'valtype'('strqq')
+ $P5.'add_child'($P3)
+ newops.'add_child'($P5)
+
+ .return (newops)
+}
+transform print_op (PAST::Op) :language('PIR') {
+ # This fairly lengthy bit collapses comma ops, by traversing down
+ # the tree and yanking up the children of the comma op to the
+ # current level.
+ $P1 = node.children()
+ $I0 = elements node
+ if $I0 > 1 goto no_munge
+ $P2 = $P1[0]
+ $S3 = typeof $P2
+ unless $S3 == 'PAST::Exp' goto no_munge
+ $P3 = $P2.children()
+ $P4 = $P3[0]
+ $S3 = typeof $P4
+ unless $S3 == 'PAST::Op' goto no_munge
+ $S4 = $P4.op()
+ unless $S4 == 'O_COMMA' goto no_munge
+ $P1 = $P4.'child_iter'()
+ no_munge:
+ # Done collapsing comma ops
+
+ # Create a node to contain the generated ops.
+ .local pmc newops
+ newops = new 'POST::Ops'
+ newops.'clone'(node)
+
+ # Store the opname for later reuse
+ .local string opname
+ opname = node.op()
+ opname = 'print'
+
+ # Iterate through the children of the node, and generate the result
+ # for each child.
+ .local pmc iter
+ iter = new Iterator, $P1
+ iter = 0
+ iter_loop:
+ unless iter goto iter_end # while (entries) ...
+ shift $P2, iter
+ $P3 = tree.get('result', $P2)
+ $S1 = typeof $P3
+ $P5 = new 'POST::Op'
+ $P5.'clone'(node)
+ $P5.'op'(opname)
+ $S1 = typeof $P3
+ if $S1 == 'POST::Ops' goto complex_result # the argument has setup
+ # The default case, create a new 'print' op node with the child
+ # as an argument and push it on the list of new ops.
+ $P5.'add_child'($P3)
+ newops.'add_child'($P5)
+ goto iter_loop
+ complex_result:
+ # The complex case, retrieve the temp variable from the Ops
+ # node, and push the Ops node on the list of new ops. Then
+ # create a new 'print' op node with the temp variable as an
+ # argument and push it on the list of new ops.
+ $P1 = $P3.tmpvar()
+ newops.'add_child'($P3)
+ $P5.'add_child'($P1)
+ newops.'add_child'($P5)
+ goto iter_loop
+ iter_end:
+
+ .return (newops)
+}
+
+transform result (PAST::Val) :language('PIR') {
+ .local pmc result
+ result = new 'POST::Val'
+ result.'clone'(node)
+ $P1 = node.'value'()
+ result.'value'($P1)
+ $P2 = node.'valtype'()
+ result.'valtype'($P2)
+ .return (result)
+}
+
+transform result (PAST::Var) :language('PIR') {
+ # The node to contain all the generated ops for a variable access
+ .local pmc newops
+ newops = new 'POST::Ops'
+ newops.'clone'(node)
+
+ # The PIR variable that corresponds to the HLL variable for this
+ # piece of code
+ .local pmc hllname
+ hllname = node.'varname'()
+
+ .local pmc newvar
+ newvar = new 'POST::Var'
+ newvar.'clone'(node)
+ newvar.'new_temp'()
+ newvar.'hllname'(hllname)
+ $P1 = node.'vartype'()
+ newvar.'vartype'($P1)
+ $P1 = node.'scope'()
+ newvar.'scope'($P1)
+
+ # Let the grammar know that it needs to add initialization code for
+ # this HLL variable in the global symbol table
+ self.'add_symbol'(hllname, newvar)
+
+ # A string constant argument of the name of the variable to
+ # lookup in the global symbol table
+ .local pmc name
+ name = node.'varname'()
+ .local pmc namenode
+ namenode = new 'POST::Val'
+ namenode.'clone'(node)
+ namenode.'value'(name)
+ namenode.'valtype'('strq')
+
+ # The operation to lookup the variable
+ .local pmc findop
+ findop = new 'POST::Op'
+ findop.'clone'(node)
+ findop.'op'('find_global')
+ findop.'add_child'(newvar)
+ findop.'add_child'(namenode)
+ newops.'add_child'(findop)
+
+ # The final resulting variable from the operations
+ $P1 = clone newvar
+ newops.'tmpvar'($P1)
+
+ .return (newops)
+}
+
+=head1 LICENSE
+
+Copyright (C) 2006, The Perl Foundation.
+
+This is free software; you may redistribute it and/or modify
+it under the same terms as Parrot.
+
+=head1 AUTHOR
+
+Allison Randal <allison@perl.org>
+
+=cut
188 src/PIRGrammar.tg
@@ -0,0 +1,188 @@
+=head1 NAME
+
+PIRGrammar -- A grammar for transforming an opcode syntax tree to PIR.
+
+=head1 SYNOPSYS
+
+ .sub _main :main
+ load_bytecode 'PIRGrammar.pir'
+ .local pmc grammar
+ grammar = new 'PIRGrammar'
+
+ # Build the PIR output
+ .local pmc pirbuilder
+ pirbuilder = grammar.apply(match)
+ .local pmc pir
+ pir = pirbuilder.get('result')
+
+ end
+ .end
+
+=head1 DESCRIPTION
+
+
+=cut
+
+# This is just a stub to allow Punie to execute code. It will be
+# replaced.
+grammar PIRGrammar is TGE::Grammar;
+
+transform result (ROOT) :language('PIR') {
+ .local string output
+ .local pmc iter
+ iter = node.'child_iter'()
+ iter_loop:
+ unless iter, iter_end # while (entries) ...
+ shift $P2, iter
+ $S3 = tree.get('result', $P2)
+ output .= $S3
+ goto iter_loop
+ iter_end:
+ .return (output)
+}
+
+transform result (POST::Sub) :language('PIR') {
+ .local string output
+ output = ".sub "
+ $S1 = node.'name'()
+ output .= $S1
+ $S2 = node.'attribute'()
+ unless $S2 goto no_attribute
+ output .= " :"
+ output .= $S2
+ no_attribute:
+ output .= "\n"
+
+ .local pmc iter
+ iter = node.'child_iter'()
+ iter_loop:
+ unless iter, iter_end # while (entries) ...
+ shift $P2, iter
+ $S3 = tree.get('result', $P2)
+ output .= $S3
+ goto iter_loop
+ iter_end:
+ output .= ".end\n\n"
+ .return (output)
+}
+
+# Flatten out the ops into a simple sequence.
+transform result (POST::Ops) :language('PIR') {
+ .local string output
+ .local pmc iter
+ iter = node.'child_iter'()
+ iter_loop:
+ unless iter, iter_end # while (entries) ...
+ shift $P2, iter
+ $S3 = tree.get('result', $P2)
+ output .= $S3
+ goto iter_loop
+ iter_end:
+ .return (output)
+}
+
+transform result (POST::Op) :language('PIR') {
+ .local string output
+ .local int counter
+ counter = 0
+ .local string opname
+ opname = node.op()
+ output = " " . opname
+ output .= " "
+ .local pmc iter
+ iter = node.'child_iter'()
+ iter_loop:
+ unless iter goto iter_end # while (entries) ...
+ shift $P2, iter
+ inc counter
+ $S3 = tree.get('result', $P2)
+ if counter <= 1 goto no_comma_out
+ output .= ", "
+ no_comma_out:
+ output .= $S3
+ goto iter_loop
+ iter_end:
+ output .= "\n"
+ .return (output)
+}
+
+transform result (POST::Call) :language('PIR') {
+ .local string output
+ .local int counter
+ counter = 0
+
+ output = " " # initial indentation
+ .local pmc iter
+ iter = node.'child_iter'()
+ unless iter goto no_first # first entry
+ shift $P1, iter
+ $S1 = tree.get('result', $P1)
+ output .= $S1
+ output .= " = "
+ no_first:
+
+ .local string subname
+ subname = node.'name'()
+ output .= "'"
+ output .= subname
+ output .= "'("
+ iter_loop:
+ unless iter goto iter_end # while (entries) ...
+ shift $P2, iter
+ inc counter
+ $S3 = tree.get('result', $P2)
+ if counter <= 1 goto no_comma_out
+ output .= ", "
+ no_comma_out:
+ output .= $S3
+ goto iter_loop
+ iter_end:
+ output .= ")\n"
+ .return (output)
+}
+
+transform result (POST::Var) :language('PIR') {
+ $S1 = node.varname()
+ .return ($S1)
+}
+
+transform result (POST::Label) :language('PIR') {
+ $S1 = node.name()
+ $I1 = node.dest()
+ unless $I1 goto not_dest
+ $S1 .= ":\n"
+ not_dest:
+ .return ($S1)
+}
+
+transform result (POST::Val) :language('PIR') {
+ $S1 = node.value()
+ $S2 = node.valtype()
+ if $S2 == 'strq' goto wrap_string_single
+ if $S2 == 'strqq' goto wrap_string_double
+ # Otherwise, it's not a string value, so return it straight.
+ .return ($S1)
+ wrap_string_double:
+ # Wrap double quoted strings in double quotes
+ $S3 = '"' . $S1
+ $S3 .= '"'
+ .return ($S3)
+ wrap_string_single:
+ # Wrap single quoted strings in single quotes
+ $S3 = "'" . $S1