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

module Funcons.Core.Computations.Normal.Giving.Giving 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
"initialise-giving",NonStrictFuncon -> EvalFunction
NonStrictFuncon NonStrictFuncon
stepInitialise_giving),(Name
"give",[Strictness] -> Strictness -> NonStrictFuncon -> EvalFunction
PartiallyStrictFuncon [Strictness
Strict,Strictness
NonStrict] Strictness
NonStrict NonStrictFuncon
stepGive),(Name
"given",NullaryFuncon -> EvalFunction
NullaryFuncon NullaryFuncon
stepGiven),(Name
"no-given",NonStrictFuncon -> EvalFunction
NonStrictFuncon NonStrictFuncon
stepNo_given),(Name
"left-to-right-map",[Strictness] -> Strictness -> NonStrictFuncon -> EvalFunction
PartiallyStrictFuncon [Strictness
NonStrict] Strictness
Strict NonStrictFuncon
stepLeft_to_right_map),(Name
"interleave-map",[Strictness] -> Strictness -> NonStrictFuncon -> EvalFunction
PartiallyStrictFuncon [Strictness
NonStrict] Strictness
Strict NonStrictFuncon
stepInterleave_map),(Name
"left-to-right-repeat",[Strictness] -> Strictness -> NonStrictFuncon -> EvalFunction
PartiallyStrictFuncon [Strictness
NonStrict,Strictness
Strict,Strictness
Strict] Strictness
NonStrict NonStrictFuncon
stepLeft_to_right_repeat),(Name
"interleave-repeat",[Strictness] -> Strictness -> NonStrictFuncon -> EvalFunction
PartiallyStrictFuncon [Strictness
NonStrict,Strictness
Strict,Strictness
Strict] Strictness
NonStrict NonStrictFuncon
stepInterleave_repeat),(Name
"left-to-right-filter",[Strictness] -> Strictness -> NonStrictFuncon -> EvalFunction
PartiallyStrictFuncon [Strictness
NonStrict] Strictness
Strict NonStrictFuncon
stepLeft_to_right_filter),(Name
"interleave-filter",[Strictness] -> Strictness -> NonStrictFuncon -> EvalFunction
PartiallyStrictFuncon [Strictness
NonStrict] Strictness
Strict NonStrictFuncon
stepInterleave_filter),(Name
"fold-left",[Strictness] -> Strictness -> NonStrictFuncon -> EvalFunction
PartiallyStrictFuncon [Strictness
NonStrict,Strictness
Strict] Strictness
Strict NonStrictFuncon
stepFold_left),(Name
"fold-right",[Strictness] -> Strictness -> NonStrictFuncon -> EvalFunction
PartiallyStrictFuncon [Strictness
NonStrict,Strictness
Strict] Strictness
Strict NonStrictFuncon
stepFold_right)]

initialise_giving_ :: [Funcons] -> Funcons
initialise_giving_ [Funcons]
fargs = Name -> [Funcons] -> Funcons
FApp Name
"initialise-giving" ([Funcons]
fargs)
stepInitialise_giving :: NonStrictFuncon
stepInitialise_giving [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"] Env
forall k a. Map k a
env
            FTerm -> Env -> NullaryFuncon
rewriteTermTo (Name -> [FTerm] -> FTerm
TApp Name
"no-given" [MetaVar -> FTerm
TVar MetaVar
"X"]) Env
env

give_ :: [Funcons] -> Funcons
give_ [Funcons]
fargs = Name -> [Funcons] -> Funcons
FApp Name
"give" ([Funcons]
fargs)
stepGive :: NonStrictFuncon
stepGive [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 FPattern
PWildCard (Name -> FTerm
TName Name
"values"),FPattern -> FTerm -> FPattern
PAnnotated (MetaVar -> FPattern
PMetaVar MetaVar
"W") (Name -> FTerm
TName Name
"values")] Env
forall k a. Map k a
env
            FTerm -> Env -> NullaryFuncon
rewriteTermTo (MetaVar -> FTerm
TVar MetaVar
"W") 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 -> FPattern
PMetaVar MetaVar
"V") (Name -> FTerm
TName Name
"values"),MetaVar -> FPattern
PMetaVar MetaVar
"Y"] Env
forall k a. Map k a
env
            Env
