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

module Funcons.Core.Computations.Abnormal.Controlling.Controlling where

import Funcons.EDSL

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

types :: TypeRelation
types = [(Name, DataTypeMembers)] -> TypeRelation
typeEnvFromList
    [(Name
"continuations",Name -> [TPattern] -> [DataTypeAltt] -> DataTypeMembers
DataTypeMemberss Name
"continuations" [MetaVar -> TPattern
TPVar MetaVar
"T1",MetaVar -> TPattern
TPVar MetaVar
"T2"] [Name -> [FTerm] -> Maybe [TPattern] -> DataTypeAltt
DataTypeMemberConstructor Name
"continuation" [Name -> [FTerm] -> FTerm
TApp Name
"abstractions" [FTerm -> FTerm -> FTerm
TSortComputesFrom ([FTerm] -> FTerm
TSeq []) (MetaVar -> FTerm
TVar MetaVar
"T2")]] ([TPattern] -> Maybe [TPattern]
forall a. a -> Maybe a
Just [MetaVar -> TPattern
TPVar MetaVar
"T1",MetaVar -> TPattern
TPVar MetaVar
"T2"])])]

funcons :: FunconLibrary
funcons = [(Name, EvalFunction)] -> FunconLibrary
libFromList
    [(Name
"continuation",StrictFuncon -> EvalFunction
StrictFuncon StrictFuncon
stepContinuation),(Name
"hole",NullaryFuncon -> EvalFunction
NullaryFuncon NullaryFuncon
stepHole),(Name
"resume-continuation",StrictFuncon -> EvalFunction
StrictFuncon StrictFuncon
stepResume_continuation),(Name
"control",StrictFuncon -> EvalFunction
StrictFuncon StrictFuncon
stepControl),(Name
"delimit-current-continuation",NonStrictFuncon -> EvalFunction
NonStrictFuncon NonStrictFuncon
stepDelimit_current_continuation),(Name
"delimit-cc",NonStrictFuncon -> EvalFunction
NonStrictFuncon NonStrictFuncon
stepDelimit_current_continuation),(Name
"continuations",StrictFuncon -> EvalFunction
StrictFuncon StrictFuncon
stepContinuations)]

continuation_ :: [Funcons] -> Funcons
continuation_ [Funcons]
fargs = Name -> [Funcons] -> Funcons
FApp Name
"continuation" ([Funcons]
fargs)
stepContinuation :: StrictFuncon
stepContinuation [Values]
fargs =
    [NullaryFuncon] -> [MSOS StepRes] -> NullaryFuncon
evalRules [NullaryFuncon
rewrite1] []
    where rewrite1 :: NullaryFuncon
rewrite1 = do
            let env :: Map k a
env = Map k a
forall k a. Map k a
emptyEnv
            Env
env <- [Values] -> [VPattern] -> Env -> Rewrite Env
vsMatch [Values]
fargs [MetaVar -> VPattern
VPMetaVar MetaVar
"_X1"] Env
forall k a. Map k a
env
            Env
env <- SideCondition -> Env -> Rewrite Env
sideCondition (FTerm -> FTerm -> SideCondition
SCIsInSort (MetaVar -> FTerm
TVar MetaVar
"_X1") (FTerm -> SeqSortOp -> FTerm
TSortSeq (Name -> FTerm
TName Name
"values") SeqSortOp
QuestionMarkOp)) Env
env
            FTerm -> Env -> NullaryFuncon
