File Coverage

blib/lib/Blatte/Syntax.pm

Criterion	Covered	Total	%
statement	221	254	87.0
branch	20	26	76.9
condition			n/a
subroutine	65	73	89.0
pod	0	2	0.0
total	306	355	86.2

use strict;

package Blatte::Syntax;

sub transform {
  my($obj, $column) = @_;
  return $obj unless ref($obj);
  $obj->transform($column);
}

sub make_sub {
  my($params, $exprs, $column) = @_;

  my @positional;
  my @named;
  my $rest;

  foreach my $param (@$params) {
    if ($param->isa('Blatte::Syntax::Param::Positional')) {
      push(@positional, $param->name());
    } elsif ($param->isa('Blatte::Syntax::Param::Named')) {
      push(@named, $param->name());
    } elsif ($param->isa('Blatte::Syntax::Param::Rest')) {
      $rest = $param->name();
    }
  }

  my $indent = (' ' x $column);

  my $result = "sub {\n";
  $result .= sprintf("%s  my \$_named = shift;\n", $indent);
  if (@positional) {
    $result .= sprintf("%s  my(%s) = map {\n",
                       $indent,
                       join(sprintf(",\n%s     ", $indent),
                            map { sprintf('$%s', $_) } @positional));
    $result .= sprintf("%s    &Blatte::unwrapws(\$_);\n",
                       $indent);
    $result .= sprintf("%s  } splice(\@_, 0, %d);\n",
                       $indent,
                       scalar(@positional));
  }
  foreach my $named (@named) {
    $result .= sprintf("%s  my \$%s = \$_named->{%s};\n",
                       $indent, $named, $named);
  }
  if (defined($rest)) {
    $result .= sprintf("%s  my \$%s = [\@_];\n", $indent, $rest);
  }
  $result .= sprintf("%s  %s;\n",
                     $indent,
                     join(sprintf(";\n%s  ", $indent),
                          map { &Blatte::Syntax::transform($_, $column + 2) } @$exprs));
  $result .= sprintf("%s}", $indent);

  $result;
}

############################################################

package Blatte::Syntax::List;

sub new {
  my $type = shift;
  bless [@_], $type;
}

sub transform {
  my($self, $column) = @_;

  return '[]' unless @$self;

  my @exprs;
  my @assignments;

  foreach my $subexpr (@$self) {
    if (UNIVERSAL::isa($subexpr, 'Blatte::Syntax::Assignment')) {
      push(@assignments, $subexpr);
    } else {
      push(@exprs, $subexpr);
    }
  }

  my $first = shift(@exprs);

  my $indent = (' ' x $column);
  my $result = "do {\n";
  $result .= sprintf("%s  my \$_first = %s;\n",
                     $indent,
                     &Blatte::Syntax::transform($first, $column + 15));
  $result .= sprintf("%s  my \@_rest = (%s);\n",
                     $indent,
                     join(sprintf(",\n%s               ", $indent),
                          map {
                            my $result =
                                sprintf("&Blatte::wrapws('%s',\n",
                                        &Blatte::wsof($_));
                            $result .=
                                sprintf("%s%s%s%s)",
                                        $indent,
                                        (' ' x 15),
                                        (' ' x 16),
                                        &Blatte::Syntax::transform($_,
                                                               $column + 31));
                            $result;
                          } @exprs));
  $result .= sprintf("%s  if (ref(\$_first) eq 'CODE') {\n", $indent);
  $result .= sprintf("%s    &\$_first({%s}",
                     $indent,
                     join(sprintf(",\n%s              ", $indent),
                          map {
                            sprintf('%s => %s',
                                    $_->name(),
                                    &Blatte::Syntax::transform($_->expr(),
                                                               $column + 16));
                          } @assignments));
  if (@exprs) {
    $result .= sprintf(",\n%s             &Blatte::unwrapws(\$_rest[0])",
                       $indent);
    if (@exprs > 1) {
      $result .= sprintf(",\n%s             \@_rest[1 .. \$#_rest]",
                         $indent);
    }
  }
  $result .= ");\n";
  $result .= sprintf("%s  } else {\n", $indent);
  $result .= sprintf("%s    [\$_first, \@_rest];\n", $indent);
  $result .= sprintf("%s  }\n", $indent);
  $result .= sprintf("%s}", $indent);

  $result;
}

