From: sof Date: Wed, 25 Feb 1998 19:49:13 +0000 (+0000) Subject: [project @ 1998-02-25 19:48:54 by sof] X-Git-Tag: Approx_2487_patches~908 X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=33362962fa2c0cccee533b6cbe36f5cd2b049c8a [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_ 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.) --- diff --git a/ghc/compiler/Makefile b/ghc/compiler/Makefile index a603512..ad5d6da 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 cfd42a6..f051eef 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("") 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 255dc59..5b5c213 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 5ce4cc7..ca67c8c 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 27f444d..b29cddf 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 259b90d..5a98a5b 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 0fd3fb1..d72f128 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 9d8a1b2..d133530 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 ->