rewriteTermTo (Name -> [FTerm] -> FTerm
TApp Name
"datatype-value" [Funcons -> FTerm
TFuncon (Values -> Funcons
FValue (Name -> [Funcons] -> Values
forall t. Name -> [t] -> Values t
ADTVal Name
"list" [Values -> Funcons
FValue (Name -> [Funcons] -> Values
forall t. Name -> [t] -> Values t
ADTVal Name
"unicode-character" [Values -> Funcons
FValue (Integer -> Values
forall t. Integer -> Values t
Int Integer
99)]),Values -> Funcons
FValue (Name -> [Funcons] -> Values
forall t. Name -> [t] -> Values t
ADTVal Name
"unicode-character" [Values -> Funcons
FValue (Integer -> Values
forall t. Integer -> Values t
Int Integer
111)]),Values -> Funcons
FValue (Name -> [Funcons] -> Values
forall t. Name -> [t] -> Values t
ADTVal Name
"unicode-character" [Values -> Funcons
FValue (Integer -> Values
forall t. Integer -> Values t
Int Integer
110)]),Values -> Funcons
FValue (Name -> [Funcons] -> Values
forall t. Name -> [t] -> Values t
ADTVal Name
"unicode-character" [Values -> Funcons
FValue (Integer -> Values
forall t. Integer -> Values t
Int Integer
116)]),Values -> Funcons
FValue (Name -> [Funcons] -> Values
forall t. Name -> [t] -> Values t
ADTVal Name
"unicode-character" [Values -> Funcons
FValue (Integer -> Values
forall t. Integer -> Values t
Int Integer
105)]),Values -> Funcons
FValue (Name -> [Funcons] -> Values
forall t. Name -> [t] -> Values t
ADTVal Name
"unicode-character" [Values -> Funcons
FValue (Integer -> Values
forall t. Integer -> Values t
Int Integer
110)]),Values -> Funcons
FValue (Name -> [Funcons] -> Values
forall t. Name -> [t] -> Values t
ADTVal Name
"unicode-character" [Values -> Funcons
FValue (Integer -> Values
forall t. Integer -> Values t
Int Integer
117)]),Values -> Funcons
FValue (Name -> [Funcons] -> Values
forall t. Name -> [t] -> Values t
ADTVal Name
"unicode-character" [Values -> Funcons
FValue (Integer -> Values
forall t. Integer -> Values t
Int Integer
97)]),Values -> Funcons
FValue (Name -> [Funcons] -> Values
forall t. Name -> [t] -> Values t
ADTVal Name
"unicode-character" [Values -> Funcons
FValue (Integer -> Values
forall t. Integer -> Values t
Int Integer
116)]),Values -> Funcons
FValue (Name -> [Funcons] -> Values
forall t. Name -> [t] -> Values t
ADTVal Name
"unicode-character" [Values -> Funcons
FValue (Integer -> Values
forall t. Integer -> Values t
Int Integer
105)]),Values -> Funcons
FValue (Name -> [Funcons] -> Values
forall t. Name -> [t] -> Values t
ADTVal Name
"unicode-character" [Values -> Funcons
FValue (Integer -> Values
forall t. Integer -> Values t
Int Integer
111)]),Values -> Funcons
FValue (Name -> [Funcons] -> Values
forall t. Name -> [t] -> Values t
ADTVal Name
"unicode-character" [Values -> Funcons
FValue (Integer -> Values
forall t. Integer -> Values t
Int Integer
110)])])),MetaVar -> FTerm
TVar MetaVar
"_X1"]) Env
env

hole_ :: Funcons
hole_ = Name -> Funcons
FName Name
"hole"
stepHole :: NullaryFuncon
stepHole = [NullaryFuncon] -> [MSOS StepRes] -> NullaryFuncon
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 <- Name -> Maybe VPattern -> Env -> MSOS Env
getControlPatt Name
"plug-signal" (VPattern -> Maybe VPattern
forall a. a -> Maybe a
Just (MetaVar -> VPattern
VPMetaVar MetaVar
"V")) Env
forall k a. Map k a
env
            Name -> FTerm -> Env -> MSOS ()
raiseTerm Name
"plug-signal" (MetaVar -> FTerm
TVar MetaVar
"V") Env
env
            FTerm -> Env -> MSOS StepRes
stepTermTo (MetaVar -> FTerm
TVar MetaVar
"V") Env
env