env <- Name -> [VPattern] -> Env -> MSOS Env
getInhPatt Name
"given-value" [MetaVar -> SeqSortOp -> VPattern
VPSeqVar MetaVar
"___" SeqSortOp
QuestionMarkOp] Env
env
            Env
env <- Name -> FTerm -> Env -> MSOS Env -> MSOS Env
forall a. Name -> FTerm -> Env -> MSOS a -> MSOS a
withInhTerm Name
"given-value" (MetaVar -> FTerm
TVar MetaVar
"V") 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
"give" [MetaVar -> FTerm
TVar MetaVar
"V",MetaVar -> FTerm
TVar MetaVar
"Y'"]) Env
env

given_ :: Funcons
given_ = Name -> Funcons
FName Name
"given"
stepGiven :: NullaryFuncon
stepGiven = [NullaryFuncon] -> [MSOS StepRes] -> NullaryFuncon
evalRules [] [MSOS StepRes
step1,MSOS StepRes
step2]
    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 -> [VPattern] -> Env -> MSOS Env
getInhPatt Name
"given-value" [VPattern -> FTerm -> VPattern
VPAnnotated (MetaVar -> VPattern
VPMetaVar MetaVar
"V") (Name -> FTerm
TName Name
"values")] Env
forall k a. Map k a
env
            FTerm -> Env -> MSOS StepRes
stepTermTo (MetaVar -> FTerm
TVar MetaVar
"V") 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 <- Name -> [VPattern] -> Env -> MSOS Env
getInhPatt Name
"given-value" [] Env
forall k a. Map k a
env
            FTerm -> Env -> MSOS StepRes
stepTermTo (Name -> FTerm
TName Name
"fail") Env
env

no_given_ :: [Funcons] -> Funcons
no_given_ [Funcons]
fargs = Name -> [Funcons] -> Funcons
FApp Name
"no-given" ([Funcons]
fargs)
stepNo_given :: NonStrictFuncon
stepNo_given [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 -> FPattern
PMetaVar MetaVar
"U") (Name -> FTerm
TName Name
"values")] Env
forall k a. Map k a
env
            FTerm -> Env -> NullaryFuncon
rewriteTermTo (MetaVar -> FTerm
TVar MetaVar
"U") 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 -> [VPattern] -> Env -> MSOS Env
getInhPatt Name
"given-value" [MetaVar -> SeqSortOp -> VPattern
VPSeqVar MetaVar
"___" SeqSortOp
QuestionMarkOp] Env
env
            Env
env <- Name -> FTerm -> Env -> MSOS Env -> MSOS Env
forall a. Name -> FTerm -> Env -> MSOS a -> MSOS a
withInhTerm Name
"given-value" ([FTerm] -> FTerm
TSeq []) 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
"no-given" [MetaVar -> FTerm
TVar MetaVar
"X'"]) Env
env

