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

module Funcons.Core.Computations.Normal.Flowing.Flowing where

import Funcons.EDSL

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

types :: TypeRelation
types = [(Name, DataTypeMembers)] -> TypeRelation
typeEnvFromList
    [(Name
"yielding",Name -> [TPattern] -> [DataTypeAltt] -> DataTypeMembers
DataTypeMemberss Name
"yielding" [] [Name -> [FTerm] -> Maybe [TPattern] -> DataTypeAltt
DataTypeMemberConstructor Name
"signal" [] ([TPattern] -> Maybe [TPattern]
forall a. a -> Maybe a
Just [])])]

funcons :: FunconLibrary
funcons = [(Name, EvalFunction)] -> FunconLibrary
libFromList
    [(Name
"left-to-right",NonStrictFuncon -> EvalFunction
NonStrictFuncon NonStrictFuncon
stepLeft_to_right),(Name
"l-to-r",NonStrictFuncon -> EvalFunction
NonStrictFuncon NonStrictFuncon
stepLeft_to_right),(Name
"right-to-left",NonStrictFuncon -> EvalFunction
NonStrictFuncon NonStrictFuncon
stepRight_to_left),(Name
"r-to-l",NonStrictFuncon -> EvalFunction
NonStrictFuncon NonStrictFuncon
stepRight_to_left),(Name
"sequential",NonStrictFuncon -> EvalFunction
NonStrictFuncon NonStrictFuncon
stepSequential),(Name
"seq",NonStrictFuncon -> EvalFunction
NonStrictFuncon NonStrictFuncon
stepSequential),(Name
"effect",StrictFuncon -> EvalFunction
StrictFuncon StrictFuncon
stepEffect),(Name
"choice",NonStrictFuncon -> EvalFunction
NonStrictFuncon NonStrictFuncon
stepChoice),(Name
"if-true-else",[Strictness] -> Strictness -> NonStrictFuncon -> EvalFunction
PartiallyStrictFuncon [Strictness
Strict,Strictness
NonStrict,Strictness
NonStrict] Strictness
NonStrict NonStrictFuncon
stepIf_true_else),(Name
"if-else",[Strictness] -> Strictness -> NonStrictFuncon -> EvalFunction
PartiallyStrictFuncon [Strictness
Strict,Strictness
NonStrict,Strictness
NonStrict] Strictness
NonStrict NonStrictFuncon
stepIf_true_else),(Name
"while-true",NonStrictFuncon -> EvalFunction
NonStrictFuncon NonStrictFuncon
stepWhile_true),(Name
"while",NonStrictFuncon -> EvalFunction
NonStrictFuncon NonStrictFuncon
stepWhile_true),(Name
"do-while-true",NonStrictFuncon -> EvalFunction
NonStrictFuncon NonStrictFuncon
stepDo_while_true),(Name
"do-while",NonStrictFuncon -> EvalFunction
NonStrictFuncon NonStrictFuncon
stepDo_while_true),(Name
"interleave",StrictFuncon -> EvalFunction
StrictFuncon StrictFuncon
stepInterleave),(Name
"signal",NullaryFuncon -> EvalFunction
NullaryFuncon NullaryFuncon
stepSignal),(Name
"yield",NullaryFuncon -> EvalFunction
NullaryFuncon NullaryFuncon
stepYield),(Name
"yield-on-value",StrictFuncon -> EvalFunction
StrictFuncon StrictFuncon
stepYield_on_value),(Name
"yield-on-abrupt",NonStrictFuncon -> EvalFunction
NonStrictFuncon NonStrictFuncon
stepYield_on_abrupt),(Name
"yielding",NullaryFuncon -> EvalFunction
NullaryFuncon NullaryFuncon
stepYielding)]

left_to_right_ :: [Funcons] -> Funcons
left_to_right_ [Funcons]
fargs = Name -> [Funcons] -> Funcons
FApp Name
"left-to-right" ([Funcons]
fargs)
l_to_r_ :: [Funcons] -> Funcons
l_to_r_ [Funcons]
fargs = Name -> [Funcons] -> Funcons
FApp Name
"left-to-right" ([Funcons]
fargs)
stepLeft_to_right :: NonStrictFuncon
stepLeft_to_right [Funcons]
fargs =
    [NullaryFuncon] -> [MSOS StepRes] -> NullaryFuncon
evalRules [NullaryFuncon
rewrite1] [MSOS StepRes
step1]
    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 -> SeqSortOp -> FPattern
