[svn:parrot] r38631 - in branches/pmc_pct/compilers/pmcc: src src/emitter src/parser t t/data

cotto at svn.parrot.org cotto at svn.parrot.org
Sat May 9 11:39:58 UTC 2009


Author: cotto
Date: Sat May  9 11:39:58 2009
New Revision: 38631
URL: https://trac.parrot.org/parrot/changeset/38631

Log:
[pmcc] initial version of ATTR inheritance

Added:
   branches/pmc_pct/compilers/pmcc/t/data/Child.pmc
   branches/pmc_pct/compilers/pmcc/t/data/Parent.pmc
Modified:
   branches/pmc_pct/compilers/pmcc/src/emitter.pm
   branches/pmc_pct/compilers/pmcc/src/emitter/pmc.pm
   branches/pmc_pct/compilers/pmcc/src/nodes.pir
   branches/pmc_pct/compilers/pmcc/src/parser/actions.pm
   branches/pmc_pct/compilers/pmcc/src/parser/grammar.pg
   branches/pmc_pct/compilers/pmcc/t/05-header.t

Modified: branches/pmc_pct/compilers/pmcc/src/emitter.pm
==============================================================================
--- branches/pmc_pct/compilers/pmcc/src/emitter.pm	Sat May  9 11:38:17 2009	(r38630)
+++ branches/pmc_pct/compilers/pmcc/src/emitter.pm	Sat May  9 11:39:58 2009	(r38631)
@@ -11,11 +11,11 @@
 
     my $name     := $past.name();
     my $filename := self.filename();
-    
+
     # Get emitter for (specific) PMC.
     my $pmc_emitter := get_pmc_emitter($name, $past);
 
-    $res :=  
+    $res :=
             # Generate header.
               dont_edit($filename)
             # PMC functions
@@ -32,11 +32,11 @@
 
     my $name     := $past.name();
     my $filename := self.filename();
-    
+
     # Get emitter for (specific) PMC.
     my $pmc_emitter := get_pmc_emitter($name, $past);
 
-    $res :=  
+    $res :=
             # Generate header.
               dont_edit($filename)
             # PMC functions
