Author: coke
Date: Sat Oct 8 18:37:19 2005
New Revision: 9412
Modified:
trunk/build_tools/pmc2c.pl
trunk/classes/float.pmc
trunk/classes/integer.pmc
trunk/classes/perlint.pmc
trunk/classes/perlnum.pmc
trunk/classes/perlstring.pmc
trunk/classes/string.pmc
trunk/classes/stringarray.pmc
trunk/runtime/parrot/library/Data/Dumper.imc
trunk/runtime/parrot/library/Data/Dumper/Base.imc
trunk/runtime/parrot/library/Data/Dumper/Default.imc
trunk/t/pmc/float.t
trunk/t/pmc/integer.t
trunk/t/pmc/perlint.t
trunk/t/pmc/perlnum.t
trunk/t/pmc/perlstring.t
trunk/t/pmc/string.t
Log:
[#36641]
Data::Dumper now checks to see if a special case for a particular PMC is
implemented, and if not, the code falls back to a generic implementation for
each of array, hash, string, integer, and float.
Added in string, integer, and float does types to pmc2c.pl and the various
core/perl types that implement them.
Removed all the specific implementations that dispatched to a generic
implementation, or simply duplicated the functionality provided by "pmcDefault".
Avoid most upcoming deprecation warnings in these library routines.
Removed internal usage of Perl PMCs for these library routines.
All tests pass. (rechecked everything since I mucked with the basic PMC types
to enable the new 'does' variants.)
Modified: trunk/build_tools/pmc2c.pl
==============================================================================
--- trunk/build_tools/pmc2c.pl (original)
+++ trunk/build_tools/pmc2c.pl Sat Oct 8 18:37:19 2005
@@ -157,6 +157,9 @@ The default is "scalar". Other currently
hash : container PMC with string-keyed elements
library : PMC that corresponds to a dynamic library
ref : PMC that references another PMC
+ string : PMC that behaves similarly to the base string type
+ integer : PMC that behaves similarly to the base int type
+ float : PMC that behaves similarly to the base number type
scalar : (only used by the sample dynclasses/foo.pmc)
This is not a canonical list, but merely a snapshot of what's in use.
Modified: trunk/classes/float.pmc
==============================================================================
--- trunk/classes/float.pmc (original)
+++ trunk/classes/float.pmc Sat Oct 8 18:37:19 2005
@@ -20,7 +20,7 @@ C<Float> extends C<scalar> to provide fl
#include "parrot/parrot.h"
-pmclass Float extends scalar {
+pmclass Float extends scalar does float does scalar {
/*
Modified: trunk/classes/integer.pmc
==============================================================================
--- trunk/classes/integer.pmc (original)
+++ trunk/classes/integer.pmc Sat Oct 8 18:37:19 2005
@@ -71,7 +71,7 @@ overflow_p(Interp *interpreter, PMC *sel
}
}
-pmclass Integer extends scalar {
+pmclass Integer extends scalar does integer does scalar {
/*
Modified: trunk/classes/perlint.pmc
==============================================================================
--- trunk/classes/perlint.pmc (original)
+++ trunk/classes/perlint.pmc Sat Oct 8 18:37:19 2005
@@ -23,7 +23,7 @@ C<PerlInt> extends C<Integer> to provide
void Parrot_perlscalar_morph(Interp* , PMC* pmc, INTVAL type);
/* TODO extends PerlAny or perlscalar or whatever */
-pmclass PerlInt extends Integer {
+pmclass PerlInt extends Integer does integer does scalar {
/*
Modified: trunk/classes/perlnum.pmc
==============================================================================
--- trunk/classes/perlnum.pmc (original)
+++ trunk/classes/perlnum.pmc Sat Oct 8 18:37:19 2005
@@ -22,7 +22,7 @@ These are the vtable functions for the P
void Parrot_perlscalar_morph(Interp* , PMC* pmc, INTVAL type);
-pmclass PerlNum extends Float {
+pmclass PerlNum extends Float does float does scalar {
/*
Modified: trunk/classes/perlstring.pmc
==============================================================================
--- trunk/classes/perlstring.pmc (original)
+++ trunk/classes/perlstring.pmc Sat Oct 8 18:37:19 2005
@@ -24,7 +24,7 @@ not from C<String>.
void Parrot_perlscalar_morph(Interp* , PMC* pmc, INTVAL type);
-pmclass PerlString extends String {
+pmclass PerlString extends String does string does scalar {
/*
Modified: trunk/classes/string.pmc
==============================================================================
--- trunk/classes/string.pmc (original)
+++ trunk/classes/string.pmc Sat Oct 8 18:37:19 2005
@@ -22,7 +22,7 @@ wrapper for the functions in /src/string
#include "parrot/parrot.h"
-pmclass String extends scalar {
+pmclass String extends scalar does string does scalar {
/*
Modified: trunk/classes/stringarray.pmc
==============================================================================
--- trunk/classes/stringarray.pmc (original)
+++ trunk/classes/stringarray.pmc Sat Oct 8 18:37:19 2005
@@ -16,6 +16,6 @@ so there's something that works.
#include "parrot/parrot.h"
-pmclass StringArray extends ResizablePMCArray need_ext {
+pmclass StringArray extends ResizablePMCArray need_ext does array {
}
Modified: trunk/runtime/parrot/library/Data/Dumper.imc
==============================================================================
--- trunk/runtime/parrot/library/Data/Dumper.imc (original)
+++ trunk/runtime/parrot/library/Data/Dumper.imc Sat Oct 8 18:37:19 2005
@@ -1,4 +1,4 @@
-.sub __library_data_dumper_onload @LOAD
+.sub __library_data_dumper_onload :load
find_type $I0, "Data::Dumper"
if $I0 > 1 goto END
load_bytecode "library/Data/Dumper/Default.imc"
@@ -9,7 +9,7 @@ END:
.namespace ["Data::Dumper"]
-.sub dumper method
+.sub dumper :method
.param pmc dump
.param string name :optional
.param int has_name :opt_flag
Modified: trunk/runtime/parrot/library/Data/Dumper/Base.imc
==============================================================================
--- trunk/runtime/parrot/library/Data/Dumper/Base.imc (original)
+++ trunk/runtime/parrot/library/Data/Dumper/Base.imc Sat Oct 8 18:37:19 2005
@@ -4,7 +4,7 @@ Data::Dumper::Base - style baseclass
=head1 VERSION
-version 0.11
+version 0.20
=head1 SYNOPSIS
@@ -29,7 +29,7 @@ A Data::Dumper::Base object has the foll
.const int attrIndention = 2
.const int attrCache = 3
-.sub __library_data_dumper_base_onload @LOAD
+.sub __library_data_dumper_base_onload :load
find_type $I0, "Data::Dumper::Base"
if $I0 > 1 goto END
newclass $P0, "Data::Dumper::Base"
@@ -47,7 +47,7 @@ END:
=cut
-.sub prepare method
+.sub prepare :method
.param pmc dumper
.param string indent
.local string stemp
@@ -57,20 +57,20 @@ END:
add $I0, attrDumper
setattribute self, $I0, dumper
- new temp, .PerlInt
+ new temp, .Integer
set temp, 0
classoffset $I0, self, "Data::Dumper::Base"
add $I0, attrLevel
setattribute self, $I0, temp
- new temp, .PerlString
+ new temp, .String
clone stemp, indent
set temp, stemp
classoffset $I0, self, "Data::Dumper::Base"
add $I0, attrIndention
setattribute self, $I0, temp
- new temp, .PerlArray
+ new temp, .ResizablePMCArray
classoffset $I0, self, "Data::Dumper::Base"
add $I0, attrCache
setattribute self, $I0, temp
@@ -82,7 +82,7 @@ END:
=cut
-.sub cache method
+.sub cache :method
.param string defname
.param pmc find
.local pmc _cache
@@ -120,7 +120,7 @@ NOTFOUND:
=cut
-.sub createIndent method
+.sub createIndent :method
.param int level
.local pmc temp
.local string indent
@@ -139,7 +139,7 @@ NOTFOUND:
=cut
-.sub indent method
+.sub indent :method
.local pmc temp
.local string _indent
.local int level
@@ -158,7 +158,7 @@ NOTFOUND:
=cut
-.sub newIndent method
+.sub newIndent :method
.local pmc temp
.local string indent1
.local string indent2
@@ -181,7 +181,7 @@ NOTFOUND:
=cut
-.sub deleteIndent method
+.sub deleteIndent :method
.local pmc temp
.local string indent
.local int level
@@ -201,7 +201,7 @@ NOTFOUND:
=cut
-.sub dump method
+.sub dump :method
.param string paramName
.param pmc _dump
.local int type
@@ -223,12 +223,38 @@ NOT_IN_CACHE:
set func, "pmcNull"
if_null _dump, DUMP
- # does a helper method exists?
+ # does a specific helper method exist?
+ # (in general, it will not, let it override the general ones below)
typeof temp, _dump
set func, "pmc"
concat func, temp
can ret, self, func
if ret goto DUMP
+
+ #is _dump undef?
+ func = "genericUndef"
+ $I0 = defined _dump
+ unless $I0 goto DUMP
+
+ # does a generic helper method exist?
+ func = "genericHash"
+ $I0 = does _dump, "hash"
+ if $I0 goto DUMP
+
+ func = "genericArray"
+ $I0 = does _dump, "array"
+ if $I0 goto DUMP
+
+ func = "genericString"
+ $I0 = does _dump, "string"
+ if $I0 goto DUMP
+
+ func = "genericNumber"
+ $I0 = does _dump, "integer"
+ if $I0 goto DUMP
+ $I0 = does _dump, "float"
+ if $I0 goto DUMP
+
# no, dump as a unknown PMC
set func, "pmcDefault"
DUMP:
Modified: trunk/runtime/parrot/library/Data/Dumper/Default.imc
==============================================================================
--- trunk/runtime/parrot/library/Data/Dumper/Default.imc (original)
+++ trunk/runtime/parrot/library/Data/Dumper/Default.imc Sat Oct 8
18:37:19 2005
@@ -4,7 +4,7 @@ Data::Dumper::Default - The default outp
=head1 VERSION
-version 0.10
+version 0.20
=head1 SYNOPSIS
@@ -16,7 +16,7 @@ This module provides the default output
=cut
-.sub __library_data_dumper_default_onload @LOAD
+.sub __library_data_dumper_default_onload :load
find_type $I0, "Data::Dumper::Default"
if $I0 > 1 goto END
load_bytecode "library/Data/Dumper/Base.imc"
@@ -40,7 +40,7 @@ A Data::Dumper::Default object has the f
=cut
-.sub dumpWithName method
+.sub dumpWithName :method
.param string shortname
.param string name
.param pmc dump
@@ -59,7 +59,7 @@ A Data::Dumper::Default object has the f
=cut
-.sub dumpCached method
+.sub dumpCached :method
.param string name
.param pmc dump
@@ -74,7 +74,7 @@ A Data::Dumper::Default object has the f
=cut
-.sub dumpProperties method
+.sub dumpProperties :method
.param string paramName
.param pmc dump
.local string name
@@ -95,13 +95,13 @@ END:
.return ( ret )
.end
-=item style.dumpHash( name, hash )
+=item style.genericHash( name, hash )
Dumps a 'generic' Hash.
=cut
-.sub dumpHash method
+.sub genericHash :method
.param string name
.param pmc hash
.local string indent
@@ -114,9 +114,12 @@ Dumps a 'generic' Hash.
(subindent, indent) = self."newIndent"()
- print "{"
+ $S0 = typeof hash
+ print $S0
+
+ print " {"
- new keys, .PerlArray
+ new keys, .ResizablePMCArray
new iter, .Iterator, hash
set iter, 0
@@ -139,7 +142,7 @@ dump_loop:
shift key, keys
- new val, .PerlArray
+ new val, .ResizablePMCArray
push val, name
push val, key
sprintf name2, "%s[\"%s\"]", val
@@ -168,7 +171,7 @@ Escape any characters in a string so we
=cut
-.sub dumpStringEscaped method
+.sub dumpStringEscaped :method
.param pmc var
.param string char
.local string str
@@ -186,7 +189,7 @@ Escape any characters in a string so we
=cut
-.sub pmcDefault method
+.sub pmcDefault :method
.param string name
.param pmc dump
.local string type
@@ -206,145 +209,13 @@ END:
.return ( 1 )
.end
-=item style."pmcPMCArray"( name, array )
-
-Dumps a PMC Array.
-
-=cut
-
-.sub pmcPMCArray method
- .param string name
- .param pmc array
- self."pmcPerlArray"( name, array )
-.end
-
-=item style."pmcResizablePMCArray"( name, array )
-
-Dumps a resizable (PMC) Array.
-
-=cut
-
-.sub pmcResizablePMCArray method
- .param string name
- .param pmc array
- self."pmcPerlArray"( name, array )
-.end
-
-=item style."pmcResizableStringArray"( name, array )
-
-Dumps a resizable (string) Array.
-
-=cut
-
-.sub pmcResizableStringArray method
- .param string name
- .param pmc array
- self."pmcPerlArray"( name, array )
-.end
-
-=item style."pmcResizableIntegerArray"( name, array )
-
-Dumps a resizable (Integer) Array.
-
-=cut
-
-.sub pmcResizableIntegerArray method
- .param string name
- .param pmc array
- self."pmcPerlArray"( name, array )
-.end
-
-=item style."pmcResizableFloatArray"( name, array )
-
-Dumps a resizable (Float) Array.
-
-=cut
-
-.sub pmcResizableFloatArray method
- .param string name
- .param pmc array
- self."pmcPerlArray"( name, array )
-.end
-
-=item style."pmcFixedPMCArray"( name, array )
-
-Dumps a fixed (PMC) Array.
-
-=cut
-
-.sub pmcFixedPMCArray method
- .param string name
- .param pmc array
- self."pmcPerlArray"( name, array )
-.end
-
-=item style."pmcFixedStringArray"( name, array )
-
-Dumps a fixed (string) Array.
-
-=cut
-
-.sub pmcFixedStringArray method
- .param string name
- .param pmc array
- self."pmcPerlArray"( name, array )
-.end
-
-=item style."pmcFixedIntegerArray"( name, array )
-
-Dumps a fixed (Integer) Array.
-
-=cut
-
-.sub pmcFixedIntegerArray method
- .param string name
- .param pmc array
- self."pmcPerlArray"( name, array )
-.end
-
-=item style."pmcFixedFloatArray"( name, array )
-
-Dumps a fixed (Float) Array.
-
-=cut
-
-.sub pmcFixedFloatArray method
- .param string name
- .param pmc array
- self."pmcPerlArray"( name, array )
-.end
-
-=item style."pmcPMCArray"( name, array )
-
-Dumps a (PMC) Array.
-
-=cut
-
-.sub pmcPMCArray method
- .param string name
- .param pmc array
- self."pmcPerlArray"( name, array )
-.end
-
-=item style."pmcStringArray"( name, array )
-
-Dumps a (string) Array.
-
-=cut
-
-.sub pmcStringArray method
- .param string name
- .param pmc array
- self."pmcPerlArray"( name, array )
-.end
-
=item style."pmcIntList"( name, array )
Dumps an IntList PMC.
=cut
-.sub pmcIntList method
+.sub pmcIntList :method
.param string name
.param pmc array
.local string indent
@@ -374,7 +245,7 @@ iter_loop:
print subindent
- new val, .PerlArray
+ new val, .ResizablePMCArray
push val, name
push val, pos
sprintf name2, "%s[%d]", val
@@ -403,15 +274,16 @@ iter_end:
.return ( 1 )
.end
-=item style."pmcPerlArray"( name, array )
+=item style."genericArray"( name, array )
-Dumps a (Perl) Array.
+Dumps any pmc that implements an Array interface.
=cut
-.sub pmcPerlArray method
+.sub genericArray :method
.param string name
.param pmc array
+
.local string indent
.local string subindent
.local int size
@@ -429,8 +301,8 @@ Dumps a (Perl) Array.
print $I0
print ") ["
- set size, array
- set pos, 0
+ size = array
+ pos = 0
unless size, iter_end
@@ -439,7 +311,7 @@ iter_loop:
print subindent
- new val, .PerlArray
+ val = new .ResizablePMCArray
push val, name
push val, pos
sprintf name2, "%s[%d]", val
@@ -469,72 +341,13 @@ iter_end:
.return ( 1 )
.end
-=item style."pmcPerlHash"( name, hash )
+=item style."genericString"( name, str )
-Dumps a PerlHash PMC.
+Dumps any string-like PMC.
=cut
-.sub pmcPerlHash method
- .param string name
- .param pmc hash
- .local string indent
-
- $S0 = typeof hash
-
- print $S0
- print " "
-
- self."dumpHash"( name, hash )
-
- .return ( 1 )
-.end
-
-
-=item style."pmcHash"( name, hash )
-
-Dumps a Hash PMC.
-
-=cut
-
-.sub pmcHash method
- .param string name
- .param pmc hash
- .local string indent
-
- print "Hash "
-
- self."dumpHash"( name, hash )
-
- .return ( 1 )
-.end
-
-
-=item style."pmcString"( name, str )
-
-Dumps a String PMC.
-
-=cut
-
-.sub pmcString method
- .param string name
- .param pmc str
-
- print "\""
- self."dumpStringEscaped"( str, "\"" )
- print "\""
-
- .return ( 1 )
-.end
-
-
-=item style."pmcPerlString"( name, str )
-
-Dumps a PerlString PMC.
-
-=cut
-
-.sub pmcPerlString method
+.sub genericString :method
.param string name
.param pmc str
@@ -545,14 +358,13 @@ Dumps a PerlString PMC.
.return ( 1 )
.end
+=item style."genericNumber"
-=item style."pmcPerlInt"( name, val )
-
-Dumps a PerlInt PMC.
+Dumps a generic numeric PMC.
=cut
-.sub pmcPerlInt method
+.sub genericNumber :method
.param string name
.param pmc val
@@ -561,134 +373,29 @@ Dumps a PerlInt PMC.
.return ( 1 )
.end
-=item style."pmcPerlNum"( name, val )
+=item style."genericUndef"( name, val )
-Dumps a PerlNum PMC.
+Dumps any undef PMC.
=cut
-.sub pmcPerlNum method
- .param string name
- .param pmc val
-
- print val
-
- .return ( 1 )
-.end
-
-=item style."pmcPerlUndef"( name, val )
-
-Dumps a PerlUndef PMC.
-
-=cut
-
-.sub pmcPerlUndef method
+.sub genericUndef :method
print "undef"
.return ( 1 )
.end
-=item style."pmcSub"( name, val )
-
-Dumps a Sub pmc
-
-=cut
-
-.sub pmcSub method
- print "sub { ... }"
-
- .return ( 1 )
-.end
-
=item style."pmcNull"( name, val )
Dumps a Null PMC.
=cut
-.sub pmcNull method
+.sub pmcNull :method
print "null"
.return ( 1 )
.end
-
-=item style."pmcOrderedHash"( name, val )
-
-Dumps a OrderedHash PMC.
-
-=cut
-
-.sub pmcOrderedHash method
- print "OrderedHash { ... }"
-
- .return ( 1 )
-.end
-
-=item style."pmcManagedStruct"( name, val )
-
-Dumps a ManagedStruct PMC.
-
-=cut
-
-.sub pmcManagedStruct method
- print "ManagedStruct { ... }"
-
- .return ( 1 )
-.end
-
-=item style."pmcUnManagedStruct"( name, val )
-
-Dumps a UnManagedStruct PMC.
-
-=cut
-
-.sub pmcUnManagedStruct method
- print "UnManagedStruct { ... }"
-
- .return ( 1 )
-.end
-
-=item style."pmcArray"( name, array )
-
-Dumps an Array.
-
-=cut
-
-.sub pmcArray method
- .param string name
- .param pmc array
- self."pmcPerlArray"( name, array )
-.end
-
-=item style."pmcInteger"( name, val )
-
-Dumps an Integer PMC.
-
-=cut
-
-.sub pmcInteger method
- .param string name
- .param pmc val
-
- print val
-
- .return ( 1 )
-.end
-
-=item style."pmcFloat"( name, val )
-
-Dumps a Float PMC.
-
-=cut
-
-.sub pmcFloat method
- .param string name
- .param pmc val
-
- print val
-
- .return ( 1 )
-.end
=head1 AUTHOR
Modified: trunk/t/pmc/float.t
==============================================================================
--- trunk/t/pmc/float.t (original)
+++ trunk/t/pmc/float.t Sat Oct 8 18:37:19 2005
@@ -782,6 +782,9 @@ pir_output_is(<< 'CODE', << 'OUTPUT', "c
does bool1, pmc1, "scalar"
print bool1
print "\n"
+ does bool1, pmc1, "float"
+ print bool1
+ print "\n"
does bool1, pmc1, "no_interface"
print bool1
print "\n"
@@ -789,6 +792,7 @@ pir_output_is(<< 'CODE', << 'OUTPUT', "c
.end
CODE
1
+1
0
OUTPUT
Modified: trunk/t/pmc/integer.t
==============================================================================
--- trunk/t/pmc/integer.t (original)
+++ trunk/t/pmc/integer.t Sat Oct 8 18:37:19 2005
@@ -148,6 +148,9 @@ pir_output_is(<< 'CODE', << 'OUTPUT', "c
does bool1, pmc1, "scalar"
print bool1
print "\n"
+ does bool1, pmc1, "integer"
+ print bool1
+ print "\n"
does bool1, pmc1, "no_interface"
print bool1
print "\n"
@@ -155,6 +158,7 @@ pir_output_is(<< 'CODE', << 'OUTPUT', "c
.end
CODE
1
+1
0
OUTPUT
Modified: trunk/t/pmc/perlint.t
==============================================================================
--- trunk/t/pmc/perlint.t (original)
+++ trunk/t/pmc/perlint.t Sat Oct 8 18:37:19 2005
@@ -2022,6 +2022,9 @@ pir_output_is(<< 'CODE', << 'OUTPUT', "c
does bool1, pmc1, "scalar"
print bool1
print "\n"
+ does bool1, pmc1, "integer"
+ print bool1
+ print "\n"
does bool1, pmc1, "no_interface"
print bool1
print "\n"
@@ -2029,6 +2032,7 @@ pir_output_is(<< 'CODE', << 'OUTPUT', "c
.end
CODE
1
+1
0
OUTPUT
Modified: trunk/t/pmc/perlnum.t
==============================================================================
--- trunk/t/pmc/perlnum.t (original)
+++ trunk/t/pmc/perlnum.t Sat Oct 8 18:37:19 2005
@@ -1089,6 +1089,9 @@ pir_output_is(<< 'CODE', << 'OUTPUT', "c
does bool1, pmc1, "scalar"
print bool1
print "\n"
+ does bool1, pmc1, "float"
+ print bool1
+ print "\n"
does bool1, pmc1, "no_interface"
print bool1
print "\n"
@@ -1096,6 +1099,7 @@ pir_output_is(<< 'CODE', << 'OUTPUT', "c
.end
CODE
1
+1
0
OUTPUT
Modified: trunk/t/pmc/perlstring.t
==============================================================================
--- trunk/t/pmc/perlstring.t (original)
+++ trunk/t/pmc/perlstring.t Sat Oct 8 18:37:19 2005
@@ -1971,6 +1971,9 @@ pir_output_is(<< 'CODE', << 'OUTPUT', "c
does bool1, pmc1, "scalar"
print bool1
print "\n"
+ does bool1, pmc1, "string"
+ print bool1
+ print "\n"
does bool1, pmc1, "no_interface"
print bool1
print "\n"
@@ -1978,6 +1981,7 @@ pir_output_is(<< 'CODE', << 'OUTPUT', "c
.end
CODE
1
+1
0
OUTPUT
Modified: trunk/t/pmc/string.t
==============================================================================
--- trunk/t/pmc/string.t (original)
+++ trunk/t/pmc/string.t Sat Oct 8 18:37:19 2005
@@ -1129,6 +1129,9 @@ pir_output_is(<< 'CODE', << 'OUTPUT', "c
does bool1, pmc1, "scalar"
print bool1
print "\n"
+ does bool1, pmc1, "string"
+ print bool1
+ print "\n"
does bool1, pmc1, "no_interface"
print bool1
print "\n"
@@ -1136,6 +1139,7 @@ pir_output_is(<< 'CODE', << 'OUTPUT', "c
.end
CODE
1
+1
0
OUTPUT
