<commit_before>-- | Futhark compiler internal pipeline.
module Futhark.Pipeline
  (
    runPasses
  , FutharkM
  , PipelineState (..)
  , Pass (..)
  , canFail
  , polyPass
  , basicPass
  , unfailableBasicPass
  , basicProg
  , CompileError(..)
  , compileError
  , Action
  , actionDescription
  , applyAction
  , polyAction
  , basicAction
  , explicitMemoryAction
  , FutharkConfig(..)
  , verbose
  )

where

import Control.Applicative
import Control.Monad
import Control.Monad.Trans
import Control.Monad.Writer.Strict (Writer, tell)
import Control.Monad.Except
import Data.Maybe (isJust)

import qualified Text.PrettyPrint.Mainland as PP

import Futhark.Representation.AST (Prog)
import qualified Futhark.Representation.Basic as Basic
import qualified Futhark.Representation.ExplicitMemory as ExplicitMemory
import Futhark.TypeCheck

runPasses :: FutharkConfig -> PipelineState -> FutharkM PipelineState
runPasses config = foldl comb return $ futharkpipeline config
  where comb prev pass prog = do
          prog' <- prev prog
          when (verbose config) $ tell $ "Running " ++ passName pass ++ ".\n"
          res <- lift $ runExceptT $ passOp pass prog'
          case res of
            Left err ->
              compileError ("Error during pass '" ++ passName pass ++ "':\n" ++ errorDesc err)
                           (Just prog')
            Right prog'' ->
              validateState config pass prog''

validationError :: Pass -> PipelineState -> String -> FutharkM a
validationError pass s err =
  compileError msg $ Just s
  where msg = "Type error after pass '" ++ passName pass ++ "':\n" ++ err

validateState :: FutharkConfig -> Pass -> PipelineState -> FutharkM PipelineState
validateState config pass (Basic prog) =
  case typeCheck config prog of
    Left err -> validationError pass (Basic prog) $ show err
    Right {} -> return $ Basic prog
validateState config pass (ExplicitMemory prog) =
  case typeCheck config prog of
    Left err -> validationError pass (ExplicitMemory prog) $ show err
    Right {} -> return $ ExplicitMemory prog

data CompileError = CompileError {
    errorDesc :: String
  , errorState :: Maybe PipelineState
  }

type FutharkM = ExceptT CompileError (Writer String)

data PipelineState = Basic Basic.Prog
                   | ExplicitMemory ExplicitMemory.Prog

instance PP.Pretty PipelineState where
  ppr (Basic prog)          = PP.ppr prog
  ppr (ExplicitMemory prog) = PP.ppr prog

data Pass = Pass {
    passName :: String
  , passOp :: PipelineState -> FutharkM PipelineState
  }

data Action = Action String (PipelineState -> IO ())

actionDescription :: Action -> String
actionDescription (Action name _) = name

applyAction :: Action -> PipelineState -> IO ()
applyAction (Action _ f) = f

data FutharkConfig = FutharkConfig {
    futharkpipeline :: [Pass]
  , futharkaction :: Action
  , futharkcheckAliases :: Bool
  , futharkverbose :: Maybe (Maybe FilePath)
  , futharkboundsCheck :: Bool
}

verbose :: FutharkConfig -> Bool
verbose = isJust . futharkverbose

compileError :: String -> Maybe PipelineState -> FutharkM a
compileError s p = throwError $ CompileError s p

typeCheck :: Checkable lore => FutharkConfig -> Prog lore
          -> Either (TypeError lore) (Prog lore)
typeCheck config prog = either Left (const $ Right prog) $ check prog<commit_msg>Print aliases when showing compiler pipeline state.<commit_after>-- | Futhark compiler internal pipeline.
module Futhark.Pipeline
  (
    runPasses
  , FutharkM
  , PipelineState (..)
  , Pass (..)
  , canFail
  , polyPass
  , basicPass
  , unfailableBasicPass
  , basicProg
  , CompileError(..)
  , compileError
  , Action
  , actionDescription
  , applyAction
  , polyAction
  , basicAction
  , explicitMemoryAction
  , FutharkConfig(..)
  , verbose
  )

where

import Control.Applicative
import Control.Monad
import Control.Monad.Trans
import Control.Monad.Writer.Strict (Writer, tell)
import Control.Monad.Except
import Data.Maybe (isJust)

import qualified Text.PrettyPrint.Mainland as PP

import Futhark.Representation.AST (Prog)
import qualified Futhark.Representation.Basic as Basic
import qualified Futhark.Representation.ExplicitMemory as ExplicitMemory
import Futhark.TypeCheck
import Futhark.Analysis.Alias

runPasses :: FutharkConfig -> PipelineState -> FutharkM PipelineState
runPasses config = foldl comb return $ futharkpipeline config
  where comb prev pass prog = do
          prog' <- prev prog
          when (verbose config) $ tell $ "Running " ++ passName pass ++ ".\n"
          res <- lift $ runExceptT $ passOp pass prog'
          case res of
            Left err ->
              compileError ("Error during pass '" ++ passName pass ++ "':\n" ++ errorDesc err)
                           (Just prog')
            Right prog'' ->
              validateState config pass prog''

validationError :: Pass -> PipelineState -> String -> FutharkM a
validationError pass s err =
  compileError msg $ Just s
  where msg = "Type error after pass '" ++ passName pass ++ "':\n" ++ err

validateState :: FutharkConfig -> Pass -> PipelineState -> FutharkM PipelineState
validateState config pass (Basic prog) =
  case typeCheck config prog of
    Left err -> validationError pass (Basic prog) $ show err
    Right {} -> return $ Basic prog
validateState config pass (ExplicitMemory prog) =
  case typeCheck config prog of
    Left err -> validationError pass (ExplicitMemory prog) $ show err
    Right {} -> return $ ExplicitMemory prog

data CompileError = CompileError {
    errorDesc :: String
  , errorState :: Maybe PipelineState
  }

type FutharkM = ExceptT CompileError (Writer String)

data PipelineState = Basic Basic.Prog
                   | ExplicitMemory ExplicitMemory.Prog

instance PP.Pretty PipelineState where
  ppr (Basic prog)          = PP.ppr $ aliasAnalysis prog
  ppr (ExplicitMemory prog) = PP.ppr $ aliasAnalysis prog

data Pass = Pass {
    passName :: String
  , passOp :: PipelineState -> FutharkM PipelineState
  }

data Action = Action String (PipelineState -> IO ())

actionDescription :: Action -> String
actionDescription (Action name _) = name

applyAction :: Action -> PipelineState -> IO ()
applyAction (Action _ f) = f

data FutharkConfig = FutharkConfig {
    futharkpipeline :: [Pass]
  , futharkaction :: Action
  , futharkcheckAliases :: Bool
  , futharkverbose :: Maybe (Maybe FilePath)
  , futharkboundsCheck :: Bool
}

verbose :: FutharkConfig -> Bool
verbose = isJust . futharkverbose

compileError :: String -> Maybe PipelineState -> FutharkM a
compileError s p = throwError $ CompileError s p

typeCheck :: Checkable lore => FutharkConfig -> Prog lore
          -> Either (TypeError lore) (Prog lore)
typeCheck config prog = either Left (const $ Right prog) $ check prog
{'fraction_non_alphanumeric': 0.08887902987281869, 'fraction_numerical': 0.0, 'mean_word_length': 3.258816120906801, 'pattern_counts': {'":': 0, '<': 7, '<?xml version=': 0, '>': 53, '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': '5074871', 'n_tokens_mistral': 1999, 'n_tokens_neox': 1936, 'n_words': 633}