@@ -60,7 +60,7 @@
 # Get (specific) PMC emitter
 # Try to create specific emitter. In case of failure create generic one.
 sub get_pmc_emitter($name, $past) {
-PIR q< 
+PIR q<
     find_lex $P0, '$name'
     $S0 = $P0
 

Modified: branches/pmc_pct/compilers/pmcc/src/emitter/pmc.pm
==============================================================================
--- branches/pmc_pct/compilers/pmcc/src/emitter/pmc.pm	Sat May  9 11:38:17 2009	(r38630)
+++ branches/pmc_pct/compilers/pmcc/src/emitter/pmc.pm	Sat May  9 11:39:58 2009	(r38631)
@@ -138,16 +138,19 @@
 
     my $macro_body;
 
-    if $type eq 'INTVAL' {
+    my $canonical_type := ~$type;
+    $canonical_type.replace(' ','');
+
+    if $canonical_type eq 'INTVAL' {
         $macro_body := self.intval_getter_body($attr_name);
     }
-    elsif $type eq 'FLOATVAL' {
+    elsif $canonical_type eq 'FLOATVAL' {
         $macro_body := self.floatval_getter_body($attr_name);
     }
-    elsif $type eq 'STRING*' {
+    elsif $canonical_type eq 'STRING*' {
         $macro_body := self.strptr_getter_body($attr_name);
     }
-    elsif $type eq 'PMC*' {
+    elsif $canonical_type eq 'PMC*' {
         $macro_body := self.pmcptr_getter_body($attr_name);
     }
     else {
@@ -205,16 +208,19 @@
 
     my $macro_body;
 
-    if $type eq 'INTVAL' {
+    my $canonical_type := ~$type;
+    $canonical_type.replace(' ','');
+
+    if $canonical_type eq 'INTVAL' {
         $macro_body := self.intval_setter_body($attr_name);
     }
-    elsif $type eq 'FLOATVAL' {
+    elsif $canonical_type eq 'FLOATVAL' {
         $macro_body := self.floatval_setter_body($attr_name);
     }
-    elsif $type eq 'STRING*' {
+    elsif $canonical_type eq 'STRING*' {
         $macro_body := self.strptr_setter_body($attr_name);
     }
-    elsif $type eq 'PMC*' {
+    elsif $canonical_type eq 'PMC*' {
         $macro_body := self.pmcptr_setter_body($attr_name);
     }
     else {

Modified: branches/pmc_pct/compilers/pmcc/src/nodes.pir
==============================================================================
--- branches/pmc_pct/compilers/pmcc/src/nodes.pir	Sat May  9 11:38:17 2009	(r38630)
+++ branches/pmc_pct/compilers/pmcc/src/nodes.pir	Sat May  9 11:39:58 2009	(r38631)
@@ -119,6 +119,81 @@
     .tailcall self.'attr'('attrs',0,0)
 .end
 
+=item C<serialize_attrs>
+
+store PMC ATTRs in a file.
+
+=cut
+
+.include 'library/JSON.pir'
+
+.sub 'serialize_attrs' :method
+
+    .local string filename, pmcname
+    .local pmc attrs, fh
+
+    pmcname = self.'name'()
+    attrs = self.'attrs'()
+    $S0 = freeze attrs
+
+    filename = concat pmcname, ".dump"
+    fh = open filename, "w"
+    print fh, $S0
+    close fh
+    .return ()
+
+.end
+
+=item C<unserialize_attrs>
+
+unserialize a PMC's frozen ATTRs and add them to this PMC.
+
+=cut
+
+.include 'except_types.pasm'
+
+.sub 'unserialize_attrs' :method
+
+    .param string pmcname
+
+    .local string filename
+    .local pmc attrs, fh, eh
+
+    eh = new ['ExceptionHandler']
+    eh.'handle_types'(.EXCEPTION_PIO_ERROR)
+    set_addr eh, no_dump
+
+    filename = concat pmcname, ".dump"
+    push_eh eh
+    fh = open filename
+    pop_eh
+    $S0 = fh.'readall'()
+    close fh
+
+    .local pmc it, attr
+    .local string type, name
+
+    attrs = thaw $S0
+    it = iter attrs
+
+  iter_loop:
+    unless it goto iter_done
+    attr = shift it
+    name = attr['name']
+    type = attr['type']
+    self.'add_attr'(name, type)
+    goto iter_loop
+
+  iter_done:
+    .return ()
+
+  no_dump:
+    printerr "WARNING: couldn't read .dump for "
+    printerr pmcname
+    printerr ".pmc\n"
+    .return ()
+.end
+
 
 =item C<set_trait>
 

Modified: branches/pmc_pct/compilers/pmcc/src/parser/actions.pm
==============================================================================
--- branches/pmc_pct/compilers/pmcc/src/parser/actions.pm	Sat May  9 11:38:17 2009	(r38630)
+++ branches/pmc_pct/compilers/pmcc/src/parser/actions.pm	Sat May  9 11:39:58 2009	(r38631)
@@ -20,6 +20,7 @@
     else {
         # Set c_header and c_coda
         make $?PMC;
+        $?PMC.serialize_attrs();
     }
 }
 
@@ -36,6 +37,7 @@
     #say("traits " ~$/);
     if $key eq 'extends' {
         $?PMC.parents().push(~$<identifier>);
+        $?PMC.unserialize_attrs(~$<identifier>);
     }
     elsif $key eq 'provides' {
     }
@@ -54,7 +56,6 @@
     my $type;
     my $accessor_type;
 
-
     if $key eq 'simple_attr' {
         $type := ~$/<simple_attr><simple_attr_type>;
         $name := ~$/<simple_attr><identifier>;
@@ -63,7 +64,6 @@
         $type := ~$/<pointer_attr><pointer_attr_type>;
         $name := ~$/<pointer_attr><identifier>;
     }
-    $type.replace(' ','');
     $?PMC.add_attr($name, $type);
 }
 

Modified: branches/pmc_pct/compilers/pmcc/src/parser/grammar.pg
==============================================================================
--- branches/pmc_pct/compilers/pmcc/src/parser/grammar.pg	Sat May  9 11:38:17 2009	(r38630)
+++ branches/pmc_pct/compilers/pmcc/src/parser/grammar.pg	Sat May  9 11:39:58 2009	(r38631)
@@ -56,7 +56,7 @@
 }
 
 rule attribute {
-    'ATTR' <attribute_type>
+    'ATTR' <attribute_type> <c_comment>?
 }
 
 rule attribute_type {
@@ -69,7 +69,7 @@
     <simple_attr_type> <identifier> ';'
 }
 
-regex simple_attr_type {
+rule simple_attr_type {
     [ 'U'? 'INTVAL'
     | 'FLOATVAL'
     | 'STRING'
@@ -164,6 +164,10 @@
     [ <parrot_c_argument> [ ',' <parrot_c_argument> ]* ]*
 }
 
+rule c_comment {
+    '/*' .*? '*/'
+}
+
 rule adverb {
     [
     | ':optional' <named>?

Modified: branches/pmc_pct/compilers/pmcc/t/05-header.t
==============================================================================
--- branches/pmc_pct/compilers/pmcc/t/05-header.t	Sat May  9 11:38:17 2009	(r38630)
+++ branches/pmc_pct/compilers/pmcc/t/05-header.t	Sat May  9 11:39:58 2009	(r38631)
@@ -8,7 +8,7 @@
     load_bytecode 'pmcc.pbc'
     .local int total
 
-    plan(5)
+    plan(6)
 
     .local string filename
     filename = 't/data/class00.pmc'
@@ -39,6 +39,19 @@
     $S0 = _slurp(filename)
     check_one_header(filename, $S0, attr_macro, "ATTR macro generated")
 
+    #make sure the dump for Parent is generated
+    .local pmc emitter, capture
+    filename = 't/data/Parent.pmc'
+    $S0 = _slurp(filename)
+    (emitter, capture) = get_emitter_and_capture(filename, $S0, 'past')
+    emitter.'generate_h_file'(capture)
+
+    #test that parent ATTRs are included in children, and in the right order
+    filename = 't/data/Child.pmc'
+    $S0 = _slurp(filename)
+    attr_struct = 'parent_1\;.*parent_2\;.*parent_3\;.*child_1\;.*child_2\;.*child_3\;'
+    check_one_header(filename, $S0, attr_struct, "parent/child ATTR ordering")
+
 .end
 
 # Check genrated header.

Added: branches/pmc_pct/compilers/pmcc/t/data/Child.pmc
==============================================================================
--- /dev/null	00:00:00 1970	(empty, because file is newly added)
+++ branches/pmc_pct/compilers/pmcc/t/data/Child.pmc	Sat May  9 11:39:58 2009	(r38631)
@@ -0,0 +1,5 @@
+pmclass Child extends Parent{
+    ATTR INTVAL   child_1;
+    ATTR FLOATVAL child_2;
+    ATTR STRING*  child_3;
+}

Added: branches/pmc_pct/compilers/pmcc/t/data/Parent.pmc
==============================================================================
--- /dev/null	00:00:00 1970	(empty, because file is newly added)
+++ branches/pmc_pct/compilers/pmcc/t/data/Parent.pmc	Sat May  9 11:39:58 2009	(r38631)
@@ -0,0 +1,5 @@
+pmclass Parent {
+    ATTR FLOATVAL parent_1;
+    ATTR INTVAL   parent_2;
+    ATTR STRING*  parent_3;
+}


More information about the parrot-commits mailing list