left_to_right_map_ :: [Funcons] -> Funcons
left_to_right_map_ [Funcons]
fargs = Name -> [Funcons] -> Funcons
FApp Name
"left-to-right-map" ([Funcons]
fargs)
stepLeft_to_right_map :: NonStrictFuncon
stepLeft_to_right_map [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 [MetaVar -> FPattern
PMetaVar MetaVar
"F",FPattern -> FTerm -> FPattern
PAnnotated (MetaVar -> FPattern
PMetaVar MetaVar
"V") (Name -> FTerm
TName Name
"values"),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 (Name -> [FTerm] -> FTerm
TApp Name
"left-to-right" [Name -> [FTerm] -> FTerm
TApp Name
"give" [MetaVar -> FTerm
TVar MetaVar
"V",MetaVar -> FTerm
TVar MetaVar
"F"],Name -> [FTerm] -> FTerm
TApp Name
"left-to-right-map" [MetaVar -> FTerm
TVar MetaVar
"F",MetaVar -> FTerm
TVar MetaVar
"V*"]]) 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 [FPattern
PWildCard] Env
forall k a. Map k a
env
            FTerm -> Env -> NullaryFuncon
rewriteTermTo ([FTerm] -> FTerm
TSeq []) Env
env

interleave_map_ :: [Funcons] -> Funcons
interleave_map_ [Funcons]
fargs = Name -> [Funcons] -> Funcons
FApp Name
"interleave-map" ([Funcons]
fargs)
stepInterleave_map :: NonStrictFuncon
stepInterleave_map [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 [MetaVar -> FPattern
PMetaVar MetaVar
"F",FPattern -> FTerm -> FPattern
PAnnotated (MetaVar -> FPattern
PMetaVar MetaVar
"V") (Name -> FTerm
TName Name
"values"),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 (Name -> [FTerm] -> FTerm
TApp Name
"interleave" [Name -> [FTerm] -> FTerm
TApp Name
"give" [MetaVar -> FTerm
TVar MetaVar
"V",MetaVar -> FTerm
TVar MetaVar
"F"],Name -> [FTerm] -> FTerm
TApp Name
"interleave-map" [MetaVar -> FTerm
TVar MetaVar
"F",MetaVar -> FTerm
TVar MetaVar
"V*"]]) 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 [FPattern
PWildCard] Env
forall k a. Map k a
env
            FTerm -> Env -> NullaryFuncon
rewriteTermTo ([FTerm] -> FTerm
TSeq []) Env
env

left_to_right_repeat_ :: [Funcons] -> Funcons
left_to_right_repeat_ [Funcons]
fargs = Name -> [Funcons] -> Funcons
FApp Name
"left-to-right-repeat" ([Funcons]
fargs)
stepLeft_to_right_repeat :: NonStrictFuncon
stepLeft_to_right_repeat [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 [MetaVar -> FPattern
PMetaVar MetaVar
"F",FPattern -> FTerm -> FPattern
PAnnotated (MetaVar -> FPattern
PMetaVar MetaVar
"M") (Name -> FTerm
TName Name
"integers"),FPattern -> FTerm -> FPattern
PAnnotated (MetaVar -> FPattern
PMetaVar MetaVar
"N") (Name -> FTerm
TName Name
"integers")] Env
forall k a. Map k a
env
            Env
env <- SideCondition -> Env -> Rewrite Env
sideCondition (FTerm -> FTerm -> SideCondition
SCEquality (Name -> [FTerm] -> FTerm
TApp Name
"is-less-or-equal" [MetaVar -> FTerm
TVar MetaVar
"M",MetaVar -> FTerm
TVar MetaVar
"N"]) (Name -> FTerm
TName Name
"true")) Env
env
            FTerm -> Env -> NullaryFuncon
rewriteTermTo (Name -> [FTerm] -> FTerm
TApp Name
"left-to-right" [Name -> [FTerm] -> FTerm
TApp Name
"give" [MetaVar -> FTerm
TVar MetaVar
"M",MetaVar -> FTerm
TVar MetaVar
"F"],Name -> [FTerm] -> FTerm
TApp Name
"left-to-right-repeat" [MetaVar -> FTerm
TVar MetaVar
"F",Name -> [FTerm] -> FTerm
TApp Name
"int-add" [MetaVar -> FTerm
TVar MetaVar
"M",Funcons -> FTerm
TFuncon (Values -> Funcons
FValue (Integer -> Values
forall t. Integer -> Values t
Nat Integer
1))],MetaVar -> FTerm
TVar MetaVar
"N"]]) 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 [FPattern
PWildCard,FPattern -> FTerm -> FPattern
PAnnotated (MetaVar -> FPattern
PMetaVar MetaVar
"M") (Name -> FTerm
TName Name
"integers"),FPattern -> FTerm -> FPattern
PAnnotated (MetaVar -> FPattern
PMetaVar MetaVar
"N") (Name -> FTerm
TName Name
"integers")] Env
forall k a. Map k a
env
            Env
env <- SideCondition -> Env -> Rewrite Env
sideCondition (FTerm -> FTerm -> SideCondition
SCEquality (Name -> [FTerm] -> FTerm
TApp Name
"is-less-or-equal" [MetaVar -> FTerm
TVar MetaVar
"M",MetaVar -> FTerm
TVar MetaVar
"N"]) (Name -> FTerm
TName Name
"false")) Env
env
            FTerm -> Env -> NullaryFuncon
rewriteTermTo ([FTerm] -> FTerm
TSeq []) Env
env

interleave_repeat_ :: [Funcons] -> Funcons
interleave_repeat_ [Funcons]
fargs = Name -> [Funcons] -> Funcons
FApp Name
"interleave-repeat" ([Funcons]
fargs)
stepInterleave_repeat :: NonStrictFuncon
stepInterleave_repeat [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 [MetaVar -> FPattern
PMetaVar MetaVar
"F",FPattern -> FTerm -> FPattern
PAnnotated (MetaVar -> FPattern
PMetaVar MetaVar
"M") (Name -> FTerm
TName Name
"integers"),FPattern -> FTerm -> FPattern
PAnnotated (MetaVar -> FPattern
PMetaVar MetaVar
"N") (Name -> FTerm
TName Name
"integers")] Env
forall k a. Map k a
env
            Env
env <- SideCondition -> Env -> Rewrite Env
sideCondition (FTerm -> FTerm -> SideCondition
SCEquality (Name -> [FTerm] -> FTerm
TApp Name
"is-less-or-equal" [MetaVar -> FTerm
TVar MetaVar
"M",MetaVar -> FTerm
TVar MetaVar
"N"]) (Name -> FTerm
TName Name
"true")) Env
env
            FTerm -> Env -> NullaryFuncon
rewriteTermTo (Name -> [FTerm] -> FTerm
TApp Name
"interleave" [Name -> [FTerm] -> FTerm
TApp Name
"give" [MetaVar -> FTerm
TVar MetaVar
"M",MetaVar -> FTerm
TVar MetaVar
"F"],Name -> [FTerm] -> FTerm
TApp Name
"interleave-repeat" [MetaVar -> FTerm
TVar MetaVar
"F",Name -> [FTerm] -> FTerm
TApp Name
"int-add" [MetaVar -> FTerm
TVar MetaVar
"M",Funcons -> FTerm
TFuncon (Values -> Funcons
FValue (Integer -> Values
forall t. Integer -> Values t
Nat Integer
1))],MetaVar -> FTerm
TVar MetaVar
"N"]]) 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 [FPattern
PWildCard,FPattern -> FTerm -> FPattern
PAnnotated (MetaVar -> FPattern
PMetaVar MetaVar
"M") (Name -> FTerm
TName Name
"integers"),FPattern -> FTerm -> FPattern
PAnnotated (MetaVar -> FPattern
PMetaVar MetaVar
"N") (Name -> FTerm
TName Name
"integers")] Env
forall k a. Map k a
env
            Env
env <- SideCondition -> Env -> Rewrite Env
sideCondition (FTerm -> FTerm -> SideCondition
SCEquality (Name -> [FTerm] -> FTerm
TApp Name
"is-less-or-equal" [MetaVar -> FTerm
TVar MetaVar
"M",MetaVar -> FTerm
TVar MetaVar
"N"]) (Name -> FTerm
TName Name
"false")) Env
env
            FTerm -> Env -> NullaryFuncon
rewriteTermTo ([FTerm] -> FTerm
TSeq []) Env
env

left_to_right_filter_ :: [Funcons] -> Funcons
left_to_right_filter_ [Funcons]
fargs = Name -> [Funcons] -> Funcons
FApp Name
"left-to-right-filter" ([Funcons]
fargs)
stepLeft_to_right_filter :: NonStrictFuncon
stepLeft_to_right_filter [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 [MetaVar -> FPattern
PMetaVar MetaVar
"P",FPattern -> FTerm -> FPattern
PAnnotated (MetaVar -> FPattern
PMetaVar MetaVar
"V") (Name -> FTerm
TName Name
"values"),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 (Name -> [FTerm] -> FTerm
TApp Name
"left-to-right" [Name -> [FTerm] -> FTerm
TApp Name
"when-true" [Name -> [FTerm] -> FTerm
TApp Name
"give" [MetaVar -> FTerm
TVar MetaVar
"V",MetaVar -> FTerm
TVar MetaVar
"P"],MetaVar -> FTerm
TVar MetaVar
"V"],Name -> [FTerm] -> FTerm
TApp Name
"left-to-right-filter" [MetaVar -> FTerm
TVar MetaVar
"P",MetaVar -> FTerm
TVar MetaVar
"V*"]]) 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 [FPattern
PWildCard] Env
forall k a. Map k a
env
            FTerm -> Env -> NullaryFuncon
rewriteTermTo ([FTerm] -> FTerm
TSeq []) Env
env

interleave_filter_ :: [Funcons] -> Funcons
interleave_filter_ [Funcons]
fargs = Name -> [Funcons] -> Funcons
FApp Name
"interleave-filter" ([Funcons]
fargs)
stepInterleave_filter :: NonStrictFuncon
stepInterleave_filter [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 [MetaVar -> FPattern
PMetaVar MetaVar
"P",FPattern -> FTerm -> FPattern
PAnnotated (MetaVar -> FPattern
PMetaVar MetaVar
"V") (Name -> FTerm
TName Name
"values"),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 (Name -> [FTerm] -> FTerm
TApp Name
"interleave" [Name -> [FTerm] -> FTerm
TApp Name
"when-true" [Name -> [FTerm] -> FTerm
TApp Name
"give" [MetaVar -> FTerm
TVar MetaVar
"V",MetaVar -> FTerm
TVar MetaVar
"P"],MetaVar -> FTerm
TVar MetaVar
"V"],Name -> [FTerm] -> FTerm
TApp Name
"interleave-filter" [MetaVar -> FTerm
TVar MetaVar
"P",MetaVar -> FTerm
TVar MetaVar
"V*"]]) 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 [FPattern
PWildCard] Env
forall k a. Map k a
env
            FTerm -> Env -> NullaryFuncon
rewriteTermTo ([FTerm] -> FTerm
TSeq []) Env
env

fold_left_ :: [Funcons] -> Funcons
fold_left_ [Funcons]
fargs = Name -> [Funcons] -> Funcons
FApp Name
"fold-left" ([Funcons]
fargs)
stepFold_left :: NonStrictFuncon
stepFold_left [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 [FPattern
PWildCard,FPattern -> FTerm -> FPattern
PAnnotated (MetaVar -> FPattern
PMetaVar MetaVar
"A") (Name -> FTerm
TName Name
"values")] Env
forall k a. Map k a
env
            FTerm -> Env -> NullaryFuncon
rewriteTermTo (MetaVar -> FTerm
TVar MetaVar
"A") 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
"F",FPattern -> FTerm -> FPattern
PAnnotated (MetaVar -> FPattern
PMetaVar MetaVar
"A") (Name -> FTerm
TName Name
"values"),FPattern -> FTerm -> FPattern
PAnnotated (MetaVar -> FPattern
PMetaVar MetaVar
"V") (Name -> FTerm
TName Name
"values"),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 (Name -> [FTerm] -> FTerm
TApp Name
"fold-left" [MetaVar -> FTerm
TVar MetaVar
"F",Name -> [FTerm] -> FTerm
TApp Name
"give" [Name -> [FTerm] -> FTerm
TApp Name
"tuple" [MetaVar -> FTerm
TVar MetaVar
"A",MetaVar -> FTerm
TVar MetaVar
"V"],MetaVar -> FTerm
TVar MetaVar
"F"],MetaVar -> FTerm
TVar MetaVar
"V*"]) Env
env

fold_right_ :: [Funcons] -> Funcons
fold_right_ [Funcons]
fargs = Name -> [Funcons] -> Funcons
FApp Name
"fold-right" ([Funcons]
fargs)
stepFold_right :: NonStrictFuncon
stepFold_right [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 [FPattern
PWildCard,FPattern -> FTerm -> FPattern
PAnnotated (MetaVar -> FPattern
PMetaVar MetaVar
"A") (Name -> FTerm
TName Name
"values")] Env
forall k a. Map k a
env
            FTerm -> Env -> NullaryFuncon
rewriteTermTo (MetaVar -> FTerm
TVar MetaVar
"A") 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
"F",FPattern -> FTerm -> FPattern
PAnnotated (MetaVar -> FPattern
PMetaVar MetaVar
"A") (Name -> FTerm
TName Name
"values"),FPattern -> FTerm -> FPattern
PAnnotated (MetaVar -> SeqSortOp -> FPattern
PSeqVar MetaVar
"V*" SeqSortOp
StarOp) (FTerm -> SeqSortOp -> FTerm
TSortSeq (Name -> FTerm
TName Name
"values") SeqSortOp
StarOp),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 (Name -> [FTerm] -> FTerm
TApp Name
"give" [Name -> [FTerm] -> FTerm
TApp Name
"tuple" [MetaVar -> FTerm
TVar MetaVar
"V",Name -> [FTerm] -> FTerm
TApp Name
"fold-right" [MetaVar -> FTerm
TVar MetaVar
"F",MetaVar -> FTerm
TVar MetaVar
"A",MetaVar -> FTerm
TVar MetaVar
"V*"]],MetaVar -> FTerm
TVar MetaVar
"F"]) Env
env