15.1. The Built in error Primitive

All the error builtin has to do is to print its argument message and restart the repl. In order to restart the repl it must have a continuation to do that, therefore much like the print special form, our error will have to be initialised with arguments, this time both the output filehandle on which to print the error, and the continuation to invoke afterwards. Here's how we wire it in to the repl.

 35 sub ReadEvalPrint {
 36     my ($infh, $outfh) = @_;
 37 
 38     $outfh ||= new FileHandle(">-");
 39     my $reader      = new PScm::Read($infh);
 40     my $initial_env;
 41     $initial_env = new PScm::Env(
 42         let          => new PScm::SpecialForm::Let(),
 43         '*'          => new PScm::Primitive::Multiply(),
 44         '-'          => new PScm::Primitive::Subtract(),
 45         '+'          => new PScm::Primitive::Add(),
 46         if           => new PScm::SpecialForm::If(),
 47         lambda       => new PScm::SpecialForm::Lambda(),
 48         list         => new PScm::Primitive::List(),
 49         car          => new PScm::Primitive::Car(),
 50         cdr          => new PScm::Primitive::Cdr(),
 51         cons         => new PScm::Primitive::Cons(),
 52         letrec       => new PScm::SpecialForm::LetRec(),
 53         'let*'       => new PScm::SpecialForm::LetStar(),
 54         eval         => new PScm::SpecialForm::Eval(),
 55         macro        => new PScm::SpecialForm::Macro(),
 56         quote        => new PScm::SpecialForm::Quote(),
 57         'set!'       => new PScm::SpecialForm::Set(),
 58         begin        => new PScm::SpecialForm::Begin(),
 59         define       => new PScm::SpecialForm::Define(),
 60         'make-class' => new PScm::SpecialForm::MakeClass(),
 61         'call/cc'    => new PScm::SpecialForm::CallCC(),
 62         print        => new PScm::SpecialForm::Print($outfh),
 63         spawn        => new PScm::SpecialForm::Spawn(),
 64         exit         => new PScm::SpecialForm::Exit(),
 65         error        => new PScm::SpecialForm::Error(
 66                         $outfh,
 67                         cont { repl($initial_env, $reader, $outfh) }
 68                      ),
 69     );
 70 
 71     $initial_env->Define(
 72         PScm::Expr::Symbol->new("root"),
 73         PScm::Class::Root->new($initial_env)
 74     );
 75     __PACKAGE__->new_thread(cont { repl($initial_env, $reader, $outfh) });
 76     trampoline();
 77 }

You can see the token “error” being bound to a new PScm::SpecialForm::Error object, and the constructor for that object is passed both the current $outfh and a continuation which just calls repl() with appropriate arguments.

The constructor for PScm::SpecialForm::Error just stashes its arguments:

348 sub new {
349     my ($class, $outfh, $cont) = @_;
350     bless {
351         outfh => $outfh,
352         cont => $cont,
353     }, $class;
354 }

When we invoke error with for example (error "my error message") its Apply() method is invoked. Here it is:

356 sub Apply {
357     my ($self, $form, $env, $cont) = @_;
358 
359     $form->first->Eval($env, cont {
360         my ($msg) = @_;
361         $self->do_error($msg->display_string());
362     });
363 }

It has to use CPS because the error message itself might be computed, we can't just assume that it is already a string. So it Eval()'s the message, passing in a continuation that will first of all convert the resulting message to a string suitable for display, and then call a secondary method do_error() on that string. the display_string() method is defined in PScm::Expr to just call as_string():

 36 sub display_string { $_[0]->as_string() }

but PScm::Expr::String overrides this to call $self->value() instead:

276 sub display_string { $_[0]->value }

The upshot of this is that the error message, if it's a PScm::Expr::String, won't be wrapped in quotes when printed which is what the PScm::Expr::String::as_string() method would have done.

Returning to PScm::SpecialForm::Error, do_error() is also quite simple:

365 sub do_error {
366     my ($self, $errstr) = @_;
367     $errstr =~ s/\n$//;
368     $self->{outfh}->print("Error: ", $errstr, "\n");
369     return $self->{cont};
370 }

It expects only a simple perl string. it strips any trailing newline from the error message, prints it to the stored output file handle, then returns the stored continuation to the trampoline. That continuation will restart the repl, skipping the print stage of the current loop.

Apart from making the code a little easier on the eye, there is another reason for having a separate do_error() method, and that brings us to the second part of this chapter.

15.2. Using the error Builtin for Internal Errors

It would be very useful if we could avail ourselves of this error builtin to report and recover from internal errors such as type check and variable lookup failures. This is actually easy to do. All we have to do is look up the error handler in the current environment and invoke its do_error() method. A new method Error() in the PScm base class does exactly this, and so is available everywhere:

119 sub Error {
120     my ($self, $msg, $env) = @_;
121     my $error = $env->LookUp(new PScm::Expr::Symbol('error'));
122     $error->do_error($msg);
123 }

The only thing it has to be careful of is that it calls do_error() in tail position, so that the continuation gets returned to the trampoline.

