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

module Funcons.Core.Computations.Normal.Indexing.Indexing 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-index",NullaryFuncon -> EvalFunction
NullaryFuncon NullaryFuncon
stepInitialise_index),(Name
"allocate-index",StrictFuncon -> EvalFunction
StrictFuncon StrictFuncon
stepAllocate_index),(Name
"lookup-index",StrictFuncon -> EvalFunction
StrictFuncon StrictFuncon
stepLookup_index)]

initialise_index_ :: Funcons
initialise_index_ = Name -> Funcons
FName Name
"initialise-index"
stepInitialise_index :: NullaryFuncon
stepInitialise_index = [NullaryFuncon] -> [MSOS StepRes] -> NullaryFuncon
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 <- Name -> [VPattern] -> Env -> MSOS Env
getMutPatt Name
"value-index" [VPattern
VPWildCard] forall {k} {a}. Map k a
env
            Name -> FTerm -> Env -> MSOS ()
putMutTerm Name
"value-index" ([FTerm] -> FTerm
TSeq []) Env
env
            FTerm -> Env -> MSOS StepRes
stepTermTo (Name -> FTerm
TName Name
"null-value") Env
env

allocate_index_ :: [Funcons] -> Funcons
allocate_index_ [Funcons]
fargs = Name -> [Funcons] -> Funcons
FApp Name
"allocate-index" ([Funcons]
fargs)
stepAllocate_index :: StrictFuncon
stepAllocate_index [Values]
fargs =
    [NullaryFuncon] -> [MSOS StepRes] -> NullaryFuncon
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 <- [Values] -> [VPattern] -> Env -> MSOS Env
lifted_vsMatch [Values]
fargs [VPattern -> FTerm -> VPattern
VPAnnotated (MetaVar -> VPattern
VPMetaVar MetaVar
"V") (Name -> FTerm
TName Name
"ground-values")] forall {k} {a}. Map k a
env
            Env
env <- Name -> [VPattern] -> Env -> MSOS Env
getMutPatt Name
"value-index" [MetaVar -> SeqSortOp -> VPattern
VPSeqVar MetaVar
"V*" SeqSortOp
StarOp] Env
env
            Name -> FTerm -> Env -> MSOS ()
putMutTerm Name
"value-index" ([FTerm] -> FTerm
TSeq [MetaVar -> FTerm
TVar MetaVar
"V*",MetaVar -> FTerm
TVar MetaVar
"V"]) Env
env
            FTerm -> Env -> MSOS StepRes
stepTermTo (Name -> [FTerm] -> FTerm
TApp Name
"length" [MetaVar -> FTerm
TVar MetaVar
"V*",MetaVar -> FTerm
TVar MetaVar
"V"]) Env
env

lookup_index_ :: [Funcons] -> Funcons
lookup_index_ [Funcons]
fargs = Name -> [Funcons] -> Funcons
FApp Name
"lookup-index" ([Funcons]
fargs)
stepLookup_index :: StrictFuncon
stepLookup_index [Values]
fargs =
    [NullaryFuncon] -> [MSOS StepRes] -> NullaryFuncon
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 <- [Values] -> [VPattern] -> Env -> MSOS Env
lifted_vsMatch [Values]
fargs [VPattern -> FTerm -> VPattern
VPAnnotated (MetaVar -> VPattern
VPMetaVar MetaVar
"N") (Name -> FTerm
TName Name
"natural-numbers")] forall {k} {a}. Map k a
env
            Env
env <- Name -> [VPattern] -> Env -> MSOS Env
getMutPatt Name
"value-index" [MetaVar -> SeqSortOp -> VPattern
VPSeqVar MetaVar
"V*" SeqSortOp
StarOp] Env
env
            Name -> FTerm -> Env -> MSOS ()
putMutTerm Name
"value-index" (MetaVar -> FTerm
TVar MetaVar
"V*") Env
env
            FTerm -> Env -> MSOS StepRes
stepTermTo (Name -> [FTerm] -> FTerm
TApp Name
"index" [MetaVar -> FTerm
TVar MetaVar
"N",MetaVar -> FTerm
TVar MetaVar
"V*"]) Env
env