-- GeNeRaTeD fOr: /home/thomas/repos/plancomps/CBS-beta/Unstable-Funcons-beta/Computations/Normal/Memos/Memos.cbs
{-# LANGUAGE OverloadedStrings #-}

module Funcons.Core.Computations.Normal.Memos.Memos 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-memos",NonStrictFuncon -> EvalFunction
NonStrictFuncon NonStrictFuncon
stepInitialise_memos),(Name
"memo-value",[Strictness] -> Strictness -> NonStrictFuncon -> EvalFunction
PartiallyStrictFuncon [Strictness
Strict,Strictness
NonStrict] Strictness
NonStrict NonStrictFuncon
stepMemo_value),(Name
"initialise-memo-value",StrictFuncon -> EvalFunction
StrictFuncon StrictFuncon
stepInitialise_memo_value),(Name
"memo-value-recall",StrictFuncon -> EvalFunction
StrictFuncon StrictFuncon
stepMemo_value_recall)]

initialise_memos_ :: [Funcons] -> Funcons
initialise_memos_ [Funcons]
fargs = Name -> [Funcons] -> Funcons
FApp Name
"initialise-memos" ([Funcons]
fargs)
stepInitialise_memos :: NonStrictFuncon
stepInitialise_memos [Funcons]
fargs =
    [Rewrite Rewritten] -> [MSOS StepRes] -> Rewrite Rewritten
evalRules [] [MSOS StepRes
step1]
    where step1 :: MSOS StepRes
step1 = do
            let env :: Map k a
env = forall {k} {a}. Map k a
emptyEnv
            Env
env <- [Funcons] -> [FPattern] -> Env -> MSOS Env
lifted_fsMatch [Funcons]
fargs [MetaVar -> FPattern
PMetaVar MetaVar
"X"] forall {k} {a}. Map k a
env
            Env
env <- Name -> [VPattern] -> Env -> MSOS Env
getMutPatt Name
"memo-map" [VPattern
VPWildCard] Env
env
            Name -> FTerm -> Env -> MSOS ()
putMutTerm Name
"memo-map" (Name -> [FTerm] -> FTerm
TApp Name
"map" []) Env
env
            FTerm -> Env -> MSOS StepRes
stepTermTo (MetaVar -> FTerm
TVar MetaVar
"X") Env
env

memo_value_ :: [Funcons] -> Funcons
memo_value_ [Funcons]
fargs = Name -> [Funcons] -> Funcons
FApp Name
"memo-value" ([Funcons]
fargs)
stepMemo_value :: NonStrictFuncon
stepMemo_value [Funcons]
fargs =
    [Rewrite Rewritten] -> [MSOS StepRes] -> Rewrite Rewritten
evalRules [Rewrite Rewritten
rewrite1] []
    where rewrite1 :: Rewrite Rewritten
rewrite1 = do
            let env :: Map k a
env = 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
"K") (Name -> FTerm
TName Name
"ground-values"),MetaVar -> FPattern
PMetaVar MetaVar
"X"] forall {k} {a}. Map k a
env
            FTerm -> Env -> Rewrite Rewritten
rewriteTermTo (Name -> [FTerm] -> FTerm
TApp Name
"else" [Name -> [FTerm] -> FTerm
TApp Name
"memo-value-recall" [MetaVar -> FTerm
TVar MetaVar
"K"],Name -> [FTerm] -> FTerm
TApp Name
"give" [MetaVar -> FTerm
TVar MetaVar
"X",Name -> [FTerm] -> FTerm
TApp Name
"sequential" [Name -> [FTerm] -> FTerm
TApp Name
"else" [Name -> [FTerm] -> FTerm
TApp Name
"initialise-memo-value" [MetaVar -> FTerm
TVar MetaVar
"K",Name -> FTerm
TName Name
"given"],Name -> FTerm
TName Name
"null-value"],Name -> [FTerm] -> FTerm
TApp Name
"memo-value-recall" [MetaVar -> FTerm
TVar MetaVar
"K"]]]]) Env
env

initialise_memo_value_ :: [Funcons] -> Funcons
initialise_memo_value_ [Funcons]
fargs = Name -> [Funcons] -> Funcons
FApp Name
"initialise-memo-value" ([Funcons]
fargs)
stepInitialise_memo_value :: StrictFuncon
stepInitialise_memo_value [Values]
fargs =
    [Rewrite Rewritten] -> [MSOS StepRes] -> Rewrite Rewritten
evalRules [] [MSOS StepRes
step1,MSOS StepRes
step2]
    where step1 :: MSOS StepRes
step1 = do
            let env :: Map k a
env = 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
"K") (Name -> FTerm
TName Name
"ground-values"),VPattern -> FTerm -> VPattern
VPAnnotated (MetaVar -> VPattern
VPMetaVar MetaVar
"V") (Name -> FTerm
TName Name
"values")] forall {k} {a}. Map k a
env
            Env
env <- Name -> [VPattern] -> Env -> MSOS Env
getMutPatt Name
"memo-map" [MetaVar -> VPattern
VPMetaVar MetaVar
"M"] Env
env
            Env
