Author: jonathan
Date: Tue May 6 03:56:17 2008
New Revision: 27338
Added:
trunk/languages/perl6/src/classes/Grammar.pir (contents, props changed)
Modified:
trunk/MANIFEST
trunk/languages/perl6/config/makefiles/root.in
trunk/languages/perl6/src/classes/Object.pir
trunk/languages/perl6/src/parser/actions.pm
Log:
[rakudo] Make grammars more class-like. We now create protoobjects for them.
Added a Grammar class, implementing the ACCEPTS method which calls TOP. Had to
tweak the protoclass' ACCEPTS to also try the one in the class to make this
work; should review if this is really the Right Way for this to work.
Modified: trunk/MANIFEST
==============================================================================
--- trunk/MANIFEST (original)
+++ trunk/MANIFEST Tue May 6 03:56:17 2008
@@ -1872,6 +1872,7 @@
languages/perl6/src/classes/Bool.pir [perl6]
languages/perl6/src/classes/Capture.pir [perl6]
languages/perl6/src/classes/Code.pir [perl6]
+languages/perl6/src/classes/Grammar.pir [perl6]
languages/perl6/src/classes/Hash.pir [perl6]
languages/perl6/src/classes/IO.pir [perl6]
languages/perl6/src/classes/Int.pir [perl6]
Modified: trunk/languages/perl6/config/makefiles/root.in
==============================================================================
--- trunk/languages/perl6/config/makefiles/root.in (original)
+++ trunk/languages/perl6/config/makefiles/root.in Tue May 6 03:56:17 2008
@@ -56,6 +56,7 @@
src/classes/Whatever.pir \
src/classes/Capture.pir \
src/classes/Subset.pir \
+ src/classes/Grammar.pir \
src/builtins/assign.pir \
src/builtins/cmp.pir \
src/builtins/control.pir \
Added: trunk/languages/perl6/src/classes/Grammar.pir
==============================================================================
--- (empty file)
+++ trunk/languages/perl6/src/classes/Grammar.pir Tue May 6 03:56:17 2008
@@ -0,0 +1,50 @@
+## $Id$
+
+=head1 TITLE
+
+Grammar - Perl 6 Grammar class
+
+=head1 DESCRIPTION
+
+This file implements the Grammar class.
+
+=cut
+
+.namespace [ 'Grammar' ]
+
+.sub 'onload' :anon :init :load
+ $P0 = subclass 'Any', 'Grammar'
+ load_bytecode "PGE.pbc"
+ $P1 = get_class [ 'PGE::Grammar' ]
+ addparent $P0, $P1
+ $P1 = get_hll_global ['Perl6Object'], 'make_proto'
+ $P1($P0, 'Grammar')
+.end
+
+
+=item ACCEPTS(topic)
+
+Invokes the TOP rule in the grammar on the given topic.
+
+=cut
+
+.sub 'ACCEPTS' :method
+ .param pmc topic
+ .local pmc TOP
+
+ # If there's a TOP rule, invoke it.
+ push_eh no_TOP
+ TOP = find_method self, "TOP"
+ pop_eh
+ .return TOP(topic)
+
+ no_TOP:
+ 'die'("The grammar has no TOP rule to invoke.")
+.end
+
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
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 03:56:17 2008
@@ -212,12 +212,12 @@
$P0[0] = name
info['namespace'] = $P0
- # Create grammar.
+ # Create grammar and make a subclass of Grammar.
grammar = new 'Class', info
-
- # Stash in namespace.
- $P0 = new 'ResizableStringArray'
- set_hll_global $P0, name, grammar
+ $P0 = new 'ResizablePMCArray'
+ $P0 = get_hll_global $P0, 'Grammar'
+ $P0 = $P0.HOW()
+ addparent grammar, $P0
.return(grammar)
.end
@@ -551,8 +551,35 @@
.sub 'ACCEPTS' :method
.param pmc topic
- $P0 = self.'HOW'()
- $I0 = does topic, $P0
+ .local pmc HOW
+
+ # Do a does check against the topic.
+ HOW = self.'HOW'()
+ $I0 = does topic, HOW
+ if $I0 goto do_return
+
+ # If that didn't work, try invoking the ACCEPTS of the class itself.
+ # XXX Once we get callsame-like stuff implemented, this logic should go
away.
+ try_class_accepts:
+ .local pmc parents, found
+ .local int i, count
+ parents = inspect HOW, 'all_parents'
+ count = elements parents
+ i = 1 # skip protoclass
+ find_next_loop:
+ if i >= count goto find_next_loop_end
+ $P0 = parents[i]
+ $P0 = inspect $P0, 'methods'
+ found = $P0['ACCEPTS']
+ if found goto find_next_loop_end
+ inc i
+ goto find_next_loop
+ find_next_loop_end:
+
+ $I0 = 0
+ unless found goto do_return
+ $I0 = found(self, topic)
+ do_return:
.return 'prefix:?'($I0)
.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 03:56:17 2008
@@ -1075,6 +1075,23 @@
$?ROLE := @?ROLE.shift();
}
elsif $<sym> eq 'grammar' {
+ # Make proto-object.
+ $?GRAMMAR.push(
+ PAST::Op.new(
+ :pasttype('call'),
+ PAST::Var.new(
+ :scope('package'),
+ :namespace('Perl6Object'),
+ :name('make_proto')
+ ),
+ PAST::Var.new(
+ :scope('lexical'),
+ :name('$def')
+ ),
+ PAST::Val.new( :value(~$<name>) )
+ )
+ );
+
# Attatch grammar declaration to the init code.
unless defined( $?INIT ) {
$?INIT := PAST::Block.new();
