Alt-CWB-ambs

 view release on metacpan or  search on metacpan

data/vrt/VeryShortStories.vrt  view on Meta::CPAN

.	SENT	.
</s>
<s>
You	PP	you
must	MD	musth
get	VB	get
yourself	PP	yourself
into	IN	into
the	DT	the
right	JJ	right
frame	NN	frame
of	IN	of
mind	NN	mind
.	SENT	.
</s>
<s>
Try	VB	try
to	TO	to
feel	VB	feel
as	IN	as
light	NN	light

lib/CWB/CEQL/Parser.pm  view on Meta::CPAN

=cut

sub ErrorMessage {
  my $self = shift;
  my $error = $self->{ERROR};
  return ()
    unless defined $error;

  my @lines = "**Error:** $error";
  my $previous_frame = { RULE => "", INPUT => "" }; # init do dummy frame to avoid special case below
  foreach my $frame (reverse @{$self->{CALLSTACK}}) {
    my $rule = $frame->{RULE};
    if ($rule eq "APPLY") {
      my @done = @{$frame->{APPLY_DONE}};
      my @remain = @{$frame->{APPLY_ITEMS}};
      push @lines, " - at this location: '' @done ''**<==**'' @remain ''";
    }
    else {
      my $input = $frame->{INPUT};
      my $previous_input = $previous_frame->{INPUT} || "";
      if (($previous_input eq $input) and ($previous_frame->{RULE} ne "APPLY")) {
        $lines[-1] .= ", **$rule**";
      }
      else {
        push @lines, " - when parsing '' $input '' as **$rule**";
      }
    }
    $previous_frame = $frame;
  }
  return @lines;
}

=item I<$html_code> = I<$grammar>->B<HtmlErrorMessage>;

If the last parse failed, returns HTML-formatted error message and backtrace
of the callstack.  The string I<$html_code> is valid HTML and can directly be
included in a generated Web page.  In particular, unsafe and non-ASCII
characters have been encoded as HTML entities.  Simple, non-recursive

lib/CWB/CEQL/Parser.pm  view on Meta::CPAN

sub Call {
  confess 'Usage:  $result = $self->Call($rule, $input);'
    unless @_ == 3;
  my ($self, $rule, $input) = @_;
  confess "Sorry, we're not parsing yet"
    unless defined $self->{INPUT};
  my $method = $self->can("$rule");
  confess "the rule **$rule** does not exist in grammar **".ref($self)."** (internal error)\n"
    unless defined $method;
  my $frame = {RULE => $rule,
               INPUT => $input};
  push @{$self->{CALLSTACK}}, $frame; 
  my $result = $method->($self, $input);
  die "rule **$rule** failed to return a result (internal error)\n"
    unless defined $result;
  my $return_frame = pop @{$self->{CALLSTACK}};
  die "call stack has been corrupted (internal error)"
    unless $return_frame eq $frame;
  return $result;
}

=item I<$result> = I<$self>->B<Try>(I<$rule>, I<$input>);

Tentatively apply rule I<$rule> to the input string.  If I<$input> is parsed
successfully, B<Try> returns the translated version I<$result> (or an
arbitrary data structure such as a parse tree for I<$input>) just as B<Call>
would.  If parsing fails, B<Try> does not abort but simply returns B<undef>,
ignoring any error messages generated during the attempt.  In addition, the

lib/CWB/CEQL/Parser.pm  view on Meta::CPAN

further processed by the caller.  Note that empty strings (C<"">) are
automatically removed from the list of return values.

=cut

sub Apply {
  confess 'Usage:  @results = $self->Apply($rule, @items);'
    unless @_ >= 2;
  my $self = shift;
  my $rule = shift;
  my $frame = {RULE => "APPLY",
               INPUT => undef,
               APPLY_ITEMS => [ @_ ],
               APPLY_DONE => []};
  push @{$self->{CALLSTACK}}, $frame;

  ## data structures for nested groups and result values must be restored on exit (in case of nested Apply())
  local $self->{GROUPS} = [ [] ];   # set up data structure to collect result values of nested groups
  local $self->{GROUPSTACK} = [];   # stack of nested groups (keeps track of nesting depth and ensures proper nesting)

  ## process each input item in turn
  while (@{$frame->{APPLY_ITEMS}}) {
    my $input = shift @{$frame->{APPLY_ITEMS}};
    push @{$frame->{APPLY_DONE}}, $input;
    my $result = $self->Call($rule, $input);
    push @{$self->{GROUPS}->[0]}, $result
      unless $result eq "" and not ref $result;  # plain empty string indicates that this item does not generate output
  }

  ## check that nested bracketing was balanced and that data structure for result values is sane
  if (@{$self->{GROUPSTACK}} > 0) {
    my $next_type = pop @{$self->{GROUPSTACK}};
    my $type_msg = ($next_type eq "*") ? "" : "of type ''$next_type''";
    die "bracketing is not balanced: too many opening delimiters $type_msg\n";
  }
  confess "data structure for result values is corrupt in Apply() call (internal error)"
    unless @{$self->{GROUPS}} == 1;
  my @results = @{$self->{GROUPS}->[0]};

  my $return_frame = pop @{$self->{CALLSTACK}};
  die "call stack has been corrupted (internal error)"
    unless $return_frame eq $frame;
  return @results;
}

=item I<$self>->B<BeginGroup>([I<$name>]);

Marks the start of a nested group, when an opening delimiter is encountered.
B<BeginGroup> may only be called while the shift-reduce parser is active
during an B<Apply> operation.  The optional parameter I<$name> can be used to
ensure proper nesting of different types of groups; the default group name is
C<*>.  After calling B<BeginGroup>, a DPP rule will often return C<""> since