<commit_before>{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE UndecidableInstances #-}
-- | This module defines the concept of a simplification rule for
-- bindings.  The intent is that you pass some context (such as symbol
-- table) and a binding, and is given back a sequence of bindings that
-- compute the same result, but are "better" in some sense.
--
-- These rewrite rules are "local", in that they do not maintain any
-- state or look at the program as a whole.  Compare this to the
-- fusion algorithm in @Futhark.Optimise.Fusion.Fusion@, which must be implemented
-- as its own pass.
module Futhark.Optimise.Simplifier.Rule
       ( -- * The rule monad
         RuleM
       , cannotSimplify
       , liftMaybe

       -- * Rule definition
       , SimplificationRule(..)
       , RuleGeneric
       , RuleBasicOp
       , RuleIf
       , RuleDoLoop

       -- * Top-down rules
       , TopDown
       , TopDownRule
       , TopDownRuleGeneric
       , TopDownRuleBasicOp
       , TopDownRuleIf
       , TopDownRuleDoLoop
       , TopDownRuleOp

       -- * Bottom-up rules
       , BottomUp
       , BottomUpRule
       , BottomUpRuleGeneric
       , BottomUpRuleBasicOp
       , BottomUpRuleIf
       , BottomUpRuleDoLoop
       , BottomUpRuleOp

       -- * Assembling rules
       , RuleBook
       , ruleBook

         -- * Applying rules
       , topDownSimplifyStm
       , bottomUpSimplifyStm
       ) where

import Data.Monoid
import Control.Monad.State

import qualified Futhark.Analysis.SymbolTable as ST
import qualified Futhark.Analysis.UsageTable as UT
import Futhark.Representation.AST
import Futhark.Binder

-- | The monad in which simplification rules are evaluated.
newtype RuleM lore a = RuleM (BinderT lore (StateT VNameSource Maybe) a)
  deriving (Functor, Applicative, Monad,
            MonadBinder, MonadFreshNames, HasScope lore, LocalScope lore)

-- | Execute a 'RuleM' action.  If succesful, returns the result and a
-- list of new bindings.  Even if the action fail, there may still be
-- a monadic effect - particularly, the name source may have been
-- modified.
simplify :: (MonadFreshNames m, HasScope lore m, BinderOps lore) =>
            RuleM lore a
         -> m (Maybe (a, Stms lore))
simplify (RuleM m) = do
  scope <- askScope
  modifyNameSource $ \src ->
    case runStateT (runBinderT m scope) src of
      Nothing        -> (Nothing, src)<commit_msg>Compatibility with older GHCs.<commit_after>{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE TypeFamilies #-}
-- | This module defines the concept of a simplification rule for
-- bindings.  The intent is that you pass some context (such as symbol
-- table) and a binding, and is given back a sequence of bindings that
-- compute the same result, but are "better" in some sense.
--
-- These rewrite rules are "local", in that they do not maintain any
-- state or look at the program as a whole.  Compare this to the
-- fusion algorithm in @Futhark.Optimise.Fusion.Fusion@, which must be implemented
-- as its own pass.
module Futhark.Optimise.Simplifier.Rule
       ( -- * The rule monad
         RuleM
       , cannotSimplify
       , liftMaybe

       -- * Rule definition
       , SimplificationRule(..)
       , RuleGeneric
       , RuleBasicOp
       , RuleIf
       , RuleDoLoop

       -- * Top-down rules
       , TopDown
       , TopDownRule
       , TopDownRuleGeneric
       , TopDownRuleBasicOp
       , TopDownRuleIf
       , TopDownRuleDoLoop
       , TopDownRuleOp

       -- * Bottom-up rules
       , BottomUp
       , BottomUpRule
       , BottomUpRuleGeneric
       , BottomUpRuleBasicOp
       , BottomUpRuleIf
       , BottomUpRuleDoLoop
       , BottomUpRuleOp

       -- * Assembling rules
       , RuleBook
       , ruleBook

         -- * Applying rules
       , topDownSimplifyStm
       , bottomUpSimplifyStm
       ) where

import Data.Monoid
import Control.Monad.State

import qualified Futhark.Analysis.SymbolTable as ST
import qualified Futhark.Analysis.UsageTable as UT
import Futhark.Representation.AST
import Futhark.Binder

-- | The monad in which simplification rules are evaluated.
newtype RuleM lore a = RuleM (BinderT lore (StateT VNameSource Maybe) a)
  deriving (Functor, Applicative, Monad,
            MonadFreshNames, HasScope lore, LocalScope lore)

instance (Attributes lore, BinderOps lore) => MonadBinder (RuleM lore) where
  type Lore (RuleM lore) = lore
  mkExpAttrM pat e = RuleM $ mkExpAttrM pat e
  mkBodyM bnds res = RuleM $ mkBodyM bnds res
  mkLetNamesM pat e = RuleM $ mkLetNamesM pat e

  addStms = RuleM . addStms
  collectStms (RuleM m) = RuleM $ collectStms m
  certifying cs (RuleM m) = RuleM $ certifying cs m

-- | Execute a 'RuleM' action.  If succesful, returns the result and a
-- list of new bindings.  Even if the action fail, there may still be
-- a monadic effect - particularly, the name source may have been
-- modified.
simplify :: (MonadFreshNames m, HasScope lore m, BinderOps lore) =>
            RuleM lore a
         -> m (Maybe (a, Stms lore))
simplify (RuleM m) = do
  scope <- askScope
  modifyNameSource $ \src ->
    case runStateT (runBinderT m scope) src of
      Nothing        -> (Nothing, src)
{'fraction_non_alphanumeric': 0.0772273497833867, 'fraction_numerical': 0.0, 'mean_word_length': 2.551839464882943, 'pattern_counts': {'":': 0, '<': 5, '<?xml version=': 0, '>': 12, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '4725889', 'n_tokens_mistral': 1653, 'n_tokens_neox': 1576, 'n_words': 549}