PSeqVar MetaVar
"V*" SeqSortOp
StarOp) (FTerm -> SeqSortOp -> FTerm
TSortSeq (Name -> FTerm
TName Name
"values") SeqSortOp
StarOp)] 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 [FPattern -> FTerm -> FPattern
PAnnotated (MetaVar -> SeqSortOp -> FPattern
PSeqVar MetaVar
"V*" SeqSortOp
StarOp) (FTerm -> SeqSortOp -> FTerm
TSortSeq (Name -> FTerm
TName Name
"values") SeqSortOp
StarOp),MetaVar -> FPattern
PMetaVar MetaVar
"Y",MetaVar -> SeqSortOp -> FPattern
PSeqVar MetaVar
"Z*" SeqSortOp
StarOp] Env
forall k a. Map k a
env
            Env
env <- FTerm -> [FPattern] -> Env -> MSOS Env
premise (MetaVar -> FTerm
TVar MetaVar
"Y") [MetaVar -> FPattern
PMetaVar MetaVar
"Y'"] Env
env
            FTerm -> Env -> MSOS StepRes
stepTermTo (Name -> [FTerm] -> FTerm
TApp Name
"left-to-right" [MetaVar -> FTerm
TVar MetaVar
"V*",MetaVar -> FTerm
TVar MetaVar
"Y'",MetaVar -> FTerm
TVar MetaVar
"Z*"]) Env
env

right_to_left_ :: [Funcons] -> Funcons
right_to_left_ [Funcons]
fargs = Name -> [Funcons] -> Funcons
FApp Name
"right-to-left" ([Funcons]
fargs)
r_to_l_ :: [Funcons] -> Funcons
r_to_l_ [Funcons]
fargs = Name -> [Funcons] -> Funcons
FApp Name
"right-to-left" ([Funcons]
fargs)
stepRight_to_left :: NonStrictFuncon
stepRight_to_left [Funcons]
fargs =
    [NullaryFuncon] -> [MSOS StepRes] -> NullaryFuncon
evalRules [NullaryFuncon
rewrite1] [MSOS StepRes
step1]
    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 -> SeqSortOp -> FPattern
PSeqVar MetaVar
"V*" SeqSortOp
StarOp) (FTerm -> SeqSortOp -> FTerm
TSortSeq (Name -> FTerm
TName Name
"values") SeqSortOp
StarOp)] 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 -> SeqSortOp -> FPattern
PSeqVar MetaVar
"X*" SeqSortOp
StarOp,MetaVar -> FPattern
PMetaVar MetaVar
"Y",FPattern -> FTerm -> FPattern
PAnnotated (MetaVar -> SeqSortOp -> FPattern
PSeqVar MetaVar
"V*" SeqSortOp
StarOp) (FTerm -> SeqSortOp -> FTerm
TSortSeq (Name -> FTerm
TName Name
"values") SeqSortOp
StarOp)] Env
forall k a. Map k a
env
            Env
env <- FTerm -> [FPattern] -> Env -> MSOS Env
premise (MetaVar -> FTerm
TVar MetaVar
"Y") [MetaVar -> FPattern
PMetaVar MetaVar
"Y'"] Env
env
            FTerm -> Env -> MSOS StepRes
stepTermTo (Name -> [FTerm] -> FTerm
TApp Name
"right-to-left" [MetaVar -> FTerm
TVar MetaVar
"X*",MetaVar -> FTerm
TVar MetaVar
"Y'",MetaVar -> FTerm
TVar MetaVar
"V*"]) Env
env

sequential_ :: [Funcons] -> Funcons
sequential_ [Funcons]
fargs = Name -> [Funcons] -> Funcons
FApp Name
"sequential" ([Funcons]
fargs)
seq_ :: [Funcons] -> Funcons
seq_ [Funcons]
fargs = Name -> [Funcons] -> Funcons
FApp Name
"sequential" ([Funcons]
fargs)
stepSequential :: NonStrictFuncon
stepSequential [Funcons]
fargs =
    [NullaryFuncon] -> [MSOS StepRes] -> NullaryFuncon
evalRules [NullaryFuncon
rewrite1,NullaryFuncon
rewrite2] [MSOS StepRes
step1]
    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 [VPattern -> FPattern
PValue (Name -> [VPattern] -> VPattern
PADT Name
"null-value" []),MetaVar -> SeqSortOp -> FPattern
PSeqVar MetaVar
"Y+" SeqSortOp
PlusOp] Env
forall k a. Map k a
env
            FTerm -> Env -> NullaryFuncon
