diff options
Diffstat (limited to 'compiler/GHC/Iface')
| -rw-r--r-- | compiler/GHC/Iface/Binary.hs | 18 | ||||
| -rw-r--r-- | compiler/GHC/Iface/Load.hs | 8 | ||||
| -rw-r--r-- | compiler/GHC/Iface/Make.hs | 3 |
3 files changed, 27 insertions, 2 deletions
diff --git a/compiler/GHC/Iface/Binary.hs b/compiler/GHC/Iface/Binary.hs index 1aa1fdafef..07a9da4c96 100644 --- a/compiler/GHC/Iface/Binary.hs +++ b/compiler/GHC/Iface/Binary.hs @@ -148,7 +148,15 @@ readBinIface_ dflags checkHiWay traceBinIFaceReading hi_path ncu = do wantedGot "Way" way_descr check_way ppr when (checkHiWay == CheckHiWay) $ errorOnMismatch "mismatched interface file ways" way_descr check_way - getWithUserData ncu bh + + extFields_p <- get bh + + mod_iface <- getWithUserData ncu bh + + seekBin bh extFields_p + extFields <- get bh + + return mod_iface{mi_ext_fields = extFields} -- | This performs a get action after reading the dictionary and symbol @@ -200,8 +208,16 @@ writeBinIface dflags hi_path mod_iface = do let way_descr = getWayDescr dflags put_ bh way_descr + extFields_p_p <- tellBin bh + put_ bh extFields_p_p putWithUserData (debugTraceMsg dflags 3) bh mod_iface + + extFields_p <- tellBin bh + putAt bh extFields_p_p extFields_p + seekBin bh extFields_p + put_ bh (mi_ext_fields mod_iface) + -- And send the result to the file writeBinMem bh hi_path diff --git a/compiler/GHC/Iface/Load.hs b/compiler/GHC/Iface/Load.hs index cf881e8f11..2108e84079 100644 --- a/compiler/GHC/Iface/Load.hs +++ b/compiler/GHC/Iface/Load.hs @@ -48,6 +48,7 @@ import GHC.Driver.Types import GHC.Types.Basic hiding (SuccessFlag(..)) import GHC.Tc.Utils.Monad +import Binary ( BinData(..) ) import Constants import PrelNames import PrelInfo @@ -83,6 +84,7 @@ import GHC.Driver.Plugins import Control.Monad import Control.Exception import Data.IORef +import Data.Map ( toList ) import System.FilePath import System.Directory @@ -1159,6 +1161,7 @@ pprModIface iface@ModIface{ mi_final_exts = exts } , text "module header:" $$ nest 2 (ppr (mi_doc_hdr iface)) , text "declaration docs:" $$ nest 2 (ppr (mi_decl_docs iface)) , text "arg docs:" $$ nest 2 (ppr (mi_arg_docs iface)) + , text "extensible fields:" $$ nest 2 (pprExtensibleFields (mi_ext_fields iface)) ] where pp_hsc_src HsBootFile = text "[boot]" @@ -1248,6 +1251,11 @@ pprIfaceAnnotation :: IfaceAnnotation -> SDoc pprIfaceAnnotation (IfaceAnnotation { ifAnnotatedTarget = target, ifAnnotatedValue = serialized }) = ppr target <+> text "annotated by" <+> ppr serialized +pprExtensibleFields :: ExtensibleFields -> SDoc +pprExtensibleFields (ExtensibleFields fs) = vcat . map pprField $ toList fs + where + pprField (name, (BinData size _data)) = text name <+> text "-" <+> ppr size <+> text "bytes" + {- ********************************************************* * * diff --git a/compiler/GHC/Iface/Make.hs b/compiler/GHC/Iface/Make.hs index 677c8cef71..ef9e77b44d 100644 --- a/compiler/GHC/Iface/Make.hs +++ b/compiler/GHC/Iface/Make.hs @@ -268,7 +268,8 @@ mkIface_ hsc_env mi_doc_hdr = doc_hdr, mi_decl_docs = decl_docs, mi_arg_docs = arg_docs, - mi_final_exts = () } + mi_final_exts = (), + mi_ext_fields = emptyExtensibleFields } where cmp_rule = comparing ifRuleName -- Compare these lexicographically by OccName, *not* by unique, |