SetLink.hs

-- 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")