[svn:parrot] r38430 - in branches/pmc_pct/compilers/pmc: src/emitter src/parser t

[bacek at svn.parrot.org]

Author: bacek
Date: Fri May  1 23:07:17 2009
New Revision: 38430
URL: https://trac.parrot.org/parrot/changeset/38430

Log:
Refactor C arguments handling

Modified:
   branches/pmc_pct/compilers/pmc/src/emitter/pmc.pir
   branches/pmc_pct/compilers/pmc/src/parser/actions.pm
   branches/pmc_pct/compilers/pmc/src/parser/grammar.pg
   branches/pmc_pct/compilers/pmc/t/04-header.t

Modified: branches/pmc_pct/compilers/pmc/src/emitter/pmc.pir
==============================================================================
--- branches/pmc_pct/compilers/pmc/src/emitter/pmc.pir	Fri May  1 23:06:56 2009	(r38429)
+++ branches/pmc_pct/compilers/pmc/src/emitter/pmc.pir	Fri May  1 23:07:17 2009	(r38430)
@@ -69,6 +69,8 @@
     .local pmc vtables, it, entry, class_init
     .local string pmc_name, vtable_name
 
+    .local pmc res_builder
+
     pmc_name = past.'name'()
 
     $P0 = get_hll_global ['PMC'; 'VTableInfo'], 'vtable_hash'
@@ -83,25 +85,17 @@
     it = iter vtables
   loop:
     unless it goto done
+    res_builder = new 'ResizableStringArray'
     vtable_name = shift it
     entry = vtables[vtable_name]
     vtable_info = vtable_hash[vtable_name]
 
     # Generate 2 methods. One for read, one for write.
-    $P1 = new 'ResizableStringArray'
-    push $P1, 'PARROT_EXPORT '
-    $S0 = vtable_info.'ret_type'()
-    push $P1, $S0
-    push $P1, ' Parrot_'
-    push $P1, pmc_name
-    push $P1, '_'
-    push $P1, vtable_name
-    push $P1, '(PARROT_INTERP, '
-    $S0 = entry['parameters']
-    push $P1, $S0
-    push $P1, ");\n"
+    $S0 = self.'!generate_signature'(pmc_name, entry, 0 :named('ro'))
+    push res_builder, $S0
+    push res_builder, ";\n"
 
-    $S0 = join '', $P1
+    $S0 = join '', res_builder
     concat res, $S0
 
     goto loop
@@ -110,6 +104,52 @@
     .return (res)
 .end
 
+=item C<!generate_signature>
+
+Generate full signature of vtable.
+
+=cut
+
+.sub '!generate_signature' :method
+    .param string pmc_name
+    .param pmc    entry
+    .param int    ro       :named('ro')
+    
+    .local pmc res
+    .local string vtable_name
+    vtable_name = entry.'name'()
+
+    res = new 'ResizableStringArray'
+    push res, 'PARROT_EXPORT '
+    $S0 = entry.'returns'()
+    push res, $S0
+    push res, ' Parrot_'
+    push res, pmc_name
+    push res, '_'
+    push res, vtable_name
+    push res, '(PARROT_INTERP'
+
+    .local pmc it
+    $P1 = entry['parameters']
+    it = $P1.'iterator'()
+  param_loop:
+    unless it goto param_done
+    $P2 = shift it
+
+    push res, ', '
+    $S0 = $P2.'returns'()
+    push res, $S0
+    $S0 = $P2.'name'()
+    push res, $S0
+
+    goto param_loop
+  param_done:
+
+    push res, ")"
+    $S0 = join '', res
+    .return ($S0)
+.end
+
 .sub '!class_init' :method
     .param pmc past
     .tailcall past.'class_init'()

Modified: branches/pmc_pct/compilers/pmc/src/parser/actions.pm
==============================================================================
--- branches/pmc_pct/compilers/pmc/src/parser/actions.pm	Fri May  1 23:06:56 2009	(r38429)
+++ branches/pmc_pct/compilers/pmc/src/parser/actions.pm	Fri May  1 23:07:17 2009	(r38430)
@@ -75,12 +75,12 @@
     my $past := PAST::Block.new( 
         :name(~$<c_signature><identifier>),
         :blocktype('method'),
-        :node($/),
-        PAST::Op.new(
-            :inline(~$<c_body>)
-        )
+        :returns(~$<c_signature><c_type>),
+        :node($/)
     );
-    $past<parameters> := join(', ', $<c_signature><c_arguments><c_argument>);
+    $past<parameters> := $<c_signature><c_arguments>.ast;
+    #say(~$<c_body>);
+    $past.push($<c_body>.ast());
     make $past;
 }
 
@@ -105,7 +105,28 @@
 
 method c_body($/) {
     #say("c_body: " ~ $/);
-    my $past := PAST::Block.new( :blocktype('declaration'), :node($/) );
+    my $past := PAST::Op.new(
+        :node($/),
+        :inline(~$/)
+    );
+    make $past;
+}
+
+method c_arguments($/) {
+    #say("c_arguments");
+    my $past := PAST::Op.new();
+    for $<c_argument> {
+        $past.push($_.ast);
+    }
+    make $past;
+}
+
+method c_argument($/) {
+    #say("c_argument");
+    my $past := PAST::Var.new(
+        :name(~$<identifier>[0]),
+        :returns(~$<c_type>)
+    );
     make $past;
 }
 

Modified: branches/pmc_pct/compilers/pmc/src/parser/grammar.pg
==============================================================================
--- branches/pmc_pct/compilers/pmc/src/parser/grammar.pg	Fri May  1 23:06:56 2009	(r38429)
+++ branches/pmc_pct/compilers/pmc/src/parser/grammar.pg	Fri May  1 23:07:17 2009	(r38430)
@@ -120,10 +120,12 @@
 # Very-very simplified named? function param.
 rule c_argument {
     <c_type> <identifier>?
+    {*}
 }
 
 rule c_arguments {
     [ <c_argument> [ ',' <c_argument> ]* ]*
+    {*}
 }
 
 # c_arguments with parrot's adverbs

Modified: branches/pmc_pct/compilers/pmc/t/04-header.t
==============================================================================
--- branches/pmc_pct/compilers/pmc/t/04-header.t	Fri May  1 23:06:56 2009	(r38429)
+++ branches/pmc_pct/compilers/pmc/t/04-header.t	Fri May  1 23:07:17 2009	(r38430)
@@ -19,7 +19,7 @@
 
     filename = 't/data/class07.pmc'
     $S0 = _slurp(filename)
-    check_one_header(filename, $S0, "'PMC* Parrot_Integer_instantiate(PARROT_INTERP, PMC *sig, PMC* init)'", "VTable method generated")
+    check_one_header(filename, $S0, "'PMC * Parrot_Integer_instantiate(PARROT_INTERP, PMC *sig, PMC* init)'", "VTable method generated")
 
 .end
 
@@ -40,7 +40,7 @@
     emitter = new $P1
     emitter.'set_filename'(name)
     $S0 = emitter.'generate_h_file'($P0)
-    #say $S0
+    say $S0
     like($S0, pattern, message)
 .end