############################################################

package Blatte::Syntax::Assignment;

sub new {
  my($type, $name, $expr) = @_;
  bless [$name, $expr], $type;
}

sub name { $_[0]->[0] }
sub expr { $_[0]->[1] }

############################################################

package Blatte::Syntax::VarRef;

sub new {
  my($type, $name) = @_;
  bless \$name, $type;
}

sub name { $ {$_[0]} }

sub transform {
  my($self, $column) = @_;
  sprintf('$%s', $self->name());
}

############################################################

package Blatte::Syntax::Literal;

sub new {
  my($type, $str) = @_;
  bless \$str, $type;
}

sub str { $ {$_[0]} }

sub transform {
  my($self, $column) = @_;
  my $str = $self->str();
  $str =~ s/([\\\'])/\\$1/g;
  sprintf("'%s'", $str);
}

############################################################

package Blatte::Syntax::DefineVar;

sub new {
  my($type, $name, $expr) = @_;
  bless [$name, $expr], $type;
}

sub name { $_[0]->[0] }
sub expr { $_[0]->[1] }

sub transform {
  my($self, $column) = @_;

  my $indent = (' ' x $column);

  my $result = "do {\n";
  $result .= sprintf("%s  use vars '\$%s';\n", $indent, $self->name());
  $result .= sprintf("%s  \$%s = %s;\n",
                     $indent,
                     $self->name(),
                     &Blatte::Syntax::transform($self->expr(), $column + 4));
  $result .= sprintf("%s  [];\n", $indent);
  $result .= sprintf("%s}", $indent);

  $result;
}

############################################################

package Blatte::Syntax::DefineFn;

sub new {
  my($type, $name, $params, $exprs) = @_;
  bless [$name, $params, $exprs], $type;
}

sub name   { $_[0]->[0] }
sub params { $_[0]->[1] }
sub exprs  { $_[0]->[2] }

sub transform {
  my($self, $column) = @_;

  my $indent = (' ' x $column);

  my $result = "do {\n";
  $result .= sprintf("%s  use vars '\$%s';\n", $indent, $self->name());
  $result .= sprintf("%s  \$%s = %s;\n",
                     $indent,
                     $self->name(),
                     &Blatte::Syntax::make_sub($self->params(),
                                               $self->exprs(),
                                               $column + 4));
  $result .= sprintf("%s  [];\n", $indent);
  $result .= sprintf("%s}", $indent);

  $result;
}

############################################################

package Blatte::Syntax::SetVar;

sub new {
  my($type, $name, $expr) = @_;
  bless [$name, $expr], $type;
}

sub name { $_[0]->[0] }
sub expr { $_[0]->[1] }

sub transform {
  my($self, $column) = @_;

  sprintf("\$%s = %s",
          $self->name(),
          &Blatte::Syntax::transform($self->expr(), $column + 2));
}

############################################################

package Blatte::Syntax::Lambda;

sub new {
  my($type, $params, $exprs) = @_;
  bless [$params, $exprs], $type;
}

sub params { $_[0]->[0] }
sub exprs  { $_[0]->[1] }

sub transform {
  my($self, $column) = @_;
  &Blatte::Syntax::make_sub($self->params(), $self->exprs(), $column);
}

############################################################

package Blatte::Syntax::Param::Positional;

sub new {
  my($type, $name) = @_;
  bless \$name, $type;
}

sub name {
  $ {$_[0]};
}

############################################################

package Blatte::Syntax::Param::Named;

sub new {
  my($type, $name) = @_;
  bless \$name, $type;
}

sub name {
  $ {$_[0]};
}

############################################################

package Blatte::Syntax::Param::Rest;

sub new {
  my($type, $name) = @_;
  bless \$name, $type;
}

sub name {
  $ {$_[0]};
}

############################################################

package Blatte::Syntax::Let;

sub new {
  my($type, $clauses, $exprs) = @_;
  bless [$clauses, $exprs], $type;
}

sub clauses { @{$_[0]->[0]} }
sub exprs   { @{$_[0]->[1]} }

sub transform {
  my($self, $column) = @_;

  my $indent = (' ' x $column);

  my $result = "do {\n";
  $result .= sprintf("%s  my(%s) =\n",
                     $indent,
                     join(sprintf(",\n%s     ", $indent),
                          map {
                            sprintf('$%s', $_->name());
                          } $self->clauses()));
  $result .= sprintf("%s    (%s);\n",
                     $indent,
                     join(sprintf(",\n%s     ", $indent),
                          map {
                            sprintf('(%s)',
                                    &Blatte::Syntax::transform($_->expr(),
                                                               $column + 6));
                          } $self->clauses()));
  $result .= sprintf("%s  %s;\n",
                     $indent,
                     join(sprintf(";\n%s  ", $indent),
                          map {
                            &Blatte::Syntax::transform($_, $column + 2);
                          } $self->exprs()));
  $result .= sprintf("%s}", $indent);

  $result;
}

############################################################

package Blatte::Syntax::LetStar;

sub new {
  my($type, $clauses, $exprs) = @_;
  bless [$clauses, $exprs], $type;
}

sub clauses { @{$_[0]->[0]} }
sub exprs   { @{$_[0]->[1]} }

sub transform {
  my($self, $column) = @_;

  my $indent = (' ' x $column);

  my $result = "do {\n";
  $result .= sprintf("%s  %s;\n",
                     $indent,
                     join(sprintf(";\n%s  ", $indent),
                          map {
                            sprintf('my $%s = %s;',
                                    $_->name(),
                                    &Blatte::Syntax::transform($_->expr(),
                                                               $column + 7));
                          } $self->clauses()));
  $result .= sprintf("%s  %s;\n",
                     $indent,
                     join(sprintf(";\n%s  ", $indent),
                          map {
                            &Blatte::Syntax::transform($_, $column + 2);
                          } $self->exprs()));
  $result .= sprintf("%s}", $indent);

  $result;
}

############################################################

package Blatte::Syntax::Letrec;

sub new {
  my($type, $clauses, $exprs) = @_;
  bless [$clauses, $exprs], $type;
}

sub clauses { @{$_[0]->[0]} }
sub exprs   { @{$_[0]->[1]} }

sub transform {
  my($self, $column) = @_;

  my $indent = (' ' x $column);

  my $result = "do {\n";
  $result .= sprintf("%s  my(%s);\n",
                     $indent,
                     join(sprintf(",\n%s     ", $indent),
                          map {
                            sprintf('$%s', $_->name());
                          } $self->clauses()));
  $result .= sprintf("%s  %s;\n",
                     $indent,
                     join(sprintf(";\n%s  ", $indent),
                          map {
                            sprintf('$%s = %s;',
                                    $_->name(),
                                    &Blatte::Syntax::transform($_->expr(),
                                                               $column + 4));
                          } $self->clauses()));
  $result .= sprintf("%s  %s;\n",
                     $indent,
                     join(sprintf(";\n%s  ", $indent),
                          map {
                            &Blatte::Syntax::transform($_, $column + 2);
                          } $self->exprs()));
  $result .= sprintf("%s}", $indent);

  $result;
}

############################################################

package Blatte::Syntax::LetClause;

sub new {
  my($type, $name, $expr) = @_;
  bless [$name, $expr], $type;
}

sub name { $_[0]->[0] }
sub expr { $_[0]->[1] }

############################################################

package Blatte::Syntax::If;

sub new {
  my($type, $test, $consequent, @alternates) = @_;
  bless [$test, $consequent, @alternates], $type;
}

sub test       { $_[0]->[0] }
sub consequent { $_[0]->[1] }
sub alternates { @{$_[0]}[2 .. $#{$_[0]}] }

sub transform {
  my($self, $column) = @_;

  my $indent = (' ' x $column);

  my $result = "do {\n";
  $result .= sprintf("%s  if (&Blatte::true(%s)) {\n",
                     $indent,
                     &Blatte::Syntax::transform($self->test(),
                                                $column + 20));
  $result .= sprintf("%s    %s;\n",
                     $indent,
                     &Blatte::Syntax::transform($self->consequent(),
                                                $column + 4));
  $result .= sprintf("%s  } else {\n",
                     $indent);
  $result .= sprintf("%s    %s;\n",
                     $indent,
                     ($self->alternates() ?
                      join(sprintf(";\n%s    ", $indent),
                           map {
                             &Blatte::Syntax::transform($_, $column + 4);
                           } $self->alternates()) :
                      'undef'));
  $result .= sprintf("%s  }\n", $indent);
  $result .= sprintf("%s}", $indent);

  $result;
}

############################################################

package Blatte::Syntax::Cond;

sub new {
  my $type = shift;
  bless [@_], $type;
}

sub clauses { @{$_[0]} }

sub transform {
  my($self, $column) = @_;

  my $indent = (' ' x $column);

  my $result = "do {\n";

  my @clauses = $self->clauses();
  my $first_clause = shift(@clauses);

  $result .= sprintf("%s  if (&Blatte::true(%s)) {\n",
                     $indent,
                     &Blatte::Syntax::transform($first_clause->test(),
                                                $column + 20));
  $result .= sprintf("%s    %s;\n",
                     $indent,
                     ($first_clause->actions() ?
                      join(sprintf(";\n%s    ", $indent),
                           $indent,
                           map {
                             &Blatte::Syntax::transform($_, $column + 4);
                           } $first_clause->actions()) :
                      'undef'));
  foreach my $clause (@clauses) {
    $result .= sprintf("%s  } elsif (&Blatte::true(%s)) {\n",
                       $indent,
                       &Blatte::Syntax::transform($clause->test(),
                                                  $column + 25));
    $result .= sprintf("%s    %s;\n",
                       $indent,
                       ($clause->actions() ?
                        join(sprintf(";\n%s    ", $indent),
                             $indent,
                             map {
                               &Blatte::Syntax::transform($_, $column + 4);
                             } $clause->actions()) :
                        'undef'));
  }
  $result .= sprintf("%s  }\n", $indent);
  $result .= sprintf("%s}", $indent);

  $result;
}

############################################################

package Blatte::Syntax::CondClause;

sub new {
  my($type, $test, @actions) = @_;
  bless [$test, @actions], $type;
}

sub test { $_[0]->[0] }
sub actions { @{$_[0]}[1 .. $#{$_[0]}] }

############################################################

package Blatte::Syntax::While;

sub new {
  my($type, $test, @exprs) = @_;
  bless [$test, @exprs], $type;
}

sub test  { $_[0]->[0] }
sub exprs { @{$_[0]}[1 .. $#{$_[0]}] }

sub transform {
  my($self, $column) = @_;

  my $indent = (' ' x $column);

  my $result = "do {\n";
  $result .= sprintf("%s  while (&Blatte::true(%s)) {\n",
                     $indent,
                     &Blatte::Syntax::transform($self->test(), $column + 23));
  $result .= sprintf("%s    %s;\n",
                     $indent,
                     join(sprintf(";\n%s    ",
                                  map {
                                    &Blatte::Syntax::transform($_,
                                                               $column + 4);
                                  } $self->exprs())));
  $result .= sprintf("%s  }\n", $indent);
  $result .= sprintf("%s}", $indent);

  $result;
}

############################################################

package Blatte::Syntax::And;

sub new {
  my $type = shift;
  bless [@_], $type;
}

sub exprs { @{$_[0]} }

sub transform {
  my($self, $column) = @_;

  my $indent = (' ' x $column);

  sprintf('(%s)',
          join(sprintf("\n%s && ", $indent),
               map {
                 sprintf('&Blatte::true(%s)',
                         &Blatte::Syntax::transform($_, $column + 18));
               } $self->exprs()));
}

############################################################

package Blatte::Syntax::Or;

sub new {
  my $type = shift;
  bless [@_], $type;
}

sub exprs { @{$_[0]} }

sub transform {
  my($self, $column) = @_;

  my $indent = (' ' x $column);

  sprintf('(%s)',
          join(sprintf("\n%s || ", $indent),
               map {
                 sprintf('&Blatte::true(%s)',
                         &Blatte::Syntax::transform($_, $column + 18));
               } $self->exprs()));
}

1;

__END__