Grammar-Graph

 view release on metacpan or  search on metacpan

lib/Grammar/Graph.pm  view on Meta::CPAN

    'Grammar::Formal::OneOrMore' => \&convert_one_or_more,
    'Grammar::Formal::ZeroOrMore' => \&convert_zero_or_more,

    'Grammar::Formal::Empty' => \&convert_empty,

    'Grammar::Formal::Group' => \&convert_group,

    'Grammar::Formal::Choice' => \&convert_choice,
    'Grammar::Formal::Conjunction' => \&convert_conjunction,
    'Grammar::Formal::Subtraction' => \&convert_subtraction,

    'Grammar::Formal::OrderedChoice' => \&convert_ordered_choice,
    'Grammar::Formal::OrderedConjunction'
      => \&convert_ordered_conjunction,

  } },
);

sub reversed_copy {
  my ($self) = @_;

  my $g = Graph::Directed->new;

  $g->add_edge(reverse @$_) for $self->g->edges;

  my $copy = $self->new(%{ $self }, g => $g);

  for my $v ($self->g->vertices) {
    my $label = $self->get_vertex_label($v);
    next unless $label;
    if (0 && UNIVERSAL::can($label, 'partner')) {
      my $cloned = $label->new(%$label, partner => $v);
      $copy->set_vertex_label($label->partner, $cloned);
    } else {
      my $cloned = $label->new(%$label);
      $copy->set_vertex_label($v, $cloned);
    }
  }

  $copy->_set_start_vertex($self->final_vertex);
  $copy->_set_final_vertex($self->start_vertex);

  return $copy;
}

#####################################################################
# Helper functions
#####################################################################
sub _copy_predecessors {
  my ($self, $src, $dst) = @_;
  $self->g->add_edge($_, $dst)
    for $self->g->predecessors($src);
}

sub _copy_successors {
  my ($self, $src, $dst) = @_;
  $self->g->add_edge($dst, $_)
    for $self->g->successors($src);
}

sub _find_endpoints {
  my ($self, $id) = @_;

  my $symbols = $self->symbol_table;
  my $start = $symbols->{$id}{start_vertex};
  my $final = $symbols->{$id}{final_vertex};
  
  return ($start, $final);
}

#####################################################################
# ...
#####################################################################

sub register_converter {
  my ($self, $class, $code) = @_;
  $self->pattern_converters->{$class} = $code;
}

sub find_converter { 
  my ($self, $pkg) = @_;
  return $self->pattern_converters->{$pkg};
}

#####################################################################
# ...
#####################################################################

sub _fa_next_id {
  my ($self) = @_;
  
  my $next_id = $self->g->get_graph_attribute('fa_next_id');
  
  $next_id = do {
    my $max = max(grep { /^[0-9]+$/ } $self->g->vertices) // 0;
    $max + 1;
  } if not defined $next_id or $self->g->has_vertex($next_id);

  $self->g->set_graph_attribute('fa_next_id', $next_id + 1);

  return $next_id;
}

sub fa_add_state {
  my ($self, %o) = @_;
  
  my $expect = $o{p} // Grammar::Formal::Empty->new;
  
  my $id = $self->_fa_next_id();
  $self->g->add_vertex($id);
  $self->set_vertex_label($id, $expect)
    if defined $expect;

  return $id;
}

sub fa_all_e_reachable {
  my ($self, $v) = @_;
  my %seen;
  my @todo = ($v);
  while (@todo) {

lib/Grammar/Graph.pm  view on Meta::CPAN

  my ($self, $id) = @_;

  my %id_to_refs = partition_by {
    $self->get_vertex_label($_)->expand . ''
  } grep {
    $self->vertex_isa($_, 'Grammar::Formal::Reference')
  } $self->g->vertices;

  for my $v (@{ $id_to_refs{$id} }) {
    my $label = $self->get_vertex_label($v);

    my ($src, $dst) = $self->_clone_non_terminal($id);

    $self->_copy_predecessors($v, $src);
    $self->_copy_successors($v, $dst);
    graph_delete_vertex_fast($self->g, $v);
  }
}

sub fa_expand_references {
  my ($self) = @_;
  my $symbols = $self->symbol_table;

  my $ref_graph = $self->_fa_ref_graph;
  my $scg = $ref_graph->strongly_connected_graph;

  my @topo = grep { not $ref_graph->has_edge($_, $_) }
    reverse $scg->toposort;

  for my $id (@topo) {
    # NOTE: Relies on @topo containing invalid a+b+c+... IDs
    $self->fa_expand_one_by_copying($id);
  }

  for my $v ($self->g->vertices) {
    my $label = $self->get_vertex_label($v);

    next unless $self->vertex_isa($v, 'Grammar::Formal::Reference');

    my $id = $label->expand;

    # TODO: explain
    # TODO: remove
#    next if $scg->has_vertex("$id")
#      && !$ref_graph->has_edge("$id", "$id");

    my $v1 = $self->fa_add_state();
    my $v2 = $self->fa_add_state();

    my $name = $label->expand->name;

    my $p1 = Grammar::Graph::Start->new(
      partner => $v2, name => $name);
      
    my $p2 = Grammar::Graph::Final->new(
      partner => $v1, name => $name);

    $self->set_vertex_label($v1, $p1);
    $self->set_vertex_label($v2, $p2);

    my ($start, $final) = $self->_find_endpoints($id);

    $self->_copy_predecessors($v, $v1);
    $self->_copy_successors($start, $v1);

    $self->_copy_successors($v, $v2);
    $self->_copy_predecessors($final, $v2);
    
    graph_delete_vertex_fast($self->g, $v);
  }

  for my $v ($self->g->vertices) {
    die if $self->vertex_isa($v, 'Grammar::Formal::Reference');
  }

}

#####################################################################
# Encapsulate ...
#####################################################################

sub _find_id_by_shortname {
  my ($self, $shortname) = @_;

  for my $k (keys %{ $self->symbol_table }) {
    next unless $self->symbol_table->{$k}{shortname} eq $shortname;
    return $k;
  }
}

sub fa_prelude_postlude {
  my ($self, $shortname) = @_;

  my $s1 = $self->fa_add_state();
  my $s2 = $self->fa_add_state();

  my $sS = $self->fa_add_state();
  my $sF = $self->fa_add_state();

  my $p1 = Grammar::Graph::Prelude->new(partner => $s2);
  my $p2 = Grammar::Graph::Postlude->new(partner => $s1);

  my $pS = Grammar::Graph::Start->new(name => "", partner => $sF);
  my $pF = Grammar::Graph::Final->new(name => "", partner => $sS);

  $self->set_vertex_label($s1, $p1);
  $self->set_vertex_label($s2, $p2);

  $self->set_vertex_label($sS, $pS);
  $self->set_vertex_label($sF, $pF);

  my $id = _find_id_by_shortname($self, $shortname);

  die unless defined $id;

  my $rd = $self->symbol_table->{$id};

=pod

  _copy_predecessors($self, $rd->{start_vertex}, $s1);
  _copy_successors($self, $rd->{start_vertex}, $s1);

lib/Grammar/Graph.pm  view on Meta::CPAN

  }

  return %result;
}