resume_continuation_ :: [Funcons] -> Funcons
resume_continuation_ [Funcons]
fargs = Name -> [Funcons] -> Funcons
FApp Name
"resume-continuation" ([Funcons]
fargs)
stepResume_continuation :: StrictFuncon
stepResume_continuation [Values]
fargs =
    [NullaryFuncon] -> [MSOS StepRes] -> NullaryFuncon
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 [Name -> [VPattern] -> VPattern
PADT Name
"continuation" [Name -> [VPattern] -> VPattern
PADT Name
"abstraction" [MetaVar -> VPattern
VPMetaVar MetaVar
"X"]],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
"plug-signal" (Maybe VPattern
forall a. Maybe a
Nothing) Env
env
            (Env
env,[Maybe Values
__varplug_signal]) <- [Name] -> MSOS Env -> MSOS (Env, [Maybe Values])
forall a. [Name] -> MSOS a -> MSOS (a, [Maybe Values])
receiveSignals [Name
"plug-signal"] (Name -> Maybe FTerm -> Env -> MSOS Env -> MSOS Env
forall a. Name -> Maybe FTerm -> Env -> MSOS a -> MSOS a
withControlTerm Name
"plug-signal" (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
__varplug_signal (VPattern -> Maybe VPattern
forall a. a -> Maybe a
Just (MetaVar -> VPattern
VPMetaVar MetaVar
"V")) Env
env
            FTerm -> Env -> MSOS StepRes
stepTermTo (MetaVar -> FTerm
TVar MetaVar
"X'") Env
env

control_ :: [Funcons] -> Funcons
control_ [Funcons]
fargs = Name -> [Funcons] -> Funcons
FApp Name
"control" ([Funcons]
fargs)
stepControl :: StrictFuncon
stepControl [Values]
fargs =
    [NullaryFuncon] -> [MSOS StepRes] -> NullaryFuncon
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
"F") (Name -> [FTerm] -> FTerm
TApp Name
"functions" [FTerm -> SeqSortOp -> FTerm
TSortSeq (Name -> FTerm
TName Name
"values") SeqSortOp
QuestionMarkOp,FTerm -> SeqSortOp -> FTerm
TSortSeq (Name -> FTerm
TName Name
"values") SeqSortOp
QuestionMarkOp])] Env
forall k a. Map k a
env
            Env
env <- Name -> Maybe VPattern -> Env -> MSOS Env
getControlPatt Name
"control-signal" (VPattern -> Maybe VPattern
forall a. a -> Maybe a
Just (MetaVar -> VPattern
VPMetaVar MetaVar
"F")) Env
env
            Name -> FTerm -> Env -> MSOS ()
raiseTerm Name
"control-signal" (MetaVar -> FTerm
TVar MetaVar
"F") Env
env
            FTerm -> Env -> MSOS StepRes
stepTermTo (Name -> FTerm
TName Name
"hole") Env
env

delimit_current_continuation_ :: [Funcons] -> Funcons
delimit_current_continuation_ [Funcons]
fargs = Name -> [Funcons] -> Funcons
FApp Name
"delimit-current-continuation" ([Funcons]
fargs)
delimit_cc_ :: [Funcons] -> Funcons
delimit_cc_ [Funcons]
fargs = Name -> [Funcons] -> Funcons
FApp Name
"delimit-current-continuation" ([Funcons]
fargs)
stepDelimit_current_continuation :: NonStrictFuncon
stepDelimit_current_continuation [Funcons]
fargs =
    [NullaryFuncon] -> [MSOS StepRes] -> NullaryFuncon
evalRules [NullaryFuncon
rewrite1] [MSOS StepRes
step1,MSOS StepRes
step2]
    where rewrite1 :: NullaryFuncon
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 -> NullaryFuncon
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
"control-signal" (Maybe VPattern
forall a. Maybe a
Nothing) Env
env
            (Env
env,[Maybe Values
__varcontrol_signal]) <- [Name] -> MSOS Env -> MSOS (Env, [Maybe Values])
forall a. [Name] -> MSOS a -> MSOS (a, [Maybe Values])
receiveSignals [Name
"control-signal"] (Name -> Maybe FTerm -> Env -> MSOS Env -> MSOS Env
forall a. Name -> Maybe FTerm -> Env -> MSOS a -> MSOS a
withControlTerm Name
"control-signal" (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
__varcontrol_signal (Maybe VPattern
forall a. Maybe a
Nothing) Env
env
            FTerm -> Env -> MSOS StepRes
stepTermTo (Name -> [FTerm] -> FTerm
TApp Name
"delimit-current-continuation" [MetaVar -> FTerm
TVar MetaVar
"X'"]) 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"] Env
forall k a. Map k a
env
            Env
env <- Name -> Maybe VPattern -> Env -> MSOS Env
getControlPatt Name
"control-signal" (Maybe VPattern
forall a. Maybe a
Nothing) Env
env
            (Env
env,[Maybe Values
__varcontrol_signal]) <- [Name] -> MSOS Env -> MSOS (Env, [Maybe Values])
forall a. [Name] -> MSOS a -> MSOS (a, [Maybe Values])
receiveSignals [Name
"control-signal"] (Name -> Maybe FTerm -> Env -> MSOS Env -> MSOS Env
forall a. Name -> Maybe FTerm -> Env -> MSOS a -> MSOS a
withControlTerm Name
"control-signal" (FTerm -> Maybe FTerm
forall a. a -> Maybe a
Just (MetaVar -> FTerm
TVar MetaVar
"F")) 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
__varcontrol_signal (VPattern -> Maybe VPattern
forall a. a -> Maybe a
Just (MetaVar -> VPattern
VPMetaVar MetaVar
"F")) Env
env
            FTerm -> Env -> MSOS StepRes
stepTermTo (Name -> [FTerm] -> FTerm
TApp Name
"delimit-current-continuation" [Name -> [FTerm] -> FTerm
TApp Name
"apply" [MetaVar -> FTerm
TVar MetaVar
"F",Name -> [FTerm] -> FTerm
TApp Name
"continuation" [Name -> [FTerm] -> FTerm
TApp Name
"closure" [MetaVar -> FTerm
TVar MetaVar
"X'"]]]]) Env
env

continuations_ :: [Funcons] -> Funcons
continuations_ = Name -> [Funcons] -> Funcons
FApp Name
"continuations"
stepContinuations :: StrictFuncon
stepContinuations [Values]
ts = Name -> StrictFuncon
rewriteType Name
"continuations" [Values]
ts