Author: pmichaud
Date: Fri Oct 14 11:58:25 2005
New Revision: 9483
Added:
trunk/compilers/pge/library.pge
trunk/compilers/pge/mklib.pir
Modified:
trunk/MANIFEST
trunk/compilers/pge/PGE.pir
trunk/compilers/pge/PGE/Exp.pir
trunk/compilers/pge/PGE/Match.pir
trunk/compilers/pge/PGE/P6Rule.pir
trunk/compilers/pge/PGE/Rule.pir
trunk/config/gen/makefiles/pge.in
trunk/runtime/parrot/library/PGE/Glob.pir
trunk/runtime/parrot/library/PGE/Hs.pir
Log:
Committing a large set of changes to PGE's implementation
and internal data structures, as well as some performance
improvements.
Modified: trunk/MANIFEST
==============================================================================
--- trunk/MANIFEST (original)
+++ trunk/MANIFEST Fri Oct 14 11:58:25 2005
@@ -136,6 +136,8 @@ classes/vtablecache.pmc
compilers/pge/P6Rule.grammar []
compilers/pge/README []
compilers/pge/demo.pir []
+compilers/pge/library.pge []
+compilers/pge/mklib.pir []
compilers/pge/PGE.pir []
compilers/pge/PGE/Exp.pir []
compilers/pge/PGE/Match.pir []
Modified: trunk/compilers/pge/PGE.pir
==============================================================================
--- trunk/compilers/pge/PGE.pir (original)
+++ trunk/compilers/pge/PGE.pir Fri Oct 14 11:58:25 2005
@@ -35,3 +35,4 @@ defined.
.include "compilers/pge/PGE/Match.pir"
.include "compilers/pge/PGE/Rule.pir"
.include "compilers/pge/PGE/P6Rule.pir"
+.include "compilers/pge/PGE/Library.pir"
Modified: trunk/compilers/pge/PGE/Exp.pir
==============================================================================
--- trunk/compilers/pge/PGE/Exp.pir (original)
+++ trunk/compilers/pge/PGE/Exp.pir Fri Oct 14 11:58:25 2005
@@ -403,6 +403,7 @@ register.
.param pmc next
.param pmc pad
pad = new Hash # create a new workpad
+ pad["cutnum"] = PGE_CUT_GROUP # cut the current group
$P0 = self["exp1"]
$P0.analyze(self, pad) # analyze our subexp
self.firstchars($P0) # set firstchars
@@ -416,59 +417,41 @@ register.
.local pmc emit
.local pmc exp1
.local string firstchars
+ .local string exp1label
+ exp1label = "R"
emit = find_global "PGE::Exp", "emit"
- emit(code, ".sub _pge_rule")
+ emit(code, ".sub %s", label)
emit(code, " .param pmc mob")
- emit(code, " .param pmc pos :optional")
- emit(code, " .param int has_pos :opt_flag")
emit(code, " .local pmc corou")
- emit(code, " $I0 = isa mob, \"PGE::Match\"")
- emit(code, " if $I0 goto init_pos")
- emit(code, " new_match:")
- emit(code, " $P0 = new String")
- emit(code, " assign $P0, mob")
- emit(code, " $I0 = find_type \"PGE::Rule\"")
- emit(code, " mob = new $I0")
- emit(code, " setattribute mob, \"PGE::Match\\x0$:target\", $P0")
- emit(code, " $P0 = new PerlInt")
- emit(code, " setattribute mob, \"PGE::Match\\x0$:from\", $P0")
- emit(code, " $P0 = new PerlInt")
- emit(code, " $P0 = -1")
- emit(code, " setattribute mob, \"PGE::Match\\x0$:pos\", $P0")
- emit(code, " init_pos:")
- emit(code, " if has_pos goto start_match")
- emit(code, " $P0 = getattribute mob, \"PGE::Match\\x0$:pos\"")
- emit(code, " pos = $P0")
- emit(code, " start_match:")
- emit(code, " newsub corou, .Coroutine, _pge_rule_coroutine")
+ emit(code, " $P0 = find_global \"PGE::Match\", \"newfrom\"")
+ emit(code, " mob = $P0(mob)")
+ emit(code, " newsub corou, .Coroutine, _%s_coroutine", label)
emit(code, " setattribute mob, \"PGE::Match\\x0&:corou\", corou")
- emit(code, " corou(mob, pos)")
+ emit(code, " corou(mob)")
emit(code, " .return (mob)")
emit(code, ".end")
emit(code, "")
- emit(code, ".sub _pge_rule_coroutine")
+ emit(code, ".sub _%s_coroutine", label)
emit(code, " .param pmc mob")
- emit(code, " .param int pos")
+ emit(code, " .local int pos")
emit(code, " .local string target")
emit(code, " .local int lastpos")
emit(code, " .local int cutting")
emit(code, " .local int rep, maxrep")
emit(code, " .local int litlen")
emit(code, " .local string lit")
- emit(code, " .local pmc gpad, cpad")
- emit(code, " .local pmc cobcapt")
- emit(code, " .local pmc capt")
+ emit(code, " .local pmc gpad, rcache")
+ emit(code, " .local pmc captscope")
emit(code, " .local pmc from")
- emit(code, " .local int iscreator")
emit(code, ".include \"cclass.pasm\"")
emit(code, " gpad = new PerlArray")
- emit(code, " cpad = new PerlArray")
- emit(code, " push gpad, -1")
- emit(code, " push cpad, mob")
+ emit(code, " rcache = new PerlHash")
+ emit(code, " captscope = mob")
emit(code, " from = getattribute mob, \"PGE::Match\\x0$:from\"")
emit(code, " $P0 = getattribute mob, \"PGE::Match\\x0$:target\"")
emit(code, " target = $P0")
+ emit(code, " pos = from")
emit(code, " lastpos = length target")
emit(code, " if pos >= 0 goto try_at_pos")
emit(code, " pos = 0")
@@ -486,22 +469,23 @@ register.
emit(code, " if $I0 < 0 goto try_again")
gen_1:
emit(code, " from = pos")
- self.emitsub(code, label, "pos", "from", "lastpos", "NOCUT")
- #emit(code, " if cutting == %s goto fail_forever", PGE_CUT_RULE)
- emit(code, " if cutting == %s goto fail_forever", -2) # XXX
+ self.emitsub(code, exp1label, "pos", "from", "lastpos", "NOCUT")
+ emit(code, " if cutting == %s goto fail_forever", PGE_CUT_RULE)
emit(code, " try_again:")
emit(code, " inc pos")
emit(code, " goto try_match")
emit(code, " try_at_pos:")
emit(code, " cutting = 0")
emit(code, " from = pos")
- self.emitsub(code, label, "NOCUT")
+ self.emitsub(code, exp1label, "NOCUT")
emit(code, " fail_forever:")
+ emit(code, " $P0 = getattribute mob, \"PGE::Match\\x0$:pos\"")
+ emit(code, " $P0 = -2")
emit(code, " .yield()")
emit(code, " goto fail_forever")
exp1 = self["exp1"]
- exp1.gen(code, label, next)
+ exp1.gen(code, exp1label, next)
emit(code, ".end")
.return ()
@@ -920,7 +904,14 @@ register.
.sub "analyze" method
.param pmc next
- .param int pad
+ .param pmc pad
+ .local string token
+ token = self["token"]
+ $I0 = PGE_CUT_RULE
+ if token == ":::" goto cut_1
+ $I0 = pad["cutnum"]
+ cut_1:
+ self["cutnum"] = $I0
self.firstchars(next)
.return ()
.end
@@ -929,18 +920,13 @@ register.
.param pmc code
.param string label
.param string next
- .param string token
.local pmc emit
- .local string cutting
- token = self["token"]
- cutting = "gpad[-1]" # :: cut alternation
- unless token == ":::" goto cut_1 # ::: cut rule
- cutting = PGE_CUT_RULE
- cut_1:
+ .local int cutnum
emit = find_global "PGE::Exp", "emit"
+ cutnum = self["cutnum"]
emit(code, "\n %s:", label)
self.emitsub(code, next, "NOCUT")
- emit(code, " cutting = %s", cutting)
+ emit(code, " cutting = %s", cutnum)
emit(code, " goto fail")
.return ()
.end
@@ -1000,6 +986,9 @@ register.
.local string cname
self["firstchars"] = "" # no firstchars default
+ ($S0, $I0) = self.serno() # get a unique group number
+ pad["cutnum"] = $I0
+ self["cutnum"] = $I0
$I0 = exists pad["creps"] # create creps hash array
if $I0 goto creps_1 # if not exists
@@ -1059,229 +1048,179 @@ register.
.param string next
.local pmc emit
.local pmc exp1
- .local int min, max, isgreedy, iscut, iscapture, isarray, issubrule
- .local string sublabel
- .local string captname, captattr, captattrtype
- .local string rname
- .local int myserno
+ .local int min, max, isgreedy, iscut, iscapture, isarray, issubrule, cscope
+ .local int cutnum
+ .local string rname, captname, captsave, captback
+ .local string exp1label, exp1next
+ .local string replabel
emit = find_global "PGE::Exp", "emit"
(min, max, isgreedy, iscut) = self."_getattributes"()
- (sublabel, myserno) = self.serno()
+ (exp1label, $I0) = self.serno()
+ cutnum = self["cutnum"]
iscapture = defined self["cname"]
isarray = self["isarray"]
rname = self["rname"]
+ cscope = self["cscope"]
issubrule = exists self["rname"]
- unless iscapture goto init
$P0 = self["cname"]
- $I0 = isa $P0, "Integer"
- unless $I0 goto captsubrule
- captsubpat:
- captname = $P0
- captattr = "PGE::Match\\x0@:capt"
- captattrtype = "PerlArray"
- goto init
- captsubrule:
captname = $P0
+ $I0 = isa $P0, "Integer"
+ if $I0 goto captarray
$P1 = find_global "Data::Escape", "String"
captname = $P1(captname, '"')
captname = concat '"', captname
captname = concat captname, '"'
- captattr = "PGE::Match\\x0%:capt"
- captattrtype = "Hash"
- init:
+ captarray:
+ captsave = ""
+ captback = ""
emit(code, "\n %s:", label)
- emit(code, " $I0 = gpad[-1]")
- emit(code, " if $I0 == %s goto %s_1", myserno, label)
- emit(code, " $P0 = cpad[-1]")
- emit(code, " push cpad, $P0")
- unless iscapture goto init_1
- emit(code, " cobcapt = getattribute $P0, \"%s\"", captattr)
- emit(code, " if_null cobcapt, %s_i1", label)
- emit(code, " goto %s_i2", label)
- emit(code, " %s_i1:", label)
- emit(code, " cobcapt = new %s", captattrtype)
- emit(code, " setattribute $P0, \"%s\", cobcapt", captattr)
- emit(code, " %s_i2:", label)
- emit(code, " iscreator = 0")
- emit(code, " $I0 = defined cobcapt[%s]", captname)
- emit(code, " if $I0 goto %s_i3", label)
- emit(code, " capt = new PerlArray")
- emit(code, " $P0 = new Integer")
- emit(code, " $P0 = %s", isarray)
- emit(code, " setprop capt, \"isarray\", $P0")
- emit(code, " cobcapt[%s] = capt", captname)
- emit(code, " iscreator = 1")
- emit(code, " %s_i3:", label)
- emit(code, " capt = cobcapt[%s]", captname)
- init_1:
- emit(code, " push gpad, capt")
+ if iscapture == 0 goto subrule
+ captsave = " $P1[%s] = $P0"
+ captback = " delete $P1[%s]"
+ if isarray == 0 goto subrule
+ captsave = " $P1 = $P1[%s]\n push $P1, $P0"
+ captback = " $P1 = pop $P1"
+ emit(code, " $I0 = defined captscope[%s]", captname)
+ emit(code, " if $I0 goto %s_c1", label)
+ emit(code, " $P0 = new PerlArray")
+ emit(code, " captscope[%s] = $P0", captname)
+ emit(code, " save captscope")
+ emit(code, " bsr %s_c1", label)
+ emit(code, " restore captscope")
+ emit(code, " delete captscope[%s]", captname)
+ emit(code, " goto fail")
+ emit(code, " %s_c1:", label)
+
+ subrule:
+ if issubrule == 0 goto init
+ $I0 = 0
+ subrule_1:
+ $I1 = index rname, "::", $I0
+ if $I1 == -1 goto subrule_2
+ $I0 = $I1 + 2
+ goto subrule_1
+ subrule_2:
+ if $I0 == 0 goto subrule_simple_name
+ $S1 = substr rname, $I0 # get rule name
+ $I0 -= 2
+ $S0 = substr rname, 0, $I0 # get grammar name
+ emit(code, " $P0 = find_global \"%s\", \"%s\"", $S0, $S1)
+ emit(code, " rcache[\"%s\"] = $P0", rname)
+ emit(code, " $P1 = find_global \"PGE::Match\", \"newfrom\"")
+ emit(code, " $P1 = $P1(mob, pos, \"%s\")", $S0)
+ goto init
+ subrule_simple_name:
+ emit(code, " $I0 = can mob, \"%s\"", rname)
+ emit(code, " if $I0 goto %s_s1", label)
+ emit(code, " $P0 = find_global \"%s\"", rname)
+ emit(code, " goto %s_s2", label)
+ emit(code, " %s_s1:", label)
+ emit(code, " $P0 = find_method mob, \"%s\"", rname)
+ emit(code, " %s_s2:", label)
+ emit(code, " rcache[\"%s\"] = $P0", rname)
+ emit(code, " $P1 = mob")
+
+ init:
+ emit(code, " push gpad, captscope")
+ emit(code, " push gpad, $P1")
emit(code, " push gpad, 0")
- emit(code, " push gpad, %s", myserno)
- emit(code, " save iscreator")
- emit(code, " save cobcapt")
- emit(code, " bsr %s_1", label)
- emit(code, " restore cobcapt")
- emit(code, " restore iscreator")
- emit(code, " $I0 = pop gpad")
+ replabel = concat label, "_rep"
+ emit(code, " bsr %s", replabel)
emit(code, " $I0 = pop gpad")
emit(code, " $P0 = pop gpad")
- emit(code, " $P0 = pop cpad")
- unless iscapture goto init_2
- emit(code, " unless iscreator goto %s_i4", label)
- emit(code, " delete cobcapt[%s]", captname)
- emit(code, " %s_i4:", label)
- init_2:
- emit(code, " unless cutting == %s goto fail", myserno)
+ emit(code, " $P0 = pop gpad")
+ emit(code, " if cutting != %s goto fail", cutnum)
emit(code, " cutting = 0")
emit(code, " goto fail")
- emit(code, " %s_1:", label)
- emit(code, " rep = gpad[-2]")
- if issubrule goto greedy
- unless iscapture goto greedy
- emit(code, " capt = gpad[-3]")
- emit(code, " unless rep > 0 goto %s_2", label)
- emit(code, " $P0 = capt[-1]")
- emit(code, " $P1 = getattribute $P0, \"PGE::Match\\x0$:pos\"")
- emit(code, " $P1 = pos")
- greedy:
- emit(code, " %s_2:", label)
- unless isgreedy goto lazy
+
+ rep:
+ emit(code, " %s:", replabel)
+ emit(code, " rep = gpad[-1]")
+ if isgreedy == 0 goto lazy
emit(code, " if rep >= %s goto %s_g1", max, label)
emit(code, " inc rep")
- emit(code, " gpad[-2] = rep")
- self.emitsub(code, sublabel, "pos", "rep")
- greedy_1:
+ emit(code, " gpad[-1] = rep")
+ emit(code, " captscope = gpad[-3]")
+ $S0 = concat label, "_exp1"
+ self.emitsub(code, $S0, "rep", "pos")
emit(code, " dec rep")
emit(code, " %s_g1:", label)
emit(code, " if rep < %s goto fail", min)
- emit(code, " $I0 = pop gpad")
- emit(code, " $I0 = pop gpad")
- emit(code, " $P0 = pop gpad")
- emit(code, " $P0 = pop cpad")
- self.emitsub(code, next, "capt", "rep", "$P0", "NOCUT")
- emit(code, " push cpad, $P0")
- emit(code, " push gpad, capt")
- emit(code, " push gpad, rep")
- emit(code, " push gpad, %s", myserno)
- unless iscut goto greedy_2
- emit(code, " cutting = %s", myserno)
- greedy_2:
- emit(code, " goto fail")
- goto subpat
+ goto trynext
lazy:
emit(code, " if rep < %s goto %s_l1", min, label)
- emit(code, " $I0 = pop gpad")
- emit(code, " $I0 = pop gpad")
- emit(code, " $P0 = pop gpad")
- emit(code, " $P0 = pop cpad")
- self.emitsub(code, next, "capt", "rep", "pos", "$P0", "NOCUT")
- emit(code, " push cpad, $P0")
- emit(code, " push gpad, capt")
- emit(code, " push gpad, rep")
- emit(code, " push gpad, %s", myserno)
- unless iscut goto lazy_1
- emit(code, " cutting = %s", myserno)
- emit(code, " goto fail")
- lazy_1:
+ $S0 = concat label, "_next"
+ self.emitsub(code, $S0, "rep", "pos")
emit(code, " %s_l1:", label)
emit(code, " if rep >= %s goto fail", max)
emit(code, " inc rep")
- emit(code, " gpad[-2] = rep")
- self.emitsub(code, sublabel, "rep")
+ emit(code, " gpad[-1] = rep")
+ emit(code, " captscope = gpad[-3]")
+ emit(code, " goto %s_exp1", label)
+
+ trynext:
+ emit(code, " %s_next:", label)
+ emit(code, " $I0 = pop gpad")
+ emit(code, " $P0 = pop gpad")
+ emit(code, " captscope = pop gpad")
+ self.emitsub(code, next, "rep", "$P0", "captscope", "NOCUT")
+ emit(code, " push gpad, captscope")
+ emit(code, " push gpad, $P0")
+ emit(code, " push gpad, rep")
+ if iscut == 0 goto trynext_1
+ emit(code, " cutting = %s", cutnum)
+ trynext_1:
emit(code, " goto fail")
- subpat:
- if issubrule goto subrule
- if iscapture goto subpat_1
- exp1 = self["exp1"]
- exp1.gen(code, sublabel, label)
- goto end
- subpat_1:
- emit(code, " %s:", sublabel)
- emit(code, " $P0 = mob.\"newat\"(mob,pos)")
- $I0 = self["cscope"]
- unless $I0 goto subpat_2
- emit(code, " cpad[-1] = $P0")
- subpat_2:
- emit(code, " push capt, $P0")
- emit(code, " save capt")
- emit(code, " bsr %s_s1", sublabel)
- emit(code, " restore capt")
- emit(code, " $P0 = pop capt")
- emit(code, " ret")
+ tryexp1:
+ emit(code, " %s_exp1:", label)
+ if issubrule goto trysubr
+ if iscapture goto trysubp
+ exp1next = replabel
+ goto trysubp_2
+ trysubp:
+ exp1next = concat label, "_subp"
+ emit(code, " $P1 = captscope")
+ emit(code, " $P0 = find_global \"PGE::Match\", \"newfrom\"")
+ emit(code, " $P0 = $P0($P1, pos)")
+ emit(code, " gpad[-2] = $P0")
+ emit(code, " save captscope")
+ if cscope == 0 goto trysubp_1
+ emit(code, " captscope = $P0")
+ trysubp_1:
+ emit(code, captsave, captname)
+ self.emitsub(code, exp1label, "$P1", "NOCUT")
+ emit(code, captback, captname)
+ emit(code, " restore captscope")
+ emit(code, " goto fail")
+ emit(code, " %s:", exp1next)
+ emit(code, " $P0 = gpad[-2]")
+ emit(code, " $P0 = getattribute $P0, \"PGE::Match\\x0$:pos\"")
+ emit(code, " $P0 = pos")
+ emit(code, " goto %s", replabel)
+ trysubp_2:
exp1 = self["exp1"]
- concat sublabel, "_s1"
- exp1.gen(code, sublabel, label)
+ exp1.gen(code, exp1label, exp1next)
goto end
- subrule:
- emit(code, " %s:", sublabel)
- emit(code, " saveall")
- $I0 = 0
- subrule_1:
- $I1 = index rname, '::', $I0 # see if we have grammar
- if $I1 == -1 goto subrule_2
- $I0 = $I1 + 2
- goto subrule_1
- subrule_2:
- if $I0 == 0 goto subrule_simple_name
- $S0 = substr rname, $I0 # get rule name
- $I0 -= 2
- $S1 = substr rname, 0, $I0 # get grammar name
- emit(code, " $P2 = getclass \"%s\"", $S1)
- emit(code, " $P2 = $P2.\"newat\"(mob, pos)")
- emit(code, " $P1 = find_method $P2, \"%s\"", $S0)
- goto subrule_invoke
- subrule_simple_name:
- emit(code, " $P2 = mob.\"newat\"(mob, pos)")
- emit(code, " errorsoff %s", .PARROT_ERRORS_GLOBALS_FLAG)
-# emit(code, " $P1 = find_lex \"%s\"", rname)
-# emit(code, " $I0 = defined $P1")
-# emit(code, " if $I0 goto %s_s1", label)
- emit(code, " $I0 = can $P2, \"%s\"", rname)
- emit(code, " if $I0 goto %s_s0", label)
- emit(code, " $P1 = find_global \"%s\"", rname)
- emit(code, " goto %s_s1", label)
- emit(code, " %s_s0:", label)
- emit(code, " $P1 = find_method $P2, \"%s\"", rname)
- emit(code, " %s_s1:", label)
- subrule_invoke:
- emit(code, " $P0 = $P1($P2, pos)")
+
+ trysubr:
+ emit(code, " $P1 = gpad[-2]")
+ emit(code, " $P0 = getattribute $P1, \"PGE::Match\\x0$:pos\"")
+ emit(code, " $P0 = pos")
+ emit(code, " $P0 = rcache[\"%s\"]", rname)
+ emit(code, " $P0 = $P0($P1)")
+ emit(code, " unless $P0 goto fail")
+ emit(code, " $P1 = captscope")
+ emit(code, captsave, captname)
+ emit(code, " %s_sr3:", label)
emit(code, " pos = $P0.to()")
- emit(code, " save pos")
- emit(code, " save $P0")
- emit(code, " restoreall")
- emit(code, " restore $P0")
- emit(code, " restore pos")
- emit(code, " unless $P0 goto %s_s4", label)
- unless iscapture goto subrule_3
- emit(code, " push capt, $P0")
- subrule_3:
- emit(code, " %s_s2:", label)
- self.emitsub(code, label, "pos", "$P0", "NOCUT")
- emit(code, " unless cutting == 0 goto %s_s3", label)
- emit(code, " saveall")
+ self.emitsub(code, replabel, "$P0", "$P1", "NOCUT")
emit(code, " $P0.next()")
- emit(code, " pos = $P0.to()")
- emit(code, " save pos")
- emit(code, " restoreall")
- emit(code, " restore pos")
- emit(code, " if $P0 goto %s_s2", label)
- emit(code, " %s_s3:", label)
- unless iscapture goto subrule_4
- emit(code, " $P1 = pop capt")
- subrule_4:
- emit(code, " %s_s4:", label)
- emit(code, " ret")
+ emit(code, " if $P0 goto %s_sr3", label)
+ emit(code, captback, captname)
+ emit(code, " goto fail")
+
end:
- .return ()
.end
-
-=head1 AUTHOR
-
-Patrick Michaud ([EMAIL PROTECTED]) is the author and maintainer.
-Patches and suggestions should be sent to the Perl 6 compiler list
-([email protected]).
-
-=cut
-
+
Modified: trunk/compilers/pge/PGE/Match.pir
==============================================================================
--- trunk/compilers/pge/PGE/Match.pir (original)
+++ trunk/compilers/pge/PGE/Match.pir Fri Oct 14 11:58:25 2005
@@ -22,31 +22,56 @@ This file implements match objects retur
.return ()
.end
-=head2 Methods
+=head2 Functions
-=item C<newat(PMC mob, INT pos)>
+=item C<newfrom(PMC mob [, int from [, string grammar]])>
-Create a new match object in the same class as the invocant, from
-the match state given by C<mob>, and initialized to start from
-C<pos>.
+Creates a new Match object, based on C<mob>. If C<grammar> is
+specified then the newly created object is an instance of that class,
+otherwise if C<isa mob, "PGE::Match"> then the new object is the
+same class as C<mob>, otherwise the new object is a "PGE::Match"
+object. The optional C<from> parameter says how to initialize
+the C<$:from> attribute of the new object if it can't start from
+the current position of C<mob>.
=cut
-.sub "newat" method
+.sub "newfrom"
.param pmc mob
- .param int pos
+ .param int from :optional # from for new object
+ .param int has_from :opt_flag
+ .param string grammar :optional # grammar to use
+ .param int has_grammar :opt_flag
.local pmc me
- $S0 = classname self
- $I0 = find_type $S0
+
+ $I0 = isa mob, "PGE::Match"
+ if $I0 goto newfrom_mob
+ $P1 = new String
+ assign $P1, mob
+ $P2 = new PerlInt
+ $P2 = -1
+ if has_grammar goto new_me
+ grammar = "PGE::Rule"
+ goto new_me
+ newfrom_mob:
+ if has_grammar goto newfrom_2
+ grammar = classname mob
+ newfrom_2:
+ $P1 = getattribute mob, "PGE::Match\x0$:target"
+ $P2 = getattribute mob, "PGE::Match\x0$:pos"
+ $P2 = clone $P2
+ new_me:
+ $I0 = find_type grammar
me = new $I0
- $P0 = getattribute mob, "PGE::Match\x0$:target"
- setattribute me, "PGE::Match\x0$:target", $P0
- $P0 = new PerlInt
- $P0 = pos
- setattribute me, "PGE::Match\x0$:from", $P0
- $P0 = new PerlInt
- $P0 = -1
- setattribute me, "PGE::Match\x0$:pos", $P0
+ setattribute me, "PGE::Match\x0$:target", $P1
+ setattribute me, "PGE::Match\x0$:from", $P2
+ $P3 = new PerlInt
+ $P3 = -1
+ setattribute me, "PGE::Match\x0$:pos", $P3
+ if has_from == 0 goto end
+ if $P2 >= 0 goto end
+ $P2 = from
+ end:
.return (me)
.end
@@ -85,8 +110,7 @@ this object matched.
.sub "from" method
.local pmc from
from = getattribute self, "PGE::Match\x0$:from"
- $I0 = from
- .return ($I0)
+ .return (from)
.end
=item C<to()>
@@ -98,8 +122,7 @@ Returns the offset at the end of this ma
.sub "to" method
.local pmc to
to = getattribute self, "PGE::Match\x0$:pos"
- $I0 = to
- .return ($I0)
+ .return (to)
.end
=item C<__get_bool()>
@@ -163,34 +186,99 @@ Returns the portion of the target string
=item C<__get_pmc_keyed(PMC key)>
-Returns the subpattern or subrule capture associated with C<key>.
-If the first character of C<key> is a digit then return the
-subpattern, otherwise return the subrule. Note that this will
-return either a single Match object or an array of match objects
-depending on the rule.
+Returns the subrule capture associated with C<key>. This
+returns either a single Match object or an array of match
+objects depending on the rule.
=cut
.sub "__get_pmc_keyed" method
.param pmc key
+ $P0 = getattribute self, "PGE::Match\x0%:capt"
+ if_null $P0, get_1
+ $P0 = $P0[key]
+ get_1:
+ .return ($P0)
+.end
+
+=item C<__get_pmc_keyed_int(int key)>
+
+Returns the subpattern capture associated with C<key>. This
+returns either a single Match object or an array of match
+objects depending on the rule.
+
+=cut
+
+.sub "__get_pmc_keyed_int" method
+ .param int key
+ $P0 = getattribute self, "PGE::Match\x0@:capt"
+ if_null $P0, get_1
+ $P0 = $P0[key]
+ get_1:
+ .return ($P0)
+.end
+
+.sub "__set_pmc_keyed" method
+ .param pmc key
+ .param pmc val
+ .local pmc capt
+ capt = getattribute self, "PGE::Match\x0%:capt"
+ unless_null capt, set_1
+ capt = new PerlHash
+ setattribute self, "PGE::Match\x0%:capt", capt
+ set_1:
+ capt[key] = val
+.end
+
+.sub "__set_pmc_keyed_int" method
+ .param int key
+ .param pmc val
.local pmc capt
- $S0 = key
- .include "cclass.pasm"
- $I0 = is_cclass .CCLASS_NUMERIC, $S0, 0
- unless $I0 goto keyed_1
capt = getattribute self, "PGE::Match\x0@:capt"
- goto keyed_2
- keyed_1:
+ unless_null capt, set_1
+ capt = new PerlArray
+ setattribute self, "PGE::Match\x0@:capt", capt
+ set_1:
+ capt[key] = val
+.end
+
+.sub "__delete_keyed" :method
+ .param pmc key
+ .local pmc capt
capt = getattribute self, "PGE::Match\x0%:capt"
- keyed_2:
- $P0 = capt[key]
- $P1 = getprop "isarray", $P0
- if $P1 goto end
- $P0 = $P0[-1]
+ delete capt[key]
+.end
+
+.sub "__delete_keyed_int" :method
+ .param int key
+ .local pmc capt
+ capt = getattribute self, "PGE::Match\x0@:capt"
+ delete capt[key]
+.end
+
+.sub "__defined_keyed" :method
+ .param pmc key
+ .local pmc capt
+ $I0 = 0
+ capt = getattribute self, "PGE::Match\x0%:capt"
+ if_null capt, end
+ $I0 = defined capt[key]
end:
- .return ($P0)
+ .return ($I0)
+.end
+
+.sub "__defined_keyed_int" :method
+ .param int key
+ .local pmc capt
+ $I0 = 0
+ capt = getattribute self, "PGE::Match\x0@:capt"
+ if_null capt, end
+ $I0 = defined capt[key]
+ end:
+ .return ($I0)
.end
+
=item C<get_hash()>
Returns the hash component of the match object.
@@ -289,17 +377,15 @@ Produces a data dump of the match object
goto subrules_1
dumper:
+ $I0 = isa $P0, "Array"
+ if $I0 goto dumper_0
+ $P0."dump"(prefix1, b1, b2)
+ ret
+ dumper_0:
$I0 = 0
$I1 = elements $P0
- unless $I0 < $I1 goto dumper_1
- $P1 = getprop "isarray", $P0
- if $P1 goto dumper_2
- $P1 = $P0[-1]
- $P1."dump"(prefix1, b1, b2)
dumper_1:
- ret
- dumper_2:
- unless $I0 < $I1 goto dumper_1
+ if $I0 >= $I1 goto dumper_2
$P1 = $P0[$I0]
prefix2 = concat prefix1, b1
$S0 = $I0
@@ -307,7 +393,10 @@ Produces a data dump of the match object
concat prefix2, b2
$P1."dump"(prefix2, b1, b2)
inc $I0
- goto dumper_2
+ goto dumper_1
+ dumper_2:
+ ret
+
end:
.return ()
.end
Modified: trunk/compilers/pge/PGE/P6Rule.pir
==============================================================================
--- trunk/compilers/pge/PGE/P6Rule.pir (original)
+++ trunk/compilers/pge/PGE/P6Rule.pir Fri Oct 14 11:58:25 2005
@@ -875,6 +875,11 @@ needed).
.local pmc code
.local pmc rule
+ if has_name goto p6rule_1
+ name = "_pge_rule"
+ if has_gram goto p6rule_1
+ grammar = "PGE::Rule"
+ p6rule_1:
lex = new Hash
lex["pos"] = 0
lex["subp"] = 0
@@ -894,19 +899,20 @@ needed).
exp.serno(0)
code = new String
- exp.gen(code, "R", "fail")
+ code = ".namespace [ \""
+ code .= grammar
+ code .= "\" ]\n\n"
+ exp.gen(code, name, "fail")
$P0 = compreg "PIR"
compreg $P0, "PIR"
$S0 = code
rule = $P0($S0)
- unless has_name goto p6rule_3
+ if has_name == 0 goto p6rule_2
$I0 = find_type grammar
if $I0 > 0 goto p6rule_2
$P0 = getclass "PGE::Rule"
$P1 = subclass $P0, grammar
p6rule_2:
- store_global grammar, name, rule
- p6rule_3:
.return (rule, code, exp)
.end
Modified: trunk/compilers/pge/PGE/Rule.pir
==============================================================================
--- trunk/compilers/pge/PGE/Rule.pir (original)
+++ trunk/compilers/pge/PGE/Rule.pir Fri Oct 14 11:58:25 2005
@@ -18,9 +18,6 @@ a number of built-in rules.
.local pmc p6rule
base = getclass "PGE::Match"
$P0 = subclass base, "PGE::Rule"
- p6rule = find_global "PGE", "p6rule"
- p6rule("[_ | <?alpha>] \w*", "PGE::Rule", "ident")
- p6rule("<ident> [ \: \: <ident> ]*", "PGE::Rule", "name")
.return ()
.end
@@ -34,6 +31,8 @@ Match a null string (always returns true
.sub null
.param pmc mob
+ $P0 = find_global "PGE::Match", "newfrom"
+ mob = $P0(mob)
$P0 = getattribute mob, "PGE::Match\x0$:from"
$P1 = getattribute mob, "PGE::Match\x0$:pos"
assign $P1, $P0
@@ -48,8 +47,8 @@ Force a backtrack. (Taken from A05.)
.sub fail
.param pmc mob
- $P0 = getattribute mob, "PGE::Match\x0$:pos"
- $P0 = -1
+ $P0 = find_global "PGE::Match", "newfrom"
+ mob = $P0(mob)
.return (mob)
.end
@@ -63,6 +62,8 @@ Match a single uppercase character.
.param pmc mob
.local string target
.local int pos
+ $P0 = find_global "PGE::Match", "newfrom"
+ mob = $P0(mob)
$P0 = getattribute mob, "PGE::Match\x0$:from"
pos = $P0
$P1 = getattribute mob, "PGE::Match\x0$:target"
@@ -86,6 +87,8 @@ Match a single lowercase character.
.param pmc mob
.local string target
.local int pos
+ $P0 = find_global "PGE::Match", "newfrom"
+ mob = $P0(mob)
$P0 = getattribute mob, "PGE::Match\x0$:from"
pos = $P0
$P1 = getattribute mob, "PGE::Match\x0$:target"
@@ -109,15 +112,17 @@ Match a single alphabetic character.
.param pmc mob
.local string target
.local int pos
+ $P0 = find_global "PGE::Match", "newfrom"
+ mob = $P0(mob, 0)
$P0 = getattribute mob, "PGE::Match\x0$:from"
pos = $P0
- $P1 = getattribute mob, "PGE::Match\x0$:target"
- target = $P1
+ $P0 = getattribute mob, "PGE::Match\x0$:target"
+ target = $P0
$I0 = is_cclass .CCLASS_ALPHABETIC, target, pos
unless $I0 goto end
inc pos
- $P1 = getattribute mob, "PGE::Match\x0$:pos"
- $P1 = pos
+ $P0 = getattribute mob, "PGE::Match\x0$:pos"
+ $P0 = pos
end:
.return (mob)
.end
@@ -132,6 +137,8 @@ Match a single digit.
.param pmc mob
.local string target
.local int pos
+ $P0 = find_global "PGE::Match", "newfrom"
+ mob = $P0(mob)
$P0 = getattribute mob, "PGE::Match\x0$:from"
pos = $P0
$P1 = getattribute mob, "PGE::Match\x0$:target"
@@ -155,6 +162,8 @@ Match a single alphanumeric character.
.param pmc mob
.local string target
.local int pos
+ $P0 = find_global "PGE::Match", "newfrom"
+ mob = $P0(mob)
$P0 = getattribute mob, "PGE::Match\x0$:from"
pos = $P0
$P1 = getattribute mob, "PGE::Match\x0$:target"
@@ -178,6 +187,8 @@ Match a single whitespace character.
.param pmc mob
.local string target
.local int pos
+ $P0 = find_global "PGE::Match", "newfrom"
+ mob = $P0(mob)
$P0 = getattribute mob, "PGE::Match\x0$:from"
pos = $P0
$P1 = getattribute mob, "PGE::Match\x0$:target"
@@ -201,6 +212,8 @@ Match a single printable character.
.param pmc mob
.local string target
.local int pos
+ $P0 = find_global "PGE::Match", "newfrom"
+ mob = $P0(mob)
$P0 = getattribute mob, "PGE::Match\x0$:from"
pos = $P0
$P1 = getattribute mob, "PGE::Match\x0$:target"
@@ -224,6 +237,8 @@ Match a single "graphical" character.
.param pmc mob
.local string target
.local int pos
+ $P0 = find_global "PGE::Match", "newfrom"
+ mob = $P0(mob)
$P0 = getattribute mob, "PGE::Match\x0$:from"
pos = $P0
$P1 = getattribute mob, "PGE::Match\x0$:target"
@@ -247,6 +262,8 @@ Match a single "blank" character.
.param pmc mob
.local string target
.local int pos
+ $P0 = find_global "PGE::Match", "newfrom"
+ mob = $P0(mob)
$P0 = getattribute mob, "PGE::Match\x0$:from"
pos = $P0
$P1 = getattribute mob, "PGE::Match\x0$:target"
@@ -270,6 +287,8 @@ Match a single "control" character.
.param pmc mob
.local string target
.local int pos
+ $P0 = find_global "PGE::Match", "newfrom"
+ mob = $P0(mob)
$P0 = getattribute mob, "PGE::Match\x0$:from"
pos = $P0
$P1 = getattribute mob, "PGE::Match\x0$:target"
@@ -293,6 +312,8 @@ Match a single punctuation character.
.param pmc mob
.local string target
.local int pos
+ $P0 = find_global "PGE::Match", "newfrom"
+ mob = $P0(mob)
$P0 = getattribute mob, "PGE::Match\x0$:from"
pos = $P0
$P1 = getattribute mob, "PGE::Match\x0$:target"
@@ -316,6 +337,8 @@ Match a single alphanumeric character.
.param pmc mob
.local string target
.local int pos
+ $P0 = find_global "PGE::Match", "newfrom"
+ mob = $P0(mob)
$P0 = getattribute mob, "PGE::Match\x0$:from"
pos = $P0
$P1 = getattribute mob, "PGE::Match\x0$:target"
@@ -339,6 +362,8 @@ Match a single space character. (Taken
.param pmc mob
.local string target
.local int pos
+ $P0 = find_global "PGE::Match", "newfrom"
+ mob = $P0(mob)
$P0 = getattribute mob, "PGE::Match\x0$:from"
pos = $P0
$P1 = getattribute mob, "PGE::Match\x0$:target"
@@ -362,6 +387,8 @@ Match a single left angle bracket. (Tak
.param pmc mob
.local string target
.local int pos
+ $P0 = find_global "PGE::Match", "newfrom"
+ mob = $P0(mob)
$P0 = getattribute mob, "PGE::Match\x0$:from"
pos = $P0
$P1 = getattribute mob, "PGE::Match\x0$:target"
@@ -385,6 +412,8 @@ Match a single right angle bracket. (Tak
.param pmc mob
.local string target
.local int pos
+ $P0 = find_global "PGE::Match", "newfrom"
+ mob = $P0(mob)
$P0 = getattribute mob, "PGE::Match\x0$:from"
pos = $P0
$P1 = getattribute mob, "PGE::Match\x0$:target"
@@ -408,6 +437,8 @@ Match a single dot ('.'). (Taken from E
.param pmc mob
.local string target
.local int pos
+ $P0 = find_global "PGE::Match", "newfrom"
+ mob = $P0(mob)
$P0 = getattribute mob, "PGE::Match\x0$:from"
pos = $P0
$P1 = getattribute mob, "PGE::Match\x0$:target"
Added: trunk/compilers/pge/library.pge
==============================================================================
--- (empty file)
+++ trunk/compilers/pge/library.pge Fri Oct 14 11:58:25 2005
@@ -0,0 +1,8 @@
+grammar PGE::Rule;
+
+rule ident { [ _ | <?alpha> ] \w* }
+
+# comments
+
+rule name { <ident> [ \:\: <ident> ]* }
+
Added: trunk/compilers/pge/mklib.pir
==============================================================================
--- (empty file)
+++ trunk/compilers/pge/mklib.pir Fri Oct 14 11:58:25 2005
@@ -0,0 +1,78 @@
+=head1 TITLE
+
+Library.src.pir
+
+=head2 Description
+
+This runs the grammar engine to create source code for built-in
+subrules such as <ident> and <name>. Then can then be loaded
+(via include) pre-compiled directly into the PGE.pbc bytecode
+file.
+
+=cut
+
+.sub "main" :main
+ .local pmc load
+ .local pmc p6rule
+ .local pmc gparse
+ .local pmc stmt
+ .local string keyword
+ .local string name
+ .local string rulex
+ .local string grammar
+ .local string code
+ load_bytecode "Data/Escape.pbc"
+ load = find_global "PGE::TokenHash", "__onload"
+ load()
+ load = find_global "PGE::Exp", "__onload"
+ load()
+ load = find_global "PGE::Match", "__onload"
+ load()
+ load = find_global "PGE::P6Rule", "__onload"
+ load()
+ load = find_global "PGE::Rule", "__onload"
+ load()
+ p6rule = find_global "PGE", "p6rule"
+ $S0 = ":w ( (grammar) ([\w|\:]+) ; | (rule) (\w+) \{(<-[}]>+)\} | (\#)\N*
)*"
+ (gparse, code) = p6rule($S0)
+ grammar = "PGE::Rule"
+
+ $P0 = open "library.pge", "<"
+ $S0 = read $P0, 65535
+ close $P0
+ $P0 = gparse($S0)
+ $P1 = $P0[0]
+ $I0 = elements $P1
+ $I1 = 0
+ loop_1:
+ if $I1 >= $I0 goto end
+ stmt = $P1[$I1]
+ inc $I1
+ $P0 = stmt[0]
+ keyword = $P0
+ if keyword == "#" goto loop_1
+ if keyword == "grammar" goto grammar_stmt
+ $P0 = stmt[1]
+ name = $P0
+ $P0 = stmt[2]
+ code = $P0
+ print "\n\n# "
+ print grammar
+ print "::"
+ print name
+ print "\n"
+ ($P0, code) = p6rule(code, grammar, name)
+ print code
+ goto loop_1
+ grammar_stmt:
+ $P0 = stmt[1]
+ grammar = $P0
+ goto loop_1
+ end:
+.end
+
+.include "compilers/pge/PGE/TokenHash.pir"
+.include "compilers/pge/PGE/Exp.pir"
+.include "compilers/pge/PGE/Match.pir"
+.include "compilers/pge/PGE/Rule.pir"
+.include "compilers/pge/PGE/P6Rule.pir"
Modified: trunk/config/gen/makefiles/pge.in
==============================================================================
--- trunk/config/gen/makefiles/pge.in (original)
+++ trunk/config/gen/makefiles/pge.in Fri Oct 14 11:58:25 2005
@@ -16,7 +16,8 @@ all: $(PARROT_LIBRARY)${slash}PGE.pbc
$(PARROT_LIBRARY)${slash}PGE.pbc: PGE.pbc
$(CP) PGE.pbc $(PARROT_LIBRARY)
-PGE.pbc: PGE.pir PGE/Exp.pir PGE/Match.pir PGE/Rule.pir PGE/P6Rule.pir
PGE/TokenHash.pir
+PGE.pbc: PGE.pir PGE/Exp.pir PGE/Match.pir PGE/Rule.pir PGE/P6Rule.pir
PGE/TokenHash.pir mklib.pir library.pge
+ $(PARROT) mklib.pir >PGE/Library.pir
$(PARROT) -o PGE.pbc --output-pbc PGE.pir
# This is a listing of all targets, that are meant to be called by users
@@ -46,7 +47,7 @@ testclean:
$(RM_RF) ../../t/p6rules/*.pir ../../t/p6rules/*.pasm
clean: testclean
- $(RM_RF) PGE.pbc
+ $(RM_RF) PGE.pbc PGE/Library.pir
realclean: clean
$(RM_RF) Makefile
Modified: trunk/runtime/parrot/library/PGE/Glob.pir
==============================================================================
--- trunk/runtime/parrot/library/PGE/Glob.pir (original)
+++ trunk/runtime/parrot/library/PGE/Glob.pir Fri Oct 14 11:58:25 2005
@@ -276,7 +276,7 @@ Parse alternations of the form {a,b,c} w
exp.serno(0)
code = new String
- exp.gen(code, "R", "fail")
+ exp.gen(code, "_pge_rule", "fail")
compreg $P0, "PIR"
$S0 = code
Modified: trunk/runtime/parrot/library/PGE/Hs.pir
==============================================================================
--- trunk/runtime/parrot/library/PGE/Hs.pir (original)
+++ trunk/runtime/parrot/library/PGE/Hs.pir Fri Oct 14 11:58:25 2005
@@ -216,13 +216,9 @@ END:
goto subrules_loop
dumper:
- ari = 0
- arc = elements elm
- is_array = getprop "isarray", elm
- if is_array goto dumper_array
- unless ari < arc goto dumper_fail
- subelm = elm[-1]
- tmps = subelm."dump_hs"()
+ $I0 = isa elm, "Array"
+ if $I0 goto dumper_array
+ tmps = elm."dump_hs"()
out .= tmps
ret
dumper_fail:
@@ -232,6 +228,8 @@ END:
out .= "]"
ret
dumper_array:
+ ari = 0
+ arc = elements elm
out .= "PGE_Array ["
unless ari < arc goto dumper_done
goto dumper_array_body
