[svn:parrot] r34528 - in branches/rvar/languages/perl6/src: classes parser

[pmichaud]

Author: pmichaud
Date: Sun Dec 28 16:47:19 2008
New Revision: 34528

Modified:
   branches/rvar/languages/perl6/src/classes/Signature.pir
   branches/rvar/languages/perl6/src/parser/actions.pm

Log:
[rakudo]:  Add 'readonly' property to parameters.


Modified: branches/rvar/languages/perl6/src/classes/Signature.pir
==============================================================================
--- branches/rvar/languages/perl6/src/classes/Signature.pir     (original)
+++ branches/rvar/languages/perl6/src/classes/Signature.pir     Sun Dec 28 
16:47:19 2008
@@ -196,11 +196,11 @@
     .local string name, sigil
     name = param['name']
     sigil = substr name, 0, 1
-    .local pmc type, var
+    .local pmc type, orig, var
     type = param['type']
-    var = callerlex[name]
+    orig = callerlex[name]
     if sigil == '@' goto param_array
-    var = 'Scalar'(var)
+    var = 'Scalar'(orig)
     ##  typecheck the argument
     if null type goto param_val_done
     .lex '$/', $P99
@@ -208,14 +208,25 @@
     unless $P0 goto err_param_type
     goto param_val_done
   param_array:
-    var = 'Array'(var)
+    var = 'Array'(orig)
     goto param_val_done
   param_val_done:
-    ## place the updated variable back into lex
-    callerlex[name] = var
+    ## handle readonly/copy traits
+    $S0 = param['readtype']
+    if $S0 == 'rw' goto param_readtype_done
+    $I0 = isntsame orig, var
+    if $I0 goto param_readtype_var
+    var = new 'ObjectRef', var
+  param_readtype_var:
+    if $S0 == 'copy' goto param_readtype_done
+    $P0 = get_hll_global ['Bool'], 'True'
+    setprop var, 'readonly', $P0
+  param_readtype_done:
     ## set any type properties
     setprop var, 'type', type
-    goto param_loop
+    ## place the updated variable back into lex
+    callerlex[name] = var
+    goto param_loop 
   param_done:
   end:
     .return ()

Modified: branches/rvar/languages/perl6/src/parser/actions.pm
==============================================================================
--- branches/rvar/languages/perl6/src/parser/actions.pm (original)
+++ branches/rvar/languages/perl6/src/parser/actions.pm Sun Dec 28 16:47:19 2008
@@ -917,12 +917,25 @@
                                 :name('!add_param'), $sigobj, $name );
 
             ##  add any typechecks
-            if +$symbol<type> == 1 {
-                my $type := $symbol<type>[0];
+            my $type := $symbol<type>;
+            if +@($type) > 0 {
+                ##  don't need the 'and' junction for only one type
+                if +@($type) == 1 { $type := $type[0] }
                 $type.named('type');
                 $sigparam.push($type);
             }
 
+            ##  add traits (we're not using this yet.)
+            my $trait := $symbol<trait>;
+            if $trait {
+                $trait.named('trait');
+                $sigparam.push($trait);
+            }
+
+            my $readtype := $symbol<readtype>;
+            $readtype.named('readtype');
+            $sigparam.push($readtype);
+
             $loadinit.push($sigparam);
             $i++;
         }
@@ -978,12 +991,26 @@
         $symbol<viviself> := $( $<default_value>[0]<EXPR> );
     }
 
-    my $type := List.new();
+    ##  keep track of any type constraints
+    my $type := PAST::Op.new( :name('and'), :pasttype('call') );
     $symbol<type> := $type;
     if $<type_constraint> {
         for @($<type_constraint>) { $type.push( $( $_ ) ); }
     }
 
+    my $readtype := '';
+    #for @($<trait>) {
+    #    my $traitpast := $( $_ );
+    #    my $name := $traitpast[1];
+    #    if $name eq 'readonly' || $name eq 'rw' || $name eq 'copy' {
+    #        $readtype && 
+    #            $/.panic("Can only use one of readonly, rw, and copy");
+    #        $readtype := $name;
+    #    }
+    #    # else $traitlist.push( $traitpast );  ## when we do other traits
+    #}
+    $symbol<readtype> := PAST::Val.new( :value($readtype || 'readonly') );
+
     make $past;
 }