view release on metacpan or  search on metacpan

lib/Algorithm/ConstructDFA2.pm  view on Meta::CPAN

          ON (Edge.src = r.v)
        INNER JOIN Vertex AS src_vertex
          ON (Edge.src = src_vertex.value)
      WHERE src_vertex.is_nullable
    )
    SELECT root, v FROM all_e_successors_and_self
    ORDER BY root, v
  });
}

sub _vertex_str_from_vertices {
  my ($self, @vertices) = @_;

  return $self->_json->encode([
    nsort_by { $_ } uniq(grep { defined } @vertices)
  ]);
}

sub _vertex_str_to_vertices {
  my ($self, $vertex_str) = @_;

  return @{ $self->_json->decode($vertex_str) };
}

sub _find_state_id_by_vertex_str {
  my ($self, $vertex_str) = @_;

  my $sth = $self->_dbh->prepare(q{
    SELECT state_id FROM State WHERE vertex_str = ?
  });

  return $self->_dbh->selectrow_array($sth, {}, $vertex_str);
}

sub _find_or_create_state_from_vertex_str {
  my ($self, $vertex_str) = @_;

  my $state_id = _find_state_id_by_vertex_str($self, $vertex_str);

  return $state_id if defined $state_id;

  $self->_dbh->begin_work();

  my $sth = $self->_dbh->prepare(q{
    INSERT INTO State(vertex_str) VALUES (?)
  });

  $sth->execute($vertex_str);

  $state_id = $self->_dbh->sqlite_last_insert_rowid();

  $self->_dbh->commit();
  return $state_id;
}

sub _vertex_str_from_partial_list {
  my ($self, @vertices) = @_;

  return $self->_vertex_str_from_vertices() unless @vertices;

  my $escaped_roots = join ", ", map {
    $self->_dbh->quote($_)
  } @vertices;

  my ($vertex_str) = $self->_dbh->selectrow_array(qq{
    SELECT _canonical(json_group_array(closure.e_reachable))
    FROM Closure
    WHERE root IN ($escaped_roots)
  });

  return $vertex_str;
}

sub find_or_create_state_id {
  my ($self, @vertices) = @_;

  my $vertex_str = _vertex_str_from_partial_list($self, @vertices);

  return _find_or_create_state_from_vertex_str($self, $vertex_str);
}

sub vertices_in_state {
  my ($self, $state_id) = @_;

  return map { @$_ } $self->_dbh->selectall_array(q{
    SELECT vertex FROM Configuration WHERE state = ?
  }, {}, $state_id);
}

sub cleanup_dead_states {
  my ($self, $vertices_accept) = @_;

  $self->_dbh->sqlite_create_function( '_vertices_accept', 1, sub {
    my @vertices = $self->_vertex_str_to_vertices(@_);
    return !! $vertices_accept->(@vertices);
  });

  $self->_dbh->begin_work();

  $self->_dbh->do(q{
    CREATE TEMPORARY TABLE accepting AS
    SELECT state_id AS state
    FROM State
    WHERE _vertices_accept(vertex_str)+0 = 1
  });

  my @accepting = map { @$_ } $self->_dbh->selectall_array(q{
    SELECT state FROM accepting
  });

  # NOTE: this also renames states in transitions involving
  # possible start states, but they would then simply have no
  # transitions, which should be fine.

  $self->_dbh->do(q{
    WITH RECURSIVE all_living(state) AS (
      SELECT state FROM accepting
      
      UNION
      
      SELECT src AS state
      FROM Transition
        INNER JOIN all_living
          ON (Transition.dst = all_living.state)
    )
    UPDATE Transition
    SET dst = ?
    WHERE dst NOT IN (SELECT state FROM all_living)