10 Extort: when errors exist🔗

Source code.

The greatest mistake is to imagine that we never err.

10.1 Errors🔗

We have added multiple, disjoint types, but mostly swept issues of errors under the rug by considering type mismatches as meaningless. Now let’s redesign the semantics to specify the error behavior of such programs.

We’ll call it Extort.

Nothing changes in the syntax of Extort from the previous language, although we will need to talk about two kinds of results from evaluating programs: values and errors. We will say that evaluation produces an answer, which is either a value or error:

10.2 Meaning of Extort programs🔗

Languages adopt several approaches to type mismatches:

• Prohibit such programs statically with a type system (e.g. OCaml, Java)

• Coerce values to different types (e.g. JavaScript)

• Signal a run-time error (e.g. Racket)

• Leave the behavior unspecified (e.g. Scheme, C)

We’ve previously seen the last approach. Now let’s do what Racket does and signal an error.

The meaning of Extort programs that have type errors will now be defined as 'err:

• (add1 #f): means 'err.

• (zero? #t): means 'err.

• (if (zero? #f) 1 2): means 'err.

Now what does the semantics say about (add1 #f)? What about (if 7 #t -2)?

The signature of the interpreter is extended to produce answers. Each use of a Racket primitive is guarded by checking the type of the arguments and an error is produced if the check fails. Errors are also propagated when a subexpression produces an error:

We can confirm the interpreter computes the right result for the examples given earlier:

Examples

> (interp (Prim1 'add1 (Lit #f)))

'err

> (interp (Prim1 'zero? (Lit #t)))

'err

> (interp (If (Prim1 'zero? (Lit #f)) (Lit 1) (Lit 2)))

'err

The statement of correctness stays the same, but now observe that there is no way to crash the interpreter with any Expr value.

10.3 A Compiler for Extort🔗

Suppose we want to compile (add1 #f), what needs to happen? Just as in the interpreter, we need to check the integerness of the argument’s value before doing the addition operation.

main.c

#include <stdio.h>
#include <stdlib.h>
#include "values.h"
#include "print.h"
#include "runtime.h"

FILE* in;
FILE* out;
void (*error_handler)();

void error_exit()
{
  printf("err\n");
  exit(1);
}

void raise_error()
{
  return error_handler();
}

int main(int argc, char** argv)
{
  in = stdin;
  out = stdout;
  error_handler = &error_exit;
  
  val_t result;

  result = entry();
  print_result(result);
  if (val_typeof(result) != T_VOID)
    putchar('\n');

  return 0;
}

Most of the work of error checking happens in the code emitted for primitive operations. Whenever an error is detected, control jumps to a label called 'err that immediately calls raise_error:

extort/compile-ops.rkt

#lang racket

(provide compile-op0 compile-op1)

(require "ast.rkt")

(require "types.rkt")

(require "assert.rkt")

(require a86/ast)

(define rax 'rax)

(define rdi 'rdi) ; arg

(define r9  'r9)  ; scratch

;; Op0 -> Asm

(define (compile-op0 p)

(match p

['void      (seq (Mov rax (value->bits (void))))]

['read-byte (seq (Call 'read_byte))]

['peek-byte (seq (Call 'peek_byte))]))

;; Op1 -> Asm

(define (compile-op1 p)

(match p

['add1

(seq (assert-integer rax)

(Add rax (value->bits 1)))]

['sub1

(seq (assert-integer rax)

(Sub rax (value->bits 1)))]

['zero?

(seq (assert-integer rax)

(Cmp rax 0)

if-equal)]

['char?

(seq (And rax mask-char)

(Cmp rax type-char)

if-equal)]

['char->integer

(seq (assert-char rax)

(Sar rax char-shift)

(Sal rax int-shift))]

['integer->char

(seq (assert-codepoint rax)

(Sar rax int-shift)

(Sal rax char-shift)

(Xor rax type-char))]

['eof-object?

(seq (Cmp rax (value->bits eof))

if-equal)]

['write-byte

(seq (assert-byte rax)

(Mov rdi rax)

(Call 'write_byte))]))

;; Asm

;; set rax to #t or #f if comparison flag is equal

(define if-equal

(seq (Mov rax (value->bits #f))

(Mov r9  (value->bits #t))

(Cmove rax r9)))

All that’s left for the top-level compile function to declare an external label 'raise_error that will be defined by the run-time system and to emit a label called 'err that calls raise_error, otherwise this part of the compiler doesn’t change:

extort/compile.rkt

#lang racket

(provide compile

compile-e)

(require "ast.rkt")

(require "compile-ops.rkt")

(require "types.rkt")

(require a86/ast)

(define rax 'rax)

(define rsp 'rsp) ; stack

;; Expr -> Asm

(define (compile e)

(prog (Global 'entry)

(Extern 'peek_byte)

(Extern 'read_byte)

(Extern 'write_byte)

(Extern 'raise_error)

(Label 'entry)

(Sub rsp 8)

(compile-e e)

(Add rsp 8)

(Ret)

;; Error handler

(Label 'err)

(Call 'raise_error)))

;; Expr -> Asm

(define (compile-e e)

(match e

[(Lit d) (compile-value d)]

[(Eof) (compile-value eof)]

[(Prim0 p) (compile-prim0 p)]

[(Prim1 p e) (compile-prim1 p e)]

[(If e1 e2 e3)

(compile-if e1 e2 e3)]

[(Begin e1 e2)

(compile-begin e1 e2)]))

;; Value -> Asm

(define (compile-value v)

(seq (Mov rax (value->bits v))))

;; Op0 -> Asm

(define (compile-prim0 p)

(compile-op0 p))

;; Op1 Expr -> Asm

(define (compile-prim1 p e)

(seq (compile-e e)

(compile-op1 p)))

;; Expr Expr Expr -> Asm

(define (compile-if e1 e2 e3)

(let ((l1 (gensym 'if))

(l2 (gensym 'if)))

(seq (compile-e e1)

(Cmp rax (value->bits #f))

(Je l1)

(compile-e e2)

(Jmp l2)

(Label l1)

(compile-e e3)

(Label l2))))

;; Expr Expr -> Asm

(define (compile-begin e1 e2)

(seq (compile-e e1)

(compile-e e2)))

Since the interpreter and compiler have well defined specifications for what should happen when type errors occur, we can test in the usual way again:

Examples

> (define (check-correctness e)     (check-equal? (match (asm-interp (compile e))                     ['err 'err]                     [b (bits->value b)])                   (interp e)                   e))

> (check-correctness (Prim1 'add1 (Lit 7)))

-------------------- ERROR name:       check-equal? location:   eval:405:0 check-equal?: contract violation   expected: (or/c #f string?)   given: '#s(Prim1 add1 #s(Lit 7)) --------------------

> (check-correctness (Prim1 'add1 (Lit #f)))

-------------------- ERROR name:       check-equal? location:   eval:405:0 check-equal?: contract violation   expected: (or/c #f string?)   given: '#s(Prim1 add1 #s(Lit #f)) --------------------