فهرست منبع

updates to interp and type-check

Jeremy Siek 4 سال پیش
والد
کامیت
5c6eaed2a1
1فایلهای تغییر یافته به همراه476 افزوده شده و 264 حذف شده
  1. 476 264
      book.tex

+ 476 - 264
book.tex

@@ -81,8 +81,8 @@
 \lstset{%
 \lstset{%
 language=Lisp,
 language=Lisp,
 basicstyle=\ttfamily\small,
 basicstyle=\ttfamily\small,
-morekeywords={seq,assign,program,block,define,lambda,match,goto,if,else,then,struct,Integer,Boolean,Vector,Void,while,begin},
-deletekeywords={read,mapping},
+morekeywords={seq,assign,program,block,define,lambda,match,goto,if,else,then,struct,Integer,Boolean,Vector,Void,while,begin,define,public,override,class},
+deletekeywords={read,mapping,vector},
 escapechar=|,
 escapechar=|,
 columns=flexible,
 columns=flexible,
 moredelim=[is][\color{red}]{~}{~},
 moredelim=[is][\color{red}]{~}{~},
@@ -1185,6 +1185,129 @@ $52$ then $10$, the following produces $42$ (not $-42$).
 (let ([x (read)]) (let ([y (read)]) (+ x (- y))))
 (let ([x (read)]) (let ([y (read)]) (+ x (- y))))
 \end{lstlisting}
 \end{lstlisting}
 
 
+\subsection{Extensible Interpreters via Method Overriding}
+
+To prepare for discussing the interpreter for $R_1$, we need to
+explain why we choose to implement the interpreter using
+object-oriented programming, that is, as a collection of methods
+inside of a class. Throughout this book we define many interpreters,
+one for each of the languages that we study. Because each language
+builds on the prior one, there is a lot of commonality between their
+interpreters. We want to write down those common parts just once
+instead of many times. A naive approach would be to have, for example,
+the interpreter for $R_2$ handle all of the new features in that
+language and then have a default case that dispatches to the
+interpreter for $R_1$. The follow code sketches this idea.
+\begin{center}
+  \begin{minipage}{0.45\textwidth}
+\begin{lstlisting}
+(define (interp-R1 e)
+  (match e
+    [(Prim '- (list e))
+     (define v (interp-R1 e))
+     (fx- 0 v)]
+    ...
+    ))
+\end{lstlisting}
+\end{minipage}
+\begin{minipage}{0.45\textwidth}
+  \begin{lstlisting}
+(define (interp-R2 e)
+  (match e
+    [(If cnd thn els)
+     (define b (interp-R2 cnd))
+     (match b
+       [#t (interp-R2 thn)]
+       [#f (interp-R2 els)])]
+    ...
+    [else (interp-R1 e)]  
+    ))    
+\end{lstlisting}
+\end{minipage}
+\end{center}
+The problem with this approach is that it does not handle situations
+in which an $R_2$ feature, like \code{If}, is nested inside an $R_1$
+feature, like the \code{-} operator, as in the following program.
+\begin{lstlisting}
+(Prim '- (list (If (Bool #t) (Int 42) (Int 0))))
+\end{lstlisting}
+If we invoke \code{interp-R2} on this program, it dispatches to
+\code{interp-R1} to handle the \code{-} operator, but then it
+recurisvely calls \code{interp-R1} again on the argument of \code{-},
+which is an \code{If}.  But there is no case for \code{If} in
+\code{interp-R1}, so we get an error!
+
+To make our intepreters extensible we need something called \emph{open
+  recursion}\index{open recursion}. That is, a recursive call should
+always invoke the ``top'' interpreter, even if the recursive call is
+made from interpreters that are lower down.  Object-oriented languages
+provide open recursion in the form of method overriding\index{method
+  overriding}. The follow code sketches this idea for interpreting
+$R_1$ and $R_2$ using the
+\href{https://docs.racket-lang.org/guide/classes.html}{\code{class}}
+\index{class} feature of Racket.  We define one class for each
+language and place a method for interpreting expressions inside each
+class. The class for $R_2$ inherits from the class for $R_1$ and the
+method \code{interp-exp} for $R_2$ overrides the \code{interp-exp} for
+$R_1$. Note that the default case in \code{interp-exp} for $R_2$ uses
+\code{super} to invoke \code{interp-exp}, and because $R_2$ inherits
+from $R_1$, that dispatches to the \code{interp-exp} for $R_1$.
+\begin{center}
+\begin{minipage}{0.45\textwidth}
+\begin{lstlisting}
+(define interp-R1-class
+  (class object%
+    (define/public (interp-exp e)
+      (match e
+        [(Prim '- (list e))
+         (define v (interp-exp e))
+         (fx- 0 v)]
+        ...
+        ))
+    ...
+  ))
+\end{lstlisting}
+\end{minipage}
+\begin{minipage}{0.45\textwidth}
+  \begin{lstlisting}
+(define interp-R2-class
+  (class interp-R1-class
+    (define/override (interp-exp e)
+      (match e
+        [(If cnd thn els)
+         (define b (interp-exp cnd))
+         (match b
+           [#t (interp-exp thn)]
+           [#f (interp-exp els)])]
+        ...
+        [else (super interp-exp e)]  
+        ))
+    ...
+  ))
+\end{lstlisting}
+\end{minipage}
+\end{center}
+Getting back to the troublesome example, repeated here:
+\begin{lstlisting}
+(define e0 (Prim '- (list (If (Bool #t) (Int 42) (Int 0)))))
+\end{lstlisting}
+We can invoke the \code{interp-exp} method for $R_2$ on this
+expression by creating an object of the $R_2$ class and sending it the
+\code{interp-exp} method with the argument \code{e0}.
+\begin{lstlisting}
+(send (new interp-R2-class) interp-exp e0)
+\end{lstlisting}
+This will again hit the default case and dispatch to the
+\code{interp-exp} method for $R_1$, which will handle the \code{-}
+operator. But then for the recursive method call, it will dispatch
+back to \code{interp-exp} for $R_2$, where the \code{If} will be
+correctly handled. Thus, method overriding gives us the open recursion
+that we need to implement our interpreters in an extensible way.
+
+\newpage
+
+\subsection{Definitional Interpreter for $R_1$}
+
 \begin{wrapfigure}[24]{r}[1.0in]{0.6\textwidth}
 \begin{wrapfigure}[24]{r}[1.0in]{0.6\textwidth}
   \small
   \small
   \begin{tcolorbox}[title=Association Lists as Dictionaries]
   \begin{tcolorbox}[title=Association Lists as Dictionaries]
@@ -1219,12 +1342,14 @@ $52$ then $10$, the following produces $42$ (not $-42$).
 \end{tcolorbox}
 \end{tcolorbox}
 \end{wrapfigure}
 \end{wrapfigure}
 
 
-Figure~\ref{fig:interp-R1} shows the definitional interpreter for the
-$R_1$ language. It extends the interpreter for $R_0$ with two new
-\key{match} clauses for variables and for \key{let}.  For \key{let},
-we need a way to communicate the value of a variable to all the uses
-of a variable. To accomplish this, we maintain a mapping from
-variables to values. Throughout the compiler we often need to map
+Now that we have explained why we use classes and methods to implement
+interpreters, we turn to the discussion of the actual interpreter for
+$R_1$.  Figure~\ref{fig:interp-R1} shows the definitional interpreter
+for the $R_1$ language. It is similar to the interpreter for $R_0$ but
+it adds two new \key{match} clauses for variables and for \key{let}.
+For \key{let}, we need a way to communicate the value of a variable to
+all the uses of a variable. To accomplish this, we maintain a mapping
+from variables to values. Throughout the compiler we often need to map
 variables to information about them. We refer to these mappings as
 variables to information about them. We refer to these mappings as
 \emph{environments}\index{environment}
 \emph{environments}\index{environment}
 \footnote{Another common term for environment in the compiler
 \footnote{Another common term for environment in the compiler
@@ -1242,31 +1367,39 @@ environment with the result value bound to the variable, using
 
 
 \begin{figure}[tp]
 \begin{figure}[tp]
 \begin{lstlisting}
 \begin{lstlisting}
-(define (interp-exp env)
-  (lambda (e)
-    (match e
-      [(Int n) n]
-      [(Prim 'read '())
-       (define r (read))
-       (cond [(fixnum? r) r]
-             [else (error 'interp-R1 "expected an integer" r)])]
-      [(Prim '- (list e))
-       (define v ((interp-exp env) e))
-       (fx- 0 v)]
-      [(Prim '+ (list e1 e2))
-       (define v1 ((interp-exp env) e1))
-       (define v2 ((interp-exp env) e2))
-       (fx+ v1 v2)]
-      [(Var x) (dict-ref env x)]
-      [(Let x e body)
-       (define new-env (dict-set env x ((interp-exp env) e)))
-       ((interp-exp new-env) body)]
-      )))
+(define interp-R1-class
+  (class object%
+    (super-new)
+    
+    (define/public (interp-exp env)
+      (lambda (e)
+        (match e
+          [(Int n) n]
+          [(Prim 'read '())
+           (define r (read))
+           (cond [(fixnum? r) r]
+                 [else (error 'interp-exp "expected an integer" r)])]
+          [(Prim '- (list e))
+           (define v ((interp-exp env) e))
+           (fx- 0 v)]
+          [(Prim '+ (list e1 e2))
+           (define v1 ((interp-exp env) e1))
+           (define v2 ((interp-exp env) e2))
+           (fx+ v1 v2)]
+          [(Var x) (dict-ref env x)]
+          [(Let x e body)
+           (define new-env (dict-set env x ((interp-exp env) e)))
+           ((interp-exp new-env) body)]
+          )))
+
+    (define/public (interp-program p)
+      (match p
+        [(Program '() e) ((interp-exp '()) e)]
+        ))
+    ))
 
 
 (define (interp-R1 p)
 (define (interp-R1 p)
-  (match p
-    [(Program '() e) ((interp-exp '()) e)]
-    ))
+  (send (new interp-R1-class) interp-program p))
 \end{lstlisting}
 \end{lstlisting}
 \caption{Interpreter for the $R_1$ language.}
 \caption{Interpreter for the $R_1$ language.}
 \label{fig:interp-R1}
 \label{fig:interp-R1}
@@ -4204,8 +4337,8 @@ Section~\ref{sec:type-check-r2}.
 \label{fig:r2-syntax}
 \label{fig:r2-syntax}
 \end{figure}
 \end{figure}
 
 
-Figure~\ref{fig:interp-R2} defines the interpreter for $R_2$, omitting
-the parts that are the same as the interpreter for $R_1$
+Figure~\ref{fig:interp-R2} defines the interpreter for $R_2$,
+inheriting from the interpreter for $R_1$
 (Figure~\ref{fig:interp-R1}). The literals \code{\#t} and \code{\#f}
 (Figure~\ref{fig:interp-R1}). The literals \code{\#t} and \code{\#f}
 evaluate to the corresponding Boolean values. The conditional
 evaluate to the corresponding Boolean values. The conditional
 expression $(\key{if}\, \itm{cnd}\,\itm{thn}\,\itm{els})$ evaluates
 expression $(\key{if}\, \itm{cnd}\,\itm{thn}\,\itm{els})$ evaluates
@@ -4219,62 +4352,83 @@ $e_1$ evaluates to \code{\#f}.
 
 
 With the increase in the number of primitive operations, the
 With the increase in the number of primitive operations, the
 interpreter code for them could become repetitive without some
 interpreter code for them could become repetitive without some
-care. In Figure~\ref{fig:interp-R2} we factor out the different parts
-of the code for primitive operations into the \code{interp-op}
-function and the similar parts of the code into the match clause for
-\code{Prim} shown in Figure~\ref{fig:interp-R2}. We do not use
-\code{interp-op} for the \code{and} operation because of the
-short-circuiting behavior in the order of evaluation of its arguments.
+care. We factor out the different parts of the code for primitive
+operations into the \code{interp-op} method shown in in
+Figure~\ref{fig:interp-op-R2}. The match clause for \code{Prim} makes
+the recursive calls to interpret the arguments and then passes the
+resulting values to \code{interp-op}. We do not use \code{interp-op}
+for the \code{and} operation because of its short-circuiting behavior.
+
+\begin{figure}[tbp]
+\begin{lstlisting}
+(define interp-R2-class
+  (class interp-R1-class
+    (super-new)
+
+    (define/public (interp-op op) ...)
+
+    (define/override (interp-exp env)
+      (lambda (e)
+        (define recur (interp-exp env))
+        (match e
+          [(Bool b) b]
+          [(If cnd thn els)
+           (define b (recur cnd))
+           (match b
+             [#t (recur thn)]
+             [#f (recur els)])]
+          [(Prim 'and (list e1 e2))
+           (define v1 (recur e1))
+           (match v1
+             [#t (match (recur e2) [#t #t] [#f #f])]
+             [#f #f])]
+          [(Prim op args)
+           (apply (interp-op op) (for/list ([e args]) (recur e)))]
+          [else ((super interp-exp env) e)]
+          )))
+    ))
 
 
+(define (interp-R2 p)
+  (send (new interp-R2-class) interp-program p))
+\end{lstlisting}
+\caption{Interpreter for the $R_2$ language. (See
+  Figure~\ref{fig:interp-op-R2} for \code{interp-op}.)}
+\label{fig:interp-R2}
+\end{figure}
 
 
 \begin{figure}[tbp]
 \begin{figure}[tbp]
 \begin{lstlisting}
 \begin{lstlisting}
-(define (interp-op op)
+(define/public (interp-op op)
   (match op
   (match op
-    ...
+    ['+ fx+]
+    ['- fx-]
+    ['read read-fixnum]
     ['not (lambda (v) (match v [#t #f] [#f #t]))]
     ['not (lambda (v) (match v [#t #f] [#f #t]))]
+    ['or (lambda (v1 v2)
+           (cond [(and (boolean? v1) (boolean? v2))
+                  (or v1 v2)]))]
     ['eq? (lambda (v1 v2)
     ['eq? (lambda (v1 v2)
             (cond [(or (and (fixnum? v1) (fixnum? v2))
             (cond [(or (and (fixnum? v1) (fixnum? v2))
-                       (and (boolean? v1) (boolean? v2)))
+                       (and (boolean? v1) (boolean? v2))
+                       (and (vector? v1) (vector? v2)))
                    (eq? v1 v2)]))]
                    (eq? v1 v2)]))]
     ['< (lambda (v1 v2)
     ['< (lambda (v1 v2)
-          (cond [(and (fixnum? v1) (fixnum? v2)) (< v1 v2)]))]
+          (cond [(and (fixnum? v1) (fixnum? v2))
+                 (< v1 v2)]))]
     ['<= (lambda (v1 v2)
     ['<= (lambda (v1 v2)
-           (cond [(and (fixnum? v1) (fixnum? v2)) (<= v1 v2)]))]
+           (cond [(and (fixnum? v1) (fixnum? v2))
+                  (<= v1 v2)]))]
     ['> (lambda (v1 v2)
     ['> (lambda (v1 v2)
-          (cond [(and (fixnum? v1) (fixnum? v2)) (> v1 v2)]))]
+          (cond [(and (fixnum? v1) (fixnum? v2))
+                 (> v1 v2)]))]
     ['>= (lambda (v1 v2)
     ['>= (lambda (v1 v2)
-           (cond [(and (fixnum? v1) (fixnum? v2)) (>= v1 v2)]))]
-    [else (error 'interp-op "unknown operator")]))
-
-(define (interp-exp env)
-  (lambda (e)
-    (define recur (interp-exp env))
-    (match e
-      ...
-      [(Bool b) b]
-      [(If cnd thn els)
-       (define b (recur cnd))
-       (match b
-         [#t (recur thn)]
-         [#f (recur els)])]
-      [(Prim 'and (list e1 e2))
-       (define v1 (recur e1))
-       (match v1
-         [#t (match (recur e2) [#t #t] [#f #f])]
-         [#f #f])]
-      [(Prim op args)
-       (apply (interp-op op) (for/list ([e args]) (recur e)))]
-      )))
-
-(define (interp-R2 p)
-  (match p
-    [(Program info e)
-     ((interp-exp '()) e)]
+           (cond [(and (fixnum? v1) (fixnum? v2))
+                  (>= v1 v2)]))]
+    [else (error 'interp-op "unknown operator")]
     ))
     ))
 \end{lstlisting}
 \end{lstlisting}
-\caption{Interpreter for the $R_2$ language.}
-\label{fig:interp-R2}
+\caption{Interpreter for the primitive operators in the $R_2$ language.}
+\label{fig:interp-op-R2}
 \end{figure}
 \end{figure}
 
 
 
 
@@ -4307,118 +4461,141 @@ checker enforces the rule that the argument of \code{not} must be a
    (not (+ 10 (- (+ 12 20))))
    (not (+ 10 (- (+ 12 20))))
 \end{lstlisting}
 \end{lstlisting}
 
 
-The type checker for $R_2$ is a structurally recursive function over
-the AST. Figure~\ref{fig:type-check-R2} defines the
-\code{type-check-exp} function. The code for the type checker is in
-the file \code{type-check-R2.rkt} of the support code.
+We implement type checking using classes and method overriding for the
+same reason that we use them to implement the interpreters. We
+separate the type checker for the $R_1$ fragment into its own class,
+shown in Figure~\ref{fig:type-check-R1}. The type checker for $R_2$ is
+shown in Figure~\ref{fig:type-check-R2}; inherits from the one for
+$R_1$. The code for these type checkers are in the files
+\code{type-check-R1.rkt} and \code{type-check-R2.rkt} of the support
+code.
 %
 %
-Given an input expression \code{e}, the type checker either returns a
-type (\key{Integer} or \key{Boolean}) or it signals an error.  The
-type of an integer literal is \code{Integer} and the type of a Boolean
-literal is \code{Boolean}.  To handle variables, the type checker uses
-the environment \code{env} to map variables to types. Consider the
-clause for \key{let}.  We type check the initializing expression to
-obtain its type \key{T} and then associate type \code{T} with the
-variable \code{x} in the environment used to type check the body of
-the \key{let}. Thus, when the type checker encounters a use of
-variable \code{x}, it can find its type in the environment.
+Each type checker is a structurally recursive function over the AST.
+Given an input expression \code{e}, the type checker either signals an
+error or returns an expression and its type (\key{Integer} or
+\key{Boolean}). There are situations in which we want to change or
+update the expression.
+%
+The type of an integer literal is \code{Integer} and
+the type of a Boolean literal is \code{Boolean}.  To handle variables,
+the type checker uses the environment \code{env} to map variables to
+types. Consider the clause for \key{let}.  We type check the
+initializing expression to obtain its type \key{T} and then associate
+type \code{T} with the variable \code{x} in the environment used to
+type check the body of the \key{let}. Thus, when the type checker
+encounters a use of variable \code{x}, it can find its type in the
+environment.
 
 
 \begin{figure}[tbp]
 \begin{figure}[tbp]
 \begin{lstlisting}[basicstyle=\ttfamily\footnotesize]
 \begin{lstlisting}[basicstyle=\ttfamily\footnotesize]
-(define (type-check-exp env)
-  (lambda (e)
-    (match e
-      [(Var x)
-       (let ([t (dict-ref env x)])
-         (values (Var x) t))]
-      [(Int n) (values (Int n) 'Integer)]
-      [(Bool b) (values (Bool b) 'Boolean)]
-      [(Let x e body)
-       (define-values (e^ Te) ((type-check-exp env) e))
-       (define-values (b Tb) ((type-check-exp (dict-set env x Te)) body))
-       (values (Let x e^ b) Tb)]
-      [(If cnd thn els)
-       (define-values (c Tc) ((type-check-exp env) cnd))
-       (define-values (t Tt) ((type-check-exp env) thn))
-       (define-values (e Te) ((type-check-exp env) els))
-       (unless (type-equal? Tc 'Boolean)
-         (error 'type-check-exp "condition should be Boolean, not ~a" Tc))
-       (unless (type-equal? Tt Te)
-         (error 'type-check-exp "types of branches not equal, ~a != ~a" Tt Te))
-       (values (If c t e) Te)]
-      [(Prim 'eq? (list e1 e2))
-       (define-values (e1^ T1) ((type-check-exp env) e1))
-       (define-values (e2^ T2) ((type-check-exp env) e2))
-       (unless (type-equal? T1 T2)
-         (error 'type-check-exp "argument types of eq?: ~a != ~a" T1 T2))
-       (values (Prim 'eq? (list e1^ e2^)) 'Boolean)]
-      [(Prim op es)
-        (define-values (new-es ts)
-          (for/lists (exprs types) ([e es]) ((type-check-exp env) e)))
-        (define t-ret (type-check-op op ts))
-        (values (Prim op new-es) t-ret)]
-      [else
-       (error 'type-check-exp "couldn't match" e)])))
-
-(define (type-check-R2 e)
-  (match e
-    [(Program info body)
-     (define-values (body^ Tb) ((type-check-exp '()) body))
-     (unless (type-equal? Tb 'Integer)
-       (error 'type-check-R2 "result type must be Integer, not ~a" Tb))
-     (Program info body^)]
-    [else (error 'type-check-R2 "couldn't match ~a" e)]))
+(define type-check-R1-class
+  (class object%
+    (super-new)
+
+    (define/public (operator-types)
+      '((+ . ((Integer Integer) . Integer))
+        (- . ((Integer) . Integer))
+        (read . (() . Integer))))
+
+    (define/public (type-equal? t1 t2) (equal? t1 t2))
+
+    (define/public (check-type-equal? t1 t2 e)
+      (unless (type-equal? t1 t2)
+        (error 'type-check "~a != ~a\nin ~v" t1 t2 e)))
+
+    (define/public (type-check-op op arg-types e)
+      (match (dict-ref (operator-types) op)
+        [`(,param-types . ,return-type)
+         (for ([at arg-types] [pt param-types])
+           (check-type-equal? at pt e))
+         return-type]
+        [else (error 'type-check-op "unrecognized ~a" op)]))
+
+    (define/public (type-check-exp env)
+      (lambda (e)
+        (debug 'type-check-exp "R1" e)
+        (match e
+          [(Var x)  (values (Var x) (dict-ref env x))]
+          [(Int n)  (values (Int n) 'Integer)]
+          [(Let x e body)
+           (define-values (e^ Te) ((type-check-exp env) e))
+           (define-values (b Tb) ((type-check-exp (dict-set env x Te)) body))
+           (values (Let x e^ b) Tb)]
+          [(Prim op es)
+           (define-values (new-es ts)
+             (for/lists (exprs types) ([e es]) ((type-check-exp env) e)))
+           (values (Prim op new-es) (type-check-op op ts e))]
+          [else (error 'type-check-exp "couldn't match" e)])))
+
+    (define/public (type-check-program e)
+      (match e
+        [(Program info body)
+         (define-values (body^ Tb) ((type-check-exp '()) body))
+         (check-type-equal? Tb 'Integer body)
+         (Program info body^)]
+        [else (error 'type-check-R1 "couldn't match ~a" e)]))
+    ))
+
+(define (type-check-R1 p)
+  (send (new type-check-R1-class) type-check-program p))
 \end{lstlisting}
 \end{lstlisting}
-\caption{Type checker for the $R_2$ language.}
-\label{fig:type-check-R2}
+\caption{Type checker for the $R_1$ fragment of $R_2$.}
+\label{fig:type-check-R1}
 \end{figure}
 \end{figure}
 
 
-
-Figure~\ref{fig:type-check-aux-R2} defines three auxiliary functions
-that are used in the type checker. The \code{operator-types} function
-defines a dictionary that maps the operator names to their parameter
-and return types. The \code{type-equal?} function determines whether
-two types are equal, which for now simply dispatches to \code{equal?}
-(deep equality). The \code{type-check-op} function looks up the
-operator in the \code{operator-types} dictionary and then checks
-whether the argument types are equal to the parameter types.  The
-result is the return type of the operator.
-
 \begin{figure}[tbp]
 \begin{figure}[tbp]
-\begin{lstlisting}
-(define (operator-types)
-  '((+ . ((Integer Integer) . Integer))
-    (- . ((Integer Integer) . Integer))
-    (and . ((Boolean Boolean) . Boolean))
-    (or . ((Boolean Boolean) . Boolean))
-    (< . ((Integer Integer) . Boolean))
-    (<= . ((Integer Integer) . Boolean))
-    (> . ((Integer Integer) . Boolean))
-    (>= . ((Integer Integer) . Boolean))
-    (- . ((Integer) . Integer))
-    (not . ((Boolean) . Boolean))
-    (read . (() . Integer))
+\begin{lstlisting}[basicstyle=\ttfamily\footnotesize]
+(define type-check-R2-class
+  (class type-check-R1-class
+    (super-new)
+    (inherit check-type-equal?)
+    
+    (define/override (operator-types)
+      (append '((- . ((Integer Integer) . Integer))
+                (and . ((Boolean Boolean) . Boolean))
+                (or . ((Boolean Boolean) . Boolean))
+                (< . ((Integer Integer) . Boolean))
+                (<= . ((Integer Integer) . Boolean))
+                (> . ((Integer Integer) . Boolean))
+                (>= . ((Integer Integer) . Boolean))
+                (not . ((Boolean) . Boolean))
+                )
+              (super operator-types)))
+
+    (define/override (type-check-exp env)
+      (lambda (e)
+        (match e
+          [(Bool b) (values (Bool b) 'Boolean)]
+          [(If cnd thn els)
+           (define-values (cnd^ Tc) ((type-check-exp env) cnd))
+           (define-values (thn^ Tt) ((type-check-exp env) thn))
+           (define-values (els^ Te) ((type-check-exp env) els))
+           (check-type-equal? Tc 'Boolean e)
+           (check-type-equal? Tt Te e)
+           (values (If cnd^ thn^ els^) Te)]
+          [(Prim 'eq? (list e1 e2))
+           (define-values (e1^ T1) ((type-check-exp env) e1))
+           (define-values (e2^ T2) ((type-check-exp env) e2))
+           (check-type-equal? T1 T2 e)
+           (values (Prim 'eq? (list e1^ e2^)) 'Boolean)]
+          [else ((super type-check-exp env) e)])))
     ))
     ))
 
 
-(define (type-equal? t1 t2)
-  (equal? t1 t2))
-
-(define (type-check-op op arg-types)
-  (match (dict-ref (operator-types) op)
-    [`(,param-types . ,return-type)
-     (for ([at arg-types] [pt param-types]) 
-       (unless (type-equal? at pt)
-         (error 'type-check-op
-                "argument and parameter mismatch, ~a != ~a" at pt)))
-     return-type]
-    [else
-     (error 'type-check-op "unrecognized operator ~a" op)]))
-\end{lstlisting}
-\caption{Auxiliary functions for type checking.}
-\label{fig:type-check-aux-R2}
+(define (type-check-R2 p)
+  (send (new type-check-R2-class) type-check-program p))
+\end{lstlisting}
+\caption{Type checker for the $R_2$ language.}
+\label{fig:type-check-R2}
 \end{figure}
 \end{figure}
 
 
-
+Three auxiliary methods are used in the type checker. The method
+\code{operator-types} defines a dictionary that maps the operator
+names to their parameter and return types. The \code{type-equal?}
+method determines whether two types are equal, which for now simply
+dispatches to \code{equal?}  (deep equality). The \code{type-check-op}
+method looks up the operator in the \code{operator-types} dictionary
+and then checks whether the argument types are equal to the parameter
+types.  The result is the return type of the operator.
 
 
 \begin{exercise}\normalfont
 \begin{exercise}\normalfont
 Create 10 new example programs in $R_2$. Half of the example programs
 Create 10 new example programs in $R_2$. Half of the example programs
@@ -5811,41 +5988,51 @@ would run out of memory.\footnote{The $R_3$ language does not have
 must therefore perform automatic garbage collection.
 must therefore perform automatic garbage collection.
 
 
 Figure~\ref{fig:interp-R3} shows the definitional interpreter for the
 Figure~\ref{fig:interp-R3} shows the definitional interpreter for the
-$R_3$ language. We define the \code{vector}, \code{vector-ref}, and
-\code{vector-set!} operations for $R_3$ in terms of the corresponding
-operations in Racket. One subtle point is that the \code{vector-set!}
-operation returns the \code{\#<void>} value. The \code{\#<void>} value
-can be passed around just like other values inside an $R_3$ program
-and a \code{\#<void>} value can be compared for equality with another
-\code{\#<void>} value. However, there are no other operations specific
-to the the \code{\#<void>} value in $R_3$. In contrast, Racket defines
-the \code{void?} predicate that returns \code{\#t} when applied to
-\code{\#<void>} and \code{\#f} otherwise.
+$R_3$ language. We define the \code{vector}, \code{vector-length},
+\code{vector-ref}, and \code{vector-set!} operations for $R_3$ in
+terms of the corresponding operations in Racket. One subtle point is
+that the \code{vector-set!}  operation returns the \code{\#<void>}
+value. The \code{\#<void>} value can be passed around just like other
+values inside an $R_3$ program and a \code{\#<void>} value can be
+compared for equality with another \code{\#<void>} value. However,
+there are no other operations specific to the the \code{\#<void>}
+value in $R_3$. In contrast, Racket defines the \code{void?} predicate
+that returns \code{\#t} when applied to \code{\#<void>} and \code{\#f}
+otherwise.
 
 
 \begin{figure}[tbp]
 \begin{figure}[tbp]
 \begin{lstlisting}
 \begin{lstlisting}
-(define primitives (set ... 'vector 'vector-ref 'vector-set!))
-
-(define (interp-op op)
-  (match op
-     ...
-     ['vector vector]
-     ['vector-ref vector-ref]
-     ['vector-set! vector-set!]
-     [else (error 'interp-op "unknown operator")]))
-
-(define (interp-exp env)
-  (lambda (e)
-    (define recur (interp-exp env))
-    (match e
-       ...
-       )))
+(define interp-R3-class
+  (class interp-R2-class
+    (super-new)
+
+    (define/override (interp-op op)
+      (match op
+        ['eq? (lambda (v1 v2)
+                (cond [(or (and (fixnum? v1) (fixnum? v2))
+                           (and (boolean? v1) (boolean? v2))
+                           (and (vector? v1) (vector? v2))
+                           (and (void? v1) (void? v2)))
+                       (eq? v1 v2)]))]
+        ['vector vector]
+        ['vector-length vector-length]
+        ['vector-ref vector-ref]
+        ['vector-set! vector-set!]
+        [else (super interp-op op)]
+        ))
+
+    (define/override (interp-exp env)
+      (lambda (e)
+        (define recur (interp-exp env))
+        (match e
+          [(HasType e t)  (recur e)]
+          [(Void)  (void)]
+          [else ((super interp-exp env) e)]
+          )))
+    ))
 
 
 (define (interp-R3 p)
 (define (interp-R3 p)
- (match p
-   [(Program '() e)
-    ((interp-exp '()) e)]
-   ))
+  (send (new interp-R3-class) interp-program p))
 \end{lstlisting}
 \end{lstlisting}
 \caption{Interpreter for the $R_3$ language.}
 \caption{Interpreter for the $R_3$ language.}
 \label{fig:interp-R3}
 \label{fig:interp-R3}
@@ -5868,66 +6055,63 @@ start and end parentheses.  \index{unquote-slicing}
 
 
 \begin{figure}[tp]
 \begin{figure}[tp]
 \begin{lstlisting}[basicstyle=\ttfamily\scriptsize]
 \begin{lstlisting}[basicstyle=\ttfamily\scriptsize]
-(define (type-check-exp env)
-  (lambda (e)
-    (define recur (type-check-exp env))
-    (match e
-      ...
-      [(Void) (values (Void) 'Void)]
-      [(Prim 'vector es)
-       (define-values (e* t*) (for/lists (e* t*) ([e es]) (recur e)))
-       (let ([t `(Vector ,@t*)])
-         (values (HasType (Prim 'vector e*) t) t))]
-      [(Prim 'vector-ref (list e (Int i)))
-       (define-values (e^ t) (recur e))
-       (match t
-         [`(Vector ,ts ...)
-          (unless (and (exact-nonnegative-integer? i) (< i (length ts)))
-            (error 'type-check-exp "invalid index ~a" i))
-          (let ([t (list-ref ts i)])
-            (values (Prim 'vector-ref (list e^ (Int i)))  t))]
-         [else (error 'type-check-exp
-                      "expected a vector in vector-ref, not ~a" t)])]
-      [(Prim 'vector-set! (list e (Int i) arg) )
-       (define-values (e-vec t-vec) (recur e))
-       (define-values (e-arg^ t-arg) (recur arg))
-       (match t-vec
-         [`(Vector ,ts ...)
-          (unless (and (exact-nonnegative-integer? i) (i . < . (length ts)))
-            (error 'type-check-exp "invalid index ~a" i))
-          (unless (type-equal? (list-ref ts i) t-arg)
-            (error 'type-check-exp "type mismatch in vector-set! ~a ~a" 
-                   (list-ref ts i) t-arg))
-          (values (Prim 'vector-set! (list e-vec (Int i) e-arg^))  'Void)]
-         [else (error 'type-check-exp
-                      "expected a vector in vector-set!, not ~a" t-vec)])]
-      [(Prim 'vector-length (list e))
-       (define-values (e^ t) (recur e))
-       (match t
-         [`(Vector ,ts ...)
-          (values (Prim 'vector-length (list e^))  'Integer)]
-         [else (error 'type-check-exp
-                      "expected a vector in vector-length, not ~a" t)])]
-      [(Prim 'eq? (list arg1 arg2))
-       (define-values (e1 t1) (recur arg1))
-       (define-values (e2 t2) (recur arg2))
-       (match* (t1 t2)
-         [(`(Vector ,ts1 ...) `(Vector ,ts2 ...))  (void)]
-         [(other wise)
-          (unless (type-equal? t1 t2)
-            (error 'type-check-exp
-                   "type error: different argument types of eq?: ~a != ~a" t1 t2))])
-       (values (Prim 'eq? (list e1 e2)) 'Boolean)]
-      [(HasType (Prim 'vector es) t)
-       ((type-check-exp env) (Prim 'vector es))]
-      [(HasType e t)
-       (define-values (e^ t^) (recur e))
-       (unless (type-equal? t t^)
-         (error 'type-check-exp "type mismatch in HasType" t t^))
-       (values (HasType e^ t) t)]
-      ...
-      [else (error 'type-check-exp "R3/unmatched ~a" e)]
-      )))
+(define type-check-R3-class
+  (class type-check-R2-class
+    (super-new)
+    (inherit check-type-equal?)
+
+    (define/override (type-check-exp env)
+      (lambda (e)
+        (define recur (type-check-exp env))
+        (match e
+          [(Void) (values (Void) 'Void)]
+          [(Prim 'vector es)
+           (define-values (e* t*) (for/lists (e* t*) ([e es]) (recur e)))
+           (define t `(Vector ,@t*))
+           (values (HasType (Prim 'vector e*) t)  t)]
+          [(Prim 'vector-ref (list e1 (Int i)))
+           (define-values (e1^ t) (recur e1))
+           (match t
+             [`(Vector ,ts ...)
+              (unless (and (0 . <= . i) (i . < . (length ts)))
+                (error 'type-check "index ~a out of bounds\nin ~v" i e))
+              (values (Prim 'vector-ref (list e1^ (Int i)))  (list-ref ts i))]
+             [else (error 'type-check "expect Vector, not ~a\nin ~v" t e)])]
+          [(Prim 'vector-set! (list e1 (Int i) arg) )
+           (define-values (e-vec t-vec) (recur e1))
+           (define-values (e-arg^ t-arg) (recur arg))
+           (match t-vec
+             [`(Vector ,ts ...)
+              (unless (and (0 . <= . i) (i . < . (length ts)))
+                (error 'type-check "index ~a out of bounds\nin ~v" i e))
+              (check-type-equal? (list-ref ts i) t-arg e)
+              (values (Prim 'vector-set! (list e-vec (Int i) e-arg^))  'Void)]
+             [else (error 'type-check "expect Vector, not ~a\nin ~v" t-vec e)])]
+          [(Prim 'vector-length (list e))
+           (define-values (e^ t) (recur e))
+           (match t
+             [`(Vector ,ts ...)
+              (values (Prim 'vector-length (list e^))  'Integer)]
+             [else (error 'type-check "expect Vector, not ~a\nin ~v" t e)])]
+          [(Prim 'eq? (list arg1 arg2))
+           (define-values (e1 t1) (recur arg1))
+           (define-values (e2 t2) (recur arg2))
+           (match* (t1 t2)
+             [(`(Vector ,ts1 ...)  `(Vector ,ts2 ...))  (void)]
+             [(other wise)  (check-type-equal? t1 t2 e)])
+           (values (Prim 'eq? (list e1 e2)) 'Boolean)]
+          [(HasType (Prim 'vector es) t)
+           ((type-check-exp env) (Prim 'vector es))]
+          [(HasType e1 t)
+           (define-values (e1^ t^) (recur e1))
+           (check-type-equal? t t^ e)
+           (values (HasType e1^ t) t)]
+          [else ((super type-check-exp env) e)]
+          )))
+    ))
+
+(define (type-check-R3 p)
+  (send (new type-check-R3-class) type-check-program p))
 \end{lstlisting}
 \end{lstlisting}
 \caption{Type checker for the $R_3$ language.}
 \caption{Type checker for the $R_3$ language.}
 \label{fig:type-check-R3}
 \label{fig:type-check-R3}
@@ -10336,6 +10520,34 @@ takes a tag instead of a type. \\
 We recommend translating the type predicates (\code{boolean?}, etc.)
 We recommend translating the type predicates (\code{boolean?}, etc.)
 into uses of \code{tag-of-any} and \code{eq?}.
 into uses of \code{tag-of-any} and \code{eq?}.
 
 
+\section{Check Bounds}
+\label{sec:check-bounds-r6}
+
+UNDER CONSTRUCTION
+
+When the type of the vector argument is \code{Vectorof}, insert bounds
+checking.
+
+\begin{lstlisting}
+(vector-ref e1 e2)
+|$\Rightarrow$|
+(let ([v e1'])
+  (let ([i e2'])
+    (if (< i (vector-length v))
+        (vector-ref v i)
+        (exit))))
+\end{lstlisting}
+
+\begin{lstlisting}
+(vector-set! e1 e2 e3)
+|$\Rightarrow$|
+(let ([v e1'])
+  (let ([i e2'])
+    (if (< i (vector-length v))
+        (vector-set! v i e3')
+        (exit))))
+\end{lstlisting}
+
 \section{Remove Complex Operands}
 \section{Remove Complex Operands}
 \label{sec:rco-r6}
 \label{sec:rco-r6}