Links.hs

-- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Data flow/Linking/links.aterm
{-# LANGUAGE OverloadedStrings #-}

module Funcons.Core.Computations.DataFlow.Linking.Links where

import Funcons.EDSL

entities = []

types = typeEnvFromList
    [("reynolds-links",DataTypeMembers [(Just "Accepting",TName "types"),(Just "Producing",TName "types")] [DataTypeConstructor "simple-link" (TTuple [TName "atoms",TName "types"]),DataTypeConstructor "reynolds-link" (TTuple [TName "atoms",TName "types",TName "types"])])]

funcons = libFromList
    [("links",StrictFuncon stepLinks),("all-links",NullaryFuncon stepAll_links),("link-accepting-type",StrictFuncon stepLink_accepting_type),("link-producing-type",StrictFuncon stepLink_producing_type),("reynolds-links",StrictFuncon stepReynolds_links),("simple-link",StrictFuncon stepSimple_link),("reynolds-link",StrictFuncon stepReynolds_link)]

links_ fargs = FApp "links" (FTuple fargs)
stepLinks fargs =
    evalRules [rewrite1] []
    where rewrite1 = do
            let env = emptyEnv
            env <- vsMatch fargs [VPAnnotated (VPMetaVar "T") (TName "values")] env
            rewriteTermTo (TApp "reynolds-links" (TTuple [TVar "T",TVar "T"])) env

all_links_ = FName "all-links"
stepAll_links = evalRules [rewrite1] []
    where rewrite1 = do
            let env = emptyEnv
            rewriteTo (FApp "reynolds-links" (FTuple [FName "empty-type",FName "values"]))

-- |
-- /link-accepting-type(L)/ returns the type of values that /L/ accepts.
--   /link-producing-type(L)/ returns the type of values that /L/ can produce.
link_accepting_type_ fargs = FApp "link-accepting-type" (FTuple fargs)
stepLink_accepting_type fargs =
    evalRules [rewrite1,rewrite2] []
    where rewrite1 = do
            let env = emptyEnv
            env <- vsMatch fargs [PADT "simple-link" [VPWildCard,VPMetaVar "T"]] env
            rewriteTermTo (TVar "T") env
          rewrite2 = do
            let env = emptyEnv
            env <- vsMatch fargs [PADT "reynolds-link" [VPWildCard,VPMetaVar "Accepting",VPWildCard]] env
            rewriteTermTo (TVar "Accepting") env

link_producing_type_ fargs = FApp "link-producing-type" (FTuple fargs)
stepLink_producing_type fargs =
    evalRules [rewrite1,rewrite2] []
    where rewrite1 = do
            let env = emptyEnv
            env <- vsMatch fargs [PADT "simple-link" [VPWildCard,VPMetaVar "T"]] env
            rewriteTermTo (TVar "T") env
          rewrite2 = do
            let env = emptyEnv
            env <- vsMatch fargs [PADT "reynolds-link" [VPWildCard,VPWildCard,VPMetaVar "Producing"]] env
            rewriteTermTo (TVar "Producing") env

stepSimple_link vs = rewritten (ADTVal "simple-link" vs)

stepReynolds_link vs = rewritten (ADTVal "reynolds-link" vs)

stepReynolds_links ts = rewriteType "reynolds-links" ts