Hi all,
again, here is a new patch for libraray/dumper.pmc.
It implements:
- support for self-referential data structures
- support for PMC NULL values
- print no comma after the last entry of a hash
- 3 new tests covering the new functionality
- some minor internal tweaks
- initial support for OrderedHash, ManagedStruct, UnManagedStruct
(How can I dump them? The iterator PMC is not working with them.)
Next planned things:
- support for OrderedHash, ManagedStruct, UnManagedStruct
- "compressed" output of larger arrays with many equal values,
or maybe several values per line
But they have no high priority at the moment, if anyone wants/needs one of
these (or another) feature, just mail me :-)
jens
Index: library/dumper.imc
===================================================================
RCS file: /cvs/public/parrot/library/dumper.imc,v
retrieving revision 1.3
diff -u -w -r1.3 dumper.imc
--- library/dumper.imc 17 Feb 2004 07:23:24 -0000 1.3
+++ library/dumper.imc 17 Feb 2004 21:20:46 -0000
@@ -4,7 +4,7 @@
=head1 VERSION
-version 0.04
+version 0.07
=head1 SYNOPSIS
@@ -55,6 +55,9 @@
new helper, .PerlArray
global "Data::Dumper::helper" = helper
+ newsub sub, .Sub, _dump_null
+ _register_dumper( 0, sub )
+
newsub sub, .Sub, _dump_PerlArray
_register_dumper( .PerlArray, sub )
@@ -74,6 +77,15 @@
newsub sub, .Sub, _dump_Sub
_register_dumper( .Sub, sub )
+ newsub sub, .Sub, _dump_OrderedHash
+ _register_dumper( .OrderedHash, sub )
+
+ newsub sub, .Sub, _dump_ManagedStruct
+ _register_dumper( .ManagedStruct, sub )
+
+ newsub sub, .Sub, _dump_UnManagedStruct
+ _register_dumper( .UnManagedStruct, sub )
+
END:
restoreall
.pcc_begin_return
@@ -150,6 +162,7 @@
.param string name
.param pmc dump
.param string indent
+ .local pmc cache
# check the number of INT args
if I1 != 0 goto ERROR
@@ -158,29 +171,24 @@
# check the number of STR args
if I2 > 2 goto ERROR
if I2 < 0 goto ERROR
- if I2 == 2 goto NAMED
- if I2 == 0 goto UNNAMED
- # I2 == 1; no ident specified
+ if I2 == 2 goto NAMED
+ # I2 <= 1; no indent specified
set indent, ""
+ if I2 == 1 goto NAMED
+ # I2 == 0; no indent and no name
+ # use a default name
+ set name, "VAR1"
NAMED:
_helper()
- _do_dumper_named( name, dump, indent )
+ new cache, .PerlArray
+ _do_dumper_showname( name, name, dump, cache, indent )
print "\n"
.pcc_begin_return
.return 1
.pcc_end_return
-UNNAMED:
- _helper()
- _do_dumper_unnamed( dump, "" )
- print "\n"
-
- .pcc_begin_return
- .return 1
- .pcc_end_return
-
ERROR:
print "_dumper Syntax:\n"
print "_dumper( pmc )\n"
@@ -192,38 +200,114 @@
.end
#
+# caches the already printed PMCs and their names
+#
+.sub _dumper_cache
+ .param pmc cache
+ .param pmc find
+ .param string defname
+ .local int i
+ .local pmc entry
+ .local string name
+ .local pmc pname
+
+ set i, cache
+LOOP:
+ dec i
+ dec i
+ if i < 0 goto NOTFOUND
+ entry = cache[i]
+ ne_addr entry, find, LOOP
+
+ # found entry => get its name
+ inc i
+ name = cache[i]
+ dec i
+ .pcc_begin_return
+ .return i
+ .return name
+ .pcc_end_return
+
+NOTFOUND:
+ set name, defname
+ push cache, find
+ push cache, name
+ .pcc_begin_return
+ .return -1
+ .return name
+ .pcc_end_return
+.end
+
+#
# internal helper function
#
-.sub _do_dumper_named
+.sub _do_dumper_showname
+ .param string shortname
.param string name
.param pmc dump
+ .param pmc cache
.param string indent
print indent
print "\""
- print name
+ print shortname
print "\" => "
- _do_dumper_unnamed( dump, indent )
-
- .pcc_begin_return
- .pcc_end_return
+ # use tail calling instead of
+ # _do_dumper( name, dump, cache, indent )
+ newsub P0, .Sub, _do_dumper
+ set S5, name
+ set P5, dump
+ set P6, cache
+ set S6, indent
+ set I0, 1
+ set I1, 0
+ set I2, 2
+ set I3, 2
+ set I4, 0
+ invoke
.end
#
# internal helper function
#
-.sub _do_dumper_unnamed
+.sub _do_dumper
+ .param string name
.param pmc dump
+ .param pmc cache
.param string indent
.local pmc helper
.local int type
.local int exist
.local pmc cb
+ .local string name2
+ .local pmc ret
+
+ ret = P1
+ newsub helper, .Sub, _dumper_cache
+ .pcc_begin prototyped
+ .arg cache
+ .arg dump
+ .arg name
+ .pcc_call helper
+ .result type
+ .result name
+ .pcc_end
+
+ if type == -1 goto NOT_IN_CACHE
+ # name found in cache:
+ print "\\"
+ print name
+ branch END
+NOT_IN_CACHE:
+ # get the global helper hash
helper = global "Data::Dumper::helper"
+ set type, 0
+ isnull dump, ISNULL
typeof type, dump
+ISNULL:
exists exist, helper[type]
if exist, CALL_HELPER
@@ -233,21 +317,26 @@
branch DONE
CALL_HELPER:
-
cb = helper[type]
-
- saveall
- set S5, indent
- set P6, dump
- invokecc cb
- restoreall
+ .pcc_begin prototyped
+ .arg name
+ .arg indent
+ .arg dump
+ .arg cache
+ .pcc_call cb
+ .pcc_end
DONE:
+ isnull dump, END
prophash cb, dump
unless cb goto END
print " with-properties: "
- _dump_Hash( cb, indent )
+ clone name2, name
+ concat name2, ".properties()"
+
+ # XXX: use tail calling
+ _do_dumper( name2, cb, cache, indent )
END:
.pcc_begin_return
@@ -258,13 +347,15 @@
# Dumps a PerlArray pmc
#
.sub _dump_PerlArray
+ .param string name
.param pmc array
+ .param pmc cache
.param string indent
.local string subindent
.local int size
.local int pos
.local pmc val
- .local string posstr
+ .local string name2
.local int tmp
subindent = " "
@@ -282,10 +373,16 @@
iter_loop:
print "\n"
+ print subindent
+
+ new val, .PerlArray
+ push val, name
+ push val, pos
+ sprintf name2, "%s[%d]", val
+
set val, array[pos]
- print subindent
- _do_dumper_unnamed( val, subindent )
+ _do_dumper( name2, val, cache, subindent )
# next array member
inc pos
@@ -311,26 +408,42 @@
# Dumps a PerlHash pmc
#
.sub _dump_PerlHash
+ .param string name
.param pmc hash
+ .param pmc cache
.param string indent
print "PerlHash "
- _dump_Hash( hash, indent )
- .pcc_begin_return
- .pcc_end_return
+
+ # use tail calling instead of
+ # _dump_Hash( name, hash, cache, indent )
+ newsub P0, .Sub, _dump_Hash
+ set S5, name
+ set P5, hash
+ set P6, cache
+ set S6, indent
+ set I0, 1
+ set I1, 0
+ set I2, 2
+ set I3, 2
+ set I4, 0
+ invoke
.end
#
# Dumps a 'generic' Hash
#
.sub _dump_Hash
+ .param string name
.param pmc hash
+ .param pmc cache
.param string indent
.local string subindent
.local pmc iter
.local string key
.local pmc val
.local pmc keys
+ .local string name2
subindent = " "
concat subindent, indent
@@ -357,9 +470,17 @@
print "\n"
shift key, keys
+
+ new val, .PerlArray
+ push val, name
+ push val, key
+ sprintf name2, "%s[\"%s\"]", val
+
set val, hash[key]
- _do_dumper_named( key, val, subindent )
+ _do_dumper_showname( key, name2, val, cache, subindent )
+
+ unless keys, dump_end
print ","
branch dump_loop
@@ -377,7 +498,9 @@
# Dumps a PerlString pmc
#
.sub _dump_PerlString
+ .param string name
.param pmc str
+ .param pmc cache
.param string indent
print "\""
@@ -392,7 +515,9 @@
# Dumps a Perl[Num,Int] pmc
#
.sub _dump_PerlVal
+ .param string name
.param pmc val
+ .param pmc cache
.param string indent
print val
@@ -405,7 +530,9 @@
# Dumps a PerlUndef pmc
#
.sub _dump_PerlUndef
+ .param string name
.param pmc val
+ .param pmc cache
.param string indent
print "undef"
@@ -418,11 +545,70 @@
# Dumps a Sub pmc
#
.sub _dump_Sub
+ .param string name
.param pmc val
+ .param pmc cache
.param string indent
print "sub { ... }"
+ .pcc_begin_return
+ .pcc_end_return
+.end
+
+#
+# Dumps a null pmc
+#
+.sub _dump_null
+ .param string name
+ .param pmc val
+ .param pmc cache
+ .param string indent
+
+ print "null"
+
+ .pcc_begin_return
+ .pcc_end_return
+.end
+
+#
+# Dumps a OrderedHash pmc
+#
+.sub _dump_OrderedHash
+ .param string name
+ .param pmc hash
+ .param pmc cache
+ .param string indent
+
+ print "OrderedHash { ... }"
+ .pcc_begin_return
+ .pcc_end_return
+.end
+
+#
+# Dumps a ManagedStruct pmc
+#
+.sub _dump_ManagedStruct
+ .param string name
+ .param pmc hash
+ .param pmc cache
+ .param string indent
+
+ print "ManagedStruct { ... }"
+ .pcc_begin_return
+ .pcc_end_return
+.end
+
+#
+# Dumps a UnManagedStruct pmc
+#
+.sub _dump_UnManagedStruct
+ .param string name
+ .param pmc hash
+ .param pmc cache
+ .param string indent
+
+ print "UnManagedStruct { ... }"
.pcc_begin_return
.pcc_end_return
.end
Index: t/pmc/dumper.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/dumper.t,v
retrieving revision 1.2
diff -u -w -r1.2 dumper.t
--- t/pmc/dumper.t 17 Feb 2004 07:23:26 -0000 1.2
+++ t/pmc/dumper.t 17 Feb 2004 21:20:47 -0000
@@ -1,8 +1,9 @@
#! perl -w
use strict;
-use Parrot::Test tests => 8;
+use Parrot::Test tests => 11;
+# no. 1
output_is(<<'CODE', <<'OUT', "dumping array of sorted numbers");
##PIR##
.sub _main
@@ -39,6 +40,7 @@
]
OUT
+# no. 2
output_is(<<'CODE', <<'OUT', "dumping unsorted numbers");
##PIR##
.sub _main
@@ -75,6 +77,7 @@
]
OUT
+# no. 3
output_is(<<'CODE', <<'OUT', "dumping sorted strings");
##PIR##
.sub _main
@@ -107,6 +110,7 @@
]
OUT
+# no. 4
output_is(<<'CODE', <<'OUT', "sorting unsorted strings");
##PIR##
.sub _main
@@ -139,6 +143,7 @@
]
OUT
+# no. 5
output_is(<<'CODE', <<'OUT', "dumping different types");
##PIR##
.sub _main
@@ -195,6 +200,7 @@
]
OUT
+# no. 6
output_is(<<'CODE', <<'OUT', "dumping complex data");
##PIR##
.sub _main
@@ -260,24 +266,24 @@
"hash1" => PerlHash {
}
"hash1" => PerlHash {
- "hello" => "world",
+ "hello" => "world"
}
"hash1" => PerlHash {
"hello" => "world",
- "hello2" => "world2",
+ "hello2" => "world2"
}
"hash1" => PerlHash {
"hash2" => PerlHash {
},
"hello" => "world",
- "hello2" => "world2",
+ "hello2" => "world2"
}
"hash1" => PerlHash {
"hash2" => PerlHash {
- "hello3" => "world3",
+ "hello3" => "world3"
},
"hello" => "world",
- "hello2" => "world2",
+ "hello2" => "world2"
}
"hash1" => PerlHash {
"hash2" => PerlHash {
@@ -288,16 +294,17 @@
"test",
PerlHash {
"is" => "cool",
- "name" => "parrot",
+ "name" => "parrot"
}
],
- "hello3" => "world3",
+ "hello3" => "world3"
},
"hello" => "world",
- "hello2" => "world2",
+ "hello2" => "world2"
}
OUT
+# no.7
output_is(<<'CODE', <<'OUT', "properties");
##PIR##
.sub _main
@@ -322,15 +329,16 @@
.end
.include "library/dumper.imc"
CODE
-PerlArray (size:2) [
+"VAR1" => PerlArray (size:2) [
"test1",
"test2"
-] with-properties: {
+] with-properties: PerlHash {
"key1" => "value1",
- "key2" => "value2",
+ "key2" => "value2"
}
OUT
+# no. 8
output_is(<<'CODE', <<'OUT', "indent string");
##PIR##
.sub _main
@@ -375,13 +383,11 @@
|"test"
|]
|],
- |"test2" => "test2",
+ |"test2" => "test2"
|},
- |"test1" => "test1",
-|} with-properties: {
- |"array2" => PerlArray (size:1) [
- |"test"
- |],
+ |"test1" => "test1"
+|} with-properties: PerlHash {
+ |"array2" => \hash["hash2"]["array"][1]
|}
|"hash" => PerlHash {
|"hash2" => PerlHash {
@@ -391,14 +397,102 @@
|"test"
|]
|],
- |"test2" => "test2",
+ |"test2" => "test2"
|},
- |"test1" => "test1",
-|} with-properties: {
- |"array2" => PerlArray (size:1) [
- |"test"
- |],
+ |"test1" => "test1"
+|} with-properties: PerlHash {
+ |"array2" => \hash["hash2"]["array"][1]
|}
name = 'hash'
indent = '|'
+OUT
+
+# no. 9
+output_is(<<'CODE', <<'OUT', "back-referencing properties");
+##PIR##
+.sub _main
+ .local pmc hash
+
+ new hash, .PerlHash
+
+ set hash["hello"], "world"
+ setprop hash, "backref", hash
+ _dumper( hash )
+ end
+.end
+.include "library/dumper.imc"
+CODE
+"VAR1" => PerlHash {
+ "hello" => "world"
+} with-properties: PerlHash {
+ "backref" => \VAR1
+}
+OUT
+
+# no. 10
+output_is(<<'CODE', <<'OUT', "self-referential properties");
+##PIR##
+.sub _main
+ .local pmc hash
+ .local pmc prop
+
+ new hash, .PerlHash
+
+ set hash["hello"], "world"
+ prophash prop, hash
+ setprop hash, "self", prop
+ _dumper( hash )
+ end
+.end
+.include "library/dumper.imc"
+CODE
+"VAR1" => PerlHash {
+ "hello" => "world"
+} with-properties: PerlHash {
+ "self" => \VAR1.properties()
+}
+OUT
+
+# no. 11
+output_is(<<'CODE', <<'OUT', "self-referential properties");
+##PIR##
+.sub _main
+ .local pmc array
+ .local pmc hash1
+ .local pmc hash2
+ .local pmc prop
+
+ new array, .PerlArray
+ new hash1, .PerlHash
+ new hash2, .PerlHash
+
+ set hash1["hello1"], "world1"
+ set hash2["hello2"], "world2"
+ prophash prop, hash1
+ set prop["das leben"], "ist schoen"
+ setprop hash2, "hash1prop", prop
+ push array, hash1
+ push array, hash2
+ push array, prop
+ prophash prop, hash2
+ push array, prop
+ _dumper( array )
+ end
+.end
+.include "library/dumper.imc"
+CODE
+"VAR1" => PerlArray (size:4) [
+ PerlHash {
+ "hello1" => "world1"
+ } with-properties: PerlHash {
+ "das leben" => "ist schoen"
+ },
+ PerlHash {
+ "hello2" => "world2"
+ } with-properties: PerlHash {
+ "hash1prop" => \VAR1[0].properties()
+ },
+ \VAR1[0].properties(),
+ \VAR1[1].properties()
+]
OUT
