Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
Port HLL::Grammar.O to NQP. 
Mostly from kboga++'s pull request, with a few tweaks and some use of
native types.
  • Loading branch information
@jnthn
jnthn committed Feb 17, 2013
1 parent 32a218b commit 98a623e
Showing 1 changed file with 81 additions and 129 deletions.
210 changes: 81 additions & 129 deletions src/HLL/Grammar.pm
View file
Expand Up @@ -144,7 +144,7 @@ invocation for the subrule might be:
This says to add all of the attribute of the C<%additive> hash
(described below) and a C<pirop> entry into the match object
returned by the C<< infix:sym<+> >> token (as the C<O> named
capture). Note that this is a alphabetic 'O", not a digit zero.
capture). Note that this is a alphabetic "O", not a digit zero.

Currently the C<O> subrule accepts a string argument describing
the hash to be stored. (Note the C< q{ ... } > above. Eventually
Expand All @@ -169,140 +169,92 @@ Currently the only pairs recognized have the form C< :pair >,
C< :!pair >, and C<< :pair<strval> >>.

=end

# This lexical holds the hash cache. Right now we have one
# cache for all grammars; eventually we may need a way to
# separate them out by cursor type.
my %ohash;

method O(str $spec, $save?) {
Q:PIR {
.local pmc self, cur_class
.local string spec, save
.local int has_save
self = find_lex 'self'
cur_class = find_lex '$cursor_class'
spec = find_lex '$spec'
has_save = 0
$P0 = find_lex '$save'
unless $P0 goto no_save
save = $P0
has_save = 1
no_save:

# First, get the hash cache. Right now we have one
# cache for all grammars; eventually we may need a way to
# separate them out by cursor type.
.local pmc ohash
ohash = get_global '%!ohash'
unless null ohash goto have_ohash
ohash = new ['Hash']
set_global '%!ohash', ohash
have_ohash:

# See if we've already created a Hash for the current
# specification string -- if so, use that.
.local pmc hash
hash = ohash[spec]
unless null hash goto hash_done

# See if we've already created a Hash for the current
# specification string -- if so, use that.
my %hash := %ohash{$spec};
unless %hash {
# Otherwise, we need to build a new one.
hash = new ['Hash']
.local int pos, eos
pos = 0
eos = length spec
spec_loop:
pos = find_not_cclass .CCLASS_WHITESPACE, spec, pos, eos
if pos >= eos goto spec_done
$S0 = substr spec, pos, 1
if $S0 == ',' goto spec_comma
if $S0 == ':' goto spec_pair

# If whatever we found doesn't start with a colon, treat it
# as a lookup of a previously saved hash to be merged in.
.local string lookup
.local int lpos
# Find the first whitespace or comma
lpos = find_cclass .CCLASS_WHITESPACE, spec, pos, eos
$I0 = index spec, ',', pos
if $I0 < 0 goto have_lookup_lpos
if $I0 >= lpos goto have_lookup_lpos
lpos = $I0
have_lookup_lpos:
$I0 = lpos - pos
lookup = substr spec, pos, $I0
.local pmc lhash, lhash_it
lhash = ohash[lookup]
if null lhash goto err_lookup
lhash_it = iter lhash
lhash_loop:
unless lhash_it goto lhash_done
$S0 = shift lhash_it
$P0 = lhash[$S0]
hash[$S0] = $P0
goto lhash_loop
lhash_done:
pos = lpos
goto spec_loop

# We just ignore commas between elements for now.
spec_comma:
inc pos
goto spec_loop

# If we see a colon, then we want to parse whatever
# comes next like a pair.
spec_pair:
# eat colon
inc pos
.local string name
.local pmc value
value = new ['Boolean']

# If the pair is of the form :!name, then reverse the value
# and skip the colon.
$S0 = substr spec, pos, 1
$I0 = iseq $S0, '!'
pos += $I0
$I0 = not $I0
value = $I0

# Get the name of the pair.
lpos = find_not_cclass .CCLASS_WORD, spec, pos, eos
$I0 = lpos - pos
name = substr spec, pos, $I0
pos = lpos

# Look for a <...> that follows.
$S0 = substr spec, pos, 1
unless $S0 == '<' goto have_value
inc pos
lpos = index spec, '>', pos
$I0 = lpos - pos
$S0 = substr spec, pos, $I0
value = box $S0
pos = lpos + 1
have_value:
# Done processing the pair, store it in the hash.
hash[name] = value
goto spec_loop
spec_done:
%hash := nqp::hash();
my int $eos := nqp::chars($spec);
my int $pos := 0;
while ($pos := nqp::findnotcclass(nqp::const::CCLASS_WHITESPACE,
$spec, $pos, $eos)) < $eos
{
my int $lpos;
my str $s := nqp::substr($spec, $pos, 1);
if $s eq ',' { # Ignore commas between elements for now.
$pos++;
}
elsif $s eq ':' { # Parse whatever comes next like a pair.
$pos++;

# If the pair is of the form :!name, then reverse the value
# and skip the exclamation mark.
my $value := 1;
if nqp::substr($spec, $pos, 1) eq '!' {
$pos++;
$value := 0;
}

# Get the name of the pair.
$lpos := nqp::findnotcclass(nqp::const::CCLASS_WORD,
$spec, $pos, $eos);
my $name := nqp::substr($spec, $pos, $lpos - $pos);
$pos := $lpos;

# Look for a <...> that follows.
if nqp::substr($spec, $pos, 1) eq '<' {
$pos := $pos + 1;
$lpos := nqp::index($spec, '>', $pos);
$value := nqp::substr($spec, $pos, $lpos - $pos);
$pos := $lpos + 1;
}
# Done processing the pair, store it in the hash.
%hash{$name} := $value;
}
else {
# If whatever we found doesn't start with a colon, treat it
# as a lookup of a previously saved hash to be merged in.
# Find the first whitespace or comma
$lpos := nqp::findcclass(nqp::const::CCLASS_WHITESPACE,
$spec, $pos, $eos);
my $index := nqp::index($spec, ',', $pos);
$lpos := $index unless $index < 0 || $index >= $lpos;
my $lookup := nqp::substr($spec, $pos, $lpos - $pos);
my %lhash := %ohash{$lookup};
self.'panic'('Unknown operator precedence specification "',
$lookup, '"') unless %lhash;
my $lhash_it := nqp::iterator(%lhash);
while $lhash_it {
$s := nqp::shift($lhash_it);
%hash{$s} := %lhash{$s};
}
$pos := $lpos;
}
}
# Done processing the spec string, cache the hash for later.
ohash[spec] = hash
hash_done:
%ohash{$spec} := %hash;
}

if $save {
%ohash{$save} := %hash;
self;
}
else {
# If we've been called as a subrule, then build a pass-cursor
# to indicate success and set the hash as the subrule's match object.
if has_save goto save_hash
$P1 = self.'!cursor_start_all'()
$P0 = $P1[0]
$I0 = $P1[2]
$P0.'!cursor_pass'($I0, '')
setattribute $P0, cur_class, '$!match', hash
.return ($P0)

# save the hash under a new entry
save_hash:
ohash[save] = hash
.return (self)

err_lookup:
self.'panic'('Unknown operator precedence specification "', lookup, '"')
};
my $cur := self.'!cursor_start_cur'();
$cur.'!cursor_pass'(nqp::getattr_i($cur, $cursor_class, '$!from'));
nqp::bindattr($cur, $cursor_class, '$!match', %hash);
$cur;
}
}


Expand Down

0 comments on commit 98a623e

Please sign in to comment.