(module section-5-exceptions-1 mzscheme
  
  (require (planet "reduction-semantics.ss" ("robby" "redex.plt" 2))
           (lib "plt-match.ss")
           (prefix natural-embedding: "section-3-natural-embedding-1.ss")
           "core-calculi.ss"
           "section-5-exceptions-base.ss"
           "language-composer-tools.ss")
  
  (provide (all-defined))
  ;; ------------------------------------------------------------
  ;; LANGUAGE GRAMMARS
  
  (define-pre-grammar exceptions-1-contexts
    (s:uncaught
     s:nhc
     (in-named-hole s s:nhc (GSM m:ty (in-named-hole m m:nfc (MSG m:ty s:uncaught)))))
    
    (m:uncaught
     m:nhc
     (in-named-hole m m:nhc (MSG m:ty (in-named-hole s s:nfc (GSM m:ty m:uncaught))))))
  
  (define ms (grammar-union base
                            natural-embedding:simple-natural-embedding-extensions
                            exceptions-base
                            exceptions-1-contexts))
  
  ;; ------------------------------------------------------------
  ;; DYNAMIC SEMANTICS
  
  (define exns1-scheme-reductions
    (list
     (reduction ms
                (in-named-hole s
                               E_1
                               (handle s:e_handler (in-named-hole s s:uncaught (wrong string_1))))
                (term (in-hole E_1 s:e_handler)))
     
     (reduction ms
                (in-named-hole m m:nfc (MSG m:ty (in-named-hole s s:uncaught (wrong string_1))))
                (term string_1))))
  
  (define exns1-ml-reductions
    (list
     (reduction ms
                (in-named-hole m
                               E_1
                               (handle m:e_handler (in-named-hole m m:uncaught (raise m:ty string))))
                (term (in-hole E_1 m:e_handler)))
     
     (reduction ms
                (in-named-hole m
                               m:uncaught  
                               (raise m:ty string_1))
                (term string_1))))
  
  (define reductions (append (base-scheme-reductions/no-wrong ms)
                             (natural-embedding:natural-embedding-scheme-reductions ms)
                             (exceptions-base-scheme-reductions ms)
                             exns1-scheme-reductions
                             
                             (base-ml-reductions ms)
                             (natural-embedding:natural-embedding-ml-reductions ms)
                             (exceptions-base-ml-reductions ms)
                             exns1-ml-reductions))

  ;; ============================================================
  ;; TESTS 
  (define-values (gui E N1 N2) (get-evaluators ms m:typeof reductions error-message?)))