env <- SideCondition -> Env -> MSOS Env
lifted_sideCondition (FTerm -> [VPattern] -> SideCondition
SCPatternMatch (Name -> [FTerm] -> FTerm
TApp Name
"map-unite" [MetaVar -> FTerm
TVar MetaVar
"M",[FTerm] -> FTerm
TMap [FTerm -> FTerm -> FTerm
TBinding (MetaVar -> FTerm
TVar MetaVar
"K") (MetaVar -> FTerm
TVar MetaVar
"V")]]) [MetaVar -> VPattern
VPMetaVar MetaVar
"M'"]) Env
env
            Name -> FTerm -> Env -> MSOS ()
putMutTerm Name
"memo-map" (MetaVar -> FTerm
TVar MetaVar
"M'") Env
env
            FTerm -> Env -> MSOS StepRes
stepTermTo (Name -> FTerm
TName Name
"null-value") Env
env
          step2 :: MSOS StepRes
step2 = do
            let env :: Map k a
env = 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
"K") (Name -> FTerm
TName Name
"ground-values"),VPattern -> FTerm -> VPattern
VPAnnotated (MetaVar -> VPattern
VPMetaVar MetaVar
"V") (Name -> FTerm
TName Name
"values")] forall {k} {a}. Map k a
env
            Env
env <- Name -> [VPattern] -> Env -> MSOS Env
getMutPatt Name
"memo-map" [MetaVar -> VPattern
VPMetaVar MetaVar
"M"] Env
env
            Env
env <- SideCondition -> Env -> MSOS Env
lifted_sideCondition (FTerm -> [VPattern] -> SideCondition
SCPatternMatch (Name -> [FTerm] -> FTerm
TApp Name
"map-unite" [MetaVar -> FTerm
TVar MetaVar
"M",[FTerm] -> FTerm
TMap [FTerm -> FTerm -> FTerm
TBinding (MetaVar -> FTerm
TVar MetaVar
"K") (MetaVar -> FTerm
TVar MetaVar
"V")]]) []) Env
env
            Name -> FTerm -> Env -> MSOS ()
putMutTerm Name
"memo-map" (MetaVar -> FTerm
TVar MetaVar
"M") Env
env
            FTerm -> Env -> MSOS StepRes
stepTermTo (Name -> FTerm
TName Name
"fail") Env
env

memo_value_recall_ :: [Funcons] -> Funcons
memo_value_recall_ [Funcons]
fargs = Name -> [Funcons] -> Funcons
FApp Name
"memo-value-recall" ([Funcons]
fargs)
stepMemo_value_recall :: StrictFuncon
stepMemo_value_recall [Values]
fargs =
    [Rewrite Rewritten] -> [MSOS StepRes] -> Rewrite Rewritten
evalRules [] [MSOS StepRes
step1,MSOS StepRes
step2]
    where step1 :: MSOS StepRes
step1 = do
            let env :: Map k a
env = 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
"K") (Name -> FTerm
TName Name
"ground-values")] forall {k} {a}. Map k a
env
            Env
env <- Name -> [VPattern] -> Env -> MSOS Env
getMutPatt Name
"memo-map" [MetaVar -> VPattern
VPMetaVar MetaVar
"M"] Env
env
            Env
env <- SideCondition -> Env -> MSOS Env
lifted_sideCondition (FTerm -> [VPattern] -> SideCondition
SCPatternMatch (Name -> [FTerm] -> FTerm
TApp Name
"lookup" [MetaVar -> FTerm
TVar MetaVar
"M",MetaVar -> FTerm
TVar MetaVar
"K"]) [MetaVar -> VPattern
VPMetaVar MetaVar
"V"]) Env
env
            Name -> FTerm -> Env -> MSOS ()
putMutTerm Name
"memo-map" (MetaVar -> FTerm
TVar MetaVar
"M") Env
env
            FTerm -> Env -> MSOS StepRes
stepTermTo (MetaVar -> FTerm
TVar MetaVar
"V") Env
env
          step2 :: MSOS StepRes
step2 = do
            let env :: Map k a
env = 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
"K") (Name -> FTerm
TName Name
"ground-values")] forall {k} {a}. Map k a
env
            Env
env <- Name -> [VPattern] -> Env -> MSOS Env
getMutPatt Name
"memo-map" [MetaVar -> VPattern
VPMetaVar MetaVar
"M"] Env
env
            Env
env <- SideCondition -> Env -> MSOS Env
lifted_sideCondition (FTerm -> [VPattern] -> SideCondition
SCPatternMatch (Name -> [FTerm] -> FTerm
TApp Name
"lookup" [MetaVar -> FTerm
TVar MetaVar
"M",MetaVar -> FTerm
TVar MetaVar
"K"]) []) Env
env
            Name -> FTerm -> Env -> MSOS ()
putMutTerm Name
"memo-map" (MetaVar -> FTerm
TVar MetaVar
"M") Env
env
            FTerm -> Env -> MSOS StepRes
stepTermTo (Name -> FTerm
TName Name
"fail") Env
env