From ae31748ee4ef1a5e094664eb107cf843b8aee319 Mon Sep 17 00:00:00 2001 From: sof Date: Wed, 10 Jun 1998 13:29:24 +0000 Subject: [PATCH] [project @ 1998-06-10 13:29:21 by sof] - remove unused code - added -fno-hi-version-check - (commented out) support for @-files, i.e., pass hsc its command-line switches via a temporary file. --- ghc/compiler/main/CmdLineOpts.lhs | 53 +++++++++++++++++++------------- ghc/compiler/reader/Lex.lhs | 60 +++++++++---------------------------- 2 files changed, 46 insertions(+), 67 deletions(-) diff --git a/ghc/compiler/main/CmdLineOpts.lhs b/ghc/compiler/main/CmdLineOpts.lhs index 499b7f7..fa3c878 100644 --- a/ghc/compiler/main/CmdLineOpts.lhs +++ b/ghc/compiler/main/CmdLineOpts.lhs @@ -58,6 +58,7 @@ module CmdLineOpts ( opt_IrrefutableTuples, opt_LiberateCaseThreshold, opt_MultiParamClasses, + opt_NoHiCheck, opt_NoImplicitPrelude, opt_NumbersStrict, opt_OmitBlackHoling, @@ -270,6 +271,24 @@ lookup_def_float sw def = case (lookup_str sw) of assoc_opts = assocMaybe [ (a, True) | a <- argv ] unpacked_opts = map _UNPK_ argv + +{- + Putting the compiler options into temporary at-files + may turn out to be necessary later on if we turn hsc into + a pure Win32 application where I think there's a command-line + length limit of 255. unpacked_opts understands the @ option. + +assoc_opts = assocMaybe [ (_PK_ a, True) | a <- unpacked_opts ] + +unpacked_opts :: [String] +unpacked_opts = + concat $ + map (expandAts) $ + map _UNPK_ argv + where + expandAts ('@':fname) = words (unsafePerformIO (readFile fname)) + expandAts l = [l] +-} \end{code} \begin{code} @@ -373,7 +392,7 @@ classifyOpts :: ([CoreToDo], -- Core-to-Core processing spec classifyOpts = sep argv [] [] -- accumulators... where - sep :: [FAST_STRING] -- cmd-line opts (input) + sep :: [FAST_STRING] -- cmd-line opts (input) -> [CoreToDo] -> [StgToDo] -- to_do accumulators -> ([CoreToDo], [StgToDo]) -- result @@ -382,13 +401,10 @@ classifyOpts = sep argv [] [] -- accumulators... # define CORE_TD(to_do) sep opts (to_do:core_td) stg_td # define STG_TD(to_do) sep opts core_td (to_do:stg_td) -# define IGNORE_ARG() sep opts core_td stg_td sep (opt1:opts) core_td stg_td - = - case (_UNPK_ opt1) of -- the non-"just match a string" options are at the end... - - ',' : _ -> IGNORE_ARG() -- it is for the parser + = case (_UNPK_ opt1) of -- the non-"just match a string" options are at the end... + ',' : _ -> sep opts core_td stg_td -- it is for the parser "-fsimplify" -> -- gather up SimplifierSwitches specially... simpl_sep opts defaultSimplSwitches core_td stg_td @@ -412,14 +428,14 @@ classifyOpts = sep argv [] [] -- accumulators... "-fmassage-stg-for-profiling" -> STG_TD(StgDoMassageForProfiling) _ -> -- NB: the driver is really supposed to handle bad options - IGNORE_ARG() + sep opts core_td stg_td ---------------- - simpl_sep :: [FAST_STRING] -- cmd-line opts (input) - -> [SimplifierSwitch] -- simplifier-switch accumulator - -> [CoreToDo] -> [StgToDo] -- to_do accumulators - -> ([CoreToDo], [StgToDo]) -- result + simpl_sep :: [FAST_STRING] -- cmd-line opts (input) + -> [SimplifierSwitch] -- simplifier-switch accumulator + -> [CoreToDo] -> [StgToDo] -- to_do accumulators + -> ([CoreToDo], [StgToDo]) -- result -- "simpl_sep" tailcalls "sep" once it's seen one set -- of SimplifierSwitches for a CoreDoSimplify. @@ -533,11 +549,6 @@ lAST_SIMPL_SWITCH_TAG = IBOX(tagOf_SimplSwitch SimplCloneBinds) %************************************************************************ \begin{code} -# define ARRAY Array -# define LIFT Lift -# define SET_TO =: -(=:) a b = (a,b) - isAmongSimpl :: [SimplifierSwitch] -> SimplifierSwitch -> SwitchResult isAmongSimpl on_switches -- Switches mentioned later occur *earlier* @@ -553,20 +564,20 @@ isAmongSimpl on_switches -- Switches mentioned later occur *earlier* all_undefined) // defined_elems - all_undefined = [ i SET_TO SwBool False | i <- [0 .. lAST_SIMPL_SWITCH_TAG ] ] + all_undefined = [ (i, SwBool False) | i <- [0 .. lAST_SIMPL_SWITCH_TAG ] ] defined_elems = map mk_assoc_elem tidied_on_switches in -- (avoid some unboxing, bounds checking, and other horrible things:) - case sw_tbl of { ARRAY bounds_who_needs_'em stuff -> + case sw_tbl of { Array bounds_who_needs_'em stuff -> \ switch -> case (indexArray# stuff (tagOf_SimplSwitch switch)) of - LIFT v -> v + Lift v -> v } where - mk_assoc_elem k@(MaxSimplifierIterations lvl) = IBOX(tagOf_SimplSwitch k) SET_TO SwInt lvl + mk_assoc_elem k@(MaxSimplifierIterations lvl) = (IBOX(tagOf_SimplSwitch k), SwInt lvl) - mk_assoc_elem k = IBOX(tagOf_SimplSwitch k) SET_TO SwBool True -- I'm here, Mom! + mk_assoc_elem k = (IBOX(tagOf_SimplSwitch k), SwBool True) -- I'm here, Mom! -- cannot have duplicates if we are going to use the array thing rm_dups switches_so_far switch diff --git a/ghc/compiler/reader/Lex.lhs b/ghc/compiler/reader/Lex.lhs index beea1ef..3eee37d 100644 --- a/ghc/compiler/reader/Lex.lhs +++ b/ghc/compiler/reader/Lex.lhs @@ -38,7 +38,7 @@ import List ( isSuffixOf ) import {-# SOURCE #-} CostCentre -import CmdLineOpts ( opt_IgnoreIfacePragmas ) +import CmdLineOpts ( opt_IgnoreIfacePragmas, opt_NoHiCheck ) import Demand ( Demand(..) {- instance Read -} ) import UniqFM ( UniqFM, listToUFM, lookupUFM) import BasicTypes ( NewOrData(..), IfaceFlavour(..) ) @@ -149,7 +149,7 @@ all of an interface file before it can continue. But only a fraction of the information contained in the file turns out to be useful, so delaying as much as possible of the scanning and parsing of an interface file Makes Sense (Heap profiles of the compiler -show at a reduction in heap usage by at least a factor of two, +show a reduction in heap usage by at least a factor of two, post-renamer). Hence, the interface file lexer spots when value declarations are @@ -335,12 +335,10 @@ lex_comment cont buf = ------------------ lex_demand cont buf = --- _trace ("demand: "++[C# (currentChar# buf)]) $ case read_em [] buf of { (ls,buf') -> cont (ITstrict ls) (stepOverLexeme buf')} where -- code snatched from Demand.lhs read_em acc buf = --- _trace ("read_em: "++[C# (currentChar# buf)]) $ case currentChar# buf of 'L'# -> read_em (WwLazy False : acc) (stepOn buf) 'A'# -> read_em (WwLazy True : acc) (stepOn buf) @@ -360,7 +358,6 @@ lex_demand cont buf = ------------------ lex_scc cont buf = --- _trace ("scc: "++[C# (currentChar# buf)]) $ case currentChar# buf of '"'# -> -- YUCK^2 @@ -522,14 +519,12 @@ is_kwd_char c@(C# c#) = ----------- lex_cstring cont buf = --- _trace ("lex_cstring: "++[C# (currentChar# buf)]) $ case expandUntilMatch buf "\'\'" of buf' -> cont (ITstring (lexemeToFastString (setCurrentPos# buf' (negateInt# 2#)))) (stepOverLexeme buf') ----------- lex_tuple cont module_dot buf = --- _trace ("lex_tuple: "++[C# (currentChar# buf)]) $ go 2 buf where go n buf = @@ -663,7 +658,6 @@ lex_id2 cont module_dot buf = -- Dealt with [], (), : special cases lex_id3 cont module_dot buf = --- _trace ("lex_id3: "++[C# (currentChar# buf)]) $ case expandWhile (is_id_char) buf of buf' -> case module_dot of @@ -678,29 +672,7 @@ lex_id3 cont module_dot buf = new_buf = stepOverLexeme buf' -{- OLD: -lex_id2 module_dot [] ('[': ']': cs) = end_lex_id module_dot (ITconid SLIT("[]")) cs -lex_id2 module_dot [] ('(': ')': cs) = end_lex_id module_dot (ITconid SLIT("()")) cs -lex_id2 module_dot [] ('(': ',': cs) = lex_tuple module_dot cs -lex_id2 module_dot [] (':' : cs) = lex_id3 module_dot [':'] cs -lex_id2 module_dot xs cs = lex_id3 module_dot xs cs --} - -- Dealt with [], (), : special cases - -{- -lex_id3 module_dot len_xs xs cs = - case my_span' (is_id_char) cs of - (xs1,len_xs1,rest) -> - case module_dot of - Just m -> end_lex_id (Just m) (mk_var_token rxs) rest --OLD:_PK_ (reverse xs))) rest - Nothing -> - case _scc_ "Lex.haskellKeyword" lookupUFM haskellKeywordsFM rxs of - Just kwd_token -> kwd_token : lexIface rest - other -> token : lexIface cs end_lex_id Nothing (mk_var_token rxs) rest - where - rxs = packNChars (len_xs+len_xs1) (xs++xs1) -- OLD: _PK_ (reverse xs) --} mk_var_token pk_str = let f = _HEAD_ pk_str @@ -716,15 +688,6 @@ mk_var_token pk_str = else if isUpperISO f then ITconid pk_str else ITvarsym pk_str -{- - mk_var_token xs@(f:_) | isUpper f || isUpperISO f = ITconid n - | f == ':' = ITconsym n - | isAlpha f = ITvarid n - | otherwise = ITvarsym n - where - n = _PK_ xs --} - end_lex_id cont Nothing token buf = cont token buf end_lex_id cont (Just (m,hif)) token buf = case token of @@ -886,18 +849,23 @@ 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) + Note that if the name of 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. + (needed to deal with GHC.hi only!) + + Once we can assume we're compiling with a version of ghc that + supports interface file checking, we can drop the special + pleading -} checkVersion :: Maybe Integer -> IfM () checkVersion mb@(Just v) s l - | (v==0) || (v == PROJECTVERSION) = Succeeded () + | (v==0) || (v == PROJECTVERSION) || opt_NoHiCheck = Succeeded () | otherwise = Failed (ifaceVersionErr mb l ([]::[IfaceToken]){-Todo-}) checkVersion mb@Nothing s l | "hi-boot" `isSuffixOf` (_UNPK_ (srcLocFile l)) = Succeeded () -- 1.7.10.4