Skip to content
Snippets Groups Projects
Commit ae31748e authored by sof's avatar sof
Browse files

[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.
parent e8437f81
No related merge requests found
Hide whitespace changes
Inline Side-by-side
ghc/compiler/main/CmdLineOpts.lhs
+ 32
− 21
View file @ ae31748e
......@@ -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
......
ghc/compiler/reader/Lex.lhs
+ 14
− 46
View file @ ae31748e
......@@ -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 ()
......
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment