From 33362962fa2c0cccee533b6cbe36f5cd2b049c8a Mon Sep 17 00:00:00 2001
From: sof <unknown>
Date: Wed, 25 Feb 1998 19:49:13 +0000
Subject: [PATCH] [project @ 1998-02-25 19:48:54 by sof] Interface file version
checking support. Added a compiler version field to the interface file
header. The format is now
_interface_ <IfaceName> <ModuleVersion> <CompilerVersion>
where the compiler version follow the value of $(ProjectVersionInt).
Any mismatch in version numbers causes the renamer to give up.
A compiler version number of 0 means turn off version checking (used
by PrelGHC.hi to avoid having to update every time we release.)
.hi-boot files are treated specially, the absence of a compiler
version number in the header is taken to mean that there was a `0'.
Need to do this since hsc's .hi-boot files have to also be useable
by versions of the compiler that don't grok version info in interface
files (e.g., ghc-2.10.)
---
ghc/compiler/Makefile | 5 +++--
ghc/compiler/basicTypes/SrcLoc.lhs | 7 +++++-
ghc/compiler/main/MkIface.lhs | 9 ++++----
ghc/compiler/reader/Lex.lhs | 34 +++++++++++++++++++++++++++++-
ghc/compiler/rename/ParseIface.y | 19 ++++++++++-------
ghc/compiler/rename/Rename.lhs | 10 +++++----
ghc/driver/ghc-iface.lprl | 6 +++---
ghc/lib/std/PrelGHC.hi-boot | 2 +-
8 files changed, 68 insertions(+), 24 deletions(-)
diff --git a/ghc/compiler/Makefile b/ghc/compiler/Makefile
index a603512d129e..ad5d6dad2758 100644
--- a/ghc/compiler/Makefile
+++ b/ghc/compiler/Makefile
@@ -1,5 +1,5 @@
# -----------------------------------------------------------------------------
-# $Id: Makefile,v 1.33 1998/01/12 14:44:37 simonm Exp $
+# $Id: Makefile,v 1.34 1998/02/25 19:48:54 sof Exp $
TOP = ..
include $(TOP)/mk/boilerplate.mk
@@ -147,6 +147,7 @@ coreSyn/AnnCoreSyn_HC_OPTS = -fno-omit-reexported-instances
hsSyn/HsExpr_HC_OPTS = -K2m
hsSyn/HsSyn_HC_OPTS = -fno-omit-reexported-instances
main/Main_HC_OPTS = -fvia-C -DPROJECTVERSION=$(GhcProjectVersion)
+main/MkIface_HC_OPTS = -DPROJECTVERSION=$(GhcProjectVersionInt)
main/CmdLineOpts_HC_OPTS = -fvia-C
nativeGen/PprMach_HC_OPTS = -K2m
nativeGen/MachMisc_HC_OPTS = -K2m -fvia-C
@@ -165,7 +166,7 @@ parser/U_qid_HC_OPTS = -fvia-C '-\#include"hspincl.h"'
parser/U_tree_HC_OPTS = -H12m -fvia-C '-\#include"hspincl.h"'
parser/U_ttype_HC_OPTS = -fvia-C '-\#include"hspincl.h"'
prelude/PrimOp_HC_OPTS = -H12m -K3m
-reader/Lex_HC_OPTS = -K2m -H16m -fvia-C
+reader/Lex_HC_OPTS = -K2m -H16m -fvia-C -DPROJECTVERSION=$(GhcProjectVersionInt)
# Heap was 6m with 2.10
reader/ReadPrefix_HC_OPTS = -fvia-C '-\#include"hspincl.h"' -H10m
diff --git a/ghc/compiler/basicTypes/SrcLoc.lhs b/ghc/compiler/basicTypes/SrcLoc.lhs
index cfd42a6f641a..f051eefa6bab 100644
--- a/ghc/compiler/basicTypes/SrcLoc.lhs
+++ b/ghc/compiler/basicTypes/SrcLoc.lhs
@@ -21,7 +21,9 @@ module SrcLoc (
mkGeneratedSrcLoc, -- Code generated within the compiler
- incSrcLine
+ incSrcLine,
+
+ srcLocFile -- return the file name part.
) where
#include "HsVersions.h"
@@ -72,6 +74,9 @@ mkGeneratedSrcLoc = UnhelpfulSrcLoc SLIT("<compiler-generated-code>")
isNoSrcLoc NoSrcLoc = True
isNoSrcLoc other = False
+srcLocFile :: SrcLoc -> FAST_STRING
+srcLocFile (SrcLoc fname _) = fname
+
incSrcLine :: SrcLoc -> SrcLoc
incSrcLine (SrcLoc s l) = SrcLoc s (l +# 1#)
incSrcLine loc = loc
diff --git a/ghc/compiler/main/MkIface.lhs b/ghc/compiler/main/MkIface.lhs
index 255dc59833e0..5b5c2139e467 100644
--- a/ghc/compiler/main/MkIface.lhs
+++ b/ghc/compiler/main/MkIface.lhs
@@ -12,7 +12,8 @@ module MkIface (
#include "HsVersions.h"
-import IO ( Handle, hPutStr, openFile, hClose, IOMode(..) )
+import IO ( Handle, hPutStr, openFile,
+ hClose, hPutStrLn, IOMode(..) )
import HsSyn
import RdrHsSyn ( RdrName(..) )
@@ -99,9 +100,9 @@ endIface :: Maybe Handle -> IO ()
startIface mod
= case opt_ProduceHi of
Nothing -> return Nothing -- not producing any .hi file
- Just fn ->
- openFile fn WriteMode >>= \ if_hdl ->
- hPutStr if_hdl ("{-# GHC_PRAGMA INTERFACE VERSION 20 #-}\n_interface_ "++ _UNPK_ mod ++ "\n") >>
+ Just fn -> do
+ if_hdl <- openFile fn WriteMode
+ hPutStrLn if_hdl ("_interface_ "++ _UNPK_ mod ++ ' ':show (PROJECTVERSION :: Int))
return (Just if_hdl)
endIface Nothing = return ()
diff --git a/ghc/compiler/reader/Lex.lhs b/ghc/compiler/reader/Lex.lhs
index 5ce4cc793d32..ca67c8c8977d 100644
--- a/ghc/compiler/reader/Lex.lhs
+++ b/ghc/compiler/reader/Lex.lhs
@@ -25,6 +25,7 @@ module Lex (
-- Monad for parser
IfaceToken(..), lexIface, IfM, thenIf, returnIf, getSrcLocIf,
+ checkVersion,
happyError,
StringBuffer
@@ -33,6 +34,7 @@ module Lex (
#include "HsVersions.h"
import Char (isDigit, isAlphanum, isUpper,isLower, isSpace, ord )
+import List ( isSuffixOf )
import {-# SOURCE #-} CostCentre
@@ -40,7 +42,7 @@ import CmdLineOpts ( opt_IgnoreIfacePragmas )
import Demand ( Demand(..) {- instance Read -} )
import UniqFM ( UniqFM, listToUFM, lookupUFM)
import BasicTypes ( NewOrData(..), IfaceFlavour(..) )
-import SrcLoc ( SrcLoc, incSrcLine )
+import SrcLoc ( SrcLoc, incSrcLine, srcLocFile )
import Maybes ( MaybeErr(..) )
import ErrUtils ( ErrMsg(..) )
@@ -872,9 +874,39 @@ getSrcLocIf s l = Succeeded l
happyError :: IfM a
happyError s l = Failed (ifaceParseErr l ([]::[IfaceToken]){-Todo-})
+
+{-
+ Note that if the file we're processing ends with `hi-boot',
+ we accept it on faith as having the right version.
+ This is done so that .hi-boot files that comes with hsc
+ don't have to be updated before every release, and it
+ allows us to share .hi-boot files with versions of hsc
+ that don't have .hi version checking (e.g., ghc-2.10's)
+
+ If the version number is 0, the checking is also turned off.
+-}
+checkVersion :: Maybe Integer -> IfM ()
+checkVersion mb@(Just v) s l
+ | (v==0) || (v == PROJECTVERSION) = Succeeded ()
+ | otherwise = Failed (ifaceVersionErr mb l ([]::[IfaceToken]){-Todo-})
+checkVersion mb@Nothing s l
+ | "hi-boot" `isSuffixOf` (_UNPK_ (srcLocFile l)) = Succeeded ()
+ | otherwise = Failed (ifaceVersionErr mb l ([]::[IfaceToken]){-Todo-})
+
-----------------------------------------------------------------
ifaceParseErr l toks
= hsep [ppr l, ptext SLIT("Interface-file parse error;"),
ptext SLIT("toks="), text (show (take 10 toks))]
+
+ifaceVersionErr hi_vers l toks
+ = hsep [ppr l, ptext SLIT("Interface file version error;"),
+ ptext SLIT("Expected"), int PROJECTVERSION,
+ ptext SLIT(" found "), pp_version]
+ where
+ pp_version =
+ case hi_vers of
+ Nothing -> ptext SLIT("pre ghc-3.02 version")
+ Just v -> ptext SLIT("version") <+> integer v
+
\end{code}
diff --git a/ghc/compiler/rename/ParseIface.y b/ghc/compiler/rename/ParseIface.y
index 27f444dac504..b29cddf27931 100644
--- a/ghc/compiler/rename/ParseIface.y
+++ b/ghc/compiler/rename/ParseIface.y
@@ -125,7 +125,7 @@ iface_stuff : iface { PIface $1 }
iface :: { ParsedIface }
-iface : INTERFACE CONID INTEGER
+iface : INTERFACE CONID INTEGER checkVersion
inst_modules_part
usages_part
exports_part fixities_part
@@ -134,12 +134,12 @@ iface : INTERFACE CONID INTEGER
{ ParsedIface
$2 -- Module name
(fromInteger $3) -- Module version
- $5 -- Usages
- $6 -- Exports
- $4 -- Instance modules
- $7 -- Fixities
- $9 -- Decls
- $8 -- Local instances
+ $6 -- Usages
+ $7 -- Exports
+ $5 -- Instance modules
+ $8 -- Fixities
+ $10 -- Decls
+ $9 -- Local instances
}
@@ -607,12 +607,15 @@ prim_rep :: { Char }
: VARID { head (_UNPK_ $1) }
| CONID { head (_UNPK_ $1) }
-
-------------------------------------------------------------------
src_loc :: { SrcLoc }
src_loc : {% getSrcLocIf }
+checkVersion :: { () }
+ : {-empty-} {% checkVersion Nothing }
+ | INTEGER {% checkVersion (Just (fromInteger $1)) }
+
-------------------------------------------------------------------
-- Haskell code
diff --git a/ghc/compiler/rename/Rename.lhs b/ghc/compiler/rename/Rename.lhs
index 259b90de6779..5a98a5b89a18 100644
--- a/ghc/compiler/rename/Rename.lhs
+++ b/ghc/compiler/rename/Rename.lhs
@@ -50,10 +50,12 @@ import Outputable
\begin{code}
renameModule :: UniqSupply
-> RdrNameHsModule
- -> IO (Maybe (RenamedHsModule, -- Output, after renaming
- InterfaceDetails, -- Interface; for interface file generatino
- RnNameSupply, -- Final env; for renaming derivings
- [Module])) -- Imported modules; for profiling
+ -> IO (Maybe
+ ( RenamedHsModule -- Output, after renaming
+ , InterfaceDetails -- Interface; for interface file generatino
+ , RnNameSupply -- Final env; for renaming derivings
+ , [Module] -- Imported modules; for profiling
+ ))
renameModule us this_mod@(HsModule mod_name vers exports imports fixities local_decls loc)
= -- Initialise the renamer monad
diff --git a/ghc/driver/ghc-iface.lprl b/ghc/driver/ghc-iface.lprl
index 0fd3fb13f110..d72f128be250 100644
--- a/ghc/driver/ghc-iface.lprl
+++ b/ghc/driver/ghc-iface.lprl
@@ -114,7 +114,7 @@ sub constructNewHiFile {
}
local($new_module_version) = &calcNewModuleVersion(@decl_names);
- print NEWHI "_interface_ ", $ModuleName{'new'}, " $new_module_version\n";
+ print NEWHI "_interface_ ", $ModuleName{'new'}, " $new_module_version $GhcVersionInfo\n";
if ( $Stuff{'new:instance_modules'} ) {
print NEWHI "_instance_modules_\n";
@@ -199,11 +199,11 @@ sub readHiFile {
last hi_line;
}
- if ( /^_interface_ ([A-Z]\S*) (\d+)/ ) {
+ if ( /^_interface_ ([A-Z]\S*) (\d+)/ && $mod ne 'new' ) {
$ModuleName{$mod} = $1; # used to decide name of interface file.
$ModuleVersion{$mod} = $2;
- } elsif ( /^_interface_ ([A-Z]\S*)/ && $mod eq 'new' ) { # special case: no version
+ } elsif ( /^_interface_ ([A-Z]\S*) (\d+)/ && $mod eq 'new' ) { # special case: no version
$ModuleName{'new'} = $1;
} elsif ( /^_([a-z_]+)_$/ ) {
diff --git a/ghc/lib/std/PrelGHC.hi-boot b/ghc/lib/std/PrelGHC.hi-boot
index 9d8a1b2031a3..d133530fbcd0 100644
--- a/ghc/lib/std/PrelGHC.hi-boot
+++ b/ghc/lib/std/PrelGHC.hi-boot
@@ -5,7 +5,7 @@
-- primitive operations and types that GHC knows about.
---------------------------------------------------------------------------
-_interface_ PrelGHC 2
+_interface_ PrelGHC 2 0
_exports_
PrelGHC
->
--
GitLab