Recursive.hs

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

module Funcons.Core.Computations.DataFlow.Binding.Recursion.Recursive where

import Funcons.EDSL

entities = []

types = typeEnvFromList
    []

funcons = libFromList
    [("recursive",PartiallyStrictFuncon [Strict,NonStrict] stepRecursive),("bind-to-forward-links",StrictFuncon stepBind_to_forward_links),("set-forward-links",StrictFuncon stepSet_forward_links),("reclose",PartiallyStrictFuncon [Strict,NonStrict] stepReclose)]

-- |
-- /recursive(Bs,D)/ evaluates /D/ with potential recursion on the binders
--   in /Bs/ (which need not be the same as the set of binders bound by /D/ ).
recursive_ fargs = FApp "recursive" (FTuple fargs)
stepRecursive fargs@[arg1,arg2] =
    evalRules [rewrite1] []
    where rewrite1 = do
            let env = emptyEnv
            env <- fsMatch fargs [PAnnotated (PMetaVar "Bs") (TName "values"),PMetaVar "Decl"] env
            rewriteTermTo (TApp "reclose" (TTuple [TApp "bind-to-forward-links" (TTuple [TVar "Bs"]),TVar "Decl"])) env
stepRecursive fargs = sortErr (FApp "recursive" (FTuple fargs)) "invalid number of arguments"

bind_to_forward_links_ fargs = FApp "bind-to-forward-links" (FTuple fargs)
stepBind_to_forward_links fargs =
    evalRules [rewrite1] []
    where rewrite1 = do
            let env = emptyEnv
            env <- vsMatch fargs [VPAnnotated (VPMetaVar "Bs") (TName "values")] env
            rewriteTermTo (TApp "set-to-map" (TTuple [TApp "set-map" (TTuple [TTuple [TName "given",TApp "allocate-link" (TTuple [TName "values"])],TVar "Bs"])])) env

set_forward_links_ fargs = FApp "set-forward-links" (FTuple fargs)
stepSet_forward_links fargs =
    evalRules [rewrite1] []
    where rewrite1 = do
            let env = emptyEnv
            env <- vsMatch fargs [VPAnnotated (VPMetaVar "M") (TName "values")] env
            rewriteTermTo (TApp "effect" (TTuple [TApp "map-map" (TTuple [TApp "set-link" (TTuple [TName "given2",TApp "bound" (TTuple [TName "given1"])]),TVar "M"])])) env

reclose_ fargs = FApp "reclose" (FTuple fargs)
stepReclose fargs@[arg1,arg2] =
    evalRules [rewrite1] []
    where rewrite1 = do
            let env = emptyEnv
            env <- fsMatch fargs [PAnnotated (PMetaVar "M") (TName "values"),PMetaVar "Decl"] env
            rewriteTermTo (TApp "accumulate" (TTuple [TApp "scope" (TTuple [TVar "M",TVar "Decl"]),TApp "sequential" (TTuple [TApp "set-forward-links" (TTuple [TVar "M"]),TName "map-empty"])])) env
stepReclose fargs = sortErr (FApp "reclose" (FTuple fargs)) "invalid number of arguments"