-- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Data flow/Linking/set-link.aterm {-# LANGUAGE OverloadedStrings #-} module Funcons.Core.Computations.DataFlow.Linking.SetLink where import Funcons.EDSL entities = [] types = typeEnvFromList [] funcons = libFromList [("set-link",StrictFuncon stepSet_link)] -- | -- /set-link(L,V)/ sets the value linked to by /L/ to be /V/ . -- If /L/ has already been set, then computation instead /fail/ s. set_link_ fargs = FApp "set-link" (FTuple fargs) stepSet_link fargs = evalRules [] [step1,step2,step3,step4] where step1 = do let env = emptyEnv env <- lifted_vsMatch fargs [VPMetaVar "L",VPMetaVar "V"] env env <- getMutPatt "link-store" (VPMetaVar "Sigma") env env <- lifted_sideCondition (SCIsInSort (TApp "lookup" (TTuple [TVar "L",TVar "Sigma"])) (TName "uninitialised-values")) env env <- lifted_sideCondition (SCIsInSort (TVar "V") (TApp "link-accepting-type" (TTuple [TVar "L"]))) env putMutTerm "link-store" (TTuple [TApp "map-override" (TTuple [TMap [TTuple [TVar "L",TVar "V"]],TVar "Sigma"])]) env stepTo (FTuple []) step2 = do let env = emptyEnv env <- lifted_vsMatch fargs [VPMetaVar "L",VPAnnotated (VPMetaVar "V") (TName "values")] env env <- getMutPatt "link-store" (VPMetaVar "Sigma") env env <- lifted_sideCondition (SCEquality (TApp "is-in-set" (TTuple [TVar "L",TApp "domain" (TTuple [TVar "Sigma"])])) (TName "false")) env putMutTerm "link-store" (TTuple [TVar "Sigma"]) env stepTo (FName "fail") step3 = do let env = emptyEnv env <- lifted_vsMatch fargs [VPMetaVar "L",VPAnnotated (VPMetaVar "V") (TName "values")] env env <- getMutPatt "link-store" (VPMetaVar "Sigma") env env <- lifted_sideCondition (SCNotInSort (TApp "lookup" (TTuple [TVar "L",TVar "Sigma"])) (TName "uninitialised-values")) env putMutTerm "link-store" (TTuple [TVar "Sigma"]) env stepTo (FName "fail") step4 = do let env = emptyEnv env <- lifted_vsMatch fargs [VPMetaVar "L",VPMetaVar "V"] env env <- getMutPatt "link-store" (VPMetaVar "Sigma") env env <- lifted_sideCondition (SCNotInSort (TVar "V") (TApp "link-accepting-type" (TTuple [TVar "L"]))) env putMutTerm "link-store" (TTuple [TVar "Sigma"]) env stepTo (FName "fail")