-- GeNeRaTeD fOr: ../../CBS-beta/Funcons-beta/Computations/Abnormal/Throwing/Throwing.cbs
{-# LANGUAGE OverloadedStrings #-}

module Funcons.Core.Computations.AbnormalBuiltin where

import Funcons.EDSL

import Funcons.Operations hiding (Values,libFromList)

library :: FunconLibrary
library = [(Name, EvalFunction)] -> FunconLibrary
libFromList
    [(Name
"handle-thrown",NonStrictFuncon -> EvalFunction
NonStrictFuncon NonStrictFuncon
stepHandle_thrown)
    ,(Name
"handle-return",NonStrictFuncon -> EvalFunction
NonStrictFuncon NonStrictFuncon
stepHandle_return)
    ,(Name
"else", NonStrictFuncon -> EvalFunction
NonStrictFuncon NonStrictFuncon
stepElse)
    ]


handle_thrown_ :: [Funcons] -> Funcons
handle_thrown_ [Funcons]
fargs = Name -> [Funcons] -> Funcons
FApp Name
"handle-thrown" ([Funcons]
fargs)
stepHandle_thrown :: NonStrictFuncon
stepHandle_thrown [Funcons]
fargs =
    [Rewrite Rewritten] -> [MSOS StepRes] -> Rewrite Rewritten
evalRules [Rewrite Rewritten
rewrite1] [MSOS StepRes
step1]
    where rewrite1 :: Rewrite Rewritten
rewrite1 = do
            let env :: Map k a
env = Map k a
forall k a. Map k a
emptyEnv
            Env
env <- [Funcons] -> [FPattern] -> Env -> Rewrite Env
fsMatch [Funcons]
fargs [FPattern -> FTerm -> FPattern
PAnnotated (MetaVar -> FPattern
PMetaVar MetaVar
"V") (Name -> FTerm
TName Name
"values"),MetaVar -> FPattern
PMetaVar MetaVar
"Y"] Env
forall k a. Map k a
env
            FTerm -> Env -> Rewrite Rewritten
rewriteTermTo (MetaVar -> FTerm
TVar MetaVar
"V") Env
env
          step1 :: MSOS StepRes
step1 = do
            let env :: Map k a
env = Map k a
forall k a. Map k a
emptyEnv
            Env
env <- [Funcons] -> [FPattern] -> Env -> MSOS Env
lifted_fsMatch [Funcons]
fargs [MetaVar -> FPattern
PMetaVar MetaVar
"X",MetaVar -> FPattern
PMetaVar MetaVar
"Y"] Env
forall k a. Map k a
env
            Env
env <- Name -> Maybe VPattern -> Env -> MSOS Env
getControlPatt Name
"abrupted" (Maybe VPattern
forall a. Maybe a
Nothing) Env
env
            (Env
env,[Maybe Values
__varabrupted]) <- [Name] -> MSOS Env -> MSOS (Env, [Maybe Values])
forall a. [Name] -> MSOS a -> MSOS (a, [Maybe Values])
receiveSignals [Name
"abrupted"] (Name -> Maybe FTerm -> Env -> MSOS Env -> MSOS Env
forall a. Name -> Maybe FTerm -> Env -> MSOS a -> MSOS a
withControlTerm Name
"abrupted" (Maybe FTerm
forall a. Maybe a
Nothing) Env
env (FTerm -> [FPattern] -> Env -> MSOS Env
premise (MetaVar -> FTerm
TVar MetaVar
"X") [MetaVar -> FPattern
PMetaVar MetaVar
"X'"] Env
env))
            case Maybe Values
__varabrupted of 
              Maybe Values
Nothing -> FTerm -> Env -> MSOS StepRes
stepTermTo (Name -> [FTerm] -> FTerm
TApp Name
"handle-thrown" [MetaVar -> FTerm
TVar MetaVar
"X'",MetaVar -> FTerm
TVar MetaVar
"Y"]) Env
env
              Just (ADTVal Name
"thrown" [Funcons
v]) -> FTerm -> Env -> MSOS StepRes
stepTermTo (Name -> [FTerm] -> FTerm
TApp Name
"give" [Funcons -> FTerm
TFuncon Funcons
v, MetaVar -> FTerm
TVar MetaVar
"Y"]) Env
env
              Just Values
v  -> do Name -> Values -> MSOS ()
raiseSignal Name
"abrupted" Values
v 
                            FTerm -> Env -> MSOS StepRes
stepTermTo (Name -> [FTerm] -> FTerm
TApp Name
"handle-thrown" [MetaVar -> FTerm
TVar MetaVar
"X'",MetaVar -> FTerm
TVar MetaVar
"Y"]) Env
env

stepHandle_return :: NonStrictFuncon
stepHandle_return [Funcons]
fargs =
    [Rewrite Rewritten] -> [MSOS StepRes] -> Rewrite Rewritten
evalRules [Rewrite Rewritten
rewrite1] [MSOS StepRes
step1]
    where rewrite1 :: Rewrite Rewritten
rewrite1 = do
            let env :: Map k a
env = Map k a
forall k a. Map k a
emptyEnv
            Env
env <- [Funcons] -> [FPattern] -> Env -> Rewrite Env
fsMatch [Funcons]
fargs [FPattern -> FTerm -> FPattern
PAnnotated (MetaVar -> FPattern
PMetaVar MetaVar
"V") (Name -> FTerm
TName Name
"values")] Env
forall k a. Map k a
env
            FTerm -> Env -> Rewrite Rewritten
rewriteTermTo (MetaVar -> FTerm
TVar MetaVar
"V") Env
env
          step1 :: MSOS StepRes
step1 = do
            let env :: Map k a
env = Map k a
forall k a. Map k a
emptyEnv
            Env
env <- [Funcons] -> [FPattern] -> Env -> MSOS Env
lifted_fsMatch [Funcons]
fargs [MetaVar -> FPattern
PMetaVar MetaVar
"X"] Env
forall k a. Map k a
env
            Env
env <- Name -> Maybe VPattern -> Env -> MSOS Env
getControlPatt Name
"abrupted" (Maybe VPattern
forall a. Maybe a
Nothing) Env
env
            (Env
env,[Maybe Values
__varabrupted]) <- [Name] -> MSOS Env -> MSOS (Env, [Maybe Values])
forall a. [Name] -> MSOS a -> MSOS (a, [Maybe Values])
receiveSignals [Name
"abrupted"] (Name -> Maybe FTerm -> Env -> MSOS Env -> MSOS Env
forall a. Name -> Maybe FTerm -> Env -> MSOS a -> MSOS a
withControlTerm Name
"abrupted" (Maybe FTerm
forall a. Maybe a
Nothing) Env
env (FTerm -> [FPattern] -> Env -> MSOS Env
premise (MetaVar -> FTerm
TVar MetaVar
"X") [MetaVar -> FPattern
PMetaVar MetaVar
"X'"] Env
env))
            case Maybe Values
__varabrupted of 
              Maybe Values
Nothing -> FTerm -> Env -> MSOS StepRes
stepTermTo (Name -> [FTerm] -> FTerm
TApp Name
"handle-return" [MetaVar -> FTerm
TVar MetaVar
"X'"]) Env
env
              Just (ADTVal Name
"returned" [Funcons
v]) -> Funcons -> MSOS StepRes
stepTo Funcons
v 
              Just Values
v -> do  Name -> Values -> MSOS ()
raiseSignal Name
"abrupted" Values
v
                            FTerm -> Env -> MSOS StepRes
stepTermTo (Name -> [FTerm] -> FTerm
TApp Name
"handle-return" [MetaVar -> FTerm
TVar MetaVar
"X'"]) Env
env

stepElse :: NonStrictFuncon
stepElse [Funcons]
fargs =
    [Rewrite Rewritten] -> [MSOS StepRes] -> Rewrite Rewritten
evalRules [Rewrite Rewritten
rewrite1,Rewrite Rewritten
rewrite2] [MSOS StepRes
step1]
    where rewrite1 :: Rewrite Rewritten
rewrite1 = do
            let env :: Map k a
env = Map k a
forall k a. Map k a
emptyEnv
            Env
env <- [Funcons] -> [FPattern] -> Env -> Rewrite Env
fsMatch [Funcons]
fargs [FPattern -> FTerm -> FPattern
PAnnotated (MetaVar -> FPattern
PMetaVar MetaVar
"V") (Name -> FTerm
TName Name
"values"),MetaVar -> FPattern
PMetaVar MetaVar
"Y"] Env
forall k a. Map k a
env
            FTerm -> Env -> Rewrite Rewritten
rewriteTermTo (MetaVar -> FTerm
TVar MetaVar
"V") Env
env
          rewrite2 :: Rewrite Rewritten
rewrite2 = do
            let env :: Map k a
env = Map k a
forall k a. Map k a
emptyEnv
            Env
env <- [Funcons] -> [FPattern] -> Env -> Rewrite Env
fsMatch [Funcons]
fargs [MetaVar -> FPattern
PMetaVar MetaVar
"X",MetaVar -> FPattern
PMetaVar MetaVar
"Y",MetaVar -> SeqSortOp -> FPattern
PSeqVar MetaVar
"Z+" SeqSortOp
PlusOp] Env
forall k a. Map k a
env
            FTerm -> Env -> Rewrite Rewritten
rewriteTermTo (Name -> [FTerm] -> FTerm
TApp Name
"else" [MetaVar -> FTerm
TVar MetaVar
"X",Name -> [FTerm] -> FTerm
TApp Name
"else" [MetaVar -> FTerm
TVar MetaVar
"Y",MetaVar -> FTerm
TVar MetaVar
"Z+"]]) Env
env
          step1 :: MSOS StepRes
step1 = do
            let env :: Map k a
env = Map k a
forall k a. Map k a
emptyEnv
            Env
env <- [Funcons] -> [FPattern] -> Env -> MSOS Env
lifted_fsMatch [Funcons]
fargs [MetaVar -> FPattern
PMetaVar MetaVar
"X",MetaVar -> FPattern
PMetaVar MetaVar
"Y"] Env
forall k a. Map k a
env
            Env
env <- Name -> Maybe VPattern -> Env -> MSOS Env
getControlPatt Name
"abrupted" (Maybe VPattern
forall a. Maybe a
Nothing) Env
env
            (Env
env,[Maybe Values
__varabrupted]) <- [Name] -> MSOS Env -> MSOS (Env, [Maybe Values])
forall a. [Name] -> MSOS a -> MSOS (a, [Maybe Values])
receiveSignals [Name
"abrupted"] (Name -> Maybe FTerm -> Env -> MSOS Env -> MSOS Env
forall a. Name -> Maybe FTerm -> Env -> MSOS a -> MSOS a
withControlTerm Name
"abrupted" (Maybe FTerm
forall a. Maybe a
Nothing) Env
env (FTerm -> [FPattern] -> Env -> MSOS Env
premise (MetaVar -> FTerm
TVar MetaVar
"X") [MetaVar -> FPattern
PMetaVar MetaVar
"X'"] Env
env))
            case Maybe Values
__varabrupted of 
              Maybe Values
Nothing -> FTerm -> Env -> MSOS StepRes
stepTermTo (Name -> [FTerm] -> FTerm
TApp Name
"else" [MetaVar -> FTerm
TVar MetaVar
"X'",MetaVar -> FTerm
TVar MetaVar
"Y"]) Env
env
              Just (ADTVal Name
"failed" [Funcons]
_) -> FTerm -> Env -> MSOS StepRes
stepTermTo (MetaVar -> FTerm
TVar MetaVar
"Y") Env
env
              Just Values
v -> do Name -> Values -> MSOS ()
raiseSignal Name
"abrupted" Values
v
                           FTerm -> Env -> MSOS StepRes
stepTermTo (Name -> [FTerm] -> FTerm
TApp Name
"else" [MetaVar -> FTerm
TVar MetaVar
"X'",MetaVar -> FTerm
TVar MetaVar
"Y"]) Env
env