rewriteTermTo (Name -> [FTerm] -> FTerm
TApp Name
"sequential" [MetaVar -> FTerm
TVar MetaVar
"Y+"]) Env
env
          rewrite2 :: NullaryFuncon
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
"Y"] Env
forall k a. Map k a
env
            FTerm -> Env -> NullaryFuncon
rewriteTermTo (MetaVar -> FTerm
TVar MetaVar
"Y") 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 -> SeqSortOp -> FPattern
PSeqVar MetaVar
"Y+" SeqSortOp
PlusOp] Env
forall k a. Map k a
env
            Env
env <- FTerm -> [FPattern] -> Env -> MSOS Env
premise (MetaVar -> FTerm
TVar MetaVar
"X") [MetaVar -> FPattern
PMetaVar MetaVar
"X'"] Env
env
            FTerm -> Env -> MSOS StepRes
stepTermTo (Name -> [FTerm] -> FTerm
TApp Name
"sequential" [MetaVar -> FTerm
TVar MetaVar
"X'",MetaVar -> FTerm
TVar MetaVar
"Y+"]) Env
env

effect_ :: [Funcons] -> Funcons
effect_ [Funcons]
fargs = Name -> [Funcons] -> Funcons
FApp Name
"effect" ([Funcons]
fargs)
stepEffect :: StrictFuncon
stepEffect [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 [VPattern -> FTerm -> VPattern
VPAnnotated (MetaVar -> SeqSortOp -> VPattern
VPSeqVar MetaVar
"V*" SeqSortOp
StarOp) (FTerm -> SeqSortOp -> FTerm
TSortSeq (Name -> FTerm
TName Name
"values") SeqSortOp
StarOp)] Env
forall k a. Map k a
env
            FTerm -> Env -> NullaryFuncon
rewriteTermTo (Name -> FTerm
TName Name
"null-value") Env
env

choice_ :: [Funcons] -> Funcons
choice_ [Funcons]
fargs = Name -> [Funcons] -> Funcons
FApp Name
"choice" ([Funcons]
fargs)
stepChoice :: NonStrictFuncon
stepChoice [Funcons]
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 <- [Funcons] -> [FPattern] -> Env -> Rewrite Env
fsMatch [Funcons]
fargs [MetaVar -> SeqSortOp -> FPattern
PSeqVar MetaVar
"X*" SeqSortOp
StarOp,MetaVar -> FPattern
PMetaVar MetaVar
"Y",MetaVar -> SeqSortOp -> FPattern
PSeqVar MetaVar
"Z*" SeqSortOp
StarOp] Env
forall k a. Map k a
env
            FTerm -> Env -> NullaryFuncon
rewriteTermTo (MetaVar -> FTerm
TVar MetaVar
"Y") Env
env

if_true_else_ :: [Funcons] -> Funcons
if_true_else_ [Funcons]
fargs = Name -> [Funcons] -> Funcons
FApp Name
"if-true-else" ([Funcons]
fargs)
if_else_ :: [Funcons] -> Funcons
if_else_ [Funcons]
fargs = Name -> [Funcons] -> Funcons
FApp Name
"if-true-else" ([Funcons]
fargs)
stepIf_true_else :: NonStrictFuncon
stepIf_true_else [Funcons]
fargs =
    [NullaryFuncon] -> [MSOS StepRes] -> NullaryFuncon
evalRules [NullaryFuncon
rewrite1,NullaryFuncon
rewrite2] []
    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 [VPattern -> FPattern
PValue (Name -> [VPattern] -> VPattern
PADT Name
"true" []),MetaVar -> FPattern
PMetaVar MetaVar
"X",MetaVar -> FPattern
PMetaVar MetaVar
"Y"] Env
forall k a. Map k a
env
            FTerm -> Env -> NullaryFuncon
rewriteTermTo (MetaVar -> FTerm
TVar MetaVar
"X") Env
env
          rewrite2 :: NullaryFuncon
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 [VPattern -> FPattern
PValue (Name -> [VPattern] -> VPattern
PADT Name
"false" []),MetaVar -> FPattern
PMetaVar MetaVar
"X",MetaVar -> FPattern
PMetaVar MetaVar
"Y"] Env
forall k a. Map k a
env
            FTerm -> Env -> NullaryFuncon
rewriteTermTo (MetaVar -> FTerm
TVar MetaVar
"Y") Env
env

while_true_ :: [Funcons] -> Funcons
while_true_ [Funcons]
fargs = Name -> [Funcons] -> Funcons
FApp Name
"while-true" ([Funcons]
fargs)
while_ :: [Funcons] -> Funcons
while_ [Funcons]
fargs = Name -> [Funcons] -> Funcons
FApp Name
"while-true" ([Funcons]
fargs)
stepWhile_true :: NonStrictFuncon
stepWhile_true [Funcons]
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 <- [Funcons] -> [FPattern] -> Env -> Rewrite Env
fsMatch [Funcons]
fargs [MetaVar -> FPattern
PMetaVar MetaVar
"B",MetaVar -> FPattern
PMetaVar MetaVar
"X"] Env
forall k a. Map k a
env
            FTerm -> Env -> NullaryFuncon
rewriteTermTo (Name -> [FTerm] -> FTerm
TApp Name
"if-true-else" [MetaVar -> FTerm
TVar MetaVar
"B",Name -> [FTerm] -> FTerm
TApp Name
"sequential" [MetaVar -> FTerm
TVar MetaVar
"X",Name -> [FTerm] -> FTerm
TApp Name
"while-true" [MetaVar -> FTerm
TVar MetaVar
"B",MetaVar -> FTerm
TVar MetaVar
"X"]],Name -> FTerm
TName Name
"null-value"]) Env
env

do_while_true_ :: [Funcons] -> Funcons
do_while_true_ [Funcons]
fargs = Name -> [Funcons] -> Funcons
FApp Name
"do-while-true" ([Funcons]
fargs)
do_while_ :: [Funcons] -> Funcons
do_while_ [Funcons]
fargs = Name -> [Funcons] -> Funcons
FApp Name
"do-while-true" ([Funcons]
fargs)
stepDo_while_true :: NonStrictFuncon
stepDo_while_true [Funcons]
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 <- [Funcons] -> [FPattern] -> Env -> Rewrite Env
fsMatch [Funcons]
fargs [MetaVar -> FPattern
PMetaVar MetaVar
"X",MetaVar -> FPattern
PMetaVar MetaVar
"B"] Env
forall k a. Map k a
env
            FTerm -> Env -> NullaryFuncon
rewriteTermTo (Name -> [FTerm] -> FTerm
TApp Name
"sequential" [MetaVar -> FTerm
TVar MetaVar
"X",Name -> [FTerm] -> FTerm
TApp Name
"if-true-else" [MetaVar -> FTerm
TVar MetaVar
"B",Name -> [FTerm] -> FTerm
TApp Name
"do-while-true" [MetaVar -> FTerm
TVar MetaVar
"X",MetaVar -> FTerm
TVar MetaVar
"B"],Name -> FTerm
TName Name
"null-value"]]) Env
env

interleave_ :: [Funcons] -> Funcons
interleave_ [Funcons]
fargs = Name -> [Funcons] -> Funcons
FApp Name
"interleave" ([Funcons]
fargs)
stepInterleave :: StrictFuncon
stepInterleave [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 [VPattern -> FTerm -> VPattern
VPAnnotated (MetaVar -> SeqSortOp -> VPattern
VPSeqVar MetaVar
"V*" SeqSortOp
StarOp) (FTerm -> SeqSortOp -> FTerm
TSortSeq (Name -> FTerm
TName Name
"values") SeqSortOp
StarOp)] Env
forall k a. Map k a
env
            FTerm -> Env -> NullaryFuncon
rewriteTermTo (MetaVar -> FTerm
TVar MetaVar
"V*") Env
env

signal_ :: Funcons
signal_ = Name -> Funcons
FName Name
"signal"
stepSignal :: NullaryFuncon
stepSignal = [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
            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
115)]),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
103)]),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
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
108)])]))]) Env
forall k a. Map k a
env