sub _create_vertex_to_scc {
  my ($self) = @_;

  my $tmp = _graph_copy_graph_without_terminal_out_edges($self);

  my %result;

  for my $scc ($tmp->strongly_connected_graph->toposort) {
    # TODO: use get_graph_attribute subvertices instead of split
    next unless $tmp->has_edge($scc, $scc) or $scc =~ /\+/;
    $result{$_} = $scc for split/\+/, $scc;
  }

  return %result;
}

#####################################################################
# ...
#####################################################################

sub fa_drop_rules_not_needed_for {
  my ($self, $shortname) = @_;

  my $ref_graph = $self->_fa_ref_graph();
  my $id = $self->_find_id_by_shortname($shortname);
  my %keep = map { $_ => 1 } $id, $ref_graph->all_successors($id);

  delete $self->symbol_table->{$_} for grep {
    not $keep{$_}
  } keys %{ $self->symbol_table };
}

#####################################################################
# ...
#####################################################################
sub fa_truncate {
  my ($self) = @_;
  graph_truncate_to_vertices_between($self->g,
    $self->start_vertex, $self->final_vertex);
}

#####################################################################
# Constructor
#####################################################################
sub from_grammar_formal {
  my ($class, $formal, $shortname, %options) = @_;
  my $self = $class->new;

  _add_to_automaton($formal, $self);
  _delete_not_allowed($self);
  fa_remove_useless_epsilons($self, $self->g->vertices);
  _delete_unreachables($self);

  my $id = _find_id_by_shortname($self, $shortname);

  my ($start_vertex, $final_vertex) = _find_endpoints($self, $id);

  $self->_set_start_vertex($start_vertex);
  $self->_set_final_vertex($final_vertex);

  $self->fa_prelude_postlude($shortname);

  return $self;
}

#####################################################################
# Helper function to write some forms of repetition to the graph
#####################################################################
sub _bound_repetition {
  my ($min, $max, $child, $fa, $root) = @_;

  die if defined $max and $min > $max;
  
  if ($min <= 1 and not defined $max) {
    my $s1 = $fa->fa_add_state;
    my $s2 = $fa->fa_add_state;
    my $s3 = $fa->fa_add_state;
    my $s4 = $fa->fa_add_state;
    my ($ps, $pf) = _add_to_automaton($child, $fa, $root);
    $fa->g->add_edge($s1, $s2);
    $fa->g->add_edge($s2, $ps);
    $fa->g->add_edge($pf, $s3);
    $fa->g->add_edge($s3, $s4);
    $fa->g->add_edge($s2, $s3) if $min == 0;
    $fa->g->add_edge($s3, $s2); # loop
    return ($s1, $s4);
  }
  
  my $s1 = $fa->fa_add_state;
  my $first = $s1;
  
  while ($min--) {
    my ($src, $dst) = _add_to_automaton($child, $fa, $root);
    $fa->g->add_edge($s1, $src);
    $s1 = $dst;
    $max-- if defined $max;
  }

  if (defined $max and $max == 0) {
    my $s2 = $fa->fa_add_state;
    $fa->g->add_edge($s1, $s2);
    return ($first, $s2);
  }  

  do {
    my ($src, $dst) = _add_to_automaton($child, $fa, $root);
    $fa->g->add_edge($s1, $src);
    my $sx = $fa->fa_add_state;
    $fa->g->add_edge($dst, $sx);
    $fa->g->add_edge($s1, $sx); # optional because min <= 0 now
    $fa->g->add_edge($sx, $s1) if not defined $max; # loop
    $s1 = $sx;
  } while (defined $max and --$max);

  my $s2 = $fa->fa_add_state;
  $fa->g->add_edge($s1, $s2);