Author: jonathan
Date: Tue May 6 05:18:33 2008
New Revision: 27340
Modified:
trunk/languages/perl6/src/classes/Grammar.pir
trunk/languages/perl6/src/classes/Object.pir
trunk/languages/perl6/src/parser/actions.pm
Log:
[rakudo] Make grammar inheritance work.
Modified: trunk/languages/perl6/src/classes/Grammar.pir
==============================================================================
--- trunk/languages/perl6/src/classes/Grammar.pir (original)
+++ trunk/languages/perl6/src/classes/Grammar.pir Tue May 6 05:18:33 2008
@@ -13,9 +13,9 @@
.namespace [ 'Grammar' ]
.sub 'onload' :anon :init :load
- $P0 = subclass 'Any', 'Grammar'
load_bytecode "PGE.pbc"
- $P1 = get_class [ 'PGE::Grammar' ]
+ $P0 = subclass 'PGE::Grammar', 'Grammar'
+ $P1 = get_class [ 'Any' ]
addparent $P0, $P1
$P1 = get_hll_global ['Perl6Object'], 'make_proto'
$P1($P0, 'Grammar')
@@ -37,7 +37,8 @@
TOP = find_method self, "TOP"
pop_eh
.local pmc match
- match = TOP(topic)
+ $S0 = self.'WHAT'()
+ match = TOP(topic, 'grammar' => $S0)
$P0 = getinterp
$P1 = $P0['lexpad';2]
$P1['$/'] = match
Modified: trunk/languages/perl6/src/classes/Object.pir
==============================================================================
--- trunk/languages/perl6/src/classes/Object.pir (original)
+++ trunk/languages/perl6/src/classes/Object.pir Tue May 6 05:18:33 2008
@@ -138,6 +138,33 @@
.end
+=item make_grammar_proto(grammar [, 'name'=>name] )
+
+Create protoobjects and mappings for C<grammar>, using C<name>
+as the Perl 6 name for the grammar. The C<grammar> argument must
+be a Parrot Class object.
+
+=cut
+
+.sub 'make_grammar_proto'
+ .param pmc class
+ .param string name :optional :named('name')
+ .param int has_name :opt_flag
+
+ # We check that it has Grammar as a parent, and if not we add it.
+ $I0 = isa class, 'Grammar'
+ if $I0 goto already_grammar
+ $P0 = new 'ResizablePMCArray'
+ $P0 = get_hll_global $P0, 'Grammar'
+ $P0 = $P0.HOW()
+ addparent class, $P0
+ already_grammar:
+
+ # Now let Object's make_proto do the rest of the work.
+ 'make_proto'(class, name)
+.end
+
+
=item !keyword_class(name)
Internal helper method to create a class.
@@ -212,12 +239,8 @@
$P0[0] = name
info['namespace'] = $P0
- # Create grammar and make a subclass of Grammar.
+ # Create grammar class..
grammar = new 'Class', info
- $P0 = new 'ResizablePMCArray'
- $P0 = get_hll_global $P0, 'Grammar'
- $P0 = $P0.HOW()
- addparent grammar, $P0
.return(grammar)
.end
@@ -571,7 +594,7 @@
$P0 = parents[i]
$P0 = inspect $P0, 'methods'
found = $P0['ACCEPTS']
- if found goto find_next_loop_end
+ unless null found goto find_next_loop_end
inc i
goto find_next_loop
find_next_loop_end:
Modified: trunk/languages/perl6/src/parser/actions.pm
==============================================================================
--- trunk/languages/perl6/src/parser/actions.pm (original)
+++ trunk/languages/perl6/src/parser/actions.pm Tue May 6 05:18:33 2008
@@ -1082,7 +1082,7 @@
PAST::Var.new(
:scope('package'),
:namespace('Perl6Object'),
- :name('make_proto')
+ :name('make_grammar_proto')
),
PAST::Var.new(
:scope('lexical'),
@@ -1514,10 +1514,10 @@
$past := PAST::Block.new(
$<quote_regex>,
:compiler('PGE::Perl6Regex'),
- :blocktype('declaration'),
:namespace($?NS),
+ :blocktype('declaration'),
:node( $/ )
- )
+ );
}
elsif $key eq 'quote_concat' {
if +$<quote_concat> == 1 {