yield_ :: Funcons
yield_ = Name -> Funcons
FName Name
"yield"
stepYield :: NullaryFuncon
stepYield = [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
            FTerm -> Env -> NullaryFuncon
rewriteTermTo (Name -> [FTerm] -> FTerm
TApp Name
"yield-on-value" [Name -> FTerm
TName Name
"null-value"]) Env
forall k a. Map k a
env

yield_on_value_ :: [Funcons] -> Funcons
yield_on_value_ [Funcons]
fargs = Name -> [Funcons] -> Funcons
FApp Name
"yield-on-value" ([Funcons]
fargs)
stepYield_on_value :: StrictFuncon
stepYield_on_value [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
"V") (Name -> FTerm
TName Name
"values")] Env
forall k a. Map k a
env
            Env
env <- Name -> Maybe VPattern -> Env -> MSOS Env
getControlPatt Name
"yielded" (VPattern -> Maybe VPattern
forall a. a -> Maybe a
Just (Name -> [VPattern] -> VPattern
PADT Name
"signal" [])) Env
env
            Name -> FTerm -> Env -> MSOS ()
raiseTerm Name
"yielded" (Name -> FTerm
TName Name
"signal") Env
env
            FTerm -> Env -> MSOS StepRes
stepTermTo (MetaVar -> FTerm
TVar MetaVar
"V") Env
env

