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

module Funcons.Core.Computations.Normal.Linking.Linking where

import Funcons.EDSL

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

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

funcons :: FunconLibrary
funcons = [(Name, EvalFunction)] -> FunconLibrary
libFromList
    [(Name
"link",StrictFuncon -> EvalFunction
StrictFuncon StrictFuncon
stepLink),(Name
"initialise-linking",NonStrictFuncon -> EvalFunction
NonStrictFuncon NonStrictFuncon
stepInitialise_linking),(Name
"fresh-link",NonStrictFuncon -> EvalFunction
NonStrictFuncon NonStrictFuncon
stepFresh_link),(Name
"fresh-initialised-link",[Strictness] -> Strictness -> NonStrictFuncon -> EvalFunction
PartiallyStrictFuncon [Strictness
NonStrict,Strictness
Strict] Strictness
NonStrict NonStrictFuncon
stepFresh_initialised_link),(Name
"fresh-init-link",[Strictness] -> Strictness -> NonStrictFuncon -> EvalFunction
PartiallyStrictFuncon [Strictness
NonStrict,Strictness
Strict] Strictness
NonStrict NonStrictFuncon
stepFresh_initialised_link),(Name
"set-link",StrictFuncon -> EvalFunction
StrictFuncon StrictFuncon
stepSet_link),(Name
"follow-link",StrictFuncon -> EvalFunction
StrictFuncon StrictFuncon
stepFollow_link),(Name
"follow-if-link",StrictFuncon -> EvalFunction
StrictFuncon StrictFuncon
stepFollow_if_link),(Name
"links",NullaryFuncon -> EvalFunction
NullaryFuncon NullaryFuncon
stepLinks)]

link_ :: [Funcons] -> Funcons
link_ [Funcons]
fargs = Name -> [Funcons] -> Funcons
FApp Name
"link" ([Funcons]
fargs)
stepLink :: StrictFuncon
stepLink [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
108)]),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
107)])])),MetaVar -> FTerm
TVar MetaVar
"_X1"]) Env
env

initialise_linking_ :: [Funcons] -> Funcons
initialise_linking_ [Funcons]
fargs = Name -> [Funcons] -> Funcons
FApp Name
"initialise-linking" ([Funcons]
fargs)
stepInitialise_linking :: NonStrictFuncon
stepInitialise_linking [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
"initialise-storing" [MetaVar -> FTerm
TVar MetaVar
"X"]) Env
env

fresh_link_ :: [Funcons] -> Funcons
fresh_link_ [Funcons]
fargs = Name -> [Funcons] -> Funcons
FApp Name
"fresh-link" ([Funcons]
fargs)
stepFresh_link :: NonStrictFuncon
stepFresh_link [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
"T"] Env
forall k a. Map k a
env
            FTerm -> Env -> NullaryFuncon
rewriteTermTo (Name -> [FTerm] -> FTerm
TApp Name
"link" [Name -> [FTerm] -> FTerm
TApp Name
"allocate-variable" [MetaVar -> FTerm
TVar MetaVar
"T"]]) Env
env

fresh_initialised_link_ :: [Funcons] -> Funcons
fresh_initialised_link_ [Funcons]
fargs = Name -> [Funcons] -> Funcons
FApp Name
"fresh-initialised-link" ([Funcons]
fargs)
fresh_init_link_ :: [Funcons] -> Funcons
fresh_init_link_ [Funcons]
fargs = Name -> [Funcons] -> Funcons
FApp Name
"fresh-initialised-link" ([Funcons]
fargs)
stepFresh_initialised_link :: NonStrictFuncon
stepFresh_initialised_link [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
"T",FPattern -> FTerm -> FPattern
PAnnotated (MetaVar -> FPattern
PMetaVar MetaVar
"V") (MetaVar -> FTerm
TVar MetaVar
"T")] Env
forall k a. Map k a
env
            FTerm -> Env -> NullaryFuncon
rewriteTermTo (Name -> [FTerm] -> FTerm
TApp Name
"link" [Name -> [FTerm] -> FTerm
TApp Name
"allocate-initialised-variable" [MetaVar -> FTerm
TVar MetaVar
"T",MetaVar -> FTerm
TVar MetaVar
"V"]]) Env
env

set_link_ :: [Funcons] -> Funcons
set_link_ [Funcons]
fargs = Name -> [Funcons] -> Funcons
FApp Name
"set-link" ([Funcons]
fargs)
stepSet_link :: StrictFuncon
stepSet_link [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 [Name -> [VPattern] -> VPattern
PADT Name
"link" [VPattern -> FTerm -> VPattern
VPAnnotated (MetaVar -> VPattern
VPMetaVar MetaVar
"Var") (Name -> FTerm
TName Name
"variables")],VPattern -> FTerm -> VPattern
VPAnnotated (MetaVar -> VPattern
VPMetaVar MetaVar
"V") (Name -> FTerm
TName Name
"values")] Env
forall k a. Map k a
env
            FTerm -> Env -> NullaryFuncon
rewriteTermTo (Name -> [FTerm] -> FTerm
TApp Name
"initialise-variable" [MetaVar -> FTerm
TVar MetaVar
"Var",MetaVar -> FTerm
TVar MetaVar
"V"]) Env
env

follow_link_ :: [Funcons] -> Funcons
follow_link_ [Funcons]
fargs = Name -> [Funcons] -> Funcons
FApp Name
"follow-link" ([Funcons]
fargs)
stepFollow_link :: StrictFuncon
stepFollow_link [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 [Name -> [VPattern] -> VPattern
PADT Name
"link" [VPattern -> FTerm -> VPattern
VPAnnotated (MetaVar -> VPattern
VPMetaVar MetaVar
"Var") (Name -> FTerm
TName Name
"variables")]] Env
forall k a. Map k a
env
            FTerm -> Env -> NullaryFuncon
rewriteTermTo (Name -> [FTerm] -> FTerm
TApp Name
"assigned" [MetaVar -> FTerm
TVar MetaVar
"Var"]) Env
env

follow_if_link_ :: [Funcons] -> Funcons
follow_if_link_ [Funcons]
fargs = Name -> [Funcons] -> Funcons
FApp Name
"follow-if-link" ([Funcons]
fargs)
stepFollow_if_link :: StrictFuncon
stepFollow_if_link [Values]
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 <- [Values] -> [VPattern] -> Env -> Rewrite Env
vsMatch [Values]
fargs [Name -> [VPattern] -> VPattern
PADT Name
"link" [VPattern -> FTerm -> VPattern
VPAnnotated (MetaVar -> VPattern
VPMetaVar MetaVar
"Var") (Name -> FTerm
TName Name
"variables")]] Env
forall k a. Map k a
env
            FTerm -> Env -> NullaryFuncon
rewriteTermTo (Name -> [FTerm] -> FTerm
TApp Name
"assigned" [MetaVar -> FTerm
TVar MetaVar
"Var"]) Env
env
          rewrite2 :: NullaryFuncon
rewrite2 = 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 -> VPattern
VPMetaVar MetaVar
"V") (FTerm -> FTerm
TSortComplement (Name -> FTerm
TName Name
"links"))] Env
forall k a. Map k a
env
            FTerm -> Env -> NullaryFuncon
rewriteTermTo (MetaVar -> FTerm
TVar MetaVar
"V") Env
env

links_ :: Funcons
links_ = Name -> Funcons
FName Name
"links"
stepLinks :: NullaryFuncon
stepLinks = Name -> StrictFuncon
rewriteType Name
"links" []