Pragma.hs

module UHC.Light.Compiler.Base.Pragma
( Pragma (..)
, allSimplePragmaMp, showAllSimplePragmas', showAllSimplePragmas
, pragmaIsExcludeTarget
, pragmaInvolvesCmdLine )
where
import qualified Data.Map as Map
import Data.List
import UHC.Util.Pretty
import UHC.Util.Utils
import UHC.Light.Compiler.Base.HsName
import UHC.Light.Compiler.Base.Target
import UHC.Util.Binary
import UHC.Util.Serialize
import Control.Monad
import UHC.Light.Compiler.Opts.CommandLine

{-# LINE 33 "src/ehc/Base/Pragma.chs" #-}
-- | Data type representing pragmas.
--   The names of the constructors must begin with "Pragma_", the string used in the map allSimplePragmaMp.
data Pragma
  = Pragma_NoImplicitPrelude                -- no implicit prelude
  | Pragma_CPP                              -- preprocess with cpp
  | Pragma_Derivable                        -- generic derivability
      { pragmaDerivClassName        :: HsName       -- the class name for which
      , pragmaDerivFieldName        :: HsName       -- this field is derivable
      , pragmaDerivDefaultName      :: HsName       -- using this default value
      }
  | Pragma_NoGenericDeriving                -- turn off generic deriving
  | Pragma_GenericDeriving                  -- turn on generic deriving (default)
  | Pragma_NoBangPatterns               	-- turn off bang patterns
  | Pragma_BangPatterns                  	-- turn on bang patterns (default)
  | Pragma_NoPolyKinds               		-- turn off polymorphic kinds (default)
  | Pragma_PolyKinds                  		-- turn on
  | Pragma_NoOverloadedStrings         		-- turn off overloaded strings (default)
  | Pragma_OverloadedStrings           		-- turn on
  | Pragma_ExtensibleRecords                -- turn on extensible records
  | Pragma_Fusion               			-- turn on fusion syntax
  | Pragma_OptionsUHC              			-- commandline options
      { pragmaOptions   			:: String
      }
  | Pragma_ExcludeIfTarget
      { pragmaExcludeTargets   		:: [Target]
      }
{-
  | Pragma_CHR              			    -- CHR rules
      { pragmaCHR   			    :: String
      }
-}
  deriving (Eq,Ord,Show,Typeable,Generic)


{-# LINE 69 "src/ehc/Base/Pragma.chs" #-}
-- | All pragmas not requiring further arguments, these are accepted as LANGUAGE pragma when included in this map.
allSimplePragmaMp :: Map.Map String Pragma
allSimplePragmaMp
  = Map.fromList ts
  where ts
          = [ (drop prefixLen $ show t, t)
            | t <-
                  [ Pragma_NoImplicitPrelude
                  , Pragma_CPP
                  , Pragma_GenericDeriving
                  , Pragma_NoGenericDeriving
                  , Pragma_BangPatterns
                  , Pragma_NoBangPatterns
                  , Pragma_NoPolyKinds
                  , Pragma_PolyKinds
                  , Pragma_NoOverloadedStrings
                  , Pragma_OverloadedStrings
                  , Pragma_ExtensibleRecords
                  , Pragma_Fusion
                  ]
            ]
        prefixLen = length "Pragma_"

showAllSimplePragmas' :: String -> String
showAllSimplePragmas'
  = showStringMapKeys allSimplePragmaMp

showAllSimplePragmas :: String
showAllSimplePragmas
  = showAllSimplePragmas' " "

{-# LINE 106 "src/ehc/Base/Pragma.chs" #-}
pragmaIsExcludeTarget :: Target -> Pragma -> Bool
pragmaIsExcludeTarget t (Pragma_ExcludeIfTarget ts) = t `elem` ts
pragmaIsExcludeTarget _ _                           = False

{-# LINE 112 "src/ehc/Base/Pragma.chs" #-}
pragmaInvolvesCmdLine :: Pragma -> Bool
pragmaInvolvesCmdLine (Pragma_CPP         ) = True
pragmaInvolvesCmdLine (Pragma_OptionsUHC _) = True
pragmaInvolvesCmdLine _                     = False

{-# LINE 123 "src/ehc/Base/Pragma.chs" #-}
instance Serialize Pragma