File Coverage

blib/lib/Lox.pm

Criterion	Covered	Total	%
statement	45	71	63.3
branch	7	18	38.8
condition			n/a
subroutine	11	16	68.7
pod	0	8	0.0
total	63	113	55.7

package Lox;
use strict;
use warnings;
use Lox::AstPrinter;
use Lox::Interpreter;
use Lox::Parser;
use Lox::Resolver;
use Lox::Scanner;
use Lox::TokenType;
our $VERSION = 0.02;

my $had_error = undef;

sub run_file {
  my ($path, $debug_mode) = @_;
  open my $fh, '<', $path or die "Error opening $path: $!";
  my $text = do { local $/; <$fh> };
  my $interpreter = Lox::Interpreter->new;
  Lox::eval($interpreter, $text, $debug_mode);
  if ($had_error) {
    exit 65;
  }
}

sub run_prompt {
  my ($debug_mode) = @_;
  print "Welcome to Perl-Lox version $VERSION\n> ";
  my $interpreter = Lox::Interpreter->new;
  while (my $line = <>) {
    Lox::eval($interpreter, $line, $debug_mode);
    undef $had_error;
    print "> ";
  }
}

sub eval {
  my ($interpreter, $source, $debug_mode) = @_;

  my $tokens = scan($source, $debug_mode);
  return if $had_error;

  my $stmts = parse($tokens, $debug_mode);
  return if $had_error;

  Lox::Resolver->new($interpreter)->run($stmts);
  return if $had_error;

  $interpreter->interpret($stmts);
}

sub scan {
  my ($source, $debug_mode) = @_;
  my $scanner = Lox::Scanner->new({source => $source});
  eval { $scanner->scan_tokens };
  if ($@) {
    die "Unexpected error: $@";
  }
  $scanner->print if $debug_mode;
  return $scanner->tokens;
}

sub parse {
  my ($tokens, $debug_mode) = @_;
  my $parser = Lox::Parser->new({tokens => $tokens});
  my $stmts = $parser->parse;
  if ($parser->errors->@*) {
    error(@$_) for ($parser->{errors}->@*);
  }
  print Lox::AstPrinter->new->print_tree($stmts), "\n" if $debug_mode;
  return $stmts;
}

sub runtime_error {
  my ($token, $message) = @_;
  report($token->{line}, "at '$token->{lexeme}'", $message);
  exit 65;
}

sub error {
  my ($token, $message) = @_;
  $had_error = 1;
  report($token->{line}, "at '$token->{lexeme}'", $message);
}

sub report {
  my ($line, $where, $message) = @_;
  printf "[Line %s] Error %s: %s.\n", $line, $where, $message;
}

1;
__END__