[svn:parrot] r30162 - in trunk/languages/cardinal: src/builtins src/parser t

[tene]

Author: tene
Date: Sun Aug 10 22:02:10 2008
New Revision: 30162

Modified:
   trunk/languages/cardinal/src/builtins/guts.pir
   trunk/languages/cardinal/src/parser/actions.pm
   trunk/languages/cardinal/src/parser/grammar.pg
   trunk/languages/cardinal/t/02-functions.t
   trunk/languages/cardinal/t/08-class.t
   trunk/languages/cardinal/t/99-other.t

Log:
[cardinal]
Call nullary subs when mentioned by name.


Modified: trunk/languages/cardinal/src/builtins/guts.pir
==============================================================================
--- trunk/languages/cardinal/src/builtins/guts.pir      (original)
+++ trunk/languages/cardinal/src/builtins/guts.pir      Sun Aug 10 22:02:10 2008
@@ -212,6 +212,18 @@
     $I0 = defined x
     .return ($I0)
 .end
+
+.sub 'lex_lookup'
+    .param string name
+    $P0 = find_name name
+    .return($P0)
+.end
+
+.sub 'lookup_class'
+    .param pmc item
+    $P0 = class item
+    .return($P0)
+.end
 # Local Variables:
 #   mode: pir
 #   fill-column: 100

Modified: trunk/languages/cardinal/src/parser/actions.pm
==============================================================================
--- trunk/languages/cardinal/src/parser/actions.pm      (original)
+++ trunk/languages/cardinal/src/parser/actions.pm      Sun Aug 10 22:02:10 2008
@@ -247,7 +247,11 @@
 }
 
 method varname($/, $key) {
-    make $( $/{$key} );
+    my $past := $( $/{$key} );
+    if is_a_sub(~$/) { # unary sub
+        $past := PAST::Op.new( :pasttype('call'), :node($/), $past );
+    }
+    make $past;
 }
 
 method global($/) {
@@ -324,6 +328,10 @@
     make $past;
 }
 
+method funcall($/) {
+    my $past := $( $<local_variable> );
+    make $past;
+}
 
 method constant_variable($/) {
     my @a;
@@ -491,12 +499,13 @@
 method functiondef($/) {
     my $past := $( $<comp_stmt> );
     my $name := $<fname>;
+    my $arity := $past[0]<arity>;
     #my $args := $( $<argdecl> );
     #$past.push($args);
     $past.name(~$name);
     our $?BLOCK;
     our $?CLASS;
-    $?BLOCK.symbol(~$name, :scope('package'));
+    $?BLOCK.symbol(~$name, :scope('package'), :arity($arity));
     if defined($?CLASS) {
         $past.pirflags(':method');
     }
@@ -719,6 +728,34 @@
     }
 }
 
+sub is_a_sub($name) {
+    our $?BLOCK;
+    our @?BLOCK;
+    if $?BLOCK.symbol(~$name) {
+        if defined($?BLOCK.symbol(~$name)<arity>) {
+            return(1);
+        }
+        else {
+            return(0);
+        }
+    }
+    for @?BLOCK {
+        if $_ {
+            my $sym_table := $_.symbol(~$name);
+            if $sym_table {
+                if defined($sym_table<arity>) {
+                    return(1);
+                }
+                else {
+                    return(0);
+                }
+            }
+        }
+    }
+    my $lex := lex_lookup($name);
+    if $lex && ~lookup_class($lex) eq 'Sub' { return(1); }
+    return(0);
+}
 
 # Local Variables:
 #   mode: cperl

Modified: trunk/languages/cardinal/src/parser/grammar.pg
==============================================================================
--- trunk/languages/cardinal/src/parser/grammar.pg      (original)
+++ trunk/languages/cardinal/src/parser/grammar.pg      Sun Aug 10 22:02:10 2008
@@ -165,6 +165,10 @@
     ]
 }
 
+token funcall {
+    <!reserved_word> <local_variable> <.before \s|'('> <.before <call_args>> 
{*}
+}
+
 token mrhs {
     <args> {*}
 }
@@ -182,6 +186,7 @@
 
 token basic_primary {
     | <literal> {*}                         #= literal
+    | <funcall> {*}                         #= funcall
     | <variable> {*}                        #= variable
     | <array> {*}                           #= array
     | <ahash> {*}                           #= ahash

Modified: trunk/languages/cardinal/t/02-functions.t
==============================================================================
--- trunk/languages/cardinal/t/02-functions.t   (original)
+++ trunk/languages/cardinal/t/02-functions.t   Sun Aug 10 22:02:10 2008
@@ -21,7 +21,7 @@
   end
 end
 
-first()
+first
 second(2)
 third(3,4)
 second fib(6) - 3;

Modified: trunk/languages/cardinal/t/08-class.t
==============================================================================
--- trunk/languages/cardinal/t/08-class.t       (original)
+++ trunk/languages/cardinal/t/08-class.t       Sun Aug 10 22:02:10 2008
@@ -56,9 +56,9 @@
     end
 end
 
-x = StaticTester.new()
+x = StaticTester.new
 x.num = 6
-y = StaticTester.new()
+y = StaticTester.new
 y.speak
 y.num = y.num + 1
 x.speak

Modified: trunk/languages/cardinal/t/99-other.t
==============================================================================
--- trunk/languages/cardinal/t/99-other.t       (original)
+++ trunk/languages/cardinal/t/99-other.t       Sun Aug 10 22:02:10 2008
@@ -10,4 +10,4 @@
     return [ 9, 6, 7 ]
 end
 
-foo()[1].upto(7) { |i| puts "ok ", i }
+foo[1].upto(7) { |i| puts "ok ", i }