-- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Control flow/Abnormal/Throwing/handle-thrown.aterm
{-# LANGUAGE OverloadedStrings #-}

module Funcons.Core.Computations.ControlFlow.Abnormal.Throwing.HandleThrown where

import Funcons.EDSL

entities = []

types = typeEnvFromList
    []

funcons = libFromList
    [("handle-thrown",NonStrictFuncon stepHandle_thrown)]

-- |
-- /handle-thrown(E,H)/ evaluates /E/ .
--   If /E/ terminates normally with value /V/ ,
--   then /V/ is returned and /H/ is ignored.
--   If /E/ terminates abruptly with value /V/ ,
--   then /H/ is executed with /given-value/ /V/ .
handle_thrown_ fargs = FApp "handle-thrown" (FTuple fargs)
stepHandle_thrown fargs =
    evalRules [rewrite1] [step1,step2]
    where rewrite1 = do
            let env = emptyEnv
            env <- fsMatch fargs [PAnnotated (PMetaVar "V") (TName "values"),PWildCard] env
            rewriteTermTo (TVar "V") env
          step1 = do
            let env = emptyEnv
            env <- lifted_fsMatch fargs [PMetaVar "E",PMetaVar "H"] env
            env <- receiveSignalPatt "thrown" (Nothing) (premise (TVar "E") (PMetaVar "E'") env)
            stepTermTo (TApp "handle-thrown" (TTuple [TVar "E'",TVar "H"])) env
          step2 = do
            let env = emptyEnv
            env <- lifted_fsMatch fargs [PMetaVar "E",PMetaVar "H"] env
            env <- receiveSignalPatt "thrown" (Just (VPMetaVar "V")) (premise (TVar "E") (PWildCard) env)
            stepTermTo (TApp "else" (TTuple [TApp "give" (TTuple [TVar "V",TVar "H"]),TApp "throw" (TTuple [TVar "V"])])) env