; Lecture 22 - Exceptions

; This file contains the example I used to illustrate the discussion of
; how exceptions are formalized.

(include-book "irun")

(in-package "M5")

(defconst *exception-ct*
  (make-ct
   (list (make class
               :name "Exception"
               :supers '("Object")
               :fields '("msg")
               :methods nil)
         (make class
               :name "ExceptionType1"
               :supers '("Exception" "Object")
               :fields '()
               :methods nil)
         (make class
               :name "ExceptionType2"
               :supers '("Exception" "Object")
               :fields '()
               :methods nil)
         (make class
               :name "Demo"
               :supers '("Object")
               :fields '()
               :methods (list
                         (make method
                               :name "test"
                               :formals '(n)
                               :sync nil
                               :code '((load 0)                                    ;;;  0
                                       (const 4)                                   ;;;  1
                                       (sub)                                       ;;;  2
                                       (ifne 3)                                    ;;;  3
                                       (const 4)                                   ;;;  4
                                       (xreturn) ; if x=4, return 4                ;;;  5
                                       (load 0)                                    ;;;  6
                                       (const 3)                                   ;;;  7
                                       (sub)                                       ;;;  8
                                       (ifne 3)                                    ;;;  9
                                       (new "Object")                              ;;; 10
                                       (throw) ; if x=3, throw Object              ;;; 11
                                       (load 0)                                    ;;; 12
                                       (const 2)                                   ;;; 13
                                       (sub)                                       ;;; 14
                                       (ifne 3)                                    ;;; 15
                                       (new "ExceptionType2")                      ;;; 16
                                       (throw) ; if x=2, throw ExceptionType2      ;;; 17
                                       (load 0)                                    ;;; 18
                                       (const 1)                                   ;;; 19
                                       (sub)                                       ;;; 20
                                       (ifne 3)                                    ;;; 21
                                       (new "ExceptionType1")                      ;;; 22
                                       (throw) ; if x=1, throw ExceptionType1      ;;; 23
                                       (new "Exception")                           ;;; 24
                                       (throw) ; else (e.g., x=0), throw Exception ;;; 25
; -------   ; ExceptionType1 code
                                       (pop)                                       ;;; 26
                                       (const -1)                                  ;;; 27
                                       (xreturn)                                   ;;; 28
; -------   ; ExceptionType2 code
                                       (pop)                                       ;;; 29
                                       (const -2)                                  ;;; 30
                                       (xreturn)                                   ;;; 31
                                       )
                               :xtbl
                               '((0 25 26 "ExceptionType1")
                                 (0 25 29 "ExceptionType2")))))
         (make class
               :name "Top"
               :supers '("Object")
               :fields nil
               :methods (list
                         (make method
                               :name "main"
                               :formals '(n)
                               :sync nil
                               :code '((load 0)                                    ;;;  0
                                       (invokestatic ("Demo" "test" 1))            ;;;  1
                                       (halt)                                      ;;;  2
                                       (pop)                                       ;;;  3
                                       (const -3)                                  ;;;  4
                                       (halt))                                     ;;;  5
                               :xtbl '((0 1 3 "Exception"))))))))