diff --git a/compiler/basicTypes/ConLike.lhs b/compiler/basicTypes/ConLike.lhs index de10d0fb0a2cb29158aa6660b71f2a013665d526..3414aa4230e480e509fe17b5cefc2e2ac8677775 100644 --- a/compiler/basicTypes/ConLike.lhs +++ b/compiler/basicTypes/ConLike.lhs @@ -5,6 +5,7 @@ \section[ConLike]{@ConLike@: Constructor-like things} \begin{code} +{-# LANGUAGE CPP, DeriveDataTypeable #-} module ConLike ( ConLike(..) diff --git a/compiler/basicTypes/DataCon.lhs b/compiler/basicTypes/DataCon.lhs index ad56290694ad63db05f3a24c0bd5a25cdbeaf54b..0dcf98f6c5708e77ab5c5efaa880ee3fb9f4d324 100644 --- a/compiler/basicTypes/DataCon.lhs +++ b/compiler/basicTypes/DataCon.lhs @@ -5,7 +5,8 @@ \section[DataCon]{@DataCon@: Data Constructors} \begin{code} -{-# OPTIONS -fno-warn-tabs #-} +{-# LANGUAGE CPP, DeriveDataTypeable #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/basicTypes/Demand.lhs b/compiler/basicTypes/Demand.lhs index 8a082b98adaeb4759d9840ad270c7d4675dd8705..e00a4f71c031bddef55ea3cfac11d0aed0b0e30b 100644 --- a/compiler/basicTypes/Demand.lhs +++ b/compiler/basicTypes/Demand.lhs @@ -5,6 +5,7 @@ \section[Demand]{@Demand@: A decoupled implementation of a demand domain} \begin{code} +{-# LANGUAGE CPP, FlexibleInstances, TypeSynonymInstances #-} module Demand ( StrDmd, UseDmd(..), Count(..), diff --git a/compiler/basicTypes/Id.lhs b/compiler/basicTypes/Id.lhs index aada6dccc21877e4c1db82b06e1d2023d90f1d71..b180dc7f9abb5f16f6950fe7ab2fdbf17a139d6e 100644 --- a/compiler/basicTypes/Id.lhs +++ b/compiler/basicTypes/Id.lhs @@ -5,6 +5,8 @@ \section[Id]{@Ids@: Value and constructor identifiers} \begin{code} +{-# LANGUAGE CPP #-} + -- | -- #name_types# -- GHC uses several kinds of name internally: diff --git a/compiler/basicTypes/IdInfo.lhs b/compiler/basicTypes/IdInfo.lhs index 94b3d2a71e32cbc29fcf8b2494a232d89a9ff427..d9bce17defa7befdcb421f134d4723cd29b89d04 100644 --- a/compiler/basicTypes/IdInfo.lhs +++ b/compiler/basicTypes/IdInfo.lhs @@ -8,7 +8,7 @@ Haskell. [WDP 94/11]) \begin{code} -{-# OPTIONS -fno-warn-tabs #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/basicTypes/Literal.lhs b/compiler/basicTypes/Literal.lhs index c77915fef66dd9e2b0b742f2c2565ef7c49f950f..13fbb4d46d596850dda62393f2f3c8fa7640314b 100644 --- a/compiler/basicTypes/Literal.lhs +++ b/compiler/basicTypes/Literal.lhs @@ -5,7 +5,7 @@ \section[Literal]{@Literal@: Machine literals (unboxed, of course)} \begin{code} -{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE CPP, DeriveDataTypeable #-} module Literal ( diff --git a/compiler/basicTypes/MkId.lhs b/compiler/basicTypes/MkId.lhs index 5f4b792359ec914f9012efc1b0e26ba1436bdf10..0678f7837f0017437d2839ad86f579964fd80f97 100644 --- a/compiler/basicTypes/MkId.lhs +++ b/compiler/basicTypes/MkId.lhs @@ -12,7 +12,8 @@ have a standard form, namely: - primitive operations \begin{code} -{-# OPTIONS -fno-warn-tabs #-} +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/basicTypes/Module.lhs b/compiler/basicTypes/Module.lhs index 90bf717a857ddac2076b506b33f122447617b35b..080ae47ac96e4ef4a102726b44038eecac4b6eed 100644 --- a/compiler/basicTypes/Module.lhs +++ b/compiler/basicTypes/Module.lhs @@ -9,6 +9,7 @@ These are Uniquable, hence we can build Maps with Modules as the keys. \begin{code} +{-# LANGUAGE DeriveDataTypeable #-} module Module ( diff --git a/compiler/basicTypes/Name.lhs b/compiler/basicTypes/Name.lhs index e2742bb3a8edbef3f1cbaaca917820c2a40763a8..c2e7aeabdc1f96f1767438281da92dd2b3656a93 100644 --- a/compiler/basicTypes/Name.lhs +++ b/compiler/basicTypes/Name.lhs @@ -5,6 +5,8 @@ \section[Name]{@Name@: to transmit name info from renamer to typechecker} \begin{code} +{-# LANGUAGE DeriveDataTypeable #-} + -- | -- #name_types# -- GHC uses several kinds of name internally: diff --git a/compiler/basicTypes/NameEnv.lhs b/compiler/basicTypes/NameEnv.lhs index 292ee3d1ecba128f2c03442c6316f2123b83a4ee..f39627706db80d6d73e35ac5fcee9cb1c51a40c0 100644 --- a/compiler/basicTypes/NameEnv.lhs +++ b/compiler/basicTypes/NameEnv.lhs @@ -5,7 +5,8 @@ \section[NameEnv]{@NameEnv@: name environments} \begin{code} -{-# OPTIONS -fno-warn-tabs #-} +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/basicTypes/NameSet.lhs b/compiler/basicTypes/NameSet.lhs index ed42c2b1aadf008a8bbba2735bdb5e6416acbbea..9cd9fcef939f89c1c23f1578ae7522dc9a0516e4 100644 --- a/compiler/basicTypes/NameSet.lhs +++ b/compiler/basicTypes/NameSet.lhs @@ -4,7 +4,8 @@ % \begin{code} -{-# OPTIONS -fno-warn-tabs #-} +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/basicTypes/OccName.lhs b/compiler/basicTypes/OccName.lhs index b41d711f69f9c37c5527ee9f311957840b3f13bd..7769192b5d4805e2e2d0c55a477ddec05d144c2e 100644 --- a/compiler/basicTypes/OccName.lhs +++ b/compiler/basicTypes/OccName.lhs @@ -4,6 +4,8 @@ % \begin{code} +{-# LANGUAGE DeriveDataTypeable #-} + -- | -- #name_types# -- GHC uses several kinds of name internally: @@ -20,7 +22,7 @@ -- -- * 'Var.Var': see "Var#name_types" -{-# OPTIONS -fno-warn-tabs #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/basicTypes/PatSyn.lhs b/compiler/basicTypes/PatSyn.lhs index 9285b3c365a7c9fd76407f50558cff9ae9ee6afd..fb62486e48b59d6f43853dd86fa54d6e9e4a5a35 100644 --- a/compiler/basicTypes/PatSyn.lhs +++ b/compiler/basicTypes/PatSyn.lhs @@ -5,6 +5,7 @@ \section[PatSyn]{@PatSyn@: Pattern synonyms} \begin{code} +{-# LANGUAGE CPP, DeriveDataTypeable #-} module PatSyn ( -- * Main data types diff --git a/compiler/basicTypes/RdrName.lhs b/compiler/basicTypes/RdrName.lhs index 3ff771f0fe3b43633420d04c5959ccdfabc66772..ceab80812e2cbf75c2cabda1505182b337c136b8 100644 --- a/compiler/basicTypes/RdrName.lhs +++ b/compiler/basicTypes/RdrName.lhs @@ -4,7 +4,7 @@ % \begin{code} -{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE CPP, DeriveDataTypeable #-} -- | -- #name_types# diff --git a/compiler/basicTypes/SrcLoc.lhs b/compiler/basicTypes/SrcLoc.lhs index d53ac2b0eacc450e8322d70afa7b9cdebca93c4a..ab58a4f9f5055ad70936fb7c8eaccb83cbee6070 100644 --- a/compiler/basicTypes/SrcLoc.lhs +++ b/compiler/basicTypes/SrcLoc.lhs @@ -3,6 +3,7 @@ % \begin{code} +{-# LANGUAGE DeriveDataTypeable #-} {-# OPTIONS_GHC -fno-omit-interface-pragmas #-} -- Workaround for Trac #5252 crashes the bootstrap compiler without -O -- When the earliest compiler we want to boostrap with is diff --git a/compiler/basicTypes/UniqSupply.lhs b/compiler/basicTypes/UniqSupply.lhs index fea1489efbd71cd66de472b826345e023acea29b..6ceee20793982e6c5347a82110529365c83e5b5a 100644 --- a/compiler/basicTypes/UniqSupply.lhs +++ b/compiler/basicTypes/UniqSupply.lhs @@ -4,6 +4,8 @@ % \begin{code} +{-# LANGUAGE UnboxedTuples #-} + module UniqSupply ( -- * Main data type UniqSupply, -- Abstractly diff --git a/compiler/basicTypes/Unique.lhs b/compiler/basicTypes/Unique.lhs index 037aed06419c1333d263b4afd5f5cbd62d0c358c..897b093e392361860882f57ea48533cdb2de2e08 100644 --- a/compiler/basicTypes/Unique.lhs +++ b/compiler/basicTypes/Unique.lhs @@ -16,7 +16,7 @@ Some of the other hair in this code is to be able to use a Haskell). \begin{code} -{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP, BangPatterns, MagicHash #-} module Unique ( -- * Main data types diff --git a/compiler/basicTypes/Var.lhs b/compiler/basicTypes/Var.lhs index 70c5d4491a6a6f99a4229c29d937b473de69a23c..1f20d4adeccc89c6244f4a753fb5e260b515d0fb 100644 --- a/compiler/basicTypes/Var.lhs +++ b/compiler/basicTypes/Var.lhs @@ -5,7 +5,8 @@ \section{@Vars@: Variables} \begin{code} -{-# OPTIONS -fno-warn-tabs #-} +{-# LANGUAGE CPP, DeriveDataTypeable #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/basicTypes/VarSet.lhs b/compiler/basicTypes/VarSet.lhs index b756283b91eb2f56d364df5ed1cdbf77bc04df2d..8b7f755dcd4bb71b71fa4b90ca86d8a2d6d6f235 100644 --- a/compiler/basicTypes/VarSet.lhs +++ b/compiler/basicTypes/VarSet.lhs @@ -4,7 +4,8 @@ % \begin{code} -{-# OPTIONS -fno-warn-tabs #-} +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/cmm/Bitmap.hs b/compiler/cmm/Bitmap.hs index 54db1a9a673bd3a308d1b3db5dc21c5b90341672..e7aa072063596a6293b05349d3b5bb2e806cbcb3 100644 --- a/compiler/cmm/Bitmap.hs +++ b/compiler/cmm/Bitmap.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + -- -- (c) The University of Glasgow 2003-2006 -- diff --git a/compiler/cmm/BlockId.hs b/compiler/cmm/BlockId.hs index 8a46aed8f0f64e613e8daba49ad856d367f97661..e4cc0bccb74119155ac5d345480146dfa002fbea 100644 --- a/compiler/cmm/BlockId.hs +++ b/compiler/cmm/BlockId.hs @@ -1,5 +1,7 @@ -{- BlockId module should probably go away completely, being superseded by Label -} +{-# LANGUAGE TypeSynonymInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} + +{- BlockId module should probably go away completely, being superseded by Label -} module BlockId ( BlockId, mkBlockId -- ToDo: BlockId should be abstract, but it isn't yet , BlockSet, BlockEnv diff --git a/compiler/cmm/Cmm.hs b/compiler/cmm/Cmm.hs index fadce0b5eb2bf40939395b20751767970131fe7e..e21efc13af8a6fc1d060beabcaa2189ae4df4d4d 100644 --- a/compiler/cmm/Cmm.hs +++ b/compiler/cmm/Cmm.hs @@ -1,5 +1,5 @@ -- Cmm representations using Hoopl's Graph CmmNode e x. -{-# LANGUAGE GADTs #-} +{-# LANGUAGE CPP, GADTs #-} module Cmm ( -- * Cmm top-level datatypes diff --git a/compiler/cmm/CmmBuildInfoTables.hs b/compiler/cmm/CmmBuildInfoTables.hs index 16ace5245f2f595481f544a2732fba3f6a92b4a8..e10716a2acfd0662bc30b39a7e91f160f8a0d450 100644 --- a/compiler/cmm/CmmBuildInfoTables.hs +++ b/compiler/cmm/CmmBuildInfoTables.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE GADTs #-} +{-# LANGUAGE CPP, GADTs #-} -- See Note [Deprecations in Hoopl] in Hoopl module {-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} diff --git a/compiler/cmm/CmmCallConv.hs b/compiler/cmm/CmmCallConv.hs index 60e2c8c8f73ffddf00bf2a49c3938ecd62873d81..f36fc0bae5dfa2690e2aadfb97f067e3d9bb9e7c 100644 --- a/compiler/cmm/CmmCallConv.hs +++ b/compiler/cmm/CmmCallConv.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} module CmmCallConv ( ParamLocation(..), diff --git a/compiler/cmm/CmmExpr.hs b/compiler/cmm/CmmExpr.hs index 0c0c9714ecea98db1d04c7ec5ec8a97906f7fb9b..1d6c97f41eea4a2881fa06a0824a827feea33d15 100644 --- a/compiler/cmm/CmmExpr.hs +++ b/compiler/cmm/CmmExpr.hs @@ -1,4 +1,7 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE UndecidableInstances #-} module CmmExpr diff --git a/compiler/cmm/CmmInfo.hs b/compiler/cmm/CmmInfo.hs index 42c9e6ba53f445759d6176ac4033798d3b45150c..aae3ea1c7195e6a09a97135c82a31cbb3ce7525e 100644 --- a/compiler/cmm/CmmInfo.hs +++ b/compiler/cmm/CmmInfo.hs @@ -1,4 +1,5 @@ -{-# OPTIONS -fno-warn-tabs #-} +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/cmm/CmmLayoutStack.hs b/compiler/cmm/CmmLayoutStack.hs index bdc947829d8f1278d4f0062f503c2d17c308c3c2..db22deb639ec08f3165a44c76f7bbc828a82f1b8 100644 --- a/compiler/cmm/CmmLayoutStack.hs +++ b/compiler/cmm/CmmLayoutStack.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE RecordWildCards, GADTs #-} +{-# LANGUAGE CPP, RecordWildCards, GADTs #-} module CmmLayoutStack ( cmmLayoutStack, setInfoTableStackMap ) where diff --git a/compiler/cmm/CmmLive.hs b/compiler/cmm/CmmLive.hs index 24202cbe8c1b573b5105843e5bfff3392aaab13e..dfacd139b605e2c6d8f60c4c2048c72e7b89dd7c 100644 --- a/compiler/cmm/CmmLive.hs +++ b/compiler/cmm/CmmLive.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE ScopedTypeVariables #-} diff --git a/compiler/cmm/CmmMachOp.hs b/compiler/cmm/CmmMachOp.hs index 684a4b97291b99c03944fd8bb6e90468f166447d..c4ec393ad60ded2bc93332ebe36d86250906c075 100644 --- a/compiler/cmm/CmmMachOp.hs +++ b/compiler/cmm/CmmMachOp.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} module CmmMachOp ( MachOp(..) diff --git a/compiler/cmm/CmmNode.hs b/compiler/cmm/CmmNode.hs index 5c520d389978f2ba088a982116e2394b5604d06c..7eb2b61d9a091e1169ba921ae916de7e58a7a2cf 100644 --- a/compiler/cmm/CmmNode.hs +++ b/compiler/cmm/CmmNode.hs @@ -1,9 +1,14 @@ --- CmmNode type for representation using Hoopl graphs. +{-# LANGUAGE CPP #-} +{-# LANGUAGE ExplicitForAll #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE UndecidableInstances #-} +-- CmmNode type for representation using Hoopl graphs. + module CmmNode ( CmmNode(..), CmmFormal, CmmActual, UpdFrameOffset, Convention(..), diff --git a/compiler/cmm/CmmOpt.hs b/compiler/cmm/CmmOpt.hs index 54dbbebae67a392d7ad37aa5c263893a8a27e7c0..84499b97de930b081932459a1be1e206aae85540 100644 --- a/compiler/cmm/CmmOpt.hs +++ b/compiler/cmm/CmmOpt.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + ----------------------------------------------------------------------------- -- -- Cmm optimisation diff --git a/compiler/cmm/CmmPipeline.hs b/compiler/cmm/CmmPipeline.hs index 1447f6d8cdc0fb34f4a27f05f39518d5dfdcc424..825ffb89d8886532568fdbacc9f94e6a059d0936 100644 --- a/compiler/cmm/CmmPipeline.hs +++ b/compiler/cmm/CmmPipeline.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE BangPatterns #-} + module CmmPipeline ( -- | Converts C-- with an implicit stack and native C-- calls into -- optimized, CPS converted and native-call-less C--. The latter diff --git a/compiler/cmm/CmmType.hs b/compiler/cmm/CmmType.hs index d03c2dc0b957afa05dcfe842085b7873461eb7ff..37d92c207d4f5de8d05f9324fb8053242a5c37f8 100644 --- a/compiler/cmm/CmmType.hs +++ b/compiler/cmm/CmmType.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} module CmmType ( CmmType -- Abstract diff --git a/compiler/cmm/CmmUtils.hs b/compiler/cmm/CmmUtils.hs index afba245fbc98af9d5582247bb09920681a929897..1f6d1ac0e352fe88332fb28891fa8ddd2ea09492 100644 --- a/compiler/cmm/CmmUtils.hs +++ b/compiler/cmm/CmmUtils.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE GADTs #-} +{-# LANGUAGE CPP, GADTs, RankNTypes #-} ----------------------------------------------------------------------------- -- diff --git a/compiler/cmm/Hoopl.hs b/compiler/cmm/Hoopl.hs index 2d7139af9fe9905dadac4df20c069b4f61d2c1f4..4b3717288f47f21616bb3b48a0ba981b25a89083 100644 --- a/compiler/cmm/Hoopl.hs +++ b/compiler/cmm/Hoopl.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE RankNTypes, ScopedTypeVariables #-} + module Hoopl ( module Compiler.Hoopl, module Hoopl.Dataflow, diff --git a/compiler/cmm/Hoopl/Dataflow.hs b/compiler/cmm/Hoopl/Dataflow.hs index 7105195d3ce7c67e831136712369b49430890bf3..f5511515a9313056ba51e9867f479ef0e214f659 100644 --- a/compiler/cmm/Hoopl/Dataflow.hs +++ b/compiler/cmm/Hoopl/Dataflow.hs @@ -1,3 +1,12 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE TypeFamilies #-} +{-# OPTIONS_GHC -fprof-auto-top #-} + -- -- Copyright (c) 2010, João Dias, Simon Marlow, Simon Peyton Jones, -- and Norman Ramsey @@ -9,10 +18,6 @@ -- specialised to the UniqSM monad. -- -{-# LANGUAGE RankNTypes, ScopedTypeVariables, GADTs, TypeFamilies, MultiParamTypeClasses #-} -{-# OPTIONS_GHC -fprof-auto-top #-} -{-# LANGUAGE Trustworthy #-} - module Hoopl.Dataflow ( DataflowLattice(..), OldFact(..), NewFact(..), Fact, mkFactBase , ChangeFlag(..) diff --git a/compiler/cmm/MkGraph.hs b/compiler/cmm/MkGraph.hs index 6f9bbf8872ea3c3e644927c0426cf762e623f2e9..9bc2bd9ddc21fd357f117806391760891ff9610a 100644 --- a/compiler/cmm/MkGraph.hs +++ b/compiler/cmm/MkGraph.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE GADTs #-} +{-# LANGUAGE BangPatterns, CPP, GADTs #-} module MkGraph ( CmmAGraph, CgStmt(..) diff --git a/compiler/cmm/PprC.hs b/compiler/cmm/PprC.hs index 23989811ddf8a034d4d56f3f6df066dcc5627253..47b247e278ddaff72a5b8e1dbe7f678aad85d5b1 100644 --- a/compiler/cmm/PprC.hs +++ b/compiler/cmm/PprC.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP, GADTs #-} + ----------------------------------------------------------------------------- -- -- Pretty-printing of Cmm as C, suitable for feeding gcc @@ -16,7 +18,6 @@ -- ----------------------------------------------------------------------------- -{-# LANGUAGE GADTs #-} module PprC ( writeCs, pprStringInCStyle diff --git a/compiler/cmm/PprCmm.hs b/compiler/cmm/PprCmm.hs index 46257b4188b740f841df36d42ca5267cda48217a..b5beb07ae91b4130117b7887efc51bc06ed8ca77 100644 --- a/compiler/cmm/PprCmm.hs +++ b/compiler/cmm/PprCmm.hs @@ -1,3 +1,6 @@ +{-# LANGUAGE GADTs, TypeFamilies, FlexibleContexts, FlexibleInstances #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + ---------------------------------------------------------------------------- -- -- Pretty-printing of Cmm as (a superset of) C-- @@ -30,8 +33,6 @@ -- -- A useful example pass over Cmm is in nativeGen/MachCodeGen.hs -{-# OPTIONS_GHC -fno-warn-orphans #-} -{-# LANGUAGE GADTs, TypeFamilies, FlexibleContexts #-} module PprCmm ( module PprCmmDecl , module PprCmmExpr diff --git a/compiler/cmm/PprCmmDecl.hs b/compiler/cmm/PprCmmDecl.hs index 354a3d4563305d0e5a69ec5cc7f246a7e7a66d1a..dd80f5cd56b64fe2244fa8c7e841a7f6c4d60a49 100644 --- a/compiler/cmm/PprCmmDecl.hs +++ b/compiler/cmm/PprCmmDecl.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + ---------------------------------------------------------------------------- -- -- Pretty-printing of common Cmm types diff --git a/compiler/cmm/SMRep.lhs b/compiler/cmm/SMRep.lhs index 704c22db6a8a9e312de737aa7d0872e3553232eb..b23bcc11ce9b86455e47c7a843ba601d12238a8f 100644 --- a/compiler/cmm/SMRep.lhs +++ b/compiler/cmm/SMRep.lhs @@ -6,7 +6,7 @@ Storage manager representation of closures \begin{code} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE CPP,GeneralizedNewtypeDeriving #-} module SMRep ( -- * Words and bytes diff --git a/compiler/codeGen/CgUtils.hs b/compiler/codeGen/CgUtils.hs index 6b36ab09cd22e134762123caab470f9bf1e9e626..51b8ed9ec8c3de44f47adf4d76288b0c53f3a7df 100644 --- a/compiler/codeGen/CgUtils.hs +++ b/compiler/codeGen/CgUtils.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP, GADTs #-} + ----------------------------------------------------------------------------- -- -- Code generator utilities; mostly monadic @@ -6,7 +8,6 @@ -- ----------------------------------------------------------------------------- -{-# LANGUAGE GADTs #-} module CgUtils ( fixStgRegisters ) where #include "HsVersions.h" diff --git a/compiler/codeGen/CodeGen/Platform/ARM.hs b/compiler/codeGen/CodeGen/Platform/ARM.hs index 727a43561fd8d4f8b48de6b83745f2b5de16658c..5d1148496c2ae3f0cc43223e4fdb4d65729a0243 100644 --- a/compiler/codeGen/CodeGen/Platform/ARM.hs +++ b/compiler/codeGen/CodeGen/Platform/ARM.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} module CodeGen.Platform.ARM where diff --git a/compiler/codeGen/CodeGen/Platform/NoRegs.hs b/compiler/codeGen/CodeGen/Platform/NoRegs.hs index c4c63b7572eb8776e180b74462cf633cbb22157c..0c85ffbda77af35be3f0d0ab6be1b1b7516cac3c 100644 --- a/compiler/codeGen/CodeGen/Platform/NoRegs.hs +++ b/compiler/codeGen/CodeGen/Platform/NoRegs.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} module CodeGen.Platform.NoRegs where diff --git a/compiler/codeGen/CodeGen/Platform/PPC.hs b/compiler/codeGen/CodeGen/Platform/PPC.hs index bcbdfe244b0939d631599e2d5b6249c6d29fe213..76a2b020ac377df3dafca2fa85105c75f6d8d16a 100644 --- a/compiler/codeGen/CodeGen/Platform/PPC.hs +++ b/compiler/codeGen/CodeGen/Platform/PPC.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} module CodeGen.Platform.PPC where diff --git a/compiler/codeGen/CodeGen/Platform/PPC_Darwin.hs b/compiler/codeGen/CodeGen/Platform/PPC_Darwin.hs index 42bf22f26c972c6737b8af9f1dcba12c062f0fd1..a98e558cc10e7095615eafbba93eb6fc414ab8f2 100644 --- a/compiler/codeGen/CodeGen/Platform/PPC_Darwin.hs +++ b/compiler/codeGen/CodeGen/Platform/PPC_Darwin.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} module CodeGen.Platform.PPC_Darwin where diff --git a/compiler/codeGen/CodeGen/Platform/SPARC.hs b/compiler/codeGen/CodeGen/Platform/SPARC.hs index b49af144096b41298b5657feb86c77fd0e889082..991f515eaf4d6ee89396dcb50f0c609654c2de06 100644 --- a/compiler/codeGen/CodeGen/Platform/SPARC.hs +++ b/compiler/codeGen/CodeGen/Platform/SPARC.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} module CodeGen.Platform.SPARC where diff --git a/compiler/codeGen/CodeGen/Platform/X86.hs b/compiler/codeGen/CodeGen/Platform/X86.hs index 6dd74df130a535772e923291f5be53bc7f2fe33c..e74807ff88d5c52ef6de314cd0943b7961af76bd 100644 --- a/compiler/codeGen/CodeGen/Platform/X86.hs +++ b/compiler/codeGen/CodeGen/Platform/X86.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} module CodeGen.Platform.X86 where diff --git a/compiler/codeGen/CodeGen/Platform/X86_64.hs b/compiler/codeGen/CodeGen/Platform/X86_64.hs index 190d642ea6cadcb0b45dbac65219629e2e9fa311..102132d6797b84ddcd8310924a6ff82a9ad9ec37 100644 --- a/compiler/codeGen/CodeGen/Platform/X86_64.hs +++ b/compiler/codeGen/CodeGen/Platform/X86_64.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} module CodeGen.Platform.X86_64 where diff --git a/compiler/codeGen/StgCmm.hs b/compiler/codeGen/StgCmm.hs index a92f80439bfa8a4dafdbce835066f0f5b41abe35..740ab5f3d9f067771c9bdc6b0da4ecd546c7bb28 100644 --- a/compiler/codeGen/StgCmm.hs +++ b/compiler/codeGen/StgCmm.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + ----------------------------------------------------------------------------- -- -- Stg to C-- code generation diff --git a/compiler/codeGen/StgCmmBind.hs b/compiler/codeGen/StgCmmBind.hs index 06e17164dd34f8007208e74ac999c0c86120002c..4631b2dc14b15eba1feb6a017ae0a9353e9751cd 100644 --- a/compiler/codeGen/StgCmmBind.hs +++ b/compiler/codeGen/StgCmmBind.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + ----------------------------------------------------------------------------- -- -- Stg to C-- code generation: bindings diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs index c9302f21a1195f250992be479d78978b4d1936f9..b65d56bae2a9ee854c71d5fbf13825f3d054c24d 100644 --- a/compiler/codeGen/StgCmmClosure.hs +++ b/compiler/codeGen/StgCmmClosure.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP, RecordWildCards #-} + ----------------------------------------------------------------------------- -- -- Stg to C-- code generation: @@ -9,8 +11,6 @@ -- ----------------------------------------------------------------------------- -{-# LANGUAGE RecordWildCards #-} - module StgCmmClosure ( DynTag, tagForCon, isSmallFamily, ConTagZ, dataConTagZ, diff --git a/compiler/codeGen/StgCmmCon.hs b/compiler/codeGen/StgCmmCon.hs index a02a5da616e094cb0df5d1351dea6ff8494ec5a8..1a69927b5cb7e2a22825ecba41ec881dcb632c3f 100644 --- a/compiler/codeGen/StgCmmCon.hs +++ b/compiler/codeGen/StgCmmCon.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + ----------------------------------------------------------------------------- -- -- Stg to C--: code generation for constructors diff --git a/compiler/codeGen/StgCmmEnv.hs b/compiler/codeGen/StgCmmEnv.hs index 2b8677c408cafe352bc95cf117f19c85aadc75a8..4127b67401825df16c999515533dc60b547a5c48 100644 --- a/compiler/codeGen/StgCmmEnv.hs +++ b/compiler/codeGen/StgCmmEnv.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + ----------------------------------------------------------------------------- -- -- Stg to C-- code generation: the binding environment diff --git a/compiler/codeGen/StgCmmExpr.hs b/compiler/codeGen/StgCmmExpr.hs index 9b9d6397c464af58716d239daf1ea28a0477fd0c..ad34b5ba197f7beb91a399cfa9c5bc9801ab7964 100644 --- a/compiler/codeGen/StgCmmExpr.hs +++ b/compiler/codeGen/StgCmmExpr.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + ----------------------------------------------------------------------------- -- -- Stg to C-- code generation: expressions diff --git a/compiler/codeGen/StgCmmForeign.hs b/compiler/codeGen/StgCmmForeign.hs index bf88f1ccb34434e8f24f20c5a36e4876c323f6b9..6937c85d01edab5d3cc4b53abf048744bd542489 100644 --- a/compiler/codeGen/StgCmmForeign.hs +++ b/compiler/codeGen/StgCmmForeign.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + ----------------------------------------------------------------------------- -- -- Code generation for foreign calls. diff --git a/compiler/codeGen/StgCmmHeap.hs b/compiler/codeGen/StgCmmHeap.hs index a3a47a65e74905ba3583fae43aed41ce64420b6e..d00dc6ec8438151ca84cea67641aaf751d9ee5ac 100644 --- a/compiler/codeGen/StgCmmHeap.hs +++ b/compiler/codeGen/StgCmmHeap.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + ----------------------------------------------------------------------------- -- -- Stg to C--: heap management functions diff --git a/compiler/codeGen/StgCmmLayout.hs b/compiler/codeGen/StgCmmLayout.hs index a56248dcb9cc2afddd5a774171dbbc8cae47022c..99e926c987cb99788f86641e402dceaf4a254459 100644 --- a/compiler/codeGen/StgCmmLayout.hs +++ b/compiler/codeGen/StgCmmLayout.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + ----------------------------------------------------------------------------- -- -- Building info tables. diff --git a/compiler/codeGen/StgCmmMonad.hs b/compiler/codeGen/StgCmmMonad.hs index 348b7b9299a0fde25fc12449a9d87375ffe2417a..cad261bcfb8a459e7768631e0508c0038ec2e50f 100644 --- a/compiler/codeGen/StgCmmMonad.hs +++ b/compiler/codeGen/StgCmmMonad.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE GADTs #-} +{-# LANGUAGE CPP, GADTs, UnboxedTuples #-} + ----------------------------------------------------------------------------- -- -- Monad for Stg to C-- code generation diff --git a/compiler/codeGen/StgCmmPrim.hs b/compiler/codeGen/StgCmmPrim.hs index 5c75acba5a589809ab50dc8a615a098101dcfd5c..40a5e3649b674734874c758d866e1a759fe0819c 100644 --- a/compiler/codeGen/StgCmmPrim.hs +++ b/compiler/codeGen/StgCmmPrim.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + ---------------------------------------------------------------------------- -- -- Stg to C--: primitive operations diff --git a/compiler/codeGen/StgCmmProf.hs b/compiler/codeGen/StgCmmProf.hs index f858c5a0b6dc62ae66c58cf4b992ae8ba2cf80a3..1aa08a1e58411c3d9056cc13f05af046e600fb2d 100644 --- a/compiler/codeGen/StgCmmProf.hs +++ b/compiler/codeGen/StgCmmProf.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + ----------------------------------------------------------------------------- -- -- Code generation for profiling diff --git a/compiler/codeGen/StgCmmTicky.hs b/compiler/codeGen/StgCmmTicky.hs index b1218201a678231e74fa19a47fbf94fb2a659892..6913c9ec15215e14e21c2cb73db5cb28d923dfa4 100644 --- a/compiler/codeGen/StgCmmTicky.hs +++ b/compiler/codeGen/StgCmmTicky.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE BangPatterns, CPP #-} + ----------------------------------------------------------------------------- -- -- Code generation for ticky-ticky profiling diff --git a/compiler/codeGen/StgCmmUtils.hs b/compiler/codeGen/StgCmmUtils.hs index 1c6c3f2eae986956025f4444c474c18b085fa7cd..bc1a15fe3cf4f66c5c9e4676a4ad9e541418a0d6 100644 --- a/compiler/codeGen/StgCmmUtils.hs +++ b/compiler/codeGen/StgCmmUtils.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + ----------------------------------------------------------------------------- -- -- Code generator utilities; mostly monadic diff --git a/compiler/coreSyn/CoreArity.lhs b/compiler/coreSyn/CoreArity.lhs index ca7216fe295ad2e8b5b437786dcfa0658a888ea1..26669b6d32b7a2fc725638a4095f2f7c9deb1464 100644 --- a/compiler/coreSyn/CoreArity.lhs +++ b/compiler/coreSyn/CoreArity.lhs @@ -6,7 +6,8 @@ Arity and eta expansion \begin{code} -{-# OPTIONS -fno-warn-tabs #-} +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/coreSyn/CoreFVs.lhs b/compiler/coreSyn/CoreFVs.lhs index 636c049c4254aef2bee06d7641971d2b2ac31493..4011191d7564b2001b1abee974b8aa0e5283f02c 100644 --- a/compiler/coreSyn/CoreFVs.lhs +++ b/compiler/coreSyn/CoreFVs.lhs @@ -5,6 +5,8 @@ Taken quite directly from the Peyton Jones/Lester paper. \begin{code} +{-# LANGUAGE CPP #-} + -- | A module concerned with finding the free variables of an expression. module CoreFVs ( -- * Free variables of expressions and binding groups diff --git a/compiler/coreSyn/CoreLint.lhs b/compiler/coreSyn/CoreLint.lhs index 8665ec4111578c348d4f9487d17a82896618cae6..a5868108d9c70d3eb2c5bf5d294964c65c133466 100644 --- a/compiler/coreSyn/CoreLint.lhs +++ b/compiler/coreSyn/CoreLint.lhs @@ -7,12 +7,7 @@ A ``lint'' pass to check for Core correctness \begin{code} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and --- detab the module (please do the detabbing in a separate patch). See --- http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces --- for details - +{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fprof-auto #-} module CoreLint ( lintCoreBindings, lintUnfolding, lintExpr ) where diff --git a/compiler/coreSyn/CorePrep.lhs b/compiler/coreSyn/CorePrep.lhs index 5e0cd6599d27ffb80d8bbae519a171bd214754bb..60cb60eda1ac10002ba67c9ab1ca63a4575f9c03 100644 --- a/compiler/coreSyn/CorePrep.lhs +++ b/compiler/coreSyn/CorePrep.lhs @@ -5,7 +5,7 @@ Core pass to saturate constructors and PrimOps \begin{code} -{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE BangPatterns, CPP #-} module CorePrep ( corePrepPgm, corePrepExpr, cvtLitInteger, diff --git a/compiler/coreSyn/CoreSubst.lhs b/compiler/coreSyn/CoreSubst.lhs index ef601a2a09a7755413402448e34a2e6d6c65396a..f3215094df06b1ae6c9da5cca747e0ca8c05cb48 100644 --- a/compiler/coreSyn/CoreSubst.lhs +++ b/compiler/coreSyn/CoreSubst.lhs @@ -6,7 +6,8 @@ Utility functions on @Core@ syntax \begin{code} -{-# OPTIONS -fno-warn-tabs #-} +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/coreSyn/CoreSyn.lhs b/compiler/coreSyn/CoreSyn.lhs index defd669a7855162f8e5f4e165188b1ac18d4a286..b36cb6d8a65019752b5259d9cc40e87d5cd51b57 100644 --- a/compiler/coreSyn/CoreSyn.lhs +++ b/compiler/coreSyn/CoreSyn.lhs @@ -4,9 +4,8 @@ % \begin{code} -{-# LANGUAGE DeriveDataTypeable, DeriveFunctor #-} - -{-# OPTIONS -fno-warn-tabs #-} +{-# LANGUAGE CPP, DeriveDataTypeable, DeriveFunctor #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/coreSyn/CoreTidy.lhs b/compiler/coreSyn/CoreTidy.lhs index cb2af7c77d99e29840fe669a8d54cdb39020b7eb..af1e12c9efe737c6b12566c030fc586b47a793d5 100644 --- a/compiler/coreSyn/CoreTidy.lhs +++ b/compiler/coreSyn/CoreTidy.lhs @@ -7,7 +7,8 @@ This module contains "tidying" code for *nested* expressions, bindings, rules. The code for *top-level* bindings is in TidyPgm. \begin{code} -{-# OPTIONS -fno-warn-tabs #-} +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/coreSyn/CoreUnfold.lhs b/compiler/coreSyn/CoreUnfold.lhs index 3a2c2376020a0a872a7ec58e4f6b2a9d12a3315f..fa9259a0051627f33bafc1d6dc7068c552e36092 100644 --- a/compiler/coreSyn/CoreUnfold.lhs +++ b/compiler/coreSyn/CoreUnfold.lhs @@ -15,7 +15,8 @@ literal''). In the corner of a @CoreUnfolding@ unfolding, you will find, unsurprisingly, a Core expression. \begin{code} -{-# OPTIONS -fno-warn-tabs #-} +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/coreSyn/CoreUtils.lhs b/compiler/coreSyn/CoreUtils.lhs index 0acad9d0a910e698525d541317dc5939ba233be9..6f21c4e77bb9d95deb3ab2852a3acf08711ffb55 100644 --- a/compiler/coreSyn/CoreUtils.lhs +++ b/compiler/coreSyn/CoreUtils.lhs @@ -6,6 +6,8 @@ Utility functions on @Core@ syntax \begin{code} +{-# LANGUAGE CPP #-} + -- | Commonly useful utilites for manipulating the Core language module CoreUtils ( -- * Constructing expressions diff --git a/compiler/coreSyn/MkCore.lhs b/compiler/coreSyn/MkCore.lhs index f71b4b4ff651237f1c3817d067ce22d8114a5f4e..721dc968fc45818b9914195d5dc6a5f8d06e4967 100644 --- a/compiler/coreSyn/MkCore.lhs +++ b/compiler/coreSyn/MkCore.lhs @@ -1,5 +1,6 @@ \begin{code} -{-# OPTIONS -fno-warn-tabs #-} +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/coreSyn/TrieMap.lhs b/compiler/coreSyn/TrieMap.lhs index ac04adab1bc38165c5d4f403b3ef6282c0b77710..2744c5d0b853f41f76e20293f378ca2dbefea406 100644 --- a/compiler/coreSyn/TrieMap.lhs +++ b/compiler/coreSyn/TrieMap.lhs @@ -4,14 +4,14 @@ % \begin{code} -{-# OPTIONS -fno-warn-tabs #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See -- http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces -- for details -{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE RankNTypes, TypeFamilies #-} module TrieMap( CoreMap, emptyCoreMap, extendCoreMap, lookupCoreMap, foldCoreMap, TypeMap, emptyTypeMap, extendTypeMap, lookupTypeMap, foldTypeMap, diff --git a/compiler/deSugar/Check.lhs b/compiler/deSugar/Check.lhs index fc3150d80826cb5571c9b7b6fe727e323f38b4ad..d008893d323d976f99843280a63ac59231ea501c 100644 --- a/compiler/deSugar/Check.lhs +++ b/compiler/deSugar/Check.lhs @@ -5,6 +5,8 @@ % Author: Juan J. Quintela \begin{code} +{-# LANGUAGE CPP #-} + module Check ( check , ExhaustivePat ) where #include "HsVersions.h" diff --git a/compiler/deSugar/Coverage.lhs b/compiler/deSugar/Coverage.lhs index 6bdc61d9c23baaef0328bac32861eed42c8a4345..e646667651e037d39ec9b0d56296170eb9f6f167 100644 --- a/compiler/deSugar/Coverage.lhs +++ b/compiler/deSugar/Coverage.lhs @@ -3,6 +3,8 @@ % (c) University of Glasgow, 2007 % \begin{code} +{-# LANGUAGE NondecreasingIndentation #-} + module Coverage (addTicksToBinds, hpcInitCode) where import Type diff --git a/compiler/deSugar/Desugar.lhs b/compiler/deSugar/Desugar.lhs index cd75de9a3a18292abc611c4245e724e0d5154d09..a103e7e0fe48a0aa5b83a51b2e503878648e8ded 100644 --- a/compiler/deSugar/Desugar.lhs +++ b/compiler/deSugar/Desugar.lhs @@ -6,6 +6,8 @@ The Desugarer: turning HsSyn into Core. \begin{code} +{-# LANGUAGE CPP #-} + module Desugar ( deSugar, deSugarExpr ) where import DynFlags diff --git a/compiler/deSugar/DsArrows.lhs b/compiler/deSugar/DsArrows.lhs index f87877681c08747eda82a45e921426aee9497c70..1bbcc05e40edabac89e4d31d8e87eed46d51717d 100644 --- a/compiler/deSugar/DsArrows.lhs +++ b/compiler/deSugar/DsArrows.lhs @@ -6,7 +6,8 @@ Desugaring arrow commands \begin{code} -{-# OPTIONS -fno-warn-tabs #-} +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/deSugar/DsBinds.lhs b/compiler/deSugar/DsBinds.lhs index 1dbf530123a4859e9105f9f2cc6ee50d3689e488..9691b99975b367f3b6f6a129aa44e8ec92a27675 100644 --- a/compiler/deSugar/DsBinds.lhs +++ b/compiler/deSugar/DsBinds.lhs @@ -10,7 +10,8 @@ in that the @Rec@/@NonRec@/etc structure is thrown away (whereas at lower levels it is preserved with @let@/@letrec@s). \begin{code} -{-# OPTIONS -fno-warn-tabs #-} +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/deSugar/DsCCall.lhs b/compiler/deSugar/DsCCall.lhs index 80f2ec525f054866617db58f634a320c38cff89c..217a4ce7c98c4fb40f572e028d1b9d8084fa1ac8 100644 --- a/compiler/deSugar/DsCCall.lhs +++ b/compiler/deSugar/DsCCall.lhs @@ -6,7 +6,8 @@ Desugaring foreign calls \begin{code} -{-# OPTIONS -fno-warn-tabs #-} +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/deSugar/DsExpr.lhs b/compiler/deSugar/DsExpr.lhs index 859309d5923718a9a83b82c335d748a051c09358..31c4d1750b0b2640144d83860be5f4aa6834f9df 100644 --- a/compiler/deSugar/DsExpr.lhs +++ b/compiler/deSugar/DsExpr.lhs @@ -6,6 +6,8 @@ Desugaring exporessions. \begin{code} +{-# LANGUAGE CPP #-} + module DsExpr ( dsExpr, dsLExpr, dsLocalBinds, dsValBinds, dsLit ) where #include "HsVersions.h" diff --git a/compiler/deSugar/DsForeign.lhs b/compiler/deSugar/DsForeign.lhs index e2f4f4ff3cd3eaf195ab2b546c5da500f9ec7b67..0654ebc98353c4a8ec32667adf9785098eeeba2e 100644 --- a/compiler/deSugar/DsForeign.lhs +++ b/compiler/deSugar/DsForeign.lhs @@ -6,6 +6,8 @@ Desugaring foreign declarations (see also DsCCall). \begin{code} +{-# LANGUAGE CPP #-} + module DsForeign ( dsForeigns , dsForeigns' , dsFImport, dsCImport, dsFCall, dsPrimCall diff --git a/compiler/deSugar/DsGRHSs.lhs b/compiler/deSugar/DsGRHSs.lhs index 4573e54ce0aff57cd817551c7320e1b21aa72ff2..0a4e1edd975e7614201bcea7884a3f4e9bfd8025 100644 --- a/compiler/deSugar/DsGRHSs.lhs +++ b/compiler/deSugar/DsGRHSs.lhs @@ -6,6 +6,8 @@ Matching guarded right-hand-sides (GRHSs) \begin{code} +{-# LANGUAGE CPP #-} + module DsGRHSs ( dsGuarded, dsGRHSs, dsGRHS ) where #include "HsVersions.h" diff --git a/compiler/deSugar/DsListComp.lhs b/compiler/deSugar/DsListComp.lhs index a1131a8126727456a511d3d4eb9b39786151130d..2111c95f828565921c3030e43d6224644b238490 100644 --- a/compiler/deSugar/DsListComp.lhs +++ b/compiler/deSugar/DsListComp.lhs @@ -6,7 +6,7 @@ Desugaring list comprehensions, monad comprehensions and array comprehensions \begin{code} -{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE CPP, NamedFieldPuns #-} module DsListComp ( dsListComp, dsPArrComp, dsMonadComp ) where diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs index 73c1adfdc807da7e3daf0c816bd238c3e20d383c..687cf55a00443d3ca4d5718eeb621b8c3233895c 100644 --- a/compiler/deSugar/DsMeta.hs +++ b/compiler/deSugar/DsMeta.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + ----------------------------------------------------------------------------- -- -- (c) The University of Glasgow 2006 diff --git a/compiler/deSugar/DsMonad.lhs b/compiler/deSugar/DsMonad.lhs index b590f4b2d29d89ad6e2947331ae529cb303004aa..c017a7cc0191d44f457ab579c8b216d44d50af94 100644 --- a/compiler/deSugar/DsMonad.lhs +++ b/compiler/deSugar/DsMonad.lhs @@ -6,6 +6,8 @@ @DsMonad@: monadery used in desugaring \begin{code} +{-# LANGUAGE FlexibleInstances #-} + module DsMonad ( DsM, mapM, mapAndUnzipM, initDs, initDsTc, fixDs, diff --git a/compiler/deSugar/DsUtils.lhs b/compiler/deSugar/DsUtils.lhs index 924ba88926555531627a1dcf70fc527db88a0e44..557e77589cefb88ef39a1e337d5804e205fd7813 100644 --- a/compiler/deSugar/DsUtils.lhs +++ b/compiler/deSugar/DsUtils.lhs @@ -8,7 +8,8 @@ Utilities for desugaring This module exports some utility functions of no great interest. \begin{code} -{-# OPTIONS -fno-warn-tabs #-} +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/deSugar/Match.lhs b/compiler/deSugar/Match.lhs index b42a720c32d84bf9d573290791d7ed598c1d3229..68e55bd68d46ea0de6773cc6a73d436aa73e39a4 100644 --- a/compiler/deSugar/Match.lhs +++ b/compiler/deSugar/Match.lhs @@ -6,6 +6,8 @@ The @match@ function \begin{code} +{-# LANGUAGE CPP #-} + module Match ( match, matchEquations, matchWrapper, matchSimply, matchSinglePat ) where #include "HsVersions.h" diff --git a/compiler/deSugar/MatchCon.lhs b/compiler/deSugar/MatchCon.lhs index 2b51638bf36b36b2484eb68ff4405230fceee174..ef74bff1c6febf8998efce092df6b93e8e416034 100644 --- a/compiler/deSugar/MatchCon.lhs +++ b/compiler/deSugar/MatchCon.lhs @@ -6,7 +6,8 @@ Pattern-matching constructors \begin{code} -{-# OPTIONS -fno-warn-tabs #-} +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/deSugar/MatchLit.lhs b/compiler/deSugar/MatchLit.lhs index 7429a613d9894b9370c15f3a089223770cf6da53..07cf420372146e2a96d248032f5490a34608fee0 100644 --- a/compiler/deSugar/MatchLit.lhs +++ b/compiler/deSugar/MatchLit.lhs @@ -6,6 +6,8 @@ Pattern-matching literal patterns \begin{code} +{-# LANGUAGE CPP, ScopedTypeVariables #-} + module MatchLit ( dsLit, dsOverLit, hsLitKey, hsOverLitKey , tidyLitPat, tidyNPat , matchLiterals, matchNPlusKPats, matchNPats diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in index 9dc7826e254682cb393c02345a19d50b62fec53f..e6f86c97d98519cbf0670096eb6be30f688da46b 100644 --- a/compiler/ghc.cabal.in +++ b/compiler/ghc.cabal.in @@ -54,7 +54,9 @@ Library filepath >= 1 && < 1.4, Cabal, hpc, - transformers + transformers, + bin-package-db, + hoopl if flag(stage1) && impl(ghc < 7.5) Build-Depends: old-time >= 1 && < 1.2 @@ -71,13 +73,34 @@ Library CPP-Options: -DGHCI Include-Dirs: ../rts/dist/build @FFIIncludeDir@ - Build-Depends: bin-package-db - Build-Depends: hoopl - - Default-Extensions: CPP, MagicHash, UnboxedTuples - TypeSynonymInstances, MultiParamTypeClasses, - FlexibleInstances, RankNTypes, ScopedTypeVariables, - DeriveDataTypeable, BangPatterns, NondecreasingIndentation + Other-Extensions: + BangPatterns + CPP + DataKinds + DeriveDataTypeable + DeriveFoldable + DeriveFunctor + DeriveTraversable + DisambiguateRecordFields + ExplicitForAll + FlexibleContexts + FlexibleInstances + GADTs + GeneralizedNewtypeDeriving + MagicHash + MultiParamTypeClasses + NamedFieldPuns + NondecreasingIndentation + RankNTypes + RecordWildCards + ScopedTypeVariables + StandaloneDeriving + Trustworthy + TupleSections + TypeFamilies + TypeSynonymInstances + UnboxedTuples + UndecidableInstances Include-Dirs: . parser utils @@ -94,8 +117,6 @@ Library c-sources: parser/cutils.c - - c-sources: ghci/keepCAFsForGHCi.c cbits/genSym.c diff --git a/compiler/ghci/ByteCodeAsm.lhs b/compiler/ghci/ByteCodeAsm.lhs index 9ec783a40deb112e6bbd92ee896eae82242bd513..52d6adde863d018e4385002d9bb7938c28bd88b8 100644 --- a/compiler/ghci/ByteCodeAsm.lhs +++ b/compiler/ghci/ByteCodeAsm.lhs @@ -5,8 +5,8 @@ ByteCodeLink: Bytecode assembler and linker \begin{code} -{-# OPTIONS -optc-DNON_POSIX_SOURCE #-} -{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE BangPatterns, CPP, MagicHash #-} +{-# OPTIONS_GHC -optc-DNON_POSIX_SOURCE #-} module ByteCodeAsm ( assembleBCOs, assembleBCO, diff --git a/compiler/ghci/ByteCodeGen.lhs b/compiler/ghci/ByteCodeGen.lhs index 6dfee5629afd943e69dfdaec600d35f4a63cb27c..d4a58044f50dcc5acdce5deca878f78c311692d2 100644 --- a/compiler/ghci/ByteCodeGen.lhs +++ b/compiler/ghci/ByteCodeGen.lhs @@ -5,7 +5,8 @@ ByteCodeGen: Generate bytecode from Core \begin{code} -{-# OPTIONS -fno-warn-tabs #-} +{-# LANGUAGE CPP, MagicHash #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/ghci/ByteCodeInstr.lhs b/compiler/ghci/ByteCodeInstr.lhs index 005a430cd99301d443153a1898b2cc2ff4955b62..548c29f5140379d65ead14e49360e2e8c9012baf 100644 --- a/compiler/ghci/ByteCodeInstr.lhs +++ b/compiler/ghci/ByteCodeInstr.lhs @@ -4,7 +4,8 @@ ByteCodeInstrs: Bytecode instruction definitions \begin{code} -{-# OPTIONS -fno-warn-tabs #-} +{-# LANGUAGE CPP, MagicHash #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/ghci/ByteCodeItbls.lhs b/compiler/ghci/ByteCodeItbls.lhs index ce6bd01f16e3bee02af593d382969314af5713fa..7a7a62d980256bc1d17e45f39223653a9e7bd106 100644 --- a/compiler/ghci/ByteCodeItbls.lhs +++ b/compiler/ghci/ByteCodeItbls.lhs @@ -4,7 +4,8 @@ ByteCodeItbls: Generate infotables for interpreter-made bytecodes \begin{code} -{-# OPTIONS -optc-DNON_POSIX_SOURCE #-} +{-# LANGUAGE CPP, MagicHash #-} +{-# OPTIONS_GHC -optc-DNON_POSIX_SOURCE #-} module ByteCodeItbls ( ItblEnv, ItblPtr(..), itblCode, mkITbls, peekItbl , StgInfoTable(..) diff --git a/compiler/ghci/ByteCodeLink.lhs b/compiler/ghci/ByteCodeLink.lhs index 4c484097f0f9087f099294dfcdf347ec18e698d3..d508a1c5aaf0db7b8336b4769e179cadea1294fa 100644 --- a/compiler/ghci/ByteCodeLink.lhs +++ b/compiler/ghci/ByteCodeLink.lhs @@ -5,7 +5,12 @@ ByteCodeLink: Bytecode assembler and linker \begin{code} {-# LANGUAGE BangPatterns #-} -{-# OPTIONS -optc-DNON_POSIX_SOURCE #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE UnboxedTuples #-} +{-# OPTIONS_GHC -optc-DNON_POSIX_SOURCE #-} module ByteCodeLink ( ClosureEnv, emptyClosureEnv, extendClosureEnv, diff --git a/compiler/ghci/Debugger.hs b/compiler/ghci/Debugger.hs index 0807bf17b51c77892f327ac5139563ea4b39fd50..49667141819b8d2e9f65cbd32548deafec45cc6c 100644 --- a/compiler/ghci/Debugger.hs +++ b/compiler/ghci/Debugger.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE MagicHash #-} + ----------------------------------------------------------------------------- -- -- GHCi Interactive debugging commands diff --git a/compiler/ghci/DebuggerUtils.hs b/compiler/ghci/DebuggerUtils.hs index 3d73e69e2bfe380f21204522123ad767d5f7bffe..67767e41b9ac5bafa2e61eed43644b4c6edc1bb7 100644 --- a/compiler/ghci/DebuggerUtils.hs +++ b/compiler/ghci/DebuggerUtils.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + module DebuggerUtils ( dataConInfoPtrToName, ) where diff --git a/compiler/ghci/Linker.lhs b/compiler/ghci/Linker.lhs index 274f2fbd4477c26af09fd8c533a4ccea0272c507..0b23985be877e17a8e4233e29612ba2551586e65 100644 --- a/compiler/ghci/Linker.lhs +++ b/compiler/ghci/Linker.lhs @@ -2,15 +2,16 @@ % (c) The University of Glasgow 2005-2012 % \begin{code} +{-# LANGUAGE CPP, NondecreasingIndentation #-} +{-# OPTIONS_GHC -fno-cse #-} +-- -fno-cse is needed for GLOBAL_VAR's to behave properly + -- | The dynamic linker for GHCi. -- -- This module deals with the top-level issues of dynamic linking, -- calling the object-code linker and the byte-code linker where -- necessary. -{-# OPTIONS -fno-cse #-} --- -fno-cse is needed for GLOBAL_VAR's to behave properly - module Linker ( getHValue, showLinkerState, linkExpr, linkDecls, unload, withExtendedLinkEnv, extendLinkEnv, deleteFromLinkEnv, diff --git a/compiler/ghci/RtClosureInspect.hs b/compiler/ghci/RtClosureInspect.hs index 5e9bddca88e31fbffe15d2f304a6112e6dd7c483..a2f9af92f16744ca1d9e4fe89b65c3d35275f9f3 100644 --- a/compiler/ghci/RtClosureInspect.hs +++ b/compiler/ghci/RtClosureInspect.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP, ScopedTypeVariables, MagicHash, UnboxedTuples #-} + ----------------------------------------------------------------------------- -- -- GHC Interactive support for inspecting arbitrary closures at runtime @@ -6,7 +8,7 @@ -- ----------------------------------------------------------------------------- -{-# OPTIONS -fno-warn-tabs #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/hsSyn/Convert.lhs b/compiler/hsSyn/Convert.lhs index bcea29bea2b12db0f5a5418d7ecad0311e0ccb8d..fc291f20473b5c9ae2560e3fca8d4c199d13c05b 100644 --- a/compiler/hsSyn/Convert.lhs +++ b/compiler/hsSyn/Convert.lhs @@ -6,6 +6,8 @@ This module converts Template Haskell syntax into HsSyn \begin{code} +{-# LANGUAGE MagicHash #-} + module Convert( convertToHsExpr, convertToPat, convertToHsDecls, convertToHsType, thRdrNameGuesses ) where diff --git a/compiler/hsSyn/HsDoc.hs b/compiler/hsSyn/HsDoc.hs index 2cb28540f9174e79fa316c0af8c69f038b5b5523..72bf0e56a44f341ad8a0742a42d0557ff77e91f5 100644 --- a/compiler/hsSyn/HsDoc.hs +++ b/compiler/hsSyn/HsDoc.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE CPP, DeriveDataTypeable #-} module HsDoc ( HsDocString(..), diff --git a/compiler/hsSyn/HsExpr.lhs b/compiler/hsSyn/HsExpr.lhs index f5ba1903ee7c090bf33a68bf49cce1e309f89b82..938227ce0f1ad71d96fde3c97583331676b348a5 100644 --- a/compiler/hsSyn/HsExpr.lhs +++ b/compiler/hsSyn/HsExpr.lhs @@ -3,7 +3,7 @@ % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % \begin{code} -{-# LANGUAGE DeriveDataTypeable, ScopedTypeVariables #-} +{-# LANGUAGE CPP, DeriveDataTypeable, ScopedTypeVariables #-} -- | Abstract Haskell syntax for expressions. module HsExpr where diff --git a/compiler/hsSyn/HsLit.lhs b/compiler/hsSyn/HsLit.lhs index 9565acbc8f897b4050f015ad856abc027235470f..a4749dd730a7316d739edcf8576e93ba3f81055d 100644 --- a/compiler/hsSyn/HsLit.lhs +++ b/compiler/hsSyn/HsLit.lhs @@ -5,14 +5,14 @@ \section[HsLit]{Abstract syntax: source-language literals} \begin{code} -{-# OPTIONS -fno-warn-tabs #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See -- http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces -- for details -{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE CPP, DeriveDataTypeable #-} module HsLit where diff --git a/compiler/hsSyn/HsUtils.lhs b/compiler/hsSyn/HsUtils.lhs index eff67df3cfbe4bc61cef0f585957363e44912af9..4ac1bf0d5aa4483c2142ae4669a42421d8eb6c08 100644 --- a/compiler/hsSyn/HsUtils.lhs +++ b/compiler/hsSyn/HsUtils.lhs @@ -13,7 +13,8 @@ which deal with the intantiated versions are located elsewhere: Id typecheck/TcHsSyn \begin{code} -{-# OPTIONS -fno-warn-tabs #-} +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/iface/BinIface.hs b/compiler/iface/BinIface.hs index 9fd0c33423d47cbfbc103fc040283cf2cebbda3d..9dd95fc0f23b68177cbc9e080f017cc44a576104 100644 --- a/compiler/iface/BinIface.hs +++ b/compiler/iface/BinIface.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + -- -- (c) The University of Glasgow 2002-2006 -- diff --git a/compiler/iface/BuildTyCl.lhs b/compiler/iface/BuildTyCl.lhs index 033e8c69843c087219767504d6b18e4bb183a5eb..d0e3232e3090cb9818ab60c208be4aa789bc926f 100644 --- a/compiler/iface/BuildTyCl.lhs +++ b/compiler/iface/BuildTyCl.lhs @@ -4,7 +4,8 @@ % \begin{code} -{-# OPTIONS -fno-warn-tabs #-} +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/iface/IfaceEnv.lhs b/compiler/iface/IfaceEnv.lhs index 4a00c91381abff5c956ce9b1dea83240a1b2e71a..c29778dc23805cac72db4f31ea47852bb2064422 100644 --- a/compiler/iface/IfaceEnv.lhs +++ b/compiler/iface/IfaceEnv.lhs @@ -1,7 +1,8 @@ (c) The University of Glasgow 2002-2006 \begin{code} -{-# OPTIONS -fno-warn-tabs #-} +{-# LANGUAGE CPP, RankNTypes #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/iface/IfaceSyn.lhs b/compiler/iface/IfaceSyn.lhs index 1283b095fdccf3d79b44b29b8bd5c68caec5fc88..fb194e045c1939cbc613e0ac22050d4b338a905d 100644 --- a/compiler/iface/IfaceSyn.lhs +++ b/compiler/iface/IfaceSyn.lhs @@ -4,7 +4,8 @@ % \begin{code} -{-# OPTIONS -fno-warn-tabs #-} +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/iface/LoadIface.lhs b/compiler/iface/LoadIface.lhs index d7877943261e7745d79fb434ab6fb325c780aa6a..2824d929872f0a8c4cbf22d3f024b8055982ff9f 100644 --- a/compiler/iface/LoadIface.lhs +++ b/compiler/iface/LoadIface.lhs @@ -6,6 +6,7 @@ Loading interface files \begin{code} +{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module LoadIface ( -- RnM/TcM functions diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs index bb51cdae9d239c3c4603b415f21d7f8900fccc1c..6c87961a4e62ffe7753ed4dad9e173888e08efc9 100644 --- a/compiler/iface/MkIface.lhs +++ b/compiler/iface/MkIface.lhs @@ -4,6 +4,8 @@ % \begin{code} +{-# LANGUAGE CPP, NondecreasingIndentation #-} + -- | Module for constructing @ModIface@ values (interface files), -- writing them to disk and comparing two versions to see if -- recompilation is required. diff --git a/compiler/iface/TcIface.lhs b/compiler/iface/TcIface.lhs index 12e4e94bdcbea6db8798676b72f25a71252c2c64..980796afdf263859f1f73ad8766e17929865dc82 100644 --- a/compiler/iface/TcIface.lhs +++ b/compiler/iface/TcIface.lhs @@ -6,6 +6,8 @@ Type checking of type signatures in interface files \begin{code} +{-# LANGUAGE CPP #-} + module TcIface ( tcLookupImported_maybe, importDecl, checkWiredInTyCon, tcHiBootIface, typecheckIface, diff --git a/compiler/llvmGen/Llvm/PpLlvm.hs b/compiler/llvmGen/Llvm/PpLlvm.hs index b8343ceff3618b321306e1403095acf5cc23095c..025078226d1469deff3b7a050fc9fa2633dddd97 100644 --- a/compiler/llvmGen/Llvm/PpLlvm.hs +++ b/compiler/llvmGen/Llvm/PpLlvm.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + -------------------------------------------------------------------------------- -- | Pretty print LLVM IR Code. -- diff --git a/compiler/llvmGen/Llvm/Types.hs b/compiler/llvmGen/Llvm/Types.hs index 6b9c8c181a26e707f89f74b2f93f5a3bdab4ee8a..89b0e4e141796fa09c00694643fb8288fc66927c 100644 --- a/compiler/llvmGen/Llvm/Types.hs +++ b/compiler/llvmGen/Llvm/Types.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE CPP, GeneralizedNewtypeDeriving #-} -------------------------------------------------------------------------------- -- | The LLVM Type System. diff --git a/compiler/llvmGen/LlvmCodeGen.hs b/compiler/llvmGen/LlvmCodeGen.hs index 61e7e39a49c26d99f4b32957f91b9b1a7c8851b9..dd16e5286854630863a28494a23eb2d8f4ae63b6 100644 --- a/compiler/llvmGen/LlvmCodeGen.hs +++ b/compiler/llvmGen/LlvmCodeGen.hs @@ -1,8 +1,8 @@ +{-# LANGUAGE CPP, TypeFamilies #-} + -- ----------------------------------------------------------------------------- -- | This is the top-level module in the LLVM code generator. -- - -{-# LANGUAGE TypeFamilies #-} module LlvmCodeGen ( llvmCodeGen, llvmFixupAsm ) where #include "HsVersions.h" diff --git a/compiler/llvmGen/LlvmCodeGen/Base.hs b/compiler/llvmGen/LlvmCodeGen/Base.hs index 5d5f385ade296787f0ac47334277affbed0553b7..686b352c2ade8d2efa11a9411972179e1d7f9500 100644 --- a/compiler/llvmGen/LlvmCodeGen/Base.hs +++ b/compiler/llvmGen/LlvmCodeGen/Base.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + -- ---------------------------------------------------------------------------- -- | Base LLVM Code Generation module -- diff --git a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs index 1140145d4dba2aca82d7a49fe6e61e99e6f66098..342b94f93f6a4cbc57bc62cb52df385c8b4bca9e 100644 --- a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs +++ b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs @@ -1,9 +1,8 @@ -{-# OPTIONS -fno-warn-type-defaults #-} +{-# LANGUAGE CPP, GADTs #-} +{-# OPTIONS_GHC -fno-warn-type-defaults #-} -- ---------------------------------------------------------------------------- -- | Handle conversion of CmmProc to LLVM code. -- - -{-# LANGUAGE GADTs #-} module LlvmCodeGen.CodeGen ( genLlvmProc ) where #include "HsVersions.h" diff --git a/compiler/llvmGen/LlvmCodeGen/Data.hs b/compiler/llvmGen/LlvmCodeGen/Data.hs index 6212cfc9fbf684b903ba1c9399872d5ad3c33e65..1dbfb4b527692455f833e0a72d5bee98f6a2f476 100644 --- a/compiler/llvmGen/LlvmCodeGen/Data.hs +++ b/compiler/llvmGen/LlvmCodeGen/Data.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} -- ---------------------------------------------------------------------------- -- | Handle conversion of CmmData to LLVM code. -- diff --git a/compiler/llvmGen/LlvmCodeGen/Ppr.hs b/compiler/llvmGen/LlvmCodeGen/Ppr.hs index 202e685c0e0f794957748bb736e4dffb7d739a71..9c6a719613cfb8058b2725cd1d38d9838e5bbb2e 100644 --- a/compiler/llvmGen/LlvmCodeGen/Ppr.hs +++ b/compiler/llvmGen/LlvmCodeGen/Ppr.hs @@ -1,7 +1,8 @@ +{-# LANGUAGE CPP #-} + -- ---------------------------------------------------------------------------- -- | Pretty print helpers for the LLVM Code generator. -- - module LlvmCodeGen.Ppr ( pprLlvmHeader, pprLlvmCmmDecl, pprLlvmData, infoSection, iTableSuf ) where diff --git a/compiler/llvmGen/LlvmCodeGen/Regs.hs b/compiler/llvmGen/LlvmCodeGen/Regs.hs index 9f20aa5de567d4d903ce0e790d90fad3e1c4e537..004865906978895d8d6129fd7b7ccf454a623379 100644 --- a/compiler/llvmGen/LlvmCodeGen/Regs.hs +++ b/compiler/llvmGen/LlvmCodeGen/Regs.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + -------------------------------------------------------------------------------- -- | Deal with Cmm registers -- diff --git a/compiler/llvmGen/LlvmMangler.hs b/compiler/llvmGen/LlvmMangler.hs index a9054174e1452111f57b77c53df4681b2a560a42..7084a2e727dbcda561f94a7ec303c41794712427 100644 --- a/compiler/llvmGen/LlvmMangler.hs +++ b/compiler/llvmGen/LlvmMangler.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + -- ----------------------------------------------------------------------------- -- | GHC LLVM Mangler -- diff --git a/compiler/main/BreakArray.hs b/compiler/main/BreakArray.hs index d16d6f229dc35367181fa58807bb6f8348a78f04..6455912b671fa1e445405e17b083ef9147f6f806 100644 --- a/compiler/main/BreakArray.hs +++ b/compiler/main/BreakArray.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP, MagicHash, UnboxedTuples #-} + ------------------------------------------------------------------------------- -- -- | Break Arrays in the IO monad diff --git a/compiler/main/CmdLineParser.hs b/compiler/main/CmdLineParser.hs index 22811d44cc1b0aa5990532635ba8dd39410f08bd..5ee7086cbc775d625f847431b674ac103ade1356 100644 --- a/compiler/main/CmdLineParser.hs +++ b/compiler/main/CmdLineParser.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + ------------------------------------------------------------------------------- -- -- | Command-line parser diff --git a/compiler/main/CodeOutput.lhs b/compiler/main/CodeOutput.lhs index b8b187241b710e6d3f2501b49c6c00a13e14b867..f6756b1bbc5b16e60c4529681edab2aa664dbec5 100644 --- a/compiler/main/CodeOutput.lhs +++ b/compiler/main/CodeOutput.lhs @@ -4,6 +4,8 @@ \section{Code output phase} \begin{code} +{-# LANGUAGE CPP #-} + module CodeOutput( codeOutput, outputForeignStubs ) where #include "HsVersions.h" diff --git a/compiler/main/DriverMkDepend.hs b/compiler/main/DriverMkDepend.hs index cda0b4729f6ecd66d0a97c9815e3d3a91c1f5690..03545d482864b1d5bf9dac68a471c6e661d2eb11 100644 --- a/compiler/main/DriverMkDepend.hs +++ b/compiler/main/DriverMkDepend.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + ----------------------------------------------------------------------------- -- -- Makefile Dependency Generation diff --git a/compiler/main/DriverPhases.hs b/compiler/main/DriverPhases.hs index 8c69d4ece4eba952aaf0f1790d55eee44931e65c..fa8b2d060f149fd043007407d79e5b82a4239e8d 100644 --- a/compiler/main/DriverPhases.hs +++ b/compiler/main/DriverPhases.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + ----------------------------------------------------------------------------- -- $Id: DriverPhases.hs,v 1.38 2005/05/17 11:01:59 simonmar Exp $ -- diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index 762f4da4220a16f2451d843b95949c33e4bda317..39df2a1d135dee4d41cbb7bab77510f1c708e924 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -1,5 +1,5 @@ -{-# OPTIONS -fno-cse #-} -{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE CPP, NamedFieldPuns, NondecreasingIndentation #-} +{-# OPTIONS_GHC -fno-cse #-} -- -fno-cse is needed for GLOBAL_VAR's to behave properly ----------------------------------------------------------------------------- diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 7d24785c635e13dd19cf6f24a7df588be9ef9d35..a27541652db12b3c826b7c10297205ad6996212b 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + ------------------------------------------------------------------------------- -- -- | Dynamic flags @@ -11,7 +13,7 @@ -- ------------------------------------------------------------------------------- -{-# OPTIONS -fno-cse #-} +{-# OPTIONS_GHC -fno-cse #-} -- -fno-cse is needed for GLOBAL_VAR's to behave properly module DynFlags ( diff --git a/compiler/main/DynamicLoading.hs b/compiler/main/DynamicLoading.hs index ffafc78216722e362cb284270556d79373c95101..046d13cee57e6e979b2131a17d1a3cba8fe85abb 100644 --- a/compiler/main/DynamicLoading.hs +++ b/compiler/main/DynamicLoading.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP, MagicHash #-} + -- | Dynamically lookup up values from modules and loading them. module DynamicLoading ( #ifdef GHCI diff --git a/compiler/main/ErrUtils.lhs b/compiler/main/ErrUtils.lhs index 12b6bad68aad5d5e70b9cb48f74b473f45ff2a4e..02f731d3c2975000156b5755fa06d6bb7ad4828c 100644 --- a/compiler/main/ErrUtils.lhs +++ b/compiler/main/ErrUtils.lhs @@ -4,6 +4,7 @@ \section[ErrsUtils]{Utilities for error reporting} \begin{code} +{-# LANGUAGE CPP #-} module ErrUtils ( ErrMsg, WarnMsg, Severity(..), diff --git a/compiler/main/Finder.lhs b/compiler/main/Finder.lhs index 60683b2289eae20666b810f5a4be756acbd9efac..c0e9f8a58b427c6734a8e437dd31e5f618a0c642 100644 --- a/compiler/main/Finder.lhs +++ b/compiler/main/Finder.lhs @@ -4,6 +4,8 @@ \section[Finder]{Module Finder} \begin{code} +{-# LANGUAGE CPP #-} + module Finder ( flushFinderCaches, FindResult(..), diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs index 6576a501abaf7b944c3486bd8a835ac284923063..5c0cbf7c4d7dfbedfddb39a23785ae2a4d2a970e 100644 --- a/compiler/main/GHC.hs +++ b/compiler/main/GHC.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP, NondecreasingIndentation, ScopedTypeVariables #-} + -- ----------------------------------------------------------------------------- -- -- (c) The University of Glasgow, 2005-2012 diff --git a/compiler/main/GhcMake.hs b/compiler/main/GhcMake.hs index b7a1282f5cda9ed235c67d7ddcfcbb03ae9ffaab..694778115dda8084edbc335923df1c248561ec1a 100644 --- a/compiler/main/GhcMake.hs +++ b/compiler/main/GhcMake.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE BangPatterns, CPP, NondecreasingIndentation, ScopedTypeVariables #-} {-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} -- NB: we specifically ignore deprecations. GHC 7.6 marks the .QSem module as -- deprecated, although it became un-deprecated later. As a result, using 7.6 diff --git a/compiler/main/GhcMonad.hs b/compiler/main/GhcMonad.hs index 68b4e2b2a2728abe9cbc95abd090b585c30bd6af..5fa6452d587f05342d978b1e392c487ce1d182dc 100644 --- a/compiler/main/GhcMonad.hs +++ b/compiler/main/GhcMonad.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE RankNTypes #-} {-# OPTIONS_GHC -funbox-strict-fields #-} -- ----------------------------------------------------------------------------- -- diff --git a/compiler/main/HeaderInfo.hs b/compiler/main/HeaderInfo.hs index 3e1edc3adf8657dae074a20ebbad905ab1b054c2..fcf235bd23f9e85b42e9f7d4af84c513ff43a45f 100644 --- a/compiler/main/HeaderInfo.hs +++ b/compiler/main/HeaderInfo.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + ----------------------------------------------------------------------------- -- -- | Parsing the top of a Haskell source file to get its module name, diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs index 475b124dd3ae185c389cd8728dacd73335dc220c..7cda3d6184d9c2535a26a785909db461b13e8e92 100644 --- a/compiler/main/HscMain.hs +++ b/compiler/main/HscMain.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE BangPatterns, CPP, MagicHash, NondecreasingIndentation #-} + ------------------------------------------------------------------------------- -- -- | Main API for compiling plain Haskell source code. diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs index 6fcf8e24a7245e2f4adcc89e2ecc4ff876d8b6b2..d0f59a174a711253cc6ab64d589337e6b8faba0a 100644 --- a/compiler/main/HscTypes.lhs +++ b/compiler/main/HscTypes.lhs @@ -4,6 +4,7 @@ \section[HscTypes]{Types for the per-module compiler} \begin{code} +{-# LANGUAGE CPP, DeriveDataTypeable, ScopedTypeVariables #-} -- | Types for the per-module compiler module HscTypes ( diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs index ede519982a90ff21a7072122bcbc02507c6fc7e6..cfcc0762355c8b26a171aabb211caf5cbe97aa91 100644 --- a/compiler/main/InteractiveEval.hs +++ b/compiler/main/InteractiveEval.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP, MagicHash, NondecreasingIndentation, UnboxedTuples #-} + -- ----------------------------------------------------------------------------- -- -- (c) The University of Glasgow, 2005-2007 diff --git a/compiler/main/InteractiveEvalTypes.hs b/compiler/main/InteractiveEvalTypes.hs index e3324a39a15bd71ad77b83440a2b57d4993733b9..6ea1a256486687e4b91261cea5db0c82aac96cf9 100644 --- a/compiler/main/InteractiveEvalTypes.hs +++ b/compiler/main/InteractiveEvalTypes.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + -- ----------------------------------------------------------------------------- -- -- (c) The University of Glasgow, 2005-2007 diff --git a/compiler/main/PackageConfig.hs b/compiler/main/PackageConfig.hs index d34d9e1f5c5e64b74d4cf8cf5a27661bc6b14894..acedd7e3bfeaf8016ed8031640c07678233a63a4 100644 --- a/compiler/main/PackageConfig.hs +++ b/compiler/main/PackageConfig.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + -- | -- Package configuration information: essentially the interface to Cabal, with -- some utilities diff --git a/compiler/main/Packages.lhs b/compiler/main/Packages.lhs index a13b3599b86b8f1595333a7a2114e4cc15fa3764..bb37e4413c1cf23bbf71b791b81e2ef7d82a9df8 100644 --- a/compiler/main/Packages.lhs +++ b/compiler/main/Packages.lhs @@ -2,6 +2,8 @@ % (c) The University of Glasgow, 2006 % \begin{code} +{-# LANGUAGE CPP #-} + -- | Package manipulation module Packages ( module PackageConfig, diff --git a/compiler/main/PlatformConstants.hs b/compiler/main/PlatformConstants.hs index 03e146ca7c8702faaa7e0dfd42d47570ce44f733..b2ca32be68193ed2a1ebb865deb8c781d6c4219a 100644 --- a/compiler/main/PlatformConstants.hs +++ b/compiler/main/PlatformConstants.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + ------------------------------------------------------------------------------- -- -- | Platform constants diff --git a/compiler/main/PprTyThing.hs b/compiler/main/PprTyThing.hs index 4934024b8b632aa2a483782ce5f9d49867309f64..dadc9971c32f1b4828a85e21c0f94701f7cf6597 100644 --- a/compiler/main/PprTyThing.hs +++ b/compiler/main/PprTyThing.hs @@ -6,7 +6,7 @@ -- ----------------------------------------------------------------------------- -{-# OPTIONS -fno-warn-tabs #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/main/StaticFlags.hs b/compiler/main/StaticFlags.hs index 01dc3b7275eaba3cce1351d6318b6458b7f2c416..eb7ede00c6c26c368a7db42e32b53e2cb44bb941 100644 --- a/compiler/main/StaticFlags.hs +++ b/compiler/main/StaticFlags.hs @@ -1,4 +1,5 @@ -{-# OPTIONS -fno-cse #-} +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-cse #-} -- -fno-cse is needed for GLOBAL_VAR's to behave properly ----------------------------------------------------------------------------- diff --git a/compiler/main/SysTools.lhs b/compiler/main/SysTools.lhs index 53240faf48f48df210088f51e95dbeb60846fed8..dc9642d245a51d5bce5391a9baf6a51a88ed4a1d 100644 --- a/compiler/main/SysTools.lhs +++ b/compiler/main/SysTools.lhs @@ -7,6 +7,8 @@ ----------------------------------------------------------------------------- \begin{code} +{-# LANGUAGE CPP, ScopedTypeVariables #-} + module SysTools ( -- Initialisation initSysTools, diff --git a/compiler/main/TidyPgm.lhs b/compiler/main/TidyPgm.lhs index 1055e3d9b35a16eec533e3298e03d2507a58b401..b299015748d0ca1c5fd4c91516c23b04102c7944 100644 --- a/compiler/main/TidyPgm.lhs +++ b/compiler/main/TidyPgm.lhs @@ -4,6 +4,8 @@ \section{Tidying up Core} \begin{code} +{-# LANGUAGE CPP #-} + module TidyPgm ( mkBootModDetailsTc, tidyProgram, globaliseAndTidyId ) where diff --git a/compiler/nativeGen/AsmCodeGen.lhs b/compiler/nativeGen/AsmCodeGen.lhs index 09a3bf7ec8b72481592eab00e41ca952958f5214..82193b49ebfb52f61e9e3f8b1cf4b300b976df27 100644 --- a/compiler/nativeGen/AsmCodeGen.lhs +++ b/compiler/nativeGen/AsmCodeGen.lhs @@ -7,7 +7,8 @@ -- ----------------------------------------------------------------------------- \begin{code} -{-# LANGUAGE GADTs #-} +{-# LANGUAGE BangPatterns, CPP, GADTs, ScopedTypeVariables, UnboxedTuples #-} + module AsmCodeGen ( nativeCodeGen ) where #include "HsVersions.h" diff --git a/compiler/nativeGen/NCGMonad.hs b/compiler/nativeGen/NCGMonad.hs index 3ee3af2ea94d801c301fb59ef92e6e96700ccd42..a4c9f74df7c239d6e23c8540715843fef6161ae5 100644 --- a/compiler/nativeGen/NCGMonad.hs +++ b/compiler/nativeGen/NCGMonad.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + -- ----------------------------------------------------------------------------- -- -- (c) The University of Glasgow 1993-2004 diff --git a/compiler/nativeGen/PPC/CodeGen.hs b/compiler/nativeGen/PPC/CodeGen.hs index 3f0e7632f8ef93db71ec8f808edb423f52738486..91651e6065bd3570e45d7562839fa36c1fb09264 100644 --- a/compiler/nativeGen/PPC/CodeGen.hs +++ b/compiler/nativeGen/PPC/CodeGen.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP, GADTs #-} ----------------------------------------------------------------------------- -- @@ -12,7 +13,6 @@ -- (c) the #if blah_TARGET_ARCH} things, the -- structure should not be too overwhelming. -{-# LANGUAGE GADTs #-} module PPC.CodeGen ( cmmTopCodeGen, generateJumpTableForInstr, diff --git a/compiler/nativeGen/PPC/Cond.hs b/compiler/nativeGen/PPC/Cond.hs index b8c5208c660b10027eb347d028d63756eb5bbc4b..2568da5249fcc02c0040aa213939a4d8842f0cb2 100644 --- a/compiler/nativeGen/PPC/Cond.hs +++ b/compiler/nativeGen/PPC/Cond.hs @@ -1,5 +1,5 @@ -{-# OPTIONS -fno-warn-tabs #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/nativeGen/PPC/Instr.hs b/compiler/nativeGen/PPC/Instr.hs index ddb9c51c7bbf5a98763c21c5c0db6b5f29bb46a9..3756c649bbf86c302b8200d03dc9a3c576a78377 100644 --- a/compiler/nativeGen/PPC/Instr.hs +++ b/compiler/nativeGen/PPC/Instr.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + ----------------------------------------------------------------------------- -- -- Machine-dependent assembly language diff --git a/compiler/nativeGen/PPC/RegInfo.hs b/compiler/nativeGen/PPC/RegInfo.hs index 8b35d875736ac4718eb9c506e0dc29e8e72db77e..bffa9ea63ff87a324917e4f0dff073103089d646 100644 --- a/compiler/nativeGen/PPC/RegInfo.hs +++ b/compiler/nativeGen/PPC/RegInfo.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + ----------------------------------------------------------------------------- -- -- Machine-specific parts of the register allocator @@ -6,7 +8,7 @@ -- ----------------------------------------------------------------------------- -{-# OPTIONS -fno-warn-tabs #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/nativeGen/PPC/Regs.hs b/compiler/nativeGen/PPC/Regs.hs index f92351bd22a0a8b646100be330d83d0a02ab353c..0f636bf64c167f23f6079cd7a3ca32e955ca7332 100644 --- a/compiler/nativeGen/PPC/Regs.hs +++ b/compiler/nativeGen/PPC/Regs.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + -- ----------------------------------------------------------------------------- -- -- (c) The University of Glasgow 1994-2004 diff --git a/compiler/nativeGen/Reg.hs b/compiler/nativeGen/Reg.hs index fee74be355138ee0e9f1872b0faab0fe976f5176..77ca7480d6449fbfa50928c68c0fff1ad1571903 100644 --- a/compiler/nativeGen/Reg.hs +++ b/compiler/nativeGen/Reg.hs @@ -5,7 +5,7 @@ -- by all architectures. -- -{-# OPTIONS -fno-warn-tabs #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/nativeGen/RegAlloc/Graph/Main.hs b/compiler/nativeGen/RegAlloc/Graph/Main.hs index dbaf5098ceb8c1410429a028d0d744ef7023e28a..05db68dd463ea53e254377bbd5bb19b166e38293 100644 --- a/compiler/nativeGen/RegAlloc/Graph/Main.hs +++ b/compiler/nativeGen/RegAlloc/Graph/Main.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE ScopedTypeVariables #-} + -- | Graph coloring register allocator. module RegAlloc.Graph.Main ( regAlloc diff --git a/compiler/nativeGen/RegAlloc/Graph/Stats.hs b/compiler/nativeGen/RegAlloc/Graph/Stats.hs index 7bc842d1c9d3385cac8899e5df6dac0695b0d69d..8fada96ee25b9daab154719637a8462558b2ca42 100644 --- a/compiler/nativeGen/RegAlloc/Graph/Stats.hs +++ b/compiler/nativeGen/RegAlloc/Graph/Stats.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE BangPatterns, CPP #-} -- | Carries interesting info for debugging / profiling of the -- graph coloring register allocator. diff --git a/compiler/nativeGen/RegAlloc/Graph/TrivColorable.hs b/compiler/nativeGen/RegAlloc/Graph/TrivColorable.hs index 2d58ed99817592fab2fe399cd8c4aaa30dff2303..eba2e4314995ed752703908f372f13e830025ce2 100644 --- a/compiler/nativeGen/RegAlloc/Graph/TrivColorable.hs +++ b/compiler/nativeGen/RegAlloc/Graph/TrivColorable.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE BangPatterns, CPP #-} module RegAlloc.Graph.TrivColorable ( trivColorable, diff --git a/compiler/nativeGen/RegAlloc/Linear/FreeRegs.hs b/compiler/nativeGen/RegAlloc/Linear/FreeRegs.hs index 0247c9dfaea8874fefeb656cf46e53403bee2cf4..a1a00ba5829ff6afd107130af8ab96c958045d32 100644 --- a/compiler/nativeGen/RegAlloc/Linear/FreeRegs.hs +++ b/compiler/nativeGen/RegAlloc/Linear/FreeRegs.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} module RegAlloc.Linear.FreeRegs ( FR(..), diff --git a/compiler/nativeGen/RegAlloc/Linear/Main.hs b/compiler/nativeGen/RegAlloc/Linear/Main.hs index 46d5309f70ab510287751c191cc14a083ed03d62..ee43d25aa39737a91d81a747de48058bbaae414a 100644 --- a/compiler/nativeGen/RegAlloc/Linear/Main.hs +++ b/compiler/nativeGen/RegAlloc/Linear/Main.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP, ScopedTypeVariables #-} + ----------------------------------------------------------------------------- -- -- The register allocator diff --git a/compiler/nativeGen/RegAlloc/Linear/PPC/FreeRegs.hs b/compiler/nativeGen/RegAlloc/Linear/PPC/FreeRegs.hs index 0bdb49fb2ee549f871088c78e567cd67bb4beba7..b76fe79d7dbb53c7a7f69be1901f4d4132d4d055 100644 --- a/compiler/nativeGen/RegAlloc/Linear/PPC/FreeRegs.hs +++ b/compiler/nativeGen/RegAlloc/Linear/PPC/FreeRegs.hs @@ -1,4 +1,3 @@ - -- | Free regs map for PowerPC module RegAlloc.Linear.PPC.FreeRegs where diff --git a/compiler/nativeGen/RegAlloc/Linear/State.hs b/compiler/nativeGen/RegAlloc/Linear/State.hs index dc499c9c1f625e063c822042d7c85fdbe1b62c06..39b5777ef32ecee793064c3b4b85ab40ea5d66f0 100644 --- a/compiler/nativeGen/RegAlloc/Linear/State.hs +++ b/compiler/nativeGen/RegAlloc/Linear/State.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE UnboxedTuples #-} + -- | State monad for the linear register allocator. -- Here we keep all the state that the register allocator keeps track diff --git a/compiler/nativeGen/RegAlloc/Liveness.hs b/compiler/nativeGen/RegAlloc/Liveness.hs index b0e763a6f0cded3487397e033f83d922d32a5f91..e5e80b2fe3a6d1226186b977d6e72650a0e11f2a 100644 --- a/compiler/nativeGen/RegAlloc/Liveness.hs +++ b/compiler/nativeGen/RegAlloc/Liveness.hs @@ -1,3 +1,8 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} + ----------------------------------------------------------------------------- -- -- The register liveness determinator @@ -5,7 +10,7 @@ -- (c) The University of Glasgow 2004-2013 -- ----------------------------------------------------------------------------- -{-# LANGUAGE FlexibleContexts, TypeFamilies #-} + module RegAlloc.Liveness ( RegSet, RegMap, emptyRegMap, diff --git a/compiler/nativeGen/RegClass.hs b/compiler/nativeGen/RegClass.hs index 7ccc0c1bec9391fb16f6c38db780bd110a7f3d32..cac4e6422165f17f670f4a9bcd84689c7a061e30 100644 --- a/compiler/nativeGen/RegClass.hs +++ b/compiler/nativeGen/RegClass.hs @@ -1,4 +1,4 @@ -{-# OPTIONS -fno-warn-tabs #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/nativeGen/SPARC/CodeGen.hs b/compiler/nativeGen/SPARC/CodeGen.hs index 5d65b427e13a6d433d0772d2cdae6d25750ac101..f5e61d0a8fe0f2668718233e1c271e6c45cc4512 100644 --- a/compiler/nativeGen/SPARC/CodeGen.hs +++ b/compiler/nativeGen/SPARC/CodeGen.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + ----------------------------------------------------------------------------- -- -- Generating machine code (instruction selection) diff --git a/compiler/nativeGen/SPARC/CodeGen/Amode.hs b/compiler/nativeGen/SPARC/CodeGen/Amode.hs index 324eda94e75eb41c92f230655caabf7ce91ef4a0..f0aed0d02e486bf8e2c93d20d46b79421d7561e3 100644 --- a/compiler/nativeGen/SPARC/CodeGen/Amode.hs +++ b/compiler/nativeGen/SPARC/CodeGen/Amode.hs @@ -1,5 +1,5 @@ -{-# OPTIONS -fno-warn-tabs #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/nativeGen/SPARC/CodeGen/Base.hs b/compiler/nativeGen/SPARC/CodeGen/Base.hs index 03b31e016a4de40fe9befddf395c2695f1acc1c7..45b78019606099e100c2b8dba67774b1ffd62b35 100644 --- a/compiler/nativeGen/SPARC/CodeGen/Base.hs +++ b/compiler/nativeGen/SPARC/CodeGen/Base.hs @@ -1,5 +1,5 @@ -{-# OPTIONS -fno-warn-tabs #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/nativeGen/SPARC/CodeGen/CondCode.hs b/compiler/nativeGen/SPARC/CodeGen/CondCode.hs index 375a9e1b33907a9b07d07f37fa9d2999b617e6ff..2c3dbe6fc01ca7e54f1dcb9f073c6987425e99c8 100644 --- a/compiler/nativeGen/SPARC/CodeGen/CondCode.hs +++ b/compiler/nativeGen/SPARC/CodeGen/CondCode.hs @@ -1,5 +1,5 @@ -{-# OPTIONS -fno-warn-tabs #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/nativeGen/SPARC/CodeGen/Expand.hs b/compiler/nativeGen/SPARC/CodeGen/Expand.hs index 03f571c20bb7965b70ee1c77834d4150ef90aadb..7ebc2f6630efec447e0aa9041232c56811e77c8f 100644 --- a/compiler/nativeGen/SPARC/CodeGen/Expand.hs +++ b/compiler/nativeGen/SPARC/CodeGen/Expand.hs @@ -1,5 +1,5 @@ -{-# OPTIONS -fno-warn-tabs #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/nativeGen/SPARC/CodeGen/Gen32.hs b/compiler/nativeGen/SPARC/CodeGen/Gen32.hs index df876b46223c2b079f49417cac102d1d59527fa1..43a26e525a68b8e9d471aecb72eeac5920134bc3 100644 --- a/compiler/nativeGen/SPARC/CodeGen/Gen32.hs +++ b/compiler/nativeGen/SPARC/CodeGen/Gen32.hs @@ -1,5 +1,5 @@ -{-# OPTIONS -fno-warn-tabs #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/nativeGen/SPARC/CodeGen/Sanity.hs b/compiler/nativeGen/SPARC/CodeGen/Sanity.hs index d4cdaf2b16728419f14372ff1a7c4d9b1c4fe1c3..5dff9ce70462ff2c10122a5fac812abd675b7615 100644 --- a/compiler/nativeGen/SPARC/CodeGen/Sanity.hs +++ b/compiler/nativeGen/SPARC/CodeGen/Sanity.hs @@ -1,5 +1,5 @@ -{-# OPTIONS -fno-warn-tabs #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/nativeGen/SPARC/Cond.hs b/compiler/nativeGen/SPARC/Cond.hs index b8919a72a2a77be7d2ff55f415c94f7cbe110113..198e4a76271e423c13546ec4e254411e94badd51 100644 --- a/compiler/nativeGen/SPARC/Cond.hs +++ b/compiler/nativeGen/SPARC/Cond.hs @@ -1,5 +1,5 @@ -{-# OPTIONS -fno-warn-tabs #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/nativeGen/SPARC/Imm.hs b/compiler/nativeGen/SPARC/Imm.hs index 4c2bb5a4814eb7664dcbd6b40068ddc205859b99..844a08824bd85ecf0882159d2f60d256fe13776c 100644 --- a/compiler/nativeGen/SPARC/Imm.hs +++ b/compiler/nativeGen/SPARC/Imm.hs @@ -1,5 +1,5 @@ -{-# OPTIONS -fno-warn-tabs #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/nativeGen/SPARC/Instr.hs b/compiler/nativeGen/SPARC/Instr.hs index 601e04787a5411df9611dbfe2bc5b43ff39b3345..8e4a2b32dfc3c35025dc1179d47ffed820f16dab 100644 --- a/compiler/nativeGen/SPARC/Instr.hs +++ b/compiler/nativeGen/SPARC/Instr.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + ----------------------------------------------------------------------------- -- -- Machine-dependent assembly language @@ -6,7 +8,7 @@ -- ----------------------------------------------------------------------------- -{-# OPTIONS -fno-warn-tabs #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/nativeGen/SPARC/Ppr.hs b/compiler/nativeGen/SPARC/Ppr.hs index 601b5288a0d9ae7e11f0fc848a5b43176f749757..654179e0770c095e7055aa2b071de17a65ddff2a 100644 --- a/compiler/nativeGen/SPARC/Ppr.hs +++ b/compiler/nativeGen/SPARC/Ppr.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + ----------------------------------------------------------------------------- -- -- Pretty-printing assembly language diff --git a/compiler/nativeGen/SPARC/Regs.hs b/compiler/nativeGen/SPARC/Regs.hs index 55b6ac9156e2d42dfa11a592e6596a391fe1636d..01db0ed3ac441419ca51594612c6e631ac090cf1 100644 --- a/compiler/nativeGen/SPARC/Regs.hs +++ b/compiler/nativeGen/SPARC/Regs.hs @@ -4,7 +4,7 @@ -- -- ----------------------------------------------------------------------------- -{-# OPTIONS -fno-warn-tabs #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/nativeGen/SPARC/ShortcutJump.hs b/compiler/nativeGen/SPARC/ShortcutJump.hs index 7f978c17c5098e7d533005c77c324631c2851754..142ec6e65d00a944e90e622a253e43772849d083 100644 --- a/compiler/nativeGen/SPARC/ShortcutJump.hs +++ b/compiler/nativeGen/SPARC/ShortcutJump.hs @@ -1,5 +1,5 @@ -{-# OPTIONS -fno-warn-tabs #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/nativeGen/SPARC/Stack.hs b/compiler/nativeGen/SPARC/Stack.hs index 4a6f4c1335d919ad10cee850473e9b3a31502d5c..3560a0fe822c8236e0606636ad5ce9d6630203e9 100644 --- a/compiler/nativeGen/SPARC/Stack.hs +++ b/compiler/nativeGen/SPARC/Stack.hs @@ -1,5 +1,5 @@ -{-# OPTIONS -fno-warn-tabs #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/nativeGen/Size.hs b/compiler/nativeGen/Size.hs index 45a39645cc2b4b66637d0fbd80f5a7e2da7c5e6d..1b95ceb98bed674c8c0a0a9efccf614917e39129 100644 --- a/compiler/nativeGen/Size.hs +++ b/compiler/nativeGen/Size.hs @@ -1,4 +1,4 @@ -{-# OPTIONS -fno-warn-tabs #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/nativeGen/TargetReg.hs b/compiler/nativeGen/TargetReg.hs index 1f7f4e0db06d43271a179e28e728b556eb2cf6e0..daf1e254c8610b17afe0c092cf499e4e118582f3 100644 --- a/compiler/nativeGen/TargetReg.hs +++ b/compiler/nativeGen/TargetReg.hs @@ -1,5 +1,5 @@ - -{-# OPTIONS -fno-warn-tabs #-} +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/nativeGen/X86/CodeGen.hs b/compiler/nativeGen/X86/CodeGen.hs index e659488fe0e324cff2014b94b99cd859992c6ee8..e71a1dd46f0000e045e9ae593cbd00641cac80b9 100644 --- a/compiler/nativeGen/X86/CodeGen.hs +++ b/compiler/nativeGen/X86/CodeGen.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP, GADTs, NondecreasingIndentation #-} + ----------------------------------------------------------------------------- -- -- Generating machine code (instruction selection) @@ -10,7 +12,6 @@ -- (a) the sectioning, and (b) the type signatures, the -- structure should not be too overwhelming. -{-# LANGUAGE GADTs #-} module X86.CodeGen ( cmmTopCodeGen, generateJumpTableForInstr, diff --git a/compiler/nativeGen/X86/Instr.hs b/compiler/nativeGen/X86/Instr.hs index 75e5b9e737dbb8ce77724bafbb536408d74e12cb..05fff9be96afe86b08fcd5b9abb7614bc1a664b5 100644 --- a/compiler/nativeGen/X86/Instr.hs +++ b/compiler/nativeGen/X86/Instr.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP, TypeFamilies #-} + ----------------------------------------------------------------------------- -- -- Machine-dependent assembly language @@ -6,16 +8,15 @@ -- ----------------------------------------------------------------------------- -#include "HsVersions.h" -#include "nativeGen/NCG.h" - -{-# LANGUAGE TypeFamilies #-} module X86.Instr (Instr(..), Operand(..), PrefetchVariant(..), JumpDest, getJumpDestBlockId, canShortcut, shortcutStatics, shortcutJump, i386_insert_ffrees, allocMoreStack, maxSpillSlots, archWordSize) where +#include "HsVersions.h" +#include "nativeGen/NCG.h" + import X86.Cond import X86.Regs import Instruction diff --git a/compiler/nativeGen/X86/Ppr.hs b/compiler/nativeGen/X86/Ppr.hs index f38a04d069356acbe2408763aafa6c2ed5cd6b7a..459c041ba5345679017c99dd3e972104c9e46908 100644 --- a/compiler/nativeGen/X86/Ppr.hs +++ b/compiler/nativeGen/X86/Ppr.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + ----------------------------------------------------------------------------- -- -- Pretty-printing assembly language diff --git a/compiler/nativeGen/X86/RegInfo.hs b/compiler/nativeGen/X86/RegInfo.hs index 8c63933c5bc29a781b634bacacbe7e9dc932344f..0303295bc696f5a2d40843c3f2d071b2ad4785a7 100644 --- a/compiler/nativeGen/X86/RegInfo.hs +++ b/compiler/nativeGen/X86/RegInfo.hs @@ -1,5 +1,5 @@ - -{-# OPTIONS -fno-warn-tabs #-} +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/nativeGen/X86/Regs.hs b/compiler/nativeGen/X86/Regs.hs index 127a81183175bb6161d79479ca2c4eae4e08e497..4162e2b703f300f2af70d98a485d7793761cb610 100644 --- a/compiler/nativeGen/X86/Regs.hs +++ b/compiler/nativeGen/X86/Regs.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + module X86.Regs ( -- squeese functions for the graph allocator virtualRegSqueeze, diff --git a/compiler/parser/Ctype.lhs b/compiler/parser/Ctype.lhs index b5173b2612afef7f53da9f2692ee1d7bd0f593e0..b8819d595e333c1c9c86f1f320c45f2a11c10cc6 100644 --- a/compiler/parser/Ctype.lhs +++ b/compiler/parser/Ctype.lhs @@ -1,7 +1,8 @@ Character classification \begin{code} -{-# OPTIONS -fno-warn-tabs #-} +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/parser/RdrHsSyn.lhs b/compiler/parser/RdrHsSyn.lhs index 03ec622223050a3b7e66be307da14826ef2139d4..3ce35858bbd1688f0068f742dd6c993dd4f1a743 100644 --- a/compiler/parser/RdrHsSyn.lhs +++ b/compiler/parser/RdrHsSyn.lhs @@ -4,6 +4,8 @@ o% Functions over HsSyn specialised to RdrName. \begin{code} +{-# LANGUAGE CPP #-} + module RdrHsSyn ( mkHsOpApp, mkHsIntegral, mkHsFractional, mkHsIsString, diff --git a/compiler/prelude/PrelInfo.lhs b/compiler/prelude/PrelInfo.lhs index 014e0e7483cb2b8aead2298ff92ef285bfeb2896..829b5e3bf91029646c43110c3deb9a8d35abe0a8 100644 --- a/compiler/prelude/PrelInfo.lhs +++ b/compiler/prelude/PrelInfo.lhs @@ -4,7 +4,8 @@ \section[PrelInfo]{The @PrelInfo@ interface to the compiler's prelude knowledge} \begin{code} -{-# OPTIONS -fno-warn-tabs #-} +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/prelude/PrelNames.lhs b/compiler/prelude/PrelNames.lhs index 1d54726f2f2cb1b61010df0188700b7100c716b4..caa5e2a779dfaaebc595e41b613640c8120665f9 100644 --- a/compiler/prelude/PrelNames.lhs +++ b/compiler/prelude/PrelNames.lhs @@ -102,6 +102,8 @@ This is accomplished through a combination of mechanisms: See also Note [Built-in syntax and the OrigNameCache] \begin{code} +{-# LANGUAGE CPP #-} + module PrelNames ( Unique, Uniquable(..), hasKey, -- Re-exported for convenience diff --git a/compiler/prelude/PrelRules.lhs b/compiler/prelude/PrelRules.lhs index 786780654e88d90695245dbe542ee039bd049815..d2e648f38247b84761aa3912ee4c1198d1cbeead 100644 --- a/compiler/prelude/PrelRules.lhs +++ b/compiler/prelude/PrelRules.lhs @@ -12,8 +12,8 @@ ToDo: (i1 + i2) only if it results in a valid Float. \begin{code} -{-# LANGUAGE RankNTypes #-} -{-# OPTIONS -optc-DNON_POSIX_SOURCE #-} +{-# LANGUAGE CPP, RankNTypes #-} +{-# OPTIONS_GHC -optc-DNON_POSIX_SOURCE #-} module PrelRules ( primOpRules, builtinRules ) where diff --git a/compiler/prelude/PrimOp.lhs b/compiler/prelude/PrimOp.lhs index 12f71c22303d790f12c0ce5dac150cafa44d4bbf..4155a541ba8093fc8a456fa7d6abc24e0a862dfb 100644 --- a/compiler/prelude/PrimOp.lhs +++ b/compiler/prelude/PrimOp.lhs @@ -4,6 +4,8 @@ \section[PrimOp]{Primitive operations (machine-level)} \begin{code} +{-# LANGUAGE CPP #-} + module PrimOp ( PrimOp(..), PrimOpVecCat(..), allThePrimOps, primOpType, primOpSig, diff --git a/compiler/prelude/TysPrim.lhs b/compiler/prelude/TysPrim.lhs index 789d121519c07fb267c2d2cae8343605a0ddd783..ae9a11ebfed4a919d32b26387a481cad9fd2daf8 100644 --- a/compiler/prelude/TysPrim.lhs +++ b/compiler/prelude/TysPrim.lhs @@ -6,7 +6,8 @@ \section[TysPrim]{Wired-in knowledge about primitive types} \begin{code} -{-# OPTIONS -fno-warn-tabs #-} +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/prelude/TysWiredIn.lhs b/compiler/prelude/TysWiredIn.lhs index dc4c775e3a5e21ec5f5a3045ae9ad64d6d1ac21e..4586b90cb227a8b3a686d5a3c868589348214e48 100644 --- a/compiler/prelude/TysWiredIn.lhs +++ b/compiler/prelude/TysWiredIn.lhs @@ -4,6 +4,8 @@ \section[TysWiredIn]{Wired-in knowledge about {\em non-primitive} types} \begin{code} +{-# LANGUAGE CPP #-} + -- | This module is about types that can be defined in Haskell, but which -- must be wired into the compiler nonetheless. C.f module TysPrim module TysWiredIn ( diff --git a/compiler/profiling/CostCentre.lhs b/compiler/profiling/CostCentre.lhs index fffd6462b24f5d4d1609b1dbe1e71f86cdd49e83..4a7a063897b537d123451cd5d60cc2c395e5a94c 100644 --- a/compiler/profiling/CostCentre.lhs +++ b/compiler/profiling/CostCentre.lhs @@ -1,5 +1,5 @@ \begin{code} -{-# OPTIONS -fno-warn-tabs #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/profiling/SCCfinal.lhs b/compiler/profiling/SCCfinal.lhs index fdcf7447ebb5dc09b2e0922e72c74692ea21da2d..4a6da2417e3b95bc248ab46ffc15c9beb862d546 100644 --- a/compiler/profiling/SCCfinal.lhs +++ b/compiler/profiling/SCCfinal.lhs @@ -2,6 +2,8 @@ % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % \begin{code} +{-# LANGUAGE CPP #-} + ----------------------------------------------------------------------------- -- Modify and collect code generation for final STG program diff --git a/compiler/rename/RnBinds.lhs b/compiler/rename/RnBinds.lhs index 7251492ccffb58778724a5b185def77fed32bc1c..7d3224e8ccc725ea86ea577f3f575535fd328b4e 100644 --- a/compiler/rename/RnBinds.lhs +++ b/compiler/rename/RnBinds.lhs @@ -9,7 +9,7 @@ type-synonym declarations; those cannot be done at this stage because they may be affected by renaming (which isn't fully worked out yet). \begin{code} -{-# OPTIONS -fno-warn-tabs #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/rename/RnEnv.lhs b/compiler/rename/RnEnv.lhs index 178f722d998e8c1729ce9f9b36d770242906ee5c..58f32bc74078782b0d22af5a23b05a5f68dcfabb 100644 --- a/compiler/rename/RnEnv.lhs +++ b/compiler/rename/RnEnv.lhs @@ -4,6 +4,8 @@ \section[RnEnv]{Environment manipulation for the renamer monad} \begin{code} +{-# LANGUAGE CPP #-} + module RnEnv ( newTopSrcBinder, lookupLocatedTopBndrRn, lookupTopBndrRn, diff --git a/compiler/rename/RnExpr.lhs b/compiler/rename/RnExpr.lhs index 01e8a4492d7cfe386efdb5ff7c3ca0c4e1776670..262fde8d7a9cc056e93641d2a9861f349c9f9354 100644 --- a/compiler/rename/RnExpr.lhs +++ b/compiler/rename/RnExpr.lhs @@ -10,6 +10,8 @@ general, all of these functions return a renamed thing, and a set of free variables. \begin{code} +{-# LANGUAGE CPP, ScopedTypeVariables #-} + module RnExpr ( rnLExpr, rnExpr, rnStmts ) where diff --git a/compiler/rename/RnNames.lhs b/compiler/rename/RnNames.lhs index 55997643dccd8827a4b823d523efa5274c2130e9..db4258607a49e7a9abb525f6cff5909023494483 100644 --- a/compiler/rename/RnNames.lhs +++ b/compiler/rename/RnNames.lhs @@ -4,6 +4,8 @@ \section[RnNames]{Extracting imported and top-level names in scope} \begin{code} +{-# LANGUAGE CPP, NondecreasingIndentation #-} + module RnNames ( rnImports, getLocalNonValBinders, rnExports, extendGlobalRdrEnvRn, diff --git a/compiler/rename/RnPat.lhs b/compiler/rename/RnPat.lhs index 3c48f340324b0c35839dae842c0cfa73aa3a5407..a920781c99e029af5a99a88977ed28186c6ebf66 100644 --- a/compiler/rename/RnPat.lhs +++ b/compiler/rename/RnPat.lhs @@ -10,13 +10,8 @@ general, all of these functions return a renamed thing, and a set of free variables. \begin{code} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and --- detab the module (please do the detabbing in a separate patch). See --- http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces --- for details +{-# LANGUAGE CPP, RankNTypes, ScopedTypeVariables #-} -{-# LANGUAGE ScopedTypeVariables #-} module RnPat (-- main entry points rnPat, rnPats, rnBindPat, rnPatAndThen, diff --git a/compiler/rename/RnSource.lhs b/compiler/rename/RnSource.lhs index fbc22c0c28dabda760c5f884c67aabb8936872d3..2618792e82b1f62a9bea6297d1fdb77822ce61d9 100644 --- a/compiler/rename/RnSource.lhs +++ b/compiler/rename/RnSource.lhs @@ -4,6 +4,8 @@ \section[RnSource]{Main pass of renamer} \begin{code} +{-# LANGUAGE CPP, ScopedTypeVariables #-} + module RnSource ( rnSrcDecls, addTcgDUs, rnTyClDecls, findSplice ) where diff --git a/compiler/rename/RnSplice.lhs b/compiler/rename/RnSplice.lhs index e0614d42488f0997b8d75969b894070c381c2e25..3c0c145e6b85de1b97d209ba60198281dc357374 100644 --- a/compiler/rename/RnSplice.lhs +++ b/compiler/rename/RnSplice.lhs @@ -1,4 +1,6 @@ \begin{code} +{-# LANGUAGE CPP #-} + module RnSplice ( rnTopSpliceDecls, rnSpliceType, rnSpliceExpr, rnSplicePat, rnSpliceDecl, diff --git a/compiler/rename/RnTypes.lhs b/compiler/rename/RnTypes.lhs index 23c54c3bed9b5104fa11e97da2bdb0d3e8b768a4..d051d7277e079d4fee36704e97bb1729cf28534c 100644 --- a/compiler/rename/RnTypes.lhs +++ b/compiler/rename/RnTypes.lhs @@ -4,6 +4,8 @@ \section[RnSource]{Main pass of renamer} \begin{code} +{-# LANGUAGE CPP #-} + module RnTypes ( -- Type related stuff rnHsType, rnLHsType, rnLHsTypes, rnContext, diff --git a/compiler/simplCore/CSE.lhs b/compiler/simplCore/CSE.lhs index 691f883d02a2e2aa447dfd5dc5e2399d550488ea..90715737c2b91999a194400c0defacc567a577d8 100644 --- a/compiler/simplCore/CSE.lhs +++ b/compiler/simplCore/CSE.lhs @@ -4,6 +4,8 @@ \section{Common subexpression} \begin{code} +{-# LANGUAGE CPP #-} + module CSE (cseProgram) where #include "HsVersions.h" diff --git a/compiler/simplCore/CoreMonad.lhs b/compiler/simplCore/CoreMonad.lhs index b2f697a632d8c08e82dfa458bc832363b382eabf..c06036044d04ccd24c1ae7b4a43e1fd70aab6d6b 100644 --- a/compiler/simplCore/CoreMonad.lhs +++ b/compiler/simplCore/CoreMonad.lhs @@ -4,15 +4,14 @@ \section[CoreMonad]{The core pipeline monad} \begin{code} -{-# OPTIONS -fno-warn-tabs #-} +{-# LANGUAGE CPP, UndecidableInstances #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See -- http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces -- for details -{-# LANGUAGE UndecidableInstances #-} - module CoreMonad ( -- * Configuration of the core-to-core passes CoreToDo(..), runWhen, runMaybe, diff --git a/compiler/simplCore/FloatIn.lhs b/compiler/simplCore/FloatIn.lhs index 8a35749c6775d0f9bff9dfa9dfbd935da140c451..2cf886c5c606031dfe4298ad66d102e754e48c8f 100644 --- a/compiler/simplCore/FloatIn.lhs +++ b/compiler/simplCore/FloatIn.lhs @@ -12,7 +12,8 @@ case, so that we don't allocate things, save them on the stack, and then discover that they aren't needed in the chosen branch. \begin{code} -{-# OPTIONS -fno-warn-tabs #-} +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/simplCore/FloatOut.lhs b/compiler/simplCore/FloatOut.lhs index fbe8a3eb8a16d163c08b0ac5a26993a4b8365ba1..dbab55243117960dd3ea2789ca230adb48705c5d 100644 --- a/compiler/simplCore/FloatOut.lhs +++ b/compiler/simplCore/FloatOut.lhs @@ -6,8 +6,9 @@ ``Long-distance'' floating of bindings towards the top level. \begin{code} +{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -{-# OPTIONS -fno-warn-tabs #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/simplCore/LiberateCase.lhs b/compiler/simplCore/LiberateCase.lhs index a89396b7827bd7373b1397d2bdf4cac5e57bafc6..2593ab159cdb689e34afef65c70059dca42fd341 100644 --- a/compiler/simplCore/LiberateCase.lhs +++ b/compiler/simplCore/LiberateCase.lhs @@ -4,7 +4,8 @@ \section[LiberateCase]{Unroll recursion to allow evals to be lifted from a loop} \begin{code} -{-# OPTIONS -fno-warn-tabs #-} +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/simplCore/OccurAnal.lhs b/compiler/simplCore/OccurAnal.lhs index 2487787c8dba9db9cd15c68a5d280f50fd95a1e5..c9323359c51ac5ba86cd25174ce329f61dfac3c4 100644 --- a/compiler/simplCore/OccurAnal.lhs +++ b/compiler/simplCore/OccurAnal.lhs @@ -12,7 +12,8 @@ The occurrence analyser re-typechecks a core expression, returning a new core expression with (hopefully) improved usage information. \begin{code} -{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP, BangPatterns #-} + module OccurAnal ( occurAnalysePgm, occurAnalyseExpr, occurAnalyseExpr_NoBinderSwap ) where diff --git a/compiler/simplCore/SAT.lhs b/compiler/simplCore/SAT.lhs index bc1ce42cd628a5aba1e2a996d3df8878786b7b0d..92ebdfe389a567ae12921a72d3e05426d707beec 100644 --- a/compiler/simplCore/SAT.lhs +++ b/compiler/simplCore/SAT.lhs @@ -49,7 +49,8 @@ essential to make this work well! \begin{code} -{-# OPTIONS -fno-warn-tabs #-} +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/simplCore/SetLevels.lhs b/compiler/simplCore/SetLevels.lhs index 6edadb8bd95a1644d4f5441ba8084f24fc95932c..225d5d612ef457a5253ae8cff93559233fd8bdce 100644 --- a/compiler/simplCore/SetLevels.lhs +++ b/compiler/simplCore/SetLevels.lhs @@ -42,7 +42,8 @@ the scrutinee of the case, and we can inline it. \begin{code} -{-# OPTIONS -fno-warn-tabs #-} +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/simplCore/SimplCore.lhs b/compiler/simplCore/SimplCore.lhs index 436d1b63aaa7da6ae45bbcb78b6f1b8d4370ddc8..59b39a9c60d76b653ba33ecdc6375d7605a88e06 100644 --- a/compiler/simplCore/SimplCore.lhs +++ b/compiler/simplCore/SimplCore.lhs @@ -4,6 +4,8 @@ \section[SimplCore]{Driver for simplifying @Core@ programs} \begin{code} +{-# LANGUAGE CPP #-} + module SimplCore ( core2core, simplifyExpr ) where #include "HsVersions.h" diff --git a/compiler/simplCore/SimplEnv.lhs b/compiler/simplCore/SimplEnv.lhs index 5f1013def8930070df7b4685e834cf5c383928fb..1c5ebc501bd743d71847d52a61fb20e01f81c995 100644 --- a/compiler/simplCore/SimplEnv.lhs +++ b/compiler/simplCore/SimplEnv.lhs @@ -4,6 +4,8 @@ \section[SimplMonad]{The simplifier Monad} \begin{code} +{-# LANGUAGE CPP #-} + module SimplEnv ( InId, InBind, InExpr, InAlt, InArg, InType, InBndr, InVar, OutId, OutTyVar, OutBind, OutExpr, OutAlt, OutArg, OutType, OutBndr, OutVar, diff --git a/compiler/simplCore/SimplUtils.lhs b/compiler/simplCore/SimplUtils.lhs index 59e5d4adc153ba22105b54fd9604ae75415929a5..14789c44a49ae12ad75b64a730a25941a9ee96bb 100644 --- a/compiler/simplCore/SimplUtils.lhs +++ b/compiler/simplCore/SimplUtils.lhs @@ -4,6 +4,8 @@ \section[SimplUtils]{The simplifier utilities} \begin{code} +{-# LANGUAGE CPP #-} + module SimplUtils ( -- Rebuilding mkLam, mkCase, prepareAlts, tryEtaExpandRhs, diff --git a/compiler/simplCore/Simplify.lhs b/compiler/simplCore/Simplify.lhs index eb1a7031053b0a85c37031324f9e8e2eb1e5ad07..1125c2e883d7a7587d8a02a280b592d8f89ad0ab 100644 --- a/compiler/simplCore/Simplify.lhs +++ b/compiler/simplCore/Simplify.lhs @@ -4,6 +4,8 @@ \section[Simplify]{The main module of the simplifier} \begin{code} +{-# LANGUAGE CPP #-} + module Simplify ( simplTopBinds, simplExpr ) where #include "HsVersions.h" diff --git a/compiler/simplStg/SimplStg.lhs b/compiler/simplStg/SimplStg.lhs index c43b6526b5fcc238da1c79adee1ea573da1a803b..4d33e3392eb9da581249fe1561a6eec84ffd7f68 100644 --- a/compiler/simplStg/SimplStg.lhs +++ b/compiler/simplStg/SimplStg.lhs @@ -4,6 +4,8 @@ \section[SimplStg]{Driver for simplifying @STG@ programs} \begin{code} +{-# LANGUAGE CPP #-} + module SimplStg ( stg2stg ) where #include "HsVersions.h" diff --git a/compiler/simplStg/StgStats.lhs b/compiler/simplStg/StgStats.lhs index 5424495468906a698f879368ff439341a547080c..2a776757dad8954070d107d89a96d3229e66c97f 100644 --- a/compiler/simplStg/StgStats.lhs +++ b/compiler/simplStg/StgStats.lhs @@ -21,6 +21,8 @@ The program gather statistics about \end{enumerate} \begin{code} +{-# LANGUAGE CPP #-} + module StgStats ( showStgStats ) where #include "HsVersions.h" diff --git a/compiler/simplStg/UnariseStg.lhs b/compiler/simplStg/UnariseStg.lhs index b1717ad1206452d8283a5bf1e36b894906a119b7..1f121f71fd7658771859b27952540b6d7a9fa709 100644 --- a/compiler/simplStg/UnariseStg.lhs +++ b/compiler/simplStg/UnariseStg.lhs @@ -27,6 +27,8 @@ which is the Arity taking into account any expanded arguments, and corresponds t the number of (possibly-void) *registers* arguments will arrive in. \begin{code} +{-# LANGUAGE CPP #-} + module UnariseStg (unarise) where #include "HsVersions.h" diff --git a/compiler/specialise/Rules.lhs b/compiler/specialise/Rules.lhs index 70fc09a2ef3d4c851d09f5d7444fb19cadb07a94..2abf7fbdca0ab4f49b775b5d5e4985ae08b3368d 100644 --- a/compiler/specialise/Rules.lhs +++ b/compiler/specialise/Rules.lhs @@ -4,6 +4,8 @@ \section[CoreRules]{Transformation rules} \begin{code} +{-# LANGUAGE CPP #-} + -- | Functions for collecting together and applying rewrite rules to a module. -- The 'CoreRule' datatype itself is declared elsewhere. module Rules ( diff --git a/compiler/specialise/SpecConstr.lhs b/compiler/specialise/SpecConstr.lhs index 9df460edde445f9612d4b6f4634bf121175cd37c..24820eba4085801d6775a6a18a2cab834bddab12 100644 --- a/compiler/specialise/SpecConstr.lhs +++ b/compiler/specialise/SpecConstr.lhs @@ -9,6 +9,8 @@ ToDo [Oct 2013] \section[SpecConstr]{Specialise over constructors} \begin{code} +{-# LANGUAGE CPP #-} + module SpecConstr( specConstrProgram #ifdef GHCI diff --git a/compiler/specialise/Specialise.lhs b/compiler/specialise/Specialise.lhs index 3191ae946e79071c2161f8198525b9622b4bb86b..baa5d1971fe0345e8d1eeb0d5e9f5b9f33221580 100644 --- a/compiler/specialise/Specialise.lhs +++ b/compiler/specialise/Specialise.lhs @@ -4,6 +4,8 @@ \section[Specialise]{Stamping out overloading, and (optionally) polymorphism} \begin{code} +{-# LANGUAGE CPP #-} + module Specialise ( specProgram ) where #include "HsVersions.h" diff --git a/compiler/stgSyn/CoreToStg.lhs b/compiler/stgSyn/CoreToStg.lhs index 0c47042b4d31f0d9834444507030d56f23c2ff04..7807d895dc31910ad9e95d9e5b65b1cfd01a4641 100644 --- a/compiler/stgSyn/CoreToStg.lhs +++ b/compiler/stgSyn/CoreToStg.lhs @@ -1,4 +1,6 @@ \begin{code} +{-# LANGUAGE CPP #-} + -- -- (c) The GRASP/AQUA Project, Glasgow University, 1993-1998 -- diff --git a/compiler/stgSyn/StgLint.lhs b/compiler/stgSyn/StgLint.lhs index 04349db3dfdf1d7347e1138318141c7d0fd9a636..ec9f6fa9d67333c764bc90499b1deaf33d1190fa 100644 --- a/compiler/stgSyn/StgLint.lhs +++ b/compiler/stgSyn/StgLint.lhs @@ -4,6 +4,8 @@ \section[StgLint]{A ``lint'' pass to check for Stg correctness} \begin{code} +{-# LANGUAGE CPP #-} + module StgLint ( lintStgBindings ) where import StgSyn diff --git a/compiler/stgSyn/StgSyn.lhs b/compiler/stgSyn/StgSyn.lhs index 3fa8c68c16181c00031bfb900c91540c4a8f39a6..2ecd573133b584c16469c66976aa338c3e7876b0 100644 --- a/compiler/stgSyn/StgSyn.lhs +++ b/compiler/stgSyn/StgSyn.lhs @@ -9,6 +9,7 @@ being one that happens to be ideally suited to spineless tagless code generation. \begin{code} +{-# LANGUAGE CPP #-} module StgSyn ( GenStgArg(..), diff --git a/compiler/stranal/DmdAnal.lhs b/compiler/stranal/DmdAnal.lhs index 72137c7b4b7648d39886b9934e17d9830347a229..bd7b5c33bf3ba36a43f673ecf464ea217fa5b45a 100644 --- a/compiler/stranal/DmdAnal.lhs +++ b/compiler/stranal/DmdAnal.lhs @@ -7,7 +7,8 @@ ----------------- \begin{code} -{-# OPTIONS -fno-warn-tabs #-} +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} module DmdAnal ( dmdAnalProgram ) where diff --git a/compiler/stranal/WorkWrap.lhs b/compiler/stranal/WorkWrap.lhs index df7edae9911323265af98c2d6fbe8ef784c691a6..5b9d0a3083c0a10b427cc1a5886ac2a186ecb905 100644 --- a/compiler/stranal/WorkWrap.lhs +++ b/compiler/stranal/WorkWrap.lhs @@ -4,7 +4,8 @@ \section[WorkWrap]{Worker/wrapper-generating back-end of strictness analyser} \begin{code} -{-# OPTIONS -fno-warn-tabs #-} +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/stranal/WwLib.lhs b/compiler/stranal/WwLib.lhs index 4610b5873416a1dfe31f4c68f2d58872a8f448d4..7a9845b3d7179f9c94f8ac98fdaf9b667539cd7d 100644 --- a/compiler/stranal/WwLib.lhs +++ b/compiler/stranal/WwLib.lhs @@ -4,6 +4,8 @@ \section[WwLib]{A library for the ``worker\/wrapper'' back-end to the strictness analyser} \begin{code} +{-# LANGUAGE CPP #-} + module WwLib ( mkWwBodies, mkWWstr, mkWorkerArgs , deepSplitProductType_maybe, findTypeShape ) where diff --git a/compiler/typecheck/FamInst.lhs b/compiler/typecheck/FamInst.lhs index 572874b875a905049efe8d42af488ce542138bc0..4d5eeeacf705c369792ee81bb50c6942266d8500 100644 --- a/compiler/typecheck/FamInst.lhs +++ b/compiler/typecheck/FamInst.lhs @@ -1,8 +1,8 @@ The @FamInst@ type: family instance heads \begin{code} -{-# LANGUAGE GADTs #-} -{-# OPTIONS -fno-warn-tabs #-} +{-# LANGUAGE CPP, GADTs #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/typecheck/FunDeps.lhs b/compiler/typecheck/FunDeps.lhs index 1dc96aa03721d6cddc2ad3cfe605c4fde7ed1cda..09e143c3bc26930f71093428c14c6ccc9e531c16 100644 --- a/compiler/typecheck/FunDeps.lhs +++ b/compiler/typecheck/FunDeps.lhs @@ -8,6 +8,8 @@ FunDeps - functional dependencies It's better to read it as: "if we know these, then we're going to know these" \begin{code} +{-# LANGUAGE CPP #-} + module FunDeps ( FDEq (..), Equation(..), pprEquation, diff --git a/compiler/typecheck/Inst.lhs b/compiler/typecheck/Inst.lhs index e934984383a2a0d8af68b1962a817914edb530ba..6ec39a2214850c7c82de43828148d7507e6c00ef 100644 --- a/compiler/typecheck/Inst.lhs +++ b/compiler/typecheck/Inst.lhs @@ -6,7 +6,8 @@ The @Inst@ type: dictionaries or method instances \begin{code} -{-# OPTIONS -fno-warn-tabs #-} +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/typecheck/TcAnnotations.lhs b/compiler/typecheck/TcAnnotations.lhs index e12552f419b8f6404e7f2353e4c0f0aa4b504406..cbd19cf8f33f71233bc6a2a2508a91fe8b13127b 100644 --- a/compiler/typecheck/TcAnnotations.lhs +++ b/compiler/typecheck/TcAnnotations.lhs @@ -5,6 +5,8 @@ \section[TcAnnotations]{Typechecking annotations} \begin{code} +{-# LANGUAGE CPP #-} + module TcAnnotations ( tcAnnotations, annCtxt ) where #ifdef GHCI diff --git a/compiler/typecheck/TcArrows.lhs b/compiler/typecheck/TcArrows.lhs index 407e1725ffb7ef179f07a739d62da66ac1a76415..bf9d24be0a0982fbd16da5c7210c73bda8aaf847 100644 --- a/compiler/typecheck/TcArrows.lhs +++ b/compiler/typecheck/TcArrows.lhs @@ -5,7 +5,8 @@ Typecheck arrow notation \begin{code} -{-# OPTIONS -fno-warn-tabs #-} +{-# LANGUAGE RankNTypes #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/typecheck/TcBinds.lhs b/compiler/typecheck/TcBinds.lhs index 17f124b0d8fa18a5be6f921942c586b9f131ae4f..08a5af4e63b3b3455b65b3bd6b23e5a9d005b20c 100644 --- a/compiler/typecheck/TcBinds.lhs +++ b/compiler/typecheck/TcBinds.lhs @@ -5,6 +5,8 @@ \section[TcBinds]{TcBinds} \begin{code} +{-# LANGUAGE CPP, RankNTypes, ScopedTypeVariables #-} + module TcBinds ( tcLocalBinds, tcTopBinds, tcRecSelBinds, tcHsBootSigs, tcPolyCheck, PragFun, tcSpecPrags, tcVectDecls, mkPragFun, diff --git a/compiler/typecheck/TcCanonical.lhs b/compiler/typecheck/TcCanonical.lhs index 5784d81ce4f59b085211c4c2bd5bb775f2fddf47..670f4cfef386afdae86f94b31398d8060286545b 100644 --- a/compiler/typecheck/TcCanonical.lhs +++ b/compiler/typecheck/TcCanonical.lhs @@ -1,4 +1,6 @@ \begin{code} +{-# LANGUAGE CPP #-} + module TcCanonical( canonicalize, emitWorkNC, StopOrContinue (..) diff --git a/compiler/typecheck/TcClassDcl.lhs b/compiler/typecheck/TcClassDcl.lhs index 187aea50839f2b9ce588de64b26c690a3589d7f9..be5a74f294ef06e49736e8383898bf3e6dc52a85 100644 --- a/compiler/typecheck/TcClassDcl.lhs +++ b/compiler/typecheck/TcClassDcl.lhs @@ -6,7 +6,8 @@ Typechecking class declarations \begin{code} -{-# OPTIONS -fno-warn-tabs #-} +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/typecheck/TcDefaults.lhs b/compiler/typecheck/TcDefaults.lhs index a096e506ed33e311c278ef1baad877e2f6a6edce..7b5bd27321e420922a4f115eb1f5e13ec9103c96 100644 --- a/compiler/typecheck/TcDefaults.lhs +++ b/compiler/typecheck/TcDefaults.lhs @@ -5,7 +5,7 @@ \section[TcDefaults]{Typechecking \tr{default} declarations} \begin{code} -{-# OPTIONS -fno-warn-tabs #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/typecheck/TcDeriv.lhs b/compiler/typecheck/TcDeriv.lhs index 23975b9e077922babf04ac38e1c65168a93324b7..130736f909234b5bf0bb0680d9a8fb9a754e335a 100644 --- a/compiler/typecheck/TcDeriv.lhs +++ b/compiler/typecheck/TcDeriv.lhs @@ -6,6 +6,8 @@ Handles @deriving@ clauses on @data@ declarations. \begin{code} +{-# LANGUAGE CPP #-} + module TcDeriv ( tcDeriving ) where #include "HsVersions.h" diff --git a/compiler/typecheck/TcEnv.lhs b/compiler/typecheck/TcEnv.lhs index f3d754640fa1101d98a7a9fb0a02fe4780bd130f..44df7e1ae9247032cd08a281cc8395f9d9d70006 100644 --- a/compiler/typecheck/TcEnv.lhs +++ b/compiler/typecheck/TcEnv.lhs @@ -3,7 +3,9 @@ % \begin{code} +{-# LANGUAGE CPP, FlexibleInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} + module TcEnv( TyThing(..), TcTyThing(..), TcId, diff --git a/compiler/typecheck/TcErrors.lhs b/compiler/typecheck/TcErrors.lhs index 3ca1319a9d154a9dc7411a8f0be5e8c1073c82d9..4732769e2fb6f391914208798033ecaf42746e30 100644 --- a/compiler/typecheck/TcErrors.lhs +++ b/compiler/typecheck/TcErrors.lhs @@ -1,6 +1,6 @@ \begin{code} -{-# LANGUAGE ScopedTypeVariables #-} -{-# OPTIONS -fno-warn-tabs #-} +{-# LANGUAGE CPP, ScopedTypeVariables #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/typecheck/TcEvidence.lhs b/compiler/typecheck/TcEvidence.lhs index a31f66adaa3e04a974424c4fe011ad9e4f00a08d..493fa8f205351424cf21749dccbb283b3542cb43 100644 --- a/compiler/typecheck/TcEvidence.lhs +++ b/compiler/typecheck/TcEvidence.lhs @@ -3,6 +3,8 @@ % \begin{code} +{-# LANGUAGE CPP, DeriveDataTypeable #-} + module TcEvidence ( -- HsWrapper diff --git a/compiler/typecheck/TcExpr.lhs b/compiler/typecheck/TcExpr.lhs index 3397b0836ab65985c93783864daf1609062d755d..12f2438389f31646b4f656d76c1404217a48f884 100644 --- a/compiler/typecheck/TcExpr.lhs +++ b/compiler/typecheck/TcExpr.lhs @@ -5,6 +5,8 @@ c% \section[TcExpr]{Typecheck an expression} \begin{code} +{-# LANGUAGE CPP #-} + module TcExpr ( tcPolyExpr, tcPolyExprNC, tcMonoExpr, tcMonoExprNC, tcInferRho, tcInferRhoNC, tcSyntaxOp, tcCheckId, diff --git a/compiler/typecheck/TcForeign.lhs b/compiler/typecheck/TcForeign.lhs index 63eb020ff162aaeafe094927790e059270a87cd0..c2f812b3acb67213b8fb2ff825e38c1a0d5a0128 100644 --- a/compiler/typecheck/TcForeign.lhs +++ b/compiler/typecheck/TcForeign.lhs @@ -12,6 +12,8 @@ is restricted to what the outside world understands (read C), and this module checks to see if a foreign declaration has got a legal type. \begin{code} +{-# LANGUAGE CPP #-} + module TcForeign ( tcForeignImports , tcForeignExports diff --git a/compiler/typecheck/TcGenDeriv.lhs b/compiler/typecheck/TcGenDeriv.lhs index 7031e54f6f647394a42479619ce8d462ce0251ef..960e3faaa35a5ef61b3472ba2e7d4e818fa37461 100644 --- a/compiler/typecheck/TcGenDeriv.lhs +++ b/compiler/typecheck/TcGenDeriv.lhs @@ -11,7 +11,7 @@ This module is nominally ``subordinate'' to @TcDeriv@, which is the This is where we do all the grimy bindings' generation. \begin{code} -{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE CPP, ScopedTypeVariables #-} module TcGenDeriv ( BagDerivStuff, DerivStuff(..), diff --git a/compiler/typecheck/TcGenGenerics.lhs b/compiler/typecheck/TcGenGenerics.lhs index 35bf4245dc0a5740904a376d8625d3f9d0ebc5bd..648979b2f682688c039df00bb1ff64b38151194e 100644 --- a/compiler/typecheck/TcGenGenerics.lhs +++ b/compiler/typecheck/TcGenGenerics.lhs @@ -6,8 +6,8 @@ The deriving code for the Generic class (equivalent to the code in TcGenDeriv, for other classes) \begin{code} -{-# LANGUAGE ScopedTypeVariables #-} -{-# OPTIONS -fno-warn-tabs #-} +{-# LANGUAGE CPP, ScopedTypeVariables #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/typecheck/TcHsSyn.lhs b/compiler/typecheck/TcHsSyn.lhs index 59b42ea6732f5d6a1cc329c297fd6a2c3b96670a..0ac5fd756572dae4c307efa7a717d98d3bc7b3df 100644 --- a/compiler/typecheck/TcHsSyn.lhs +++ b/compiler/typecheck/TcHsSyn.lhs @@ -9,6 +9,8 @@ This module is an extension of @HsSyn@ syntax, for use in the type checker. \begin{code} +{-# LANGUAGE CPP #-} + module TcHsSyn ( mkHsConApp, mkHsDictLet, mkHsApp, hsLitType, hsLPatType, hsPatType, diff --git a/compiler/typecheck/TcHsType.lhs b/compiler/typecheck/TcHsType.lhs index eed906898b7d21404a76b68c52470b6d10e8f046..e257124f7c656dc36504071ecff62ab7d74c4a4d 100644 --- a/compiler/typecheck/TcHsType.lhs +++ b/compiler/typecheck/TcHsType.lhs @@ -5,7 +5,8 @@ \section[TcMonoType]{Typechecking user-specified @MonoTypes@} \begin{code} -{-# OPTIONS -fno-warn-tabs #-} +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/typecheck/TcInstDcls.lhs b/compiler/typecheck/TcInstDcls.lhs index 51e152876584f212a7f7b5792df05af524278dd5..a35d1d511875055df4184d7481292015bd59a45f 100644 --- a/compiler/typecheck/TcInstDcls.lhs +++ b/compiler/typecheck/TcInstDcls.lhs @@ -6,7 +6,8 @@ TcInstDecls: Typechecking instance declarations \begin{code} -{-# OPTIONS -fno-warn-tabs #-} +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/typecheck/TcInteract.lhs b/compiler/typecheck/TcInteract.lhs index 064bda275ce6d95c6ae495b096b0d1945f388bbf..a6b7f44f37af5997f40f1e529b85a95a3224f5f3 100644 --- a/compiler/typecheck/TcInteract.lhs +++ b/compiler/typecheck/TcInteract.lhs @@ -1,4 +1,6 @@ \begin{code} +{-# LANGUAGE CPP #-} + module TcInteract ( solveInteractGiven, -- Solves [EvVar],GivenLoc solveInteract, -- Solves Cts diff --git a/compiler/typecheck/TcMType.lhs b/compiler/typecheck/TcMType.lhs index f646305e39466545b99e67578cff96e1c946bb00..65bc0b76533bbb647e5b0e7d43cf7b0a9f56a44e 100644 --- a/compiler/typecheck/TcMType.lhs +++ b/compiler/typecheck/TcMType.lhs @@ -9,7 +9,8 @@ This module contains monadic operations over types that contain mutable type variables \begin{code} -{-# OPTIONS -fno-warn-tabs #-} +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/typecheck/TcMatches.lhs b/compiler/typecheck/TcMatches.lhs index 5859e7b810c47f0b1ff46e3d52116662b3a1f3ea..32b6d1e326e9f6de3c6367e96b254722d9a7454c 100644 --- a/compiler/typecheck/TcMatches.lhs +++ b/compiler/typecheck/TcMatches.lhs @@ -6,7 +6,8 @@ TcMatches: Typecheck some @Matches@ \begin{code} -{-# OPTIONS -fno-warn-tabs #-} +{-# LANGUAGE CPP, RankNTypes #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/typecheck/TcPat.lhs b/compiler/typecheck/TcPat.lhs index 0b2a200867814e79609f6517a539547165c6b819..077cdd81d34a3344fb12e079b0f4685c01221c56 100644 --- a/compiler/typecheck/TcPat.lhs +++ b/compiler/typecheck/TcPat.lhs @@ -6,7 +6,8 @@ TcPat: Typechecking patterns \begin{code} -{-# OPTIONS -fno-warn-tabs #-} +{-# LANGUAGE CPP, RankNTypes #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/typecheck/TcPatSyn.lhs b/compiler/typecheck/TcPatSyn.lhs index 0b3b4e4858215ea34ef12786be1d8cc07b1b3db8..7c9f876c3f082bde5715f5f5c5a1b5fce4520340 100644 --- a/compiler/typecheck/TcPatSyn.lhs +++ b/compiler/typecheck/TcPatSyn.lhs @@ -5,6 +5,8 @@ \section[TcPatSyn]{Typechecking pattern synonym declarations} \begin{code} +{-# LANGUAGE CPP #-} + module TcPatSyn (tcPatSynDecl) where import HsSyn diff --git a/compiler/typecheck/TcRnDriver.lhs b/compiler/typecheck/TcRnDriver.lhs index 26e83cd07183a42d1e0e2cf4ef071b8ef5f776d5..b6585f087896694072fe98467f1aa2c0c8eb5c1b 100644 --- a/compiler/typecheck/TcRnDriver.lhs +++ b/compiler/typecheck/TcRnDriver.lhs @@ -5,6 +5,8 @@ \section[TcMovectle]{Typechecking a whole module} \begin{code} +{-# LANGUAGE CPP, NondecreasingIndentation #-} + module TcRnDriver ( #ifdef GHCI tcRnStmt, tcRnExpr, tcRnType, diff --git a/compiler/typecheck/TcRnMonad.lhs b/compiler/typecheck/TcRnMonad.lhs index 0fc4d6ba9a7f844eb1e2a7a8fe8dd208aeaee53e..17700e77ce4e4688314c73be2fc1a0c135c3adcc 100644 --- a/compiler/typecheck/TcRnMonad.lhs +++ b/compiler/typecheck/TcRnMonad.lhs @@ -5,7 +5,9 @@ Functions for working with the typechecker environment (setters, getters...). \begin{code} +{-# LANGUAGE CPP, ExplicitForAll, FlexibleInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} + module TcRnMonad( module TcRnMonad, module TcRnTypes, diff --git a/compiler/typecheck/TcRnTypes.lhs b/compiler/typecheck/TcRnTypes.lhs index 7670566a98f536a28ab16ffb5273ca51efb08b18..01aece7e85dbe3e9d5aba90205e62822bf7c720f 100644 --- a/compiler/typecheck/TcRnTypes.lhs +++ b/compiler/typecheck/TcRnTypes.lhs @@ -16,6 +16,8 @@ For state that is global and should be returned at the end (e.g not part of the stack mechanism), you should use an TcRef (= IORef) to store them. \begin{code} +{-# LANGUAGE CPP #-} + module TcRnTypes( TcRnIf, TcRn, TcM, RnM, IfM, IfL, IfG, -- The monad is opaque outside this module TcRef, diff --git a/compiler/typecheck/TcRules.lhs b/compiler/typecheck/TcRules.lhs index c2f3b6b30237f86bee89388a5c2de9d04200ef87..47b38f114bcce3f9f14975bd047759581ccd1439 100644 --- a/compiler/typecheck/TcRules.lhs +++ b/compiler/typecheck/TcRules.lhs @@ -6,7 +6,7 @@ TcRules: Typechecking transformation rules \begin{code} -{-# OPTIONS -fno-warn-tabs #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/typecheck/TcSMonad.lhs b/compiler/typecheck/TcSMonad.lhs index 70ba19e15781a72aefc759257103a4accff36b77..4e391dc6e3a847da40dec7b5711e89ef9d179171 100644 --- a/compiler/typecheck/TcSMonad.lhs +++ b/compiler/typecheck/TcSMonad.lhs @@ -1,6 +1,7 @@ \begin{code} +{-# LANGUAGE CPP, TypeFamilies #-} + -- Type definitions for the constraint solver -{-# LANGUAGE TypeFamilies #-} module TcSMonad ( -- Canonical constraints, definition is now in TcRnTypes diff --git a/compiler/typecheck/TcSimplify.lhs b/compiler/typecheck/TcSimplify.lhs index 8981a36a196defa97b208f799a995b5dc318df24..50fcbac84bf0fce64515fa42829aaef1e8b04316 100644 --- a/compiler/typecheck/TcSimplify.lhs +++ b/compiler/typecheck/TcSimplify.lhs @@ -1,4 +1,6 @@ \begin{code} +{-# LANGUAGE CPP #-} + module TcSimplify( simplifyInfer, quantifyPred, simplifyAmbiguityCheck, diff --git a/compiler/typecheck/TcSplice.lhs b/compiler/typecheck/TcSplice.lhs index 7ec8a9ef5bd5ba398b7111eac37e2fdc4b5d5afd..b3991b2ad2ce0e904b4acc38da3990c8b0c7fa7d 100644 --- a/compiler/typecheck/TcSplice.lhs +++ b/compiler/typecheck/TcSplice.lhs @@ -7,8 +7,9 @@ TcSplice: Template Haskell splices \begin{code} -{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE CPP, FlexibleInstances, MagicHash, ScopedTypeVariables #-} {-# OPTIONS_GHC -fno-warn-orphans #-} + module TcSplice( -- These functions are defined in stage1 and stage2 -- The raise civilised errors in stage1 diff --git a/compiler/typecheck/TcSplice.lhs-boot b/compiler/typecheck/TcSplice.lhs-boot index c496aed798da8434a47a4c07bf4e541cc78b6a8f..ea3848db183ceeef00adf6bfd0f51429bcf26c91 100644 --- a/compiler/typecheck/TcSplice.lhs-boot +++ b/compiler/typecheck/TcSplice.lhs-boot @@ -1,4 +1,6 @@ \begin{code} +{-# LANGUAGE CPP #-} + module TcSplice where import HsSyn ( HsSplice, HsBracket, HsQuasiQuote, HsExpr, LHsType, LHsExpr, LPat, LHsDecl ) diff --git a/compiler/typecheck/TcTyClsDecls.lhs b/compiler/typecheck/TcTyClsDecls.lhs index 9f45732b252e25f730fbddf3715878e8f0aff949..1fa4fcf62d42272f6803dcee6e4cb89703c6e2fb 100644 --- a/compiler/typecheck/TcTyClsDecls.lhs +++ b/compiler/typecheck/TcTyClsDecls.lhs @@ -6,7 +6,7 @@ TcTyClsDecls: Typecheck type and class declarations \begin{code} -{-# LANGUAGE TupleSections #-} +{-# LANGUAGE CPP, TupleSections #-} module TcTyClsDecls ( tcTyAndClassDecls, tcAddImplicits, diff --git a/compiler/typecheck/TcTyDecls.lhs b/compiler/typecheck/TcTyDecls.lhs index ed9a5b7661cff32e88ee033ae6d84e20df117e0f..7f859cfd8699c7c5ee0667f7512d664bae7058b9 100644 --- a/compiler/typecheck/TcTyDecls.lhs +++ b/compiler/typecheck/TcTyDecls.lhs @@ -9,7 +9,8 @@ This stuff is only used for source-code decls; it's recorded in interface files for imported data types. \begin{code} -{-# OPTIONS -fno-warn-tabs #-} +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/typecheck/TcType.lhs b/compiler/typecheck/TcType.lhs index 08c7a627ce595b04b2ae2d1855f010a1d0cd1ba4..8640a4961cc7d11c5103ae0b745a31a7908e48d2 100644 --- a/compiler/typecheck/TcType.lhs +++ b/compiler/typecheck/TcType.lhs @@ -15,6 +15,8 @@ The "tc" prefix is for "TypeChecker", because the type checker is the principal client. \begin{code} +{-# LANGUAGE CPP #-} + module TcType ( -------------------------------- -- Types diff --git a/compiler/typecheck/TcUnify.lhs b/compiler/typecheck/TcUnify.lhs index 144744897340580f8c476244d6d0f087d73bc682..ef06ddd2634c3a84d4e330bf8e04b664afc3c39c 100644 --- a/compiler/typecheck/TcUnify.lhs +++ b/compiler/typecheck/TcUnify.lhs @@ -6,7 +6,8 @@ Type subsumption and unification \begin{code} -{-# OPTIONS -fno-warn-tabs #-} +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/typecheck/TcValidity.lhs b/compiler/typecheck/TcValidity.lhs index 84453eb700b5c1f97340bc35eee7f753d6031cd8..15f60a3a77aa1209efab35f2edfd3372791ef753 100644 --- a/compiler/typecheck/TcValidity.lhs +++ b/compiler/typecheck/TcValidity.lhs @@ -4,6 +4,8 @@ % \begin{code} +{-# LANGUAGE CPP #-} + module TcValidity ( Rank, UserTypeCtxt(..), checkValidType, checkValidMonoType, expectedKindInCtxt, diff --git a/compiler/types/Class.lhs b/compiler/types/Class.lhs index 2d145683bf1be6549faef4570e95fa2bb4f95661..29df06572bb81bff0e7dd8eea8fa78e3f33a51ad 100644 --- a/compiler/types/Class.lhs +++ b/compiler/types/Class.lhs @@ -6,7 +6,8 @@ The @Class@ datatype \begin{code} -{-# OPTIONS -fno-warn-tabs #-} +{-# LANGUAGE CPP, DeriveDataTypeable #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/types/CoAxiom.lhs b/compiler/types/CoAxiom.lhs index d6122b21e69fcf4a4aa6e4683bf421376db6bddd..06b74a43f0138be8493580e8ff5eb68a3cd5e304 100644 --- a/compiler/types/CoAxiom.lhs +++ b/compiler/types/CoAxiom.lhs @@ -4,7 +4,7 @@ \begin{code} -{-# LANGUAGE GADTs, ScopedTypeVariables #-} +{-# LANGUAGE CPP, DeriveDataTypeable, GADTs, ScopedTypeVariables #-} -- | Module for coercion axioms, used to represent type family instances -- and newtypes diff --git a/compiler/types/Coercion.lhs b/compiler/types/Coercion.lhs index a8f9a2ee599b35436b41418c41238dc003bc08cb..6f237b0d254032c41b2b64d33b4a84cd041103a4 100644 --- a/compiler/types/Coercion.lhs +++ b/compiler/types/Coercion.lhs @@ -3,6 +3,8 @@ % \begin{code} +{-# LANGUAGE CPP, DeriveDataTypeable #-} + -- | Module for (a) type kinds and (b) type coercions, -- as used in System FC. See 'CoreSyn.Expr' for -- more on System FC and how coercions fit into it. diff --git a/compiler/types/FamInstEnv.lhs b/compiler/types/FamInstEnv.lhs index 50ced7d323e89544937172b77dec469b7d6ec8c8..525b6061937009c8806e6a14abdeb47f15a5b139 100644 --- a/compiler/types/FamInstEnv.lhs +++ b/compiler/types/FamInstEnv.lhs @@ -5,8 +5,7 @@ FamInstEnv: Type checked family instance declarations \begin{code} - -{-# LANGUAGE GADTs #-} +{-# LANGUAGE CPP, GADTs #-} module FamInstEnv ( FamInst(..), FamFlavor(..), famInstAxiom, famInstTyCon, famInstRHS, diff --git a/compiler/types/InstEnv.lhs b/compiler/types/InstEnv.lhs index 826537db17bbc533045be2fdc187c685bc7725d6..e7fcab0d8daad87290ee3a8a3d55ceaa50956199 100644 --- a/compiler/types/InstEnv.lhs +++ b/compiler/types/InstEnv.lhs @@ -7,6 +7,8 @@ The bits common to TcInstDcls and TcDeriv. \begin{code} +{-# LANGUAGE CPP, DeriveDataTypeable #-} + module InstEnv ( DFunId, OverlapFlag(..), InstMatch, ClsInstLookupResult, ClsInst(..), DFunInstType, pprInstance, pprInstanceHdr, pprInstances, diff --git a/compiler/types/Kind.lhs b/compiler/types/Kind.lhs index 793aa4a761dbefe6c468f1650a9673ff546b0476..61239bc7b86c0c7c20160f5b1703e70f956ed472 100644 --- a/compiler/types/Kind.lhs +++ b/compiler/types/Kind.lhs @@ -3,7 +3,8 @@ % \begin{code} -{-# OPTIONS -fno-warn-tabs #-} +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/types/OptCoercion.lhs b/compiler/types/OptCoercion.lhs index 2f03a72b6da186e5342af7b1fcbdf3c68b95f80d..12787b25a3f112d24df2b1abb5e96558dd2b91b2 100644 --- a/compiler/types/OptCoercion.lhs +++ b/compiler/types/OptCoercion.lhs @@ -3,7 +3,8 @@ % \begin{code} -{-# OPTIONS -fno-warn-tabs #-} +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/types/TyCon.lhs b/compiler/types/TyCon.lhs index bb489b33e1b328bf09e763b9344386aac2884863..abdf44a2c42d7c8b56e2ec6a18ceb326c3a330cf 100644 --- a/compiler/types/TyCon.lhs +++ b/compiler/types/TyCon.lhs @@ -6,6 +6,7 @@ The @TyCon@ datatype \begin{code} +{-# LANGUAGE CPP, DeriveDataTypeable #-} module TyCon( -- * Main TyCon data types diff --git a/compiler/types/Type.lhs b/compiler/types/Type.lhs index 7395329eaada3ee2cd49062e1c7920ec222dce35..7ddd45add2e0b3d37c04a2f552d55918fea94503 100644 --- a/compiler/types/Type.lhs +++ b/compiler/types/Type.lhs @@ -6,6 +6,7 @@ Type - public interface \begin{code} +{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -- | Main functions for manipulating types and type-related things diff --git a/compiler/types/TypeRep.lhs b/compiler/types/TypeRep.lhs index 866fc777184cb2fa9a491922a97e9fc6dce2ab0f..31b73bb2444dfeecec2f540d84a13546a322a4b1 100644 --- a/compiler/types/TypeRep.lhs +++ b/compiler/types/TypeRep.lhs @@ -15,16 +15,16 @@ Note [The Type-related module hierarchy] Coercion imports Type \begin{code} -{-# OPTIONS -fno-warn-tabs #-} +{-# LANGUAGE CPP, DeriveDataTypeable, DeriveFunctor, DeriveFoldable, DeriveTraversable #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See -- http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces -- for details - --- We expose the relevant stuff from this module via the Type module {-# OPTIONS_HADDOCK hide #-} -{-# LANGUAGE DeriveDataTypeable, DeriveFunctor, DeriveFoldable, DeriveTraversable #-} +-- We expose the relevant stuff from this module via the Type module + module TypeRep ( TyThing(..), Type(..), diff --git a/compiler/types/Unify.lhs b/compiler/types/Unify.lhs index d56a3f65fc562d178a27ada03c9d849077a141d5..1ce1d62f9a644f5b9bb29572a2379c1bd9480622 100644 --- a/compiler/types/Unify.lhs +++ b/compiler/types/Unify.lhs @@ -3,7 +3,8 @@ % \begin{code} -{-# OPTIONS -fno-warn-tabs #-} +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/utils/Bag.lhs b/compiler/utils/Bag.lhs index 2d823e46bbe00ba09db3b2aab6d8de2d41baea3b..65c5b39df17d01d85dab5b708716856f2f9e81db 100644 --- a/compiler/utils/Bag.lhs +++ b/compiler/utils/Bag.lhs @@ -6,6 +6,8 @@ Bag: an unordered collection with duplicates \begin{code} +{-# LANGUAGE DeriveDataTypeable, ScopedTypeVariables #-} + module Bag ( Bag, -- abstract type diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs index e9b71236f22b3e5bcb342843651c46254b0b2f2e..166a94850bee05d8021f46074884e24ab85f7014 100644 --- a/compiler/utils/Binary.hs +++ b/compiler/utils/Binary.hs @@ -1,4 +1,4 @@ -{-# OPTIONS -cpp #-} +{-# LANGUAGE CPP, MagicHash, UnboxedTuples #-} {-# OPTIONS_GHC -O -funbox-strict-fields #-} -- We always optimise this, otherwise performance of a non-optimised -- compiler is severely affected diff --git a/compiler/utils/BufWrite.hs b/compiler/utils/BufWrite.hs index f85ea8e792e0a1415a50beff9e39f0a9673599b8..7eba0753fe6285ca15efd7b68be6a7f0f74093d0 100644 --- a/compiler/utils/BufWrite.hs +++ b/compiler/utils/BufWrite.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + ----------------------------------------------------------------------------- -- -- Fast write-buffered Handles @@ -10,7 +12,7 @@ -- ----------------------------------------------------------------------------- -{-# OPTIONS -fno-warn-tabs #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/utils/Digraph.lhs b/compiler/utils/Digraph.lhs index cc684303b63d8ef0a8d2eaf7fd10db430f3d3d7e..a89eb7105df77439593abe7c2b88f524d0159486 100644 --- a/compiler/utils/Digraph.lhs +++ b/compiler/utils/Digraph.lhs @@ -3,14 +3,14 @@ % \begin{code} -{-# OPTIONS -fno-warn-tabs #-} +{-# LANGUAGE CPP, ScopedTypeVariables #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See -- http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces -- for details -{-# LANGUAGE ScopedTypeVariables #-} module Digraph( Graph, graphFromVerticesAndAdjacency, graphFromEdgedVertices, diff --git a/compiler/utils/Encoding.hs b/compiler/utils/Encoding.hs index c4a669c1341cb63fdf4223027961210a7b54c3f9..115703fc69d63d33ee9fe83f8a9a62f2da433adc 100644 --- a/compiler/utils/Encoding.hs +++ b/compiler/utils/Encoding.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE BangPatterns, CPP, MagicHash, UnboxedTuples #-} {-# OPTIONS_GHC -O #-} -- We always optimise this, otherwise performance of a non-optimised -- compiler is severely affected diff --git a/compiler/utils/ExtsCompat46.hs b/compiler/utils/ExtsCompat46.hs index da0e67ab932d0581927762359cec0b03d2aeacb3..a33fef57d8f61be2e57ba9305aebf412de1afbc0 100644 --- a/compiler/utils/ExtsCompat46.hs +++ b/compiler/utils/ExtsCompat46.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE BangPatterns, CPP #-} +{-# LANGUAGE BangPatterns, CPP, MagicHash #-} ----------------------------------------------------------------------------- -- | diff --git a/compiler/utils/FastBool.lhs b/compiler/utils/FastBool.lhs index 32cb7aef3a58be310db943ed242fd87e74569f66..9558da7079cb53369a56b6b90a9e7cac9146c49b 100644 --- a/compiler/utils/FastBool.lhs +++ b/compiler/utils/FastBool.lhs @@ -4,6 +4,8 @@ \section{Fast booleans} \begin{code} +{-# LANGUAGE CPP, MagicHash #-} + module FastBool ( --fastBool could be called bBox; isFastTrue, bUnbox; but they're not FastBool, fastBool, isFastTrue, fastOr, fastAnd diff --git a/compiler/utils/FastFunctions.lhs b/compiler/utils/FastFunctions.lhs index b1dacdcd9bc110f876198881809b79cde861cb5c..457fcc9c9338377bec0ab9de0b9ff91797e26847 100644 --- a/compiler/utils/FastFunctions.lhs +++ b/compiler/utils/FastFunctions.lhs @@ -4,6 +4,7 @@ Z% \section{Fast functions} \begin{code} +{-# LANGUAGE CPP, MagicHash, UnboxedTuples #-} module FastFunctions ( unsafeChr, inlinePerformIO, unsafeDupableInterleaveIO, diff --git a/compiler/utils/FastMutInt.lhs b/compiler/utils/FastMutInt.lhs index 7156cdc9fb0e1179720ce8ccaa8ffc351972395e..0f0ca78e144ca2f71d4809823cbbd0239b6ef047 100644 --- a/compiler/utils/FastMutInt.lhs +++ b/compiler/utils/FastMutInt.lhs @@ -1,6 +1,5 @@ \begin{code} -{-# LANGUAGE BangPatterns #-} -{-# OPTIONS -cpp #-} +{-# LANGUAGE CPP, BangPatterns, MagicHash, UnboxedTuples #-} {-# OPTIONS_GHC -O #-} -- We always optimise this, otherwise performance of a non-optimised -- compiler is severely affected diff --git a/compiler/utils/FastString.lhs b/compiler/utils/FastString.lhs index 5a78c0b59bd25a99005595d01d4b3cdc03ee812e..0396c027494e8bdd861bacbfdb6bbb52271d2c33 100644 --- a/compiler/utils/FastString.lhs +++ b/compiler/utils/FastString.lhs @@ -2,7 +2,7 @@ % (c) The University of Glasgow, 1997-2006 % \begin{code} -{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE BangPatterns, CPP, DeriveDataTypeable, MagicHash, UnboxedTuples #-} {-# OPTIONS_GHC -O -funbox-strict-fields #-} -- We always optimise this, otherwise performance of a non-optimised -- compiler is severely affected diff --git a/compiler/utils/FastTypes.lhs b/compiler/utils/FastTypes.lhs index 0ef10ade561ef1f903e62790bd3a2240a8479179..36d8e4c4fd7c60bef10f01ad82d419d0c4c9967b 100644 --- a/compiler/utils/FastTypes.lhs +++ b/compiler/utils/FastTypes.lhs @@ -4,6 +4,7 @@ \section{Fast integers, etc... booleans moved to FastBool for using panic} \begin{code} +{-# LANGUAGE CPP, MagicHash #-} --Even if the optimizer could handle boxed arithmetic equally well, --this helps automatically check the sources to make sure that diff --git a/compiler/utils/Fingerprint.hsc b/compiler/utils/Fingerprint.hsc index 9a55e385b3da8ec17a0c737b0e04566227ff8509..464337b7a913de14d4d23aaba2391be2b13c252b 100644 --- a/compiler/utils/Fingerprint.hsc +++ b/compiler/utils/Fingerprint.hsc @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + -- ---------------------------------------------------------------------------- -- -- (c) The University of Glasgow 2006 diff --git a/compiler/utils/GraphBase.hs b/compiler/utils/GraphBase.hs index 8cb3acee718cb0adc80d29934436489690b28087..2aa16ae99e1888341b31a43c2c33a1820e7670e4 100644 --- a/compiler/utils/GraphBase.hs +++ b/compiler/utils/GraphBase.hs @@ -1,7 +1,7 @@ -- | Types for the general graph colorer. -{-# OPTIONS -fno-warn-tabs #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/utils/GraphPpr.hs b/compiler/utils/GraphPpr.hs index a896bbbf63b4419d09ef1e62a4782098c047b283..2682c7347e6b31e05427491fa9e2643a469e6a7a 100644 --- a/compiler/utils/GraphPpr.hs +++ b/compiler/utils/GraphPpr.hs @@ -1,7 +1,7 @@ -- | Pretty printing of graphs. -{-# OPTIONS -fno-warn-tabs #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See diff --git a/compiler/utils/IOEnv.hs b/compiler/utils/IOEnv.hs index 6885bbd12795a690c25a48d4ef11cf485043d74f..1db15537c7dd921e50f263753e5946fa2cff409c 100644 --- a/compiler/utils/IOEnv.hs +++ b/compiler/utils/IOEnv.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE DeriveDataTypeable, UndecidableInstances #-} + -- -- (c) The University of Glasgow 2002-2006 -- @@ -7,7 +9,6 @@ -- as its in the IO monad, mutable references can be used -- for updating state. -- -{-# LANGUAGE UndecidableInstances #-} module IOEnv ( IOEnv, -- Instance of Monad diff --git a/compiler/utils/ListSetOps.lhs b/compiler/utils/ListSetOps.lhs index 5ad402d0815f896e3cfca48043ca3bed738a1948..6247dc67f6204616cdcf5dd52353f3b2cb904a40 100644 --- a/compiler/utils/ListSetOps.lhs +++ b/compiler/utils/ListSetOps.lhs @@ -5,6 +5,7 @@ \section[ListSetOps]{Set-like operations on lists} \begin{code} +{-# LANGUAGE CPP #-} module ListSetOps ( unionLists, minusList, insertList, diff --git a/compiler/utils/Pair.lhs b/compiler/utils/Pair.lhs index 9e847d69505503c18e22034ddf88ff6f92a20e3e..ca7c2a7f8e3f6c557dea2210e81035a2fab0d412 100644 --- a/compiler/utils/Pair.lhs +++ b/compiler/utils/Pair.lhs @@ -3,6 +3,8 @@ A simple homogeneous pair type with useful Functor, Applicative, and Traversable instances. \begin{code} +{-# LANGUAGE CPP #-} + module Pair ( Pair(..), unPair, toPair, swap ) where #include "HsVersions.h" diff --git a/compiler/utils/Panic.lhs b/compiler/utils/Panic.lhs index fc04668ae16a73ce25274d6a7f6185e9f7815353..583174b201b8c278a6d69546b09dba27514eeaac 100644 --- a/compiler/utils/Panic.lhs +++ b/compiler/utils/Panic.lhs @@ -8,6 +8,8 @@ It's hard to put these functions anywhere else without causing some unnecessary loops in the module dependency graph. \begin{code} +{-# LANGUAGE CPP, DeriveDataTypeable, ScopedTypeVariables #-} + module Panic ( GhcException(..), showGhcException, throwGhcException, throwGhcExceptionIO, diff --git a/compiler/utils/Pretty.lhs b/compiler/utils/Pretty.lhs index fb7fe2b7fb66e28312406db9e63a41b41c866023..f6a5a44e2ee7d5e5611582367d0b3e86771db449 100644 --- a/compiler/utils/Pretty.lhs +++ b/compiler/utils/Pretty.lhs @@ -152,7 +152,7 @@ Relative to John's original paper, there are the following new features: \begin{code} -{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE BangPatterns, CPP, MagicHash #-} module Pretty ( Doc, -- Abstract diff --git a/compiler/utils/Serialized.hs b/compiler/utils/Serialized.hs index 902d2feea06c1e5155c4c60831f2d75fa30cfe8b..b1576a087f60b2e5924c7f1067146f668580c841 100644 --- a/compiler/utils/Serialized.hs +++ b/compiler/utils/Serialized.hs @@ -1,9 +1,10 @@ +{-# LANGUAGE CPP, RankNTypes, ScopedTypeVariables #-} + -- -- (c) The University of Glasgow 2002-2006 -- -- Serialized values -{-# LANGUAGE ScopedTypeVariables #-} module Serialized ( -- * Main Serialized data type Serialized, diff --git a/compiler/utils/State.hs b/compiler/utils/State.hs index 0b6a2855627d76b7fb089d6586eeeb9e3660f8e3..216034fdbf36a7e0d9b6b1104149626ceedc5f33 100644 --- a/compiler/utils/State.hs +++ b/compiler/utils/State.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE UnboxedTuples #-} module State (module State, mapAccumLM {- XXX hack -}) where diff --git a/compiler/utils/StringBuffer.lhs b/compiler/utils/StringBuffer.lhs index 46cce5864d1b83667b918231fe9f50568f2b8c11..a54f45ffff9ee9b6a76acb5623b6618c9fa4b7d5 100644 --- a/compiler/utils/StringBuffer.lhs +++ b/compiler/utils/StringBuffer.lhs @@ -6,7 +6,7 @@ Buffers for scanning string input stored in external arrays. \begin{code} -{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE BangPatterns, CPP, MagicHash, UnboxedTuples #-} {-# OPTIONS_GHC -O -funbox-strict-fields #-} -- We always optimise this, otherwise performance of a non-optimised -- compiler is severely affected diff --git a/compiler/utils/UniqFM.lhs b/compiler/utils/UniqFM.lhs index a13a17c412f14e0c5a9b7b28b30c664950bb8749..8797330a71f698439499964ed5f9c12700193edb 100644 --- a/compiler/utils/UniqFM.lhs +++ b/compiler/utils/UniqFM.lhs @@ -20,9 +20,9 @@ and ``addToUFM\_C'' and ``Data.IntMap.insertWith'' differ in the order of arguments of combining function. \begin{code} -{-# LANGUAGE DeriveTraversable, GeneralizedNewtypeDeriving #-} +{-# LANGUAGE DeriveTraversable, DeriveDataTypeable, GeneralizedNewtypeDeriving #-} +{-# OPTIONS_GHC -Wall #-} -{-# OPTIONS -Wall #-} module UniqFM ( -- * Unique-keyed mappings UniqFM, -- abstract type diff --git a/compiler/utils/Util.lhs b/compiler/utils/Util.lhs index 5c82c757aa5b6681075e9dad09b4484dffcc7c3f..0274c590ea9bfb50a7a023b99aa2ff571c57f9d6 100644 --- a/compiler/utils/Util.lhs +++ b/compiler/utils/Util.lhs @@ -3,6 +3,7 @@ % \begin{code} +{-# LANGUAGE CPP #-} -- | Highly random utility functions -- diff --git a/compiler/vectorise/Vectorise/Exp.hs b/compiler/vectorise/Vectorise/Exp.hs index fb0c14861067d30456f8bd7a96b5681ec63844d2..6adb9ec435d5769e18e2639f125882bf7073e69d 100644 --- a/compiler/vectorise/Vectorise/Exp.hs +++ b/compiler/vectorise/Vectorise/Exp.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TupleSections #-} +{-# LANGUAGE CPP, TupleSections #-} -- |Vectorisation of expressions. diff --git a/compiler/vectorise/Vectorise/Monad/InstEnv.hs b/compiler/vectorise/Vectorise/Monad/InstEnv.hs index 84b29ceb6119a114d2b672c4f6b838988ac53390..a97f319b4f0af710bf219b99eb6598259cda4e11 100644 --- a/compiler/vectorise/Vectorise/Monad/InstEnv.hs +++ b/compiler/vectorise/Vectorise/Monad/InstEnv.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + module Vectorise.Monad.InstEnv ( existsInst , lookupInst diff --git a/compiler/vectorise/Vectorise/Type/Env.hs b/compiler/vectorise/Vectorise/Type/Env.hs index 34008efbbd4d1f20c287d0abf6d7d6b0365597e7..6ee5ca6cd9e53ba944823f5e1daa4b87439389c7 100644 --- a/compiler/vectorise/Vectorise/Type/Env.hs +++ b/compiler/vectorise/Vectorise/Type/Env.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + -- Vectorise a modules type and class declarations. -- -- This produces new type constructors and family instances top be included in the module toplevel diff --git a/compiler/vectorise/Vectorise/Utils/Base.hs b/compiler/vectorise/Vectorise/Utils/Base.hs index cb7b34e36a1e770ca3428b727b1346a850d60b71..7d4bae3046d06732cd9b86ed1ae469baed3b815a 100644 --- a/compiler/vectorise/Vectorise/Utils/Base.hs +++ b/compiler/vectorise/Vectorise/Utils/Base.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + module Vectorise.Utils.Base ( voidType , newLocalVVar