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

module Funcons.Core.Computations.Abnormal.Abrupting.Abrupting where

import Funcons.EDSL

import Funcons.Operations hiding (Values,libFromList)
entities :: [a]
entities = []

types :: TypeRelation
types = [(Name, DataTypeMembers)] -> TypeRelation
typeEnvFromList
    []

funcons :: FunconLibrary
funcons = [(Name, EvalFunction)] -> FunconLibrary
libFromList
    [(Name
"finalise-abrupting",NonStrictFuncon -> EvalFunction
NonStrictFuncon NonStrictFuncon
stepFinalise_abrupting),(Name
"abrupt",StrictFuncon -> EvalFunction
StrictFuncon StrictFuncon
stepAbrupt),(Name
"handle-abrupt",NonStrictFuncon -> EvalFunction
NonStrictFuncon NonStrictFuncon
stepHandle_abrupt),(Name
"finally",NonStrictFuncon -> EvalFunction
NonStrictFuncon NonStrictFuncon
stepFinally)]

finalise_abrupting_ :: [Funcons] -> Funcons
finalise_abrupting_ [Funcons]
fargs = Name -> [Funcons] -> Funcons
FApp Name
"finalise-abrupting" ([Funcons]
fargs)
stepFinalise_abrupting :: NonStrictFuncon
stepFinalise_abrupting [Funcons]
fargs =
    [Rewrite Rewritten] -> [MSOS StepRes] -> Rewrite Rewritten
evalRules [Rewrite Rewritten
rewrite1] []
    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 [MetaVar -> FPattern
PMetaVar MetaVar
"X"] Env
forall k a. Map k a
env
            FTerm -> Env -> Rewrite Rewritten
rewriteTermTo (Name -> [FTerm] -> FTerm
TApp Name
"handle-abrupt" [MetaVar -> FTerm
TVar MetaVar
"X",Name -> FTerm
TName Name
"null-value"]) Env
env

abrupt_ :: [Funcons] -> Funcons
abrupt_ [Funcons]
fargs = Name -> [Funcons] -> Funcons
FApp Name
"abrupt" ([Funcons]
fargs)
stepAbrupt :: StrictFuncon
stepAbrupt [Values]
fargs =
    [Rewrite Rewritten] -> [MSOS StepRes] -> Rewrite Rewritten
evalRules [] [MSOS StepRes
step1]
    where step1 :: MSOS StepRes
step1 = do
            let env :: Map k a
env = Map k a
forall k a. Map k a
emptyEnv
            Env
env <- [Values] -> [VPattern] -> Env -> MSOS Env
lifted_vsMatch [Values]
fargs [VPattern -> FTerm -> VPattern
VPAnnotated (MetaVar -> VPattern
VPMetaVar MetaVar
"V") (Name -> FTerm
TName Name
"values")] Env
forall k a. Map k a
env
            Env
env <- Name -> Maybe VPattern -> Env -> MSOS Env
getControlPatt Name
"abrupted" (VPattern -> Maybe VPattern
forall a. a -> Maybe a
Just (MetaVar -> VPattern
VPMetaVar MetaVar
"V")) Env
env
            Name -> FTerm -> Env -> MSOS ()
raiseTerm Name
"abrupted" (MetaVar -> FTerm
TVar MetaVar
"V") Env
env
            FTerm -> Env -> MSOS StepRes
stepTermTo (Name -> FTerm
TName Name
"stuck") Env
env

handle_abrupt_ :: [Funcons] -> Funcons
handle_abrupt_ [Funcons]
fargs = Name -> [Funcons] -> Funcons
FApp Name
"handle-abrupt" ([Funcons]
fargs)
stepHandle_abrupt :: NonStrictFuncon
stepHandle_abrupt [Funcons]
fargs =
    [Rewrite Rewritten] -> [MSOS StepRes] -> Rewrite Rewritten
evalRules [Rewrite Rewritten
rewrite1] [MSOS StepRes
step1,MSOS StepRes
step2]
    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))
            Env
env <- Maybe Values -> Maybe VPattern -> Env -> MSOS Env
receiveSignalPatt Maybe Values
__varabrupted (Maybe VPattern
forall a. Maybe a
Nothing) Env
env
            FTerm -> Env -> MSOS StepRes
stepTermTo (Name -> [FTerm] -> FTerm
TApp Name
"handle-abrupt" [MetaVar -> FTerm
TVar MetaVar
"X'",MetaVar -> FTerm
TVar MetaVar
"Y"]) Env
env
          step2 :: MSOS StepRes
step2 = 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" (FTerm -> Maybe FTerm
forall a. a -> Maybe a
Just (MetaVar -> FTerm
TVar MetaVar
"V")) Env
env (FTerm -> [FPattern] -> Env -> MSOS Env
premise (MetaVar -> FTerm
TVar MetaVar
"X") [MetaVar -> FPattern
PMetaVar MetaVar
"X'"] Env
env))
            Env
env <- Maybe Values -> Maybe VPattern -> Env -> MSOS Env
receiveSignalPatt Maybe Values
__varabrupted (VPattern -> Maybe VPattern
forall a. a -> Maybe a
Just (VPattern -> FTerm -> VPattern
VPAnnotated (MetaVar -> VPattern
VPMetaVar MetaVar
"V") (Name -> FTerm
TName Name
"values"))) Env
env
            FTerm -> Env -> MSOS StepRes
stepTermTo (Name -> [FTerm] -> FTerm
TApp Name
"give" [MetaVar -> FTerm
TVar MetaVar
"V",MetaVar -> FTerm
TVar MetaVar
"Y"]) Env
env

finally_ :: [Funcons] -> Funcons
finally_ [Funcons]
fargs = Name -> [Funcons] -> Funcons
FApp Name
"finally" ([Funcons]
fargs)
stepFinally :: NonStrictFuncon
stepFinally [Funcons]
fargs =
    [Rewrite Rewritten] -> [MSOS StepRes] -> Rewrite Rewritten
evalRules [Rewrite Rewritten
rewrite1] [MSOS StepRes
step1,MSOS StepRes
step2]
    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 (Name -> [FTerm] -> FTerm
TApp Name
"sequential" [MetaVar -> FTerm
TVar MetaVar
"Y",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))
            Env
env <- Maybe Values -> Maybe VPattern -> Env -> MSOS Env
receiveSignalPatt Maybe Values
__varabrupted (Maybe VPattern
forall a. Maybe a
Nothing) Env
env
            FTerm -> Env -> MSOS StepRes
stepTermTo (Name -> [FTerm] -> FTerm
TApp Name
"finally" [MetaVar -> FTerm
TVar MetaVar
"X'",MetaVar -> FTerm
TVar MetaVar
"Y"]) Env
env
          step2 :: MSOS StepRes
step2 = 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" (FTerm -> Maybe FTerm
forall a. a -> Maybe a
Just (MetaVar -> FTerm
TVar MetaVar
"V")) Env
env (FTerm -> [FPattern] -> Env -> MSOS Env
premise (MetaVar -> FTerm
TVar MetaVar
"X") [MetaVar -> FPattern
PMetaVar MetaVar
"X'"] Env
env))
            Env
env <- Maybe Values -> Maybe VPattern -> Env -> MSOS Env
receiveSignalPatt Maybe Values
__varabrupted (VPattern -> Maybe VPattern
forall a. a -> Maybe a
Just (VPattern -> FTerm -> VPattern
VPAnnotated (MetaVar -> VPattern
VPMetaVar MetaVar
"V") (Name -> FTerm
TName Name
"values"))) Env
env
            FTerm -> Env -> MSOS StepRes
stepTermTo (Name -> [FTerm] -> FTerm
TApp Name
"sequential" [MetaVar -> FTerm
TVar MetaVar
"Y",Name -> [FTerm] -> FTerm
TApp Name
"abrupt" [MetaVar -> FTerm
TVar MetaVar
"V"]]) Env
env