first cut of rspace/rstrat code with eq semi cut over

[scpubgit/DX.git] / lib / DX / Deparse.pm

package DX::Deparse;

use DX::Class;

sub indent_by { '    ' }

sub max_width { 78 }

sub _inner_meta {
  my ($self, $ometa) = @_;
  +{ %$ometa, width_left => $ometa->{width_left} - length $self->indent_by };
}

sub _indent_one {
  my ($self, $to_indent) = @_;
  $to_indent =~ s/^/${\$self->indent_by}/mg;
  $to_indent;
}

sub fmt {
  my ($self, $thing) = @_;
  $self->_fmt($thing, { width_left => $self->max_width })."\n";
}

sub _fmt {
  my ($self, $thing, $meta) = @_;
  return '{}' unless defined($thing);
  return $thing unless ref($thing);
  my $type = join'_', split '::', lc +(ref($thing) =~ /^(?:DX::)?(.*)/)[0];
  $self->${\"_fmt_${type}"}($thing, $meta);
}

sub _fmt_error_typetiny_assertion {
  $_[1]->to_string;
}

sub _fmt_value_dict {
  my ($self, $dict, $meta) = @_;
  my $chunks = $self->_fmt_pairs([
    map [ $_, $dict->get_member_at($_) ], $dict->index_list
  ], $meta);
  return '{{ }}' unless $chunks =~ /\S/;
  s/^\s+//, s/\n\s+/ /g for (my $maybe = $chunks);
  return "{{ ${maybe} }}" if length($maybe) < $meta->{width_left};
  "{{\n${chunks}\n}}";
}

sub _fmt_pairs {
  my ($self, $pairs, $ometa) = @_;
  my $imeta = $self->_inner_meta($ometa);
  $self->_indent_one(join "\n", map {
    join ' ', map $self->_fmt($_, $imeta), @$_
  } @$pairs);
}

sub _fmt_value_string {
  my ($self, $string) = @_;
  # TODO: multiline handling
  my $val = $string->string_value;
  if ($val =~ /^\w+$/) {
    qq{'${val}'}
  } else {
    qq{{'${val}'}}
  }
}

sub _fmt_value_number { $_[1]->number_value }

sub _fmt_value_true { 'true' }

sub _fmt_value_false { 'false' }

sub _fmt_value_unset { 'unset' }

sub _fmt_object {
  my ($self, $pairs, $meta) = @_;
  my $chunks = $self->_fmt_pairs($pairs, $meta);
  return '{ }' unless $chunks =~ /\S/;
  s/^\s+//, s/\n\s+/ /g for (my $maybe = $chunks);
  return "{ ${maybe} }" if length($maybe) < $meta->{width_left};
  "{\n${chunks}\n}"
}

sub _fmt_hypothesis {
  my ($self, $hyp, $meta) = @_;
  $self->_fmt_object([
    map [ $_ => $hyp->$_ ],
      qw(actions resolved_propositions scope)
  ], $meta);
}

sub _fmt_array {
  my ($self, $ary, $ometa) = @_;
  my $imeta = $self->_inner_meta($ometa);
  my $chunks = $self->_indent_one(
    join "\n", map $self->_fmt($_, $imeta), @$ary
  );
  return '{ }' unless $chunks =~ /\S/;
  "{\n${chunks}\n}";
}

sub _fmt_glob {
  my ($self, $glob, $meta) = @_;
  return ((''.*$glob) =~ /::([A-Z_]+)$/)[0];
}

sub _fmt_action_setvalue {
  my ($self, $action, $meta) = @_;
  $self->_fmt_action_generic(SetValue => $action, $meta);
}

sub _fmt_action_addvalue {
  my ($self, $action, $meta) = @_;
  $self->_fmt_action_generic(AddValue => $action, $meta);
}

sub _fmt_action_bindvalue {
  my ($self, $action, $meta) = @_;
  my $path = join '.', map $self->_fmt($_, $meta), @{$action->target_path};
  my $bound_path = join '.',
                     map $self->_fmt($_, $meta),
                       @{$action->new_value
                                ->action_builder
                                ->inner_action_builder
                                ->target_path};
  join ' ', BindValue => $path, $bound_path;
}

sub _fmt_action_addboundvalue {
  my ($self, $action, $meta) = @_;
  $self->_fmt_action_generic(AddBoundValue => $action, $meta);
}

sub _fmt_action_setboundvalue {
  my ($self, $action, $meta) = @_;
  $self->_fmt_action_generic(SetBoundValue => $action, $meta);
}

sub _fmt_action_generic {
  my ($self, $name, $action, $meta) = @_;
  my $path = join '.', map $self->_fmt($_, $meta), @{$action->target_path};
  join ' ', $name, $path, $self->_fmt($action->new_value, $meta);
}

sub _fmt_resolvedpropositionset {
  my ($self, $rps, $meta) = @_;
  $self->_fmt_object([
    map {
      [ $_, [
        map bless([ @$_ ], 'DX::Dependency'),
          map @{$_}[1..$#$_],
            @{$rps->dependencies_for($_)}
      ] ]
    } @{$rps->propositions},
  ], $meta);
}

sub _fmt_dependency {
  my ($self, $dep, $meta) = @_;
  '{ '.join(' ', map $self->_fmt($_, $meta), @$dep).' }'
}

sub _fmt_proposition {
  my ($self, $prop, $meta) = @_;
  join ' ',
    $prop->predicate,
    map $self->_fmt($_, $meta),
      map +((!ref($_) and $prop->introduced_names->{$_}) ? "?$_" : $_),
        @{$prop->args};
}

sub _fmt_scope {
  my ($self, $scope, $meta) = @_;
  $self->_fmt_object([
    [ W => $scope->globals ],
    map [ $_ => $scope->locals->[$_] ], 0..$#{$scope->locals}
  ], $meta);
}

sub _fmt_searchstate {
  my ($self, $ss, $meta) = @_;
  $self->_fmt_object([
    [ adjustments_made => '{...}' ],
    [ current_hypothesis => $ss->current_hypothesis ],
  ], $meta);
}

sub _fmt_step_considerproposition {
  my ($self, $step, $meta) = @_;
  'consider '.$self->_fmt($step->proposition, $meta);
}

sub _fmt_step_resolveproposition {
  my ($self, $step, $meta) = @_;
  'resolve '.$self->_fmt_object([
    [ actions => $step->actions ],
    ($step->alternative_step
      ? [ alternative_step => '...' ]
      : ()),
    [ depends_on => [
      map bless([ @$_ ], 'DX::Dependency'),
        map @{$_}[1..$#$_],
          @{$step->depends_on}
    ] ],
  ], $meta);
}

sub _fmt_step_backtrack { 'backtrack' }

sub _fmt_step_markassolution { 'mark as solution' }

sub _fmt_step_enterrecheck {
  my ($self, $step, $meta) = @_;
  'recheck '.$self->_fmt($step->proposition_list->[0], $meta);
}

sub _fmt_step_completerecheck { 'complete recheck' }

sub _fmt_step_failrecheck { 'fail recheck' }

1;