I'm using this code to dump PGE parse trees in Perl5 dump format.
Can it get modified/added to HLLCompiler and PCT?
I'm using it for a research project where the compiler is written in Perl5.
The compiler translates the PGE parse tree into c++ code which is then
compiled.
I'd like to eventually write the compiler in Perl6 once it has stabilized.
Kevin
Index: runtime/parrot/library/Parrot/HLLCompiler.pir
===================================================================
--- runtime/parrot/library/Parrot/HLLCompiler.pir (revision 23792)
+++ runtime/parrot/library/Parrot/HLLCompiler.pir (working copy)
@@ -15,6 +15,8 @@
.sub '__onload' :load :init
load_bytecode 'Parrot/Exception.pbc'
+ load_bytecode 'Parrot/Exception.pbc'
+ load_bytecode 'Data/Dumper/PerlPGEDumper.pbc'
$P0 = newclass [ 'HLLCompiler' ]
addattribute $P0, '$parsegrammar'
@@ -482,10 +484,19 @@
$P0 = self.'eval'(code, args, adverbs :flat :named)
if target == '' goto end
if target == 'pir' goto end
+ .local string dumpfmt
+ dumpfmt = adverbs['dumpfmt']
+ dumpfmt = downcase dumpfmt
+ if dumpfmt == 'perl_dump' goto perl_dump
+
'_dumper'($P0, target)
end:
.return ($P0)
+ perl_dump:
+ "perlPGEDumper"($P0)
+ goto end
+
err_infile:
$P0 = new 'Exception'
$S0 = 'Error: file cannot be read: '
@@ -518,6 +529,7 @@
getopts = new 'Getopt::Obj'
getopts.'notOptStop'(1)
push getopts, 'target=s'
+ push getopts, 'dumpfmt=s'
push getopts, 'trace|t=s'
push getopts, 'encoding|e=s'
push getopts, 'output|o=s'
Index: runtime/parrot/library/Data/Dumper/PerlPGEDumper.pir
===================================================================
--- runtime/parrot/library/Data/Dumper/PerlPGEDumper.pir (revision 0)
+++ runtime/parrot/library/Data/Dumper/PerlPGEDumper.pir (revision 0)
@@ -0,0 +1,646 @@
+=head1 TITLE
+
+Data::Dumper::PerlPGEDumper - An output module of Data::Dumper.
+
+=head1 VERSION
+
+version 0.20
+
+=head1 SYNOPSIS
+
+TDB
+
+=head1 DESCRIPTION
+
+This module provides an output style of C<Data::Dumper>.
+
+=cut
+
+.sub __library_data_dumper_default_onload :load
+ .local pmc ddb_class
+ ddb_class = get_class "Data::Dumper::PerlPGEDumper"
+ if null ddb_class goto create_ddb
+ goto END
+
+ create_ddb:
+ load_bytecode "library/Data/Dumper/Base.pir"
+ getclass $P0, "Data::Dumper::Base"
+ subclass $P0, $P0, "Data::Dumper::PerlPGEDumper"
+END:
+ .return ()
+.end
+
+.sub perlPGEDumper
+ .param pmc it
+ .local pmc dumper
+ dumper = new 'Data::Dumper::PerlPGEDumper'
+ dumper.'prepare'(dumper, " ")
+ #print "my $tree = "
+ dumper.'perlDump'(it)
+.end
+
+.namespace ["Data::Dumper::PerlPGEDumper"]
+
+=head1 METHODS
+
+A Data::Dumper::Default object has the following methods:
+
+=over 4
+
+=item style."dumpWithName"( shortname, name, dump )
+
+=cut
+
+.sub "perlDump" :method
+ .param pmc it
+
+ $I0 = isa it, 'ResizablePMCArray'
+ if $I0 goto array
+ $I0 = isa it, 'PGE::Text'
+ if $I0 goto text
+ $I0 = isa it, 'PGE::Match'
+ if $I0 goto match
+ $I0 = isa it, 'Integer'
+ if $I0 goto integer_l
+ $I0 = isa it, 'String'
+ if $I0 goto string_l
+ $I0 = isa it, 'Sub'
+ if $I0 goto sub_l
+ $I0 = isa it, 'Hash'
+ if $I0 goto hash
+ goto else
+
+ array:
+ self."dumpArray"(it)
+ goto end
+ match:
+ self."dumpMatch"(it)
+ goto end
+ text:
+ self."dumpPGEText"(it)
+ goto end
+ string_l:
+ self."dumpString"(it)
+ goto end
+ sub_l:
+ print "\"##sub##\""
+ goto end
+ integer_l:
+ print it
+ goto end
+ hash:
+ self."dumpHash"(it)
+ goto end
+ else:
+ $S0 = typeof it
+ print "####"
+ print $S0
+ print "####\n"
+ end:
+
+.end
+
+.sub printType
+ .param pmc id
+ $S0 = typeof id
+ print $S0
+.end
+
+.sub "dumpString" :method
+ .param pmc it
+ print "\""
+ $S0 = it
+ $S0 = escape $S0
+ print $S0
+ print "\""
+.end
+
+.sub "dumpHash" :method
+ .param pmc it
+ .local pmc iter
+ .local pmc key
+ .local pmc val
+ .local string indent, subindent
+
+ iter = new 'Iterator', it
+ unless iter goto end
+ print "{"
+ (subindent, indent) = self."newIndent"()
+ loop:
+ unless iter goto done
+ print "\n"
+ print subindent
+ key = shift iter
+ val = it[key]
+ print "\""
+ print key
+ print "\" => "
+ self."perlDump"(val)
+ print ","
+ goto loop
+ done:
+
+ print indent
+ print "}"
+ self."deleteIndent"()
+ end:
+.end
+
+.sub "dumpPGEText" :method
+ .param pmc it
+ print "<<\"__EMBEDDED\"\n"
+ $P0 = it.'get_array'()
+ $P0 = $P0[0]
+ print $P0
+ print "\n__EMBEDDED\n"
+.end
+
+.sub "dumpArray" :method
+ .param pmc it
+ .local pmc iter, val
+ .local string indent, subindent
+
+ (subindent, indent) = self."newIndent"()
+
+ print "[\n"
+
+ iter = new 'Iterator', it
+ loop:
+ unless iter goto done
+ val = shift iter
+ print subindent
+ self."perlDump"(val)
+ print ",\n"
+ goto loop
+ done:
+
+ print indent
+ print "]"
+ self."deleteIndent"()
+ end:
+
+.end
+
+.sub "dumpMatch2" :method
+ .param pmc it
+
+.end
+
+.sub "dumpMatch" :method
+ .param pmc it
+ .local string indent, subindent
+ .local pmc iter, val
+ .local string key
+ .local pmc hash, array
+ .local int hascapts
+ .local int hassubparts
+ .local pmc hash, array
+
+ (subindent, indent) = self."newIndent"()
+
+ hascapts = 0
+ hassubparts = 0
+ hash = it."get_hash"()
+ if_null hash, dump_array
+
+ iter = new 'Iterator', hash
+ dump_hash_1:
+ unless iter goto dump_array
+ hassubparts = 1
+ if hascapts goto dump_hash_2
+ print "{"
+ hascapts = 1
+ dump_hash_2:
+ print "\n"
+ print subindent
+ key = shift iter
+ val = hash[key]
+ print "\""
+ print key
+ print "\" => "
+ self."perlDump"(val)
+ print ","
+ goto dump_hash_1
+
+
+ dump_array:
+ array = it."get_array"()
+ if_null array, dump_val
+ $I1 = elements array
+ $I0 = 0
+ dump_array_1:
+ if $I0 >= $I1 goto dump_end
+ hassubparts = 1
+ if hascapts goto dump_array_2
+ print " {"
+ hascapts = 1
+ dump_array_2:
+ print "\n"
+ print subindent
+ val = array[$I0]
+ print "["
+ print $I0
+ print "] => "
+ self."perlDump"(val)
+ inc $I0
+ goto dump_array_1
+
+
+ dump_val:
+ if hassubparts == 1 goto dump_end
+ print "\""
+ $S0 = it
+ $S0 = escape $S0
+ print $S0
+ print "\""
+ dump_end:
+ unless hascapts goto end
+ print "\n"
+ print indent
+ print "}"
+
+ end:
+ self."deleteIndent"()
+.end
+
+.sub dumpWithName :method
+ .param string shortname
+ .param string name
+ .param pmc dump
+ .local int ret
+
+ print "\""
+ print shortname
+ print "\" => "
+
+ ret = self."dump"( name, dump )
+
+ .return ( ret )
+.end
+
+=item style."dumpCached"( name, dump )
+
+=cut
+
+.sub dumpCached :method
+ .param string name
+ .param pmc dump
+
+ print "\\"
+ print name
+
+ .return ( 1 )
+.end
+
+
+=item style."dumpProperties"( name, dump )
+
+=cut
+
+.sub dumpProperties :method
+ .param string paramName
+ .param pmc dump
+ .local string name
+ .local pmc prop
+ .local int ret
+
+ ret = 1
+ if_null dump, END
+ prophash prop, dump
+ if_null prop, END
+
+ print " with-properties: "
+ clone name, paramName
+ concat name, ".properties()"
+ ret = self."dump"( name, prop )
+
+END:
+ .return ( ret )
+.end
+
+=item style.genericHash( name, hash )
+
+Dumps a 'generic' Hash.
+
+=cut
+
+.sub genericHash :method
+ .param string name
+ .param pmc hash
+ .local string indent
+ .local string subindent
+ .local pmc iter
+ .local string key
+ .local pmc val
+ .local pmc keys
+ .local string name2
+
+ (subindent, indent) = self."newIndent"()
+
+ $S0 = typeof hash
+ print $S0
+
+ print " {"
+
+ new keys, "ResizablePMCArray"
+ new iter, "Iterator", hash
+ set iter, 0
+
+iter_loop:
+ unless iter, iter_end
+
+ shift key, iter
+ push keys, key
+ branch iter_loop
+
+iter_end:
+ keys."sort"()
+
+dump_loop:
+ unless keys, dump_end
+
+ print "\n"
+ print subindent
+
+ shift key, keys
+
+ new val, "ResizablePMCArray"
+ push val, name
+ push val, key
+ sprintf name2, "%s[\"%s\"]", val
+
+ set val, hash[key]
+
+ self."dumpWithName"( key, name2, val )
+
+ unless keys, dump_end
+ print ","
+
+ branch dump_loop
+
+dump_end:
+ print "\n"
+ print indent
+ print "}"
+ self."deleteIndent"()
+
+ .return ( 1 )
+.end
+
+=item style."dumpStringEscaped"( string, escapeChar )
+
+Escape any characters in a string so we can re-use it as a literal.
+
+=cut
+
+.sub dumpStringEscaped :method
+ .param pmc var
+ .param string char
+ .local string str
+
+ str = var
+ str = escape str
+ print str
+
+ .return ( 1 )
+.end
+
+=item style."pmcDefault"( name, dump )
+
+=cut
+
+.sub pmcDefault :method
+ .param string name
+ .param pmc dump
+ .local pmc class
+ .local string type
+
+ type = typeof dump
+
+ print "PMC '"
+ print type
+ print "' "
+
+ $I0 = can dump, "__dump"
+ if $I0 goto CAN_DUMP
+ print "{ ... }"
+ branch END
+CAN_DUMP:
+ dump."__dump"( self, name )
+END:
+ .return ( 1 )
+.end
+
+=item style."pmcIntList"( name, array )
+
+Dumps an IntList PMC.
+
+=cut
+
+.sub pmcIntList :method
+ .param string name
+ .param pmc array
+ .local string indent
+ .local string subindent
+ .local int size
+ .local int pos
+ .local pmc val
+ .local string name2
+ .local int tmp
+
+ (subindent, indent) = self."newIndent"()
+
+ typeof name2, array
+ print name2
+ print " (size:"
+ $I0 = array
+ print $I0
+ print ") ["
+
+ set size, array
+ set pos, 0
+
+ unless size, iter_end
+
+iter_loop:
+ print "\n"
+
+ print subindent
+
+ new val, "ResizablePMCArray"
+ push val, name
+ push val, pos
+ sprintf name2, "%s[%d]", val
+
+ $I0 = array[pos]
+ print $I0
+
+ # next array member
+ inc pos
+
+ # skip the ',' after the last element
+ if pos >= size goto iter_end
+
+ print ","
+
+ # elements left?
+ branch iter_loop
+
+iter_end:
+ print "\n"
+ print indent
+ print "]"
+
+ self."deleteIndent"()
+
+ .return ( 1 )
+.end
+
+=item style."genericArray"( name, array )
+
+Dumps any pmc that implements an Array interface.
+
+=cut
+
+.sub genericArray :method
+ .param string name
+ .param pmc array
+
+ .local string indent
+ .local string subindent
+ .local int size
+ .local int pos
+ .local pmc val
+ .local string name2
+ .local int tmp
+
+ (subindent, indent) = self."newIndent"()
+
+ typeof name2, array
+ print name2
+ print " (size:"
+ $I0 = array
+ print $I0
+ print ") ["
+
+ size = array
+ pos = 0
+
+ unless size, iter_end
+
+iter_loop:
+ print "\n"
+
+ print subindent
+
+ val = new 'ResizablePMCArray'
+ push val, name
+ push val, pos
+ sprintf name2, "%s[%d]", val
+
+ set val, array[pos]
+
+ self."dump"( name2, val )
+
+ # next array member
+ inc pos
+
+ # skip the ',' after the last element
+ if pos >= size goto iter_end
+
+ print ","
+
+ # elements left?
+ branch iter_loop
+
+iter_end:
+ print "\n"
+ print indent
+ print "]"
+
+ self."deleteIndent"()
+
+ .return ( 1 )
+.end
+
+=item style."genericString"( name, str )
+
+Dumps any string-like PMC.
+
+=cut
+
+.sub genericString :method
+ .param string name
+ .param pmc str
+
+ print "\""
+ self."dumpStringEscaped"( str, "\"" )
+ print "\""
+
+ .return ( 1 )
+.end
+
+=item style."genericNumber"
+
+Dumps a generic numeric PMC.
+
+=cut
+
+.sub genericNumber :method
+ .param string name
+ .param pmc val
+
+ print val
+
+ .return ( 1 )
+.end
+
+=item style."genericUndef"( name, val )
+
+Dumps any undef PMC.
+
+=cut
+
+.sub genericUndef :method
+ .param string name
+ .param pmc val
+
+ print "undef"
+
+ .return ( 1 )
+.end
+
+=item style."pmcNull"( name, val )
+
+Dumps a Null PMC.
+
+=cut
+
+.sub pmcNull :method
+ .param string name
+ .param pmc val
+
+ print "null"
+
+ .return ( 1 )
+.end
+
+=back
+
+=head1 AUTHOR
+
+Jens Rieks E<lt>parrot at jensbeimsurfen dot deE<gt> is the author
+and maintainer.
+Please send patches and suggestions to the Perl 6 Internals mailing list.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2004-2007, The Perl Foundation.
+
+=cut
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:
Index: config/gen/makefiles/root.in
===================================================================
--- config/gen/makefiles/root.in (revision 23792)
+++ config/gen/makefiles/root.in (working copy)
@@ -266,6 +266,7 @@
$(LIBRARY_DIR)/Config/JSON.pbc \
$(LIBRARY_DIR)/Data/Dumper/Base.pbc \
$(LIBRARY_DIR)/Data/Dumper/Default.pbc \
+ $(LIBRARY_DIR)/Data/Dumper/PerlPGEDumper.pbc \
$(LIBRARY_DIR)/Data/Dumper.pbc \
$(LIBRARY_DIR)/Data/Escape.pbc \
$(LIBRARY_DIR)/Data/Sort.pbc \
