diff options
30 files changed, 227 insertions, 67 deletions
diff --git a/.gitignore b/.gitignore index 7d53060ac9..a71cfd859f 100644 --- a/.gitignore +++ b/.gitignore @@ -154,3 +154,11 @@ _darcs/ .tm_properties VERSION GIT_COMMIT_ID + +# ------------------------------------------------------------------------------------- +# when using a docker image, one can mount the source code directory as the home folder +# ------------------------------------------------------------------------------------- +.arcrc +.ghc +.bash_history +.gitconfig diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index c18b868d33..8dfd5321b8 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -287,6 +287,7 @@ data DumpFlag | Opt_D_dump_if_trace | Opt_D_dump_vt_trace | Opt_D_dump_splices + | Opt_D_th_dec_file | Opt_D_dump_BCOs | Opt_D_dump_vect | Opt_D_dump_ticked @@ -1685,6 +1686,7 @@ dopt f dflags = (fromEnum f `IntSet.member` dumpFlags dflags) enableIfVerbose Opt_D_verbose_core2core = False enableIfVerbose Opt_D_verbose_stg2stg = False enableIfVerbose Opt_D_dump_splices = False + enableIfVerbose Opt_D_th_dec_file = False enableIfVerbose Opt_D_dump_rule_firings = False enableIfVerbose Opt_D_dump_rule_rewrites = False enableIfVerbose Opt_D_dump_simpl_trace = False @@ -2477,6 +2479,8 @@ dynamic_flags = [ setDumpFlag' Opt_D_dump_cs_trace)) , defGhcFlag "ddump-vt-trace" (setDumpFlag Opt_D_dump_vt_trace) , defGhcFlag "ddump-splices" (setDumpFlag Opt_D_dump_splices) + , defGhcFlag "dth-dec-file" (setDumpFlag Opt_D_th_dec_file) + , defGhcFlag "ddump-rn-stats" (setDumpFlag Opt_D_dump_rn_stats) , defGhcFlag "ddump-opt-cmm" (setDumpFlag Opt_D_dump_opt_cmm) , defGhcFlag "ddump-simpl-stats" (setDumpFlag Opt_D_dump_simpl_stats) diff --git a/compiler/main/ErrUtils.hs b/compiler/main/ErrUtils.hs index 20d628f312..82587d28bc 100644 --- a/compiler/main/ErrUtils.hs +++ b/compiler/main/ErrUtils.hs @@ -301,7 +301,7 @@ dumpSDoc dflags print_unqual flag hdr doc chooseDumpFile :: DynFlags -> DumpFlag -> Maybe String chooseDumpFile dflags flag - | gopt Opt_DumpToFile dflags + | gopt Opt_DumpToFile dflags || flag == Opt_D_th_dec_file , Just prefix <- getPrefix = Just $ setDir (prefix ++ (beautifyDumpName flag)) @@ -325,6 +325,7 @@ chooseDumpFile dflags flag -- | Build a nice file name from name of a GeneralFlag constructor beautifyDumpName :: DumpFlag -> String +beautifyDumpName Opt_D_th_dec_file = "th.hs" beautifyDumpName flag = let str = show flag suff = case stripPrefix "Opt_D_" str of diff --git a/compiler/rename/RnSplice.hs b/compiler/rename/RnSplice.hs index e147e6a883..e0ebd300ed 100644 --- a/compiler/rename/RnSplice.hs +++ b/compiler/rename/RnSplice.hs @@ -16,6 +16,7 @@ import TcRnMonad import Kind #ifdef GHCI +import ErrUtils ( dumpIfSet_dyn_printer ) import Control.Monad ( unless, when ) import DynFlags import DsMeta ( decsQTyConName, expQTyConName, patQTyConName, typeQTyConName ) @@ -274,8 +275,11 @@ rnTopSpliceDecls (HsSplice _ expr'') -- Run the expression ; decls <- runMetaD zonked_q_expr - ; showSplice "declarations" expr' - (ppr (getLoc expr) $$ (vcat (map ppr decls))) + ; traceSplice $ SpliceInfo True + "declarations" + (Just (getLoc expr)) + (Just $ ppr expr') + (vcat (map ppr decls)) ; return (decls,fvs) } @@ -404,12 +408,55 @@ showSplice :: String -> LHsExpr Name -> SDoc -> TcM () -- (b) data constructors after type checking have been -- changed to their *wrappers*, and that makes them -- print always fully qualified -showSplice what before after - = do { loc <- getSrcSpanM - ; traceSplice (vcat [ppr loc <> colon <+> text "Splicing" <+> text what, - nest 2 (sep [nest 2 (ppr before), - text "======>", - nest 2 after])]) } +showSplice what before after = + traceSplice $ SpliceInfo False what Nothing (Just $ ppr before) after + +-- | The splice data to be logged +-- +-- duplicates code in TcSplice.lhs +data SpliceInfo + = SpliceInfo + { spliceIsDeclaration :: Bool + , spliceDescription :: String + , spliceLocation :: Maybe SrcSpan + , spliceSource :: Maybe SDoc + , spliceGenerated :: SDoc + } + +-- | outputs splice information for 2 flags which have different output formats: +-- `-ddump-splices` and `-dth-dec-file` +-- +-- This duplicates code in TcSplice.lhs +traceSplice :: SpliceInfo -> TcM () +traceSplice sd = do + loc <- case sd of + SpliceInfo { spliceLocation = Nothing } -> getSrcSpanM + SpliceInfo { spliceLocation = Just loc } -> return loc + traceOptTcRn Opt_D_dump_splices (spliceDebugDoc loc sd) + when (spliceIsDeclaration sd) $ do + dflags <- getDynFlags + liftIO $ dumpIfSet_dyn_printer alwaysQualify dflags Opt_D_th_dec_file + (spliceCodeDoc loc sd) + where + -- `-ddump-splices` + spliceDebugDoc :: SrcSpan -> SpliceInfo -> SDoc + spliceDebugDoc loc sd + = let code = case spliceSource sd of + Nothing -> ending + Just b -> nest 2 b : ending + ending = [ text "======>", nest 2 (spliceGenerated sd) ] + in (vcat [ ppr loc <> colon + <+> text "Splicing" <+> text (spliceDescription sd) + , nest 2 (sep code) + ]) + + -- `-dth-dec-file` + spliceCodeDoc :: SrcSpan -> SpliceInfo -> SDoc + spliceCodeDoc loc sd + = (vcat [ text "--" <+> ppr loc <> colon + <+> text "Splicing" <+> text (spliceDescription sd) + , sep [spliceGenerated sd] + ]) illegalBracket :: SDoc illegalBracket = ptext (sLit "Template Haskell brackets cannot be nested (without intervening splices)") diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs index dfe69055cf..ea8f90c52d 100644 --- a/compiler/typecheck/TcRnDriver.hs +++ b/compiler/typecheck/TcRnDriver.hs @@ -24,7 +24,7 @@ module TcRnDriver ( ) where #ifdef GHCI -import {-# SOURCE #-} TcSplice ( runQuasi ) +import {-# SOURCE #-} TcSplice ( runQuasi, traceSplice, SpliceInfo(..) ) import RnSplice ( rnTopSpliceDecls ) #endif @@ -567,9 +567,12 @@ tc_rn_src_decls boot_details ds rnTopSrcDecls extra_deps th_group -- Dump generated top-level declarations - ; loc <- getSrcSpanM - ; traceSplice (vcat [ppr loc <> colon <+> text "Splicing top-level declarations added with addTopDecls ", - nest 2 (nest 2 (ppr th_rn_decls))]) + ; let msg = "top-level declarations added with addTopDecls" + ; traceSplice $ SpliceInfo True + msg + Nothing + Nothing + (ppr th_rn_decls) ; return (tcg_env, appendGroups rn_decls th_rn_decls) } diff --git a/compiler/typecheck/TcRnMonad.hs b/compiler/typecheck/TcRnMonad.hs index b7038ecef1..374a859a8d 100644 --- a/compiler/typecheck/TcRnMonad.hs +++ b/compiler/typecheck/TcRnMonad.hs @@ -502,15 +502,12 @@ traceTc herald doc = traceTcN 1 (hang (text herald) 2 doc) -- | Typechecker trace traceTcN :: Int -> SDoc -> TcRn () traceTcN level doc - = do { dflags <- getDynFlags - ; when (level <= traceLevel dflags) $ - traceOptTcRn Opt_D_dump_tc_trace doc } + = do dflags <- getDynFlags + when (level <= traceLevel dflags && not opt_NoDebugOutput) $ + traceOptTcRn Opt_D_dump_tc_trace doc traceRn :: SDoc -> TcRn () -traceRn doc = traceOptTcRn Opt_D_dump_rn_trace doc - -traceSplice :: SDoc -> TcRn () -traceSplice doc = traceOptTcRn Opt_D_dump_splices doc +traceRn = traceOptTcRn Opt_D_dump_rn_trace -- Renamer Trace -- | Output a doc if the given 'DumpFlag' is set. -- diff --git a/compiler/typecheck/TcSplice.hs b/compiler/typecheck/TcSplice.hs index 020722c594..8144029fa5 100644 --- a/compiler/typecheck/TcSplice.hs +++ b/compiler/typecheck/TcSplice.hs @@ -21,7 +21,7 @@ module TcSplice( -- These ones are defined only in stage2, and are -- called only in stage2 (ie GHCI is on) runMetaE, runMetaP, runMetaT, runMetaD, runQuasi, - tcTopSpliceExpr, lookupThName_maybe, + tcTopSpliceExpr, lookupThName_maybe, traceSplice, SpliceInfo(..), defaultRunMeta, runMeta' #endif ) where @@ -460,7 +460,7 @@ tcTopSplice expr res_ty -- Run the expression ; expr2 <- runMetaE zonked_q_expr - ; showSplice "expression" expr (ppr expr2) + ; showSplice False "expression" expr (ppr expr2) -- Rename and typecheck the spliced-in expression, -- making sure it has type res_ty @@ -660,7 +660,7 @@ runQuasiQuote (HsQuasiQuote quoter q_span quote) quote_selector meta_ty descr me -- Run the expression ; result <- runMeta meta_req zonked_q_expr - ; showSplice descr quoteExpr (ppr result) + ; showSplice (descr == "declarations") descr quoteExpr (ppr result) ; return result } @@ -967,18 +967,61 @@ instance TH.Quasi (IOEnv (Env TcGblEnv TcLclEnv)) where ************************************************************************ -} -showSplice :: String -> LHsExpr Name -> SDoc -> TcM () -- Note that 'before' is *renamed* but not *typechecked* -- Reason (a) less typechecking crap -- (b) data constructors after type checking have been -- changed to their *wrappers*, and that makes them -- print always fully qualified -showSplice what before after - = do { loc <- getSrcSpanM - ; traceSplice (vcat [ppr loc <> colon <+> text "Splicing" <+> text what, - nest 2 (sep [nest 2 (ppr before), - text "======>", - nest 2 after])]) } +showSplice :: Bool -> String -> LHsExpr Name -> SDoc -> TcM () +showSplice isDec what before after = + traceSplice $ SpliceInfo isDec what Nothing (Just $ ppr before) after + +-- | The splice data to be logged +-- +-- duplicates code in RnSplice.lhs +data SpliceInfo + = SpliceInfo + { spliceIsDeclaration :: Bool + , spliceDescription :: String + , spliceLocation :: Maybe SrcSpan + , spliceSource :: Maybe SDoc + , spliceGenerated :: SDoc + } + +-- | outputs splice information for 2 flags which have different output formats: +-- `-ddump-splices` and `-dth-dec-file` +-- +-- This duplicates code in RnSplice.lhs +traceSplice :: SpliceInfo -> TcM () +traceSplice sd = do + loc <- case sd of + SpliceInfo { spliceLocation = Nothing } -> getSrcSpanM + SpliceInfo { spliceLocation = Just loc } -> return loc + traceOptTcRn Opt_D_dump_splices (spliceDebugDoc loc sd) + when (spliceIsDeclaration sd) $ do + dflags <- getDynFlags + liftIO $ dumpIfSet_dyn_printer alwaysQualify dflags Opt_D_th_dec_file + (spliceCodeDoc loc sd) + where + -- `-ddump-splices` + spliceDebugDoc :: SrcSpan -> SpliceInfo -> SDoc + spliceDebugDoc loc sd + = let code = case spliceSource sd of + Nothing -> ending + Just b -> nest 2 b : ending + ending = [ text "======>", nest 2 (spliceGenerated sd) ] + in (vcat [ ppr loc <> colon + <+> text "Splicing" <+> text (spliceDescription sd) + , nest 2 (sep code) + ]) + + -- `-dth-dec-file` + spliceCodeDoc :: SrcSpan -> SpliceInfo -> SDoc + spliceCodeDoc loc sd + = (vcat [ text "--" <+> ppr loc <> colon + <+> text "Splicing" <+> text (spliceDescription sd) + , sep [spliceGenerated sd] + ]) {- ************************************************************************ diff --git a/compiler/typecheck/TcSplice.hs-boot b/compiler/typecheck/TcSplice.hs-boot index cff4dc9c56..f039bde175 100644 --- a/compiler/typecheck/TcSplice.hs-boot +++ b/compiler/typecheck/TcSplice.hs-boot @@ -11,8 +11,10 @@ import TcType ( TcRhoType ) import Annotations ( Annotation, CoreAnnTarget ) #ifdef GHCI -import Id ( Id ) +import Id ( Id ) import qualified Language.Haskell.TH as TH +import Outputable (SDoc) +import SrcLoc (SrcSpan) #endif tcSpliceExpr :: HsSplice Name @@ -43,4 +45,14 @@ runMetaD :: LHsExpr Id -> TcM [LHsDecl RdrName] lookupThName_maybe :: TH.Name -> TcM (Maybe Name) runQuasi :: TH.Q a -> TcM a + +data SpliceInfo + = SpliceInfo + { spliceIsDeclaration :: Bool + , spliceDescription :: String + , spliceLocation :: Maybe SrcSpan + , spliceSource :: Maybe SDoc + , spliceGenerated :: SDoc + } +traceSplice :: SpliceInfo -> TcM () #endif diff --git a/docs/users_guide/7.12.1-notes.xml b/docs/users_guide/7.12.1-notes.xml index e2134f1429..0196884591 100644 --- a/docs/users_guide/7.12.1-notes.xml +++ b/docs/users_guide/7.12.1-notes.xml @@ -42,8 +42,11 @@ <itemizedlist> <listitem> <para> - TODO FIXME. - </para> + Added the option <option>-dth-dec-file</option>. + + This dumps out a .th.hs file of all Template Haskell declarations in a corresponding .hs file. The idea is that application developers can check this into their repository so that they can grep for identifiers used elsewhere that were defined in Template Haskell. + This is similar to using <option>-ddump-to-file</option> with <option>-ddump-splices</option> but it always generates a file instead of being coupled to <option>-ddump-to-file</option> and only outputs code that does not exist in the .hs file and a comment for the splice location in the original file. + </para> </listitem> </itemizedlist> </sect3> diff --git a/docs/users_guide/flags.xml b/docs/users_guide/flags.xml index 464cce7c48..98c09bf322 100644 --- a/docs/users_guide/flags.xml +++ b/docs/users_guide/flags.xml @@ -3101,6 +3101,12 @@ <entry>-</entry> </row> <row> + <entry><option>-dth-dec-file</option></entry> + <entry>Show evaluated TH declarations in a .th.hs file</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> <entry><option>-ddump-types</option></entry> <entry>Dump type signatures</entry> <entry>dynamic</entry> diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml index 61ab799e1e..f352a32ee6 100644 --- a/docs/users_guide/glasgow_exts.xml +++ b/docs/users_guide/glasgow_exts.xml @@ -9331,9 +9331,6 @@ Typed expression splices and quotations are supported.) </para></listitem> <listitem><para> - The flag <literal>-ddump-splices</literal> shows the expansion of all top-level splices as they happen. - </para></listitem> - <listitem><para> If you are building GHC from source, you need at least a stage-2 bootstrap compiler to run Template Haskell. A stage-1 compiler will reject the TH constructs. Reason: TH compiles and runs a program, and then looks at the result. So it's important that @@ -9348,6 +9345,45 @@ Typed expression splices and quotations are supported.) </para> </sect2> +<sect2 id="th-view-gen-code"> <title> Viewing Template Haskell generated code </title> + <para> + The flag <literal>-ddump-splices</literal> shows the expansion of all top-level declaration splices, both typed and untyped, as they happen. + As with all dump flags, the default is for this output to be sent to stdout. + For a non-trivial program, you may be interested in combining this with the <literal>-ddump-to-file flag</literal> (see <xref linkend="dumping-output"/>. + For each file using Template Haskell, this will show the output in a <literal>.dump-splices</literal> file. + </para> + + <para> + The flag <literal>-dth-dec-file</literal> shows the expansions of all top-level TH declaration splices, both typed and untyped, in the file <literal>M.th.hs</literal> where M is the name of the module being compiled. + Note that other types of splices (expressions, types, and patterns) are not shown. + Application developers can check this into their repository so that they can grep for identifiers that were defined in Template Haskell. + This is similar to using <option>-ddump-to-file</option> with <option>-ddump-splices</option> but it always generates a file instead of being coupled to <option>-ddump-to-file</option>. The format is also different: it does not show code from the original file, instead it only shows generated code and has a comment for the splice location of the original file. + </para> + + <para> + Below is a sample output of <literal>-ddump-splices</literal> + </para> + +<programlisting> +TH_pragma.hs:(6,4)-(8,26): Splicing declarations + [d| foo :: Int -> Int + foo x = x + 1 |] +======> + foo :: Int -> Int + foo x = (x + 1) +</programlisting> + + <para> + Below is the output of the same sample using <literal>-dth-dec-file</literal> + </para> + +<programlisting> +-- TH_pragma.hs:(6,4)-(8,26): Splicing declarations +foo :: Int -> Int +foo x = (x + 1) +</programlisting> +</sect2> + <sect2 id="th-example"> <title> A Template Haskell Worked Example </title> <para>To help you get over the confidence barrier, try out this skeletal worked example. First cut and paste the two modules below into "Main.hs" and "Printf.hs":</para> diff --git a/testsuite/tests/indexed-types/should_fail/T8129.stdout b/testsuite/tests/indexed-types/should_fail/T8129.stdout index 31d82e59fa..975ee8a721 100644 --- a/testsuite/tests/indexed-types/should_fail/T8129.stdout +++ b/testsuite/tests/indexed-types/should_fail/T8129.stdout @@ -1,2 +1 @@ Could not deduce (C x0 (F x0)) - Could not deduce (C x0 (F x0)) diff --git a/testsuite/tests/th/Makefile b/testsuite/tests/th/Makefile index b06042bd40..d10476ee2c 100644 --- a/testsuite/tests/th/Makefile +++ b/testsuite/tests/th/Makefile @@ -37,3 +37,9 @@ TH_Depends: T8333: '$(TEST_HC)' $(TEST_HC_OPTS) $(ghcThWayFlags) --interactive -v0 T8333.hs < /dev/null + +# This was an easy way to re-use the stdout testing +# to check the contents of a generated file. +T8624: + '$(TEST_HC)' $(TEST_HC_OPTS) $(ghcThWayFlags) -v0 -c T8624.hs && cat T8624.th.hs + $(RM) T8624.th.hs diff --git a/testsuite/tests/th/T3319.stderr b/testsuite/tests/th/T3319.stderr index f325ffb8dc..b7e3411d41 100644 --- a/testsuite/tests/th/T3319.stderr +++ b/testsuite/tests/th/T3319.stderr @@ -1,8 +1,7 @@ -T3319.hs:1:1: Splicing declarations
+T3319.hs:8:3-93: Splicing declarations
return
[ForeignD
(ImportF
CCall Unsafe "&" (mkName "foo") (AppT (ConT ''Ptr) (ConT ''())))]
======>
- T3319.hs:8:3-93
foreign import ccall unsafe "static &foo" foo :: Ptr GHC.Tuple.()
diff --git a/testsuite/tests/th/T3600.stderr b/testsuite/tests/th/T3600.stderr index a7f988416e..615be3ba25 100644 --- a/testsuite/tests/th/T3600.stderr +++ b/testsuite/tests/th/T3600.stderr @@ -1,5 +1,4 @@ -T3600.hs:1:1: Splicing declarations
+T3600.hs:5:3-6: Splicing declarations
test
======>
- T3600.hs:5:3-6
myFunction = (testFun1 [], testFun2 [], testFun2 "x")
diff --git a/testsuite/tests/th/T5217.stderr b/testsuite/tests/th/T5217.stderr index a749282710..f69875b31f 100644 --- a/testsuite/tests/th/T5217.stderr +++ b/testsuite/tests/th/T5217.stderr @@ -1,4 +1,4 @@ -T5217.hs:1:1: Splicing declarations
+T5217.hs:(6,3)-(9,53): Splicing declarations
[d| data T a b
where
T1 :: Int -> T Int Char
@@ -6,7 +6,6 @@ T5217.hs:1:1: Splicing declarations T3 :: a -> T [a] a
T4 :: a -> b -> T b [a] |]
======>
- T5217.hs:(6,3)-(9,53)
data T a b
= (b ~ Char, a ~ Int) => T1 Int |
b ~ a => T2 a |
diff --git a/testsuite/tests/th/T5290.stderr b/testsuite/tests/th/T5290.stderr index 9f7067be06..2b4275d842 100644 --- a/testsuite/tests/th/T5290.stderr +++ b/testsuite/tests/th/T5290.stderr @@ -1,6 +1,5 @@ -T5290.hs:1:1: Splicing declarations +T5290.hs:(7,4)-(8,67): Splicing declarations let n = mkName "T" in return [DataD [] n [] [NormalC n [(Unpacked, ConT ''Int)]] []] ======> - T5290.hs:(7,4)-(8,67) data T = T {-# UNPACK #-} !Int diff --git a/testsuite/tests/th/T5700.stderr b/testsuite/tests/th/T5700.stderr index dd1ece7583..729a36604f 100644 --- a/testsuite/tests/th/T5700.stderr +++ b/testsuite/tests/th/T5700.stderr @@ -1,7 +1,6 @@ -T5700.hs:1:1: Splicing declarations +T5700.hs:8:3-9: Splicing declarations mkC ''D ======> - T5700.hs:8:3-9 instance C D where {-# INLINE inlinable #-} inlinable _ = GHC.Tuple.() diff --git a/testsuite/tests/th/T5883.stderr b/testsuite/tests/th/T5883.stderr index 0b0f705823..aa87a41052 100644 --- a/testsuite/tests/th/T5883.stderr +++ b/testsuite/tests/th/T5883.stderr @@ -1,11 +1,10 @@ -T5883.hs:1:1: Splicing declarations +T5883.hs:(7,4)-(12,4): Splicing declarations [d| data Unit = Unit instance Show Unit where show _ = "" {-# INLINE show #-} |] ======> - T5883.hs:(7,4)-(12,4) data Unit = Unit instance Show Unit where {-# INLINE show #-} diff --git a/testsuite/tests/th/T5984.stderr b/testsuite/tests/th/T5984.stderr index 50c7cbfdd0..2e612c7e9e 100644 --- a/testsuite/tests/th/T5984.stderr +++ b/testsuite/tests/th/T5984.stderr @@ -1,10 +1,8 @@ -T5984.hs:1:1: Splicing declarations +T5984.hs:7:1-3: Splicing declarations nt ======> - T5984.hs:7:1-3 newtype Foo = Foo Int -T5984.hs:1:1: Splicing declarations +T5984.hs:8:1-3: Splicing declarations dt ======> - T5984.hs:8:1-3 data Bar = Bar Int diff --git a/testsuite/tests/th/T7532.stderr b/testsuite/tests/th/T7532.stderr index 0890ae2f89..3e57bb8955 100644 --- a/testsuite/tests/th/T7532.stderr +++ b/testsuite/tests/th/T7532.stderr @@ -3,10 +3,9 @@ instance C Bool where data D Bool = T7532.MkD -T7532.hs:1:1: Splicing declarations +T7532.hs:11:3-6: Splicing declarations bang ======> - T7532.hs:11:3-6 instance C Int where data D Int = T diff --git a/testsuite/tests/th/T8624.hs b/testsuite/tests/th/T8624.hs new file mode 100644 index 0000000000..49f67d5a33 --- /dev/null +++ b/testsuite/tests/th/T8624.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -dth-dec-file #-} +module T8624 (THDec(..)) where + +import Language.Haskell.TH + +$(return [DataD [] (mkName "THDec") [] [NormalC (mkName "THDec") []] []]) diff --git a/testsuite/tests/th/T8624.stderr b/testsuite/tests/th/T8624.stderr new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/testsuite/tests/th/T8624.stderr diff --git a/testsuite/tests/th/T8624.stdout b/testsuite/tests/th/T8624.stdout new file mode 100644 index 0000000000..82ea19598c --- /dev/null +++ b/testsuite/tests/th/T8624.stdout @@ -0,0 +1,2 @@ +-- T8624.hs:7:3-72: Splicing declarations +data THDec = THDec diff --git a/testsuite/tests/th/TH_TyInstWhere1.stderr b/testsuite/tests/th/TH_TyInstWhere1.stderr index 5a830aa792..971b7eed24 100644 --- a/testsuite/tests/th/TH_TyInstWhere1.stderr +++ b/testsuite/tests/th/TH_TyInstWhere1.stderr @@ -1,9 +1,8 @@ -TH_TyInstWhere1.hs:1:1: Splicing declarations +TH_TyInstWhere1.hs:(5,3)-(7,24): Splicing declarations [d| type family F (a :: k) (b :: k) :: Bool where F a a = True F a b = False |] ======> - TH_TyInstWhere1.hs:(5,3)-(7,24) type family F (a :: k) (b :: k) :: Bool where F a a = True F a b = False diff --git a/testsuite/tests/th/TH_foreignCallingConventions.stderr b/testsuite/tests/th/TH_foreignCallingConventions.stderr index bf1f8b81f5..1ff81a4fc8 100644 --- a/testsuite/tests/th/TH_foreignCallingConventions.stderr +++ b/testsuite/tests/th/TH_foreignCallingConventions.stderr @@ -8,7 +8,7 @@ foreign import stdcall safe "bay" bay :: (GHC.Types.Int -> GHC.Types.IO GHC.Types.Int foreign import javascript unsafe "bax" bax :: GHC.Ptr.Ptr GHC.Types.Int -> GHC.Types.IO GHC.Base.String -TH_foreignCallingConventions.hs:1:1: Splicing declarations +TH_foreignCallingConventions.hs:(13,4)-(23,25): Splicing declarations do { let fi cconv safety lbl name ty = ForeignD (ImportF cconv safety lbl name ty); dec1 <- fi CCall Interruptible "&" (mkName "foo") @@ -25,6 +25,5 @@ TH_foreignCallingConventions.hs:1:1: Splicing declarations >> hFlush stdout; return [dec1, dec2] } ======> - TH_foreignCallingConventions.hs:(13,4)-(23,25) foreign import ccall interruptible "static &foo" foo :: Ptr () foreign import prim safe "static bar" bar :: Int# -> Int# diff --git a/testsuite/tests/th/TH_foreignInterruptible.stderr b/testsuite/tests/th/TH_foreignInterruptible.stderr index 6893d0a773..9cbf34ac87 100644 --- a/testsuite/tests/th/TH_foreignInterruptible.stderr +++ b/testsuite/tests/th/TH_foreignInterruptible.stderr @@ -1,4 +1,4 @@ -TH_foreignInterruptible.hs:1:1: Splicing declarations +TH_foreignInterruptible.hs:8:3-100: Splicing declarations return [ForeignD (ImportF @@ -8,6 +8,5 @@ TH_foreignInterruptible.hs:1:1: Splicing declarations (mkName "foo") (AppT (ConT ''Ptr) (ConT ''())))] ======> - TH_foreignInterruptible.hs:8:3-100 foreign import ccall interruptible "static &foo" foo :: Ptr GHC.Tuple.() diff --git a/testsuite/tests/th/TH_genEx.stderr b/testsuite/tests/th/TH_genEx.stderr index 843959f693..8f2d5926e9 100644 --- a/testsuite/tests/th/TH_genEx.stderr +++ b/testsuite/tests/th/TH_genEx.stderr @@ -1,6 +1,5 @@ -TH_genEx.hs:1:1: Splicing declarations +TH_genEx.hs:13:3-30: Splicing declarations genAny (reify ''MyInterface) ======> - TH_genEx.hs:13:3-30 data AnyMyInterface1111 = forall a. MyInterface a => AnyMyInterface1111 a diff --git a/testsuite/tests/th/TH_pragma.stderr b/testsuite/tests/th/TH_pragma.stderr index 15feece963..0fcd167aa4 100644 --- a/testsuite/tests/th/TH_pragma.stderr +++ b/testsuite/tests/th/TH_pragma.stderr @@ -1,18 +1,16 @@ -TH_pragma.hs:1:1: Splicing declarations +TH_pragma.hs:(6,4)-(8,26): Splicing declarations [d| foo :: Int -> Int {-# NOINLINE foo #-} foo x = x + 1 |] ======> - TH_pragma.hs:(6,4)-(8,26) foo :: Int -> Int {-# NOINLINE foo #-} foo x = (x + 1) -TH_pragma.hs:1:1: Splicing declarations +TH_pragma.hs:(10,4)-(12,31): Splicing declarations [d| bar :: Num a => a -> a {-# SPECIALIZE INLINE[~1] bar :: Float -> Float #-} bar x = x * 10 |] ======> - TH_pragma.hs:(10,4)-(12,31) bar :: forall a. Num a => a -> a {-# SPECIALIZE INLINE[~1] bar :: Float -> Float #-} bar x = (x * 10) diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index 021afd9554..2b4c37a4af 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -354,4 +354,5 @@ test('T1476', normal, compile, ['-v0']) test('T1476b', normal, compile_fail, ['-v0']) test('T9824', normal, compile, ['-v0']) test('T8031', normal, compile, ['-v0']) +test('T8624', normal, run_command, ['$MAKE -s --no-print-directory T8624']) test('TH_Lift', normal, compile, ['-v0']) |