funcons-tools-0.1.0.0: cbs/Funcons/Core/Computations/DataFlow/Storing/Variables.hs
-- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Data flow/Storing/variables.aterm
{-# LANGUAGE OverloadedStrings #-}
module Funcons.Core.Computations.DataFlow.Storing.Variables where
import Funcons.EDSL
entities = []
types = typeEnvFromList
[("reynolds-variables",DataTypeMembers [(Just "Accepting",TName "types"),(Just "Producing",TName "types")] [DataTypeConstructor "simple-variable" (TTuple [TName "atoms",TName "types"]),DataTypeConstructor "reynolds-variable" (TTuple [TName "atoms",TName "types",TName "types"])])]
funcons = libFromList
[("variables",StrictFuncon stepVariables),("all-variables",NullaryFuncon stepAll_variables),("variable-accepting-type",StrictFuncon stepVariable_accepting_type),("variable-producing-type",StrictFuncon stepVariable_producing_type),("reynolds-variables",StrictFuncon stepReynolds_variables),("simple-variable",StrictFuncon stepSimple_variable),("reynolds-variable",StrictFuncon stepReynolds_variable)]
variables_ fargs = FApp "variables" (FTuple fargs)
stepVariables fargs =
evalRules [rewrite1] []
where rewrite1 = do
let env = emptyEnv
env <- vsMatch fargs [VPAnnotated (VPMetaVar "T") (TName "values")] env
rewriteTermTo (TApp "reynolds-variables" (TTuple [TVar "T",TVar "T"])) env
all_variables_ = FName "all-variables"
stepAll_variables = evalRules [rewrite1] []
where rewrite1 = do
let env = emptyEnv
rewriteTo (FApp "reynolds-variables" (FTuple [FName "empty-type",FName "values"]))
-- |
-- /variable-accepting-type(Var)/ returns the type of values that /Var/ accepts.
-- /variable-producing-type(Var)/ returns the type of values that /Var/ can produce.
variable_accepting_type_ fargs = FApp "variable-accepting-type" (FTuple fargs)
stepVariable_accepting_type fargs =
evalRules [rewrite1,rewrite2] []
where rewrite1 = do
let env = emptyEnv
env <- vsMatch fargs [PADT "simple-variable" [VPWildCard,VPMetaVar "T"]] env
rewriteTermTo (TVar "T") env
rewrite2 = do
let env = emptyEnv
env <- vsMatch fargs [PADT "reynolds-variable" [VPWildCard,VPMetaVar "Accepting",VPWildCard]] env
rewriteTermTo (TVar "Accepting") env
variable_producing_type_ fargs = FApp "variable-producing-type" (FTuple fargs)
stepVariable_producing_type fargs =
evalRules [rewrite1,rewrite2] []
where rewrite1 = do
let env = emptyEnv
env <- vsMatch fargs [PADT "simple-variable" [VPWildCard,VPMetaVar "T"]] env
rewriteTermTo (TVar "T") env
rewrite2 = do
let env = emptyEnv
env <- vsMatch fargs [PADT "reynolds-variable" [VPWildCard,VPWildCard,VPMetaVar "Producing"]] env
rewriteTermTo (TVar "Producing") env
stepSimple_variable vs = rewritten (ADTVal "simple-variable" vs)
stepReynolds_variable vs = rewritten (ADTVal "reynolds-variable" vs)
stepReynolds_variables ts = rewriteType "reynolds-variables" ts