yield_on_abrupt_ :: [Funcons] -> Funcons
yield_on_abrupt_ [Funcons]
fargs = Name -> [Funcons] -> Funcons
FApp Name
"yield-on-abrupt" ([Funcons]
fargs)
stepYield_on_abrupt :: NonStrictFuncon
stepYield_on_abrupt [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
"abrupt" (VPattern -> Maybe VPattern
forall a. a -> Maybe a
Just (MetaVar -> VPattern
VPMetaVar MetaVar
"V")) Env
env
            Env
env <- Name -> Maybe VPattern -> Env -> MSOS Env
getControlPatt Name
"yielded" (VPattern -> Maybe VPattern
forall a. a -> Maybe a
Just (Name -> [VPattern] -> VPattern
PADT Name
"signal" [])) Env
env
            (Env
env,[Maybe Values
__varabrupt,Maybe Values
__varyielded]) <- [Name] -> MSOS Env -> MSOS (Env, [Maybe Values])
forall a. [Name] -> MSOS a -> MSOS (a, [Maybe Values])
receiveSignals [Name
"abrupt",Name
"yielded"] (Name -> Maybe FTerm -> Env -> MSOS Env -> MSOS Env
forall a. Name -> Maybe FTerm -> Env -> MSOS a -> MSOS a
withControlTerm Name
"abrupt" (FTerm -> Maybe FTerm
forall a. a -> Maybe a
Just (MetaVar -> FTerm
TVar MetaVar
"V")) Env
env (Name -> Maybe FTerm -> Env -> MSOS Env -> MSOS Env
forall a. Name -> Maybe FTerm -> Env -> MSOS a -> MSOS a
withControlTerm Name
"yielded" (FTerm -> Maybe FTerm
forall a. a -> Maybe a
Just (MetaVar -> FTerm
TVar MetaVar
"___")) 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
__varabrupt (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
            Env
env <- Maybe Values -> Maybe VPattern -> Env -> MSOS Env
receiveSignalPatt Maybe Values
__varyielded (VPattern -> Maybe VPattern
forall a. a -> Maybe a
Just (MetaVar -> SeqSortOp -> VPattern
VPSeqVar MetaVar
"___" SeqSortOp
QuestionMarkOp)) Env
env
            Name -> FTerm -> Env -> MSOS ()
raiseTerm Name
"abrupt" (MetaVar -> FTerm
TVar MetaVar
"V") Env
env
            Name -> FTerm -> Env -> MSOS ()
raiseTerm Name
"yielded" (Name -> FTerm
TName Name
"signal") Env
env
            FTerm -> Env -> MSOS StepRes
stepTermTo (Name -> [FTerm] -> FTerm
TApp Name
"yield-on-abrupt" [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
"abrupt" (Maybe VPattern
forall a. Maybe a
Nothing) Env
env
            (Env
env,[Maybe Values
__varabrupt]) <- [Name] -> MSOS Env -> MSOS (Env, [Maybe Values])
forall a. [Name] -> MSOS a -> MSOS (a, [Maybe Values])
receiveSignals [Name
"abrupt"] (Name -> Maybe FTerm -> Env -> MSOS Env -> MSOS Env
forall a. Name -> Maybe FTerm -> Env -> MSOS a -> MSOS a
withControlTerm Name
"abrupt" (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
__varabrupt (Maybe VPattern
forall a. Maybe a
Nothing) Env
env
            FTerm -> Env -> MSOS StepRes
stepTermTo (Name -> [FTerm] -> FTerm
TApp Name
"yield-on-abrupt" [MetaVar -> FTerm
TVar MetaVar
"X'"]) Env
env

yielding_ :: Funcons
yielding_ = Name -> Funcons
FName Name
"yielding"
stepYielding :: NullaryFuncon
stepYielding = Name -> StrictFuncon
rewriteType Name
"yielding" []