[svn:parrot] r35444 - trunk/languages/perl6/src/parser

Author: jonathan
Date: Mon Jan 12 09:25:44 2009
New Revision: 35444

Modified:
   trunk/languages/perl6/src/parser/grammar.pg
   trunk/languages/perl6/src/parser/methods.pir

Log:
[rakudo] Add more type registry implementation. For now it's not enabled, as it causes us to regress two sanity tests and 20ish spectests; follow up commits will deal with this.

Modified: trunk/languages/perl6/src/parser/grammar.pg
==============================================================================
--- trunk/languages/perl6/src/parser/grammar.pg	(original)
+++ trunk/languages/perl6/src/parser/grammar.pg	Mon Jan 12 09:25:44 2009
@@ -751,7 +751,11 @@
     <?{{
         $P0 = match['name']
         $S0 = $P0.'text'()
-        $I0 = match.'is_type'($S0)
+        # XXX Uncomment next line to test type registration. Disabled in
+        # commited version for now, while I track down the bugs/regressions
+        # that it causes.
+        #.tailcall match.'is_type'($S0)
+        .return (1)
     }}>
     {*}
 }

Modified: trunk/languages/perl6/src/parser/methods.pir
==============================================================================
--- trunk/languages/perl6/src/parser/methods.pir	(original)
+++ trunk/languages/perl6/src/parser/methods.pir	Mon Jan 12 09:25:44 2009
@@ -19,7 +19,25 @@
 .namespace [ "Perl6";"Grammar" ]
 .sub "add_type" :method
     .param string name
-    # XXX TODO
+
+    # Parse name.
+    .local pmc ns
+    .local string short_name
+    $P0 = compreg 'Perl6'
+    ns = $P0.'parse_name'(name)
+    short_name = pop ns
+
+    # Check if the symbol already exists in the NS; if so we're done.
+    $P0 = get_hll_global ns, short_name
+    unless null $P0 goto done
+
+    # Add name to the current block's symbols.
+    .local pmc cur_block
+    cur_block = get_hll_global ['Perl6';'Grammar';'Actions'], '@?BLOCK'
+    cur_block = cur_block[0]
+    cur_block.'symbol'(name, 'does_abstraction'=>1)
+
+  done:
 .end
 
 
@@ -30,9 +48,55 @@
 =cut
 
 .sub 'is_type' :method
-    .param string name
-    # XXX TODO
-    .return (1)
+    .param string full_name
+
+    # If it starts with ::, it's a declaration.
+    $S0 = substr full_name, 0, 2
+    if $S0 == '::' goto type_ok
+
+    # Look in @?BLOCK first.
+    .local pmc blocks, block_it, block, sym_info
+    blocks = get_hll_global [ 'Perl6' ; 'Grammar' ; 'Actions' ], '@?BLOCK'
+    block_it = iter blocks
+    block_it_loop:
+    unless block_it goto block_it_loop_end
+    block = shift block_it
+    sym_info = block.'symbol'(full_name)
+    if null sym_info goto block_it_loop
+    $P0 = sym_info['does_abstraction']
+    if null $P0 goto block_it_loop
+    unless $P0 goto block_it_loop
+    goto type_ok
+    block_it_loop_end:
+
+    # Parse name and look for the symbol in the namespace, then check if
+    # it's a type.
+    .local pmc compiler_obj, check_ns, check_symbol
+    .local string short_name
+    compiler_obj = get_hll_global [ 'Perl6' ], 'Compiler'
+    check_ns = compiler_obj.'parse_name'(full_name)
+    short_name = pop check_ns
+    check_symbol = get_hll_global check_ns, short_name
+    if null check_symbol goto fail_it
+    $I0 = does check_symbol, 'Abstraction'
+    if $I0 goto type_ok
+    # XXX The following should be covered by a check for does Abstraction
+    $I0 = isa check_symbol, 'P6protoobject'
+    if $I0 goto type_ok
+    $I0 = isa check_symbol, 'Role'
+    if $I0 goto type_ok
+    $P0 = class check_symbol
+    $P0 = getprop 'enum', $P0
+    if null $P0 goto not_enum
+    if $P0 goto type_ok
+  not_enum:
+    goto fail_it
+
+      type_ok:
+        .return (1)
+      fail_it:
+        say "failed it"
+        .return (0)
 .end
 
 =back

• [svn:parrot] r35444 - trunk/languages/perl6/src/parser by jonathan