-- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Data flow/Storing/Simple variables/current-value.aterm
{-# LANGUAGE OverloadedStrings #-}

module Funcons.Core.Computations.DataFlow.Storing.SimpleVariables.CurrentValue where

import Funcons.EDSL

entities = []

types = typeEnvFromList
    []

funcons = libFromList
    [("current-value",StrictFuncon stepCurrent_value)]

-- |
-- If /V/ is a variable, /current-value(V)/ computes the value currently
--   assigned to /V/ .  Otherwise it evaluates to /V/ .
current_value_ fargs = FApp "current-value" (FTuple fargs)
stepCurrent_value fargs =
    evalRules [rewrite1,rewrite2] []
    where rewrite1 = do
            let env = emptyEnv
            env <- vsMatch fargs [VPMetaVar "V"] env
            env <- sideCondition (SCIsInSort (TVar "V") (TName "all-variables")) env
            rewriteTermTo (TApp "assigned" (TTuple [TVar "V"])) env
          rewrite2 = do
            let env = emptyEnv
            env <- vsMatch fargs [VPMetaVar "V"] env
            env <- sideCondition (SCNotInSort (TVar "V") (TName "all-variables")) env
            rewriteTermTo (TVar "V") env