Let's look at a few places where we can make use of this new method. If you remember, way back in Section 3.6 we saw how the various primitive operations made use of a check_type() method, which would die if the argument object was not of the desired type. Now we can cheat a little, and rather than rewriting those primitives in CPS, we just catch the error with a (Perl) eval in the shared PScm::Primitive::Apply() method, and call Error() with argument $@ if an error was detected. Here's the previous version of that PScm::Primitive::Apply():

  8 sub Apply {
  9     my ($self, $form, $env, $cont) = @_;
 10 
 11     $form->map_eval(
 12         $env,
 13         cont {
 14             my ($evaluated_args) = @_;
 15             $cont->Cont($self->_apply($evaluated_args->value));
 16         }
 17     );
 18 }

and here's the changes:

  8 sub Apply {
  9     my ($self, $form, $env, $cont) = @_;
 10 
 11     $form->map_eval(
 12         $env,
 13         cont {
 14             my ($evaluated_args) = @_;
 15             my $result = eval {
 16                 $self->_apply($evaluated_args->value);
 17             };
 18             if ($@) {
 19                 $self->Error($@, $env);
 20             } else {
 21                 $cont->Cont($result);
 22             }
 23         }
 24     );
 25 }

It is safe for Apply(), on Line 16 to evaluate the individual primitive separately, since it is not in CPS form. Then all it has to do is either call the current continuation on the result, or invoke Error() with $@, both calls being in tail position.

Apart from primitive expressions, another place where we throw an exception on a recoverable error is in the LookUp() method of PScm::Env, when we don't find a binding for a variable. Unfortunately LookUp() was treated as a simple expression in our CPS rewrite, so we need to backtrack to find the CPS code that invokes LookUp() in order to install the error handling. Fortunately there is only one place where that happens, when a symbol is evaluated. Here's the previous PScm::Expr::Symbol::Eval().

103 sub Eval {
104     my ($self, $env, $cont) = @_;
105     $cont->Cont($env->LookUp($self));
106 }

and the changes:

230 sub Eval {
231     my ($self, $env, $cont) = @_;
232     my $result = eval { $env->LookUp($self) };
233     if ($@) {
234         $self->Error($@, $env);
235     } else {
236         $cont->Cont($result);
237     }
238 }

Again, as with the primitive Apply() above, it is safe for it to execute the LookUp() first, since LookUp() is not in CPS. Then, depending on $@, it either invokes Error() or calls the continuation on the result of the lookup.

We next make an identical change to PScm::SpecialForm::Set::Apply(). If you remember the set! special form uses PScm::Env::Assign() to replace an existing binding with a new value, and it is an error if Assign() can't find a binding to change. It is Assign() that dies if the binding is not found, and since Assign() is a simple expression that has not been rewritten into CPS, PScm::SpecialForm::Set::Apply() must trap the exception and throw the PScheme error. Firstly here's PScm::SpecialForm::Set::Apply() before the changes:

197 sub Apply {
198     my ($self, $form, $env, $cont) = @_;
199     my ($symbol, $expr) = $form->value;
200     $expr->Eval(
201         $env,
202         cont {
203             my ($val) = @_;
204             $cont->Cont($env->Assign($symbol, $val));
205         }
206     );
207 }

and here's the changes:

197 sub Apply {
198     my ($self, $form, $env, $cont) = @_;
199     my ($symbol, $expr) = $form->value;
200     $expr->Eval(
201         $env,
202         cont {
203             my ($val) = @_;
204             my $result = eval { $env->Assign($symbol, $val) };
205             if ($@) {
206                 $self->Error($@, $env);
207             } else {
208                 $cont->Cont($result);
209             }
210         }
211     );
212 }

Another place where we died was in PScm::Env::_populate_bindings() where we handle the possibility of dot notation and single values in the formal arguments to a lambda expression. This routine is only called by ExtendUnevaluated(), but unfortunately ExtendUnevaluated() is not yet in CPS form. In this case, because ExtendUnevaluated() is called from a number of places and all those places would have to be aware that ExtendUnevaluated() could throw a Perl exception, it seems better to rewrite ExtendUnevaluated() into CPS, and change its callers to use the CPS form. Here's the CPS version of ExtendUnevaluated().

 38 sub ExtendUnevaluated {
 39     my ($self, $symbols, $values, $cont) = @_;
 40 
 41     my %bindings;
 42     eval {
 43         $self->_populate_bindings(\%bindings, $symbols, $values);
 44     };
 45     if ($@) {
 46         $self->Error($@, $self);
 47     } else {
 48         my $newenv = $self->new(%bindings);
 49         $newenv->{parent} = $self;
 50         $cont->Cont($newenv);
 51     }
 52 }

Most of the methods that call ExtendUnevaluated() are already in CPS so we don't really need to see the changes to them. One method, make_instance() in PScm::Class is not in CPS, so we need to rewrite that too:

 48 sub make_instance {
 49     my ($self, $cont) = @_;
 50 
 51     $self->{parent}->make_instance(cont {
 52         my ($parent_instance) = @_;
 53 
 54         $self->{env}->ExtendUnevaluated(
 55             new PScm::Expr::List(
 56                 PScm::Expr::Symbol->new("class"),    # $self
 57                 PScm::Expr::Symbol->new("super"),    # $parent_instance
 58                 @{ $self->{fields} },                # 0...
 59             ),
 60             new PScm::Expr::List(
 61                 $self,                               # "class"
 62                 PScm::Env::Super->new(super => $parent_instance)
 63                 ,                                    # "super"
 64                 ((PScm::Expr::Number->new(0)) x @{ $self->{fields} })
 65                 ,                                    # field...
 66             ),
 67             $cont
 68         );
 69     });
 70 }

And the equivalent method in PScm::Class::Root:

 98 sub make_instance {
 99     my ($self, $cont) = @_;
100 
101     $self->{env}->ExtendUnevaluated(
102         new PScm::Expr::Symbol("class"),
103         $self,
104         $cont
105     );
106 }

The caller of make_instance(), PScm::Class::Apply(), was already in CPS so transforming that to call the CPS form of make_instance() is trivial:

 33 sub Apply {
 34     my ($self, $form, $env, $cont) = @_;
 35 
 36     $self->make_instance( cont {
 37         my ($new_object) = @_;
 38         $new_object->call_method(
 39             $new_object,
 40             "init", $form, $env,
 41             cont {
 42                 $cont->Cont($new_object);
 43             }
 44         );
 45     });
 46 }

The last place where we die unnecessarily is in PScm::Env::CallMethodOrDie() where it is an error if a method can not be found. Fortunately CallMethodOrDie() is already in CPS so it is even easier to change. Here's the original:

209 sub CallMethodOrDie {
210     my ($self, $this, $method, $args, $env, $cont) = @_;
211     $self->call_method(
212         $this,
213         $method->value,
214         $args, $env,
215         cont {
216             my ($res) = @_;
217             if (defined $res) {
218                 $cont->Cont($res);
219             } else {
220                 die "method ", $method->value, " not found\n";
221             }
222         }
223     );
224 }

and here are the changes:

213 sub CallMethodOrDie {
214     my ($self, $this, $method, $args, $env, $cont) = @_;
215     $self->call_method(
216         $this,
217         $method->value,
218         $args, $env,
219         cont {
220             my ($res) = @_;
221             if (defined $res) {
222                 $cont->Cont($res);
223             } else {
224                 $self->Error(
225                     "method " . $method->value . " not found\n",
226                     $env
227                 );
228             }
229         }
230     );
231 }

Very simple: the die was already in tail position, so where it used to die, it invokes Error() instead.

15.3. Tests

A few simple tests for error are in Listing 29. Primarily, besides demonstrating that the error builtin works, they show that the repl is still up and running afterwards.

  1 use strict;
  2 use warnings;
  3 use Test::More;
  4 use lib 't/lib';
  5 use PScm::Test tests => 8;
  6 
  7 BEGIN { use_ok('PScm') }
  8 
  9 eval_ok(<<EOF, <<EOR, 'built in error');
 10 (define div
 11   (lambda (numerator denominator)
 12     (if denominator
 13         (/ numerator denominator)
 14         (error "division by zero"))))
 15 (+ (div 2 0) 1)
 16 EOF
 17 div
 18 Error: division by zero
 19 EOR
 20 
 21 eval_ok(<<EOF, <<EOR, 'argument to error need not be a string');
 22 (error '(an error "message"))
 23 EOF
 24 Error: (an error "message")
 25 EOR
 26 
 27 eval_ok(<<EOF, <<EOR, 'internal type error and recovery');
 28 (* 2 "2")
 29 (* 2 2)
 30 EOF
 31 Error: wrong type argument(PScm::Expr::String) to PScm::Primitive::Multiply
 32 4
 33 EOR
 34 
 35 eval_ok(<<EOF, <<EOR, 'internal lookup error and recovery');
 36 x
 37 2
 38 EOF
 39 Error: no binding for x in PScm::Env
 40 2
 41 EOR
 42 
 43 eval_ok(<<EOF, <<EOR, 'method lookup error and recovery');
 44 (define testclass
 45   (make-class
 46     root
 47     ()
 48     (say-hello () 'hello)))
 49 (define testobj (testclass))
 50 (testobj say-goodbye)
 51 (testobj say-hello)
 52 EOF
 53 testclass
 54 testobj
 55 Error: method say-goodbye not found
 56 hello
 57 EOR
 58 
 59 eval_ok(<<EOF, <<EOR, 'set! error and recovery');
 60 (set! x 1)
 61 2
 62 EOF
 63 Error: no binding for x in PScm::Env
 64 2
 65 EOR
 66 
 67 eval_ok(<<EOF, <<EOR, 'lambda error and recovery');
 68 (define test
 69   (lambda (a b c)
 70     (list a b c)))
 71 (test 1 2)
 72 2
 73 EOF
 74 test
 75 Error: not enough arguments
 76 2
 77 EOR
 78 
 79 # vim: ft=perl