Accumulate.hs

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

module Funcons.Core.Computations.DataFlow.Binding.Accumulate where

import Funcons.EDSL

entities = []

types = typeEnvFromList
    []

funcons = libFromList
    [("accumulate",NonStrictFuncon stepAccumulate)]

-- |
-- /accumulate(D1,D*)/ first evaluates /D1/ to /Rho1/ .
--   It then lets /Rho1/ override the current environment during the evaluation
--   of /accumulate(D*)/ to /Rho2/ , and finally computes /Rho2/ overriding /Rho1/ .
--   /accumulate()/ computes /map-empty/ .
accumulate_ fargs = FApp "accumulate" (FTuple fargs)
stepAccumulate fargs =
    evalRules [rewrite1,rewrite2,rewrite3] [step1]
    where rewrite1 = do
            let env = emptyEnv
            env <- fsMatch fargs [] env
            rewriteTo (FName "map-empty")
          rewrite2 = do
            let env = emptyEnv
            env <- fsMatch fargs [PAnnotated (PMetaVar "Rho") (TName "environments")] env
            rewriteTermTo (TVar "Rho") env
          rewrite3 = do
            let env = emptyEnv
            env <- fsMatch fargs [PAnnotated (PMetaVar "Rho") (TName "environments"),PSeqVar "D+" PlusOp] env
            rewriteTermTo (TApp "scope" (TTuple [TVar "Rho",TApp "map-override" (TTuple [TApp "accumulate" (TTuple [TVar "D+"]),TVar "Rho"])])) env
          step1 = do
            let env = emptyEnv
            env <- lifted_fsMatch fargs [PMetaVar "D",PSeqVar "D*" StarOp] env
            env <- premise (TVar "D") (PMetaVar "D'") env
            stepTermTo (TApp "accumulate" (TTuple [TVar "D'",TVar "D*"])) env