CmdLineOpts.lhs 18.4 KB
Newer Older
1
%
2
% (c) The University of Glasgow, 1996-2000
3 4 5 6
%
\section[CmdLineOpts]{Things to do with command-line options}

\begin{code}
7

8 9
module CmdLineOpts (
	CoreToDo(..),
10
	SimplifierSwitch(..), isAmongSimpl,
11 12
	StgToDo(..),
	SwitchResult(..),
13

14
	HscLang(..),
15
	DynFlag(..),	-- needed non-abstractly by DriverFlags
16
	DynFlags(..),
17
	defaultDynFlags,
18

19 20
	v_Static_hsc_opts,

21 22
	intSwitchSet,
	switchIsOn,
23
	isStaticHscFlag,
24

25
	opt_PprStyle_NoPrags,
26
	opt_PprStyle_RawTypes,
27
	opt_PprUserLength,
28 29
	opt_PprStyle_Debug,

30 31
	dopt,

32 33 34
	-- other dynamic flags
	dopt_CoreToDo,
	dopt_StgToDo,
35
	dopt_HscLang,
36
	dopt_OutName,
37 38 39 40 41 42 43

	-- profiling opts
	opt_AutoSccsOnAllToplevs,
	opt_AutoSccsOnExportedToplevs,
	opt_AutoSccsOnIndividualCafs,
	opt_AutoSccsOnDicts,
	opt_SccProfilingOn,
44
	opt_DoTickyProfiling,
45 46 47 48 49 50 51 52

	-- language opts
	opt_AllStrict,
	opt_DictsStrict,
        opt_MaxContextReductionDepth,
	opt_IrrefutableTuples,
	opt_NumbersStrict,
	opt_Parallel,
53
	opt_SMP,
54
	opt_NoMonomorphismRestriction,
55 56 57

	-- optimisation opts
	opt_DoSemiTagging,
58
	opt_FoldrBuildOn,
59 60 61
	opt_LiberateCaseThreshold,
	opt_StgDoLetNoEscapes,
	opt_UnfoldCasms,
62
        opt_UsageSPOn,
63
	opt_UnboxStrictFields,
64 65 66 67 68 69
	opt_SimplNoPreInlining,
	opt_SimplDoEtaReduction,
	opt_SimplDoLambdaEtaExpansion,
	opt_SimplCaseOfCase,
	opt_SimplCaseMerge,
	opt_SimplPedanticBottoms,
70
	opt_SimplExcessPrecision,
71 72 73 74 75 76 77

	-- Unfolding control
	opt_UF_HiFileThreshold,
	opt_UF_CreationThreshold,
	opt_UF_UseThreshold,
	opt_UF_FunAppDiscount,
	opt_UF_KeenessFactor,
78
	opt_UF_UpdateInPlace,
79 80
	opt_UF_CheapOp,
	opt_UF_DearOp,
81 82

	-- misc opts
83
	opt_InPackage,
84 85
	opt_EmitCExternDecls,
	opt_EnsureSplittableC,
86
	opt_GranMacros,
sof's avatar
sof committed
87
	opt_HiVersion,
88
	opt_HistorySize,
sof's avatar
sof committed
89
	opt_IgnoreAsserts,
90
	opt_IgnoreIfacePragmas,
sof's avatar
sof committed
91
        opt_NoHiCheck,
92 93
	opt_OmitBlackHoling,
	opt_OmitInterfacePragmas,
94
	opt_NoPruneTyDecls,
95
	opt_NoPruneDecls,
sof's avatar
sof committed
96
	opt_Static,
97
	opt_Unregisterised
98 99
    ) where

100 101 102
#include "HsVersions.h"

import Array	( array, (//) )
sof's avatar
sof committed
103
import GlaExts
104
import IOExts	( IORef, readIORef )
105
import Constants	-- Default values for some flags
106
import Util
107
import FastTypes
108
import Config
109

110 111
import Maybes		( firstJust )
import Panic		( panic )
112 113 114 115 116 117

#if __GLASGOW_HASKELL__ < 301
import ArrBase	( Array(..) )
#else
import PrelArr  ( Array(..) )
#endif
118 119
\end{code}

120 121 122 123 124 125 126 127 128 129 130 131 132 133 134
%************************************************************************
%*									*
\subsection{Command-line options}
%*									*
%************************************************************************

The hsc command-line options are split into two categories:

  - static flags
  - dynamic flags

Static flags are represented by top-level values of type Bool or Int,
for example.  They therefore have the same value throughout the
invocation of hsc.

135 136 137 138 139
Dynamic flags are represented by an abstract type, DynFlags, which is
passed into hsc by the compilation manager for every compilation.
Dynamic flags are those that change on a per-compilation basis,
perhaps because they may be present in the OPTIONS pragma at the top
of a module.
140 141

Other flag-related blurb:
142 143 144 145 146 147 148 149 150 151 152 153 154

A list of {\em ToDo}s is things to be done in a particular part of
processing.  A (fictitious) example for the Core-to-Core simplifier
might be: run the simplifier, then run the strictness analyser, then
run the simplifier again (three ``todos'').

There are three ``to-do processing centers'' at the moment.  In the
main loop (\tr{main/Main.lhs}), in the Core-to-Core processing loop
(\tr{simplCore/SimplCore.lhs), and in the STG-to-STG processing loop
(\tr{simplStg/SimplStg.lhs}).

%************************************************************************
%*									*
155
\subsection{Datatypes associated with command-line options}
156 157 158 159 160
%*									*
%************************************************************************

\begin{code}
data SwitchResult
161 162 163
  = SwBool	Bool		-- on/off
  | SwString	FAST_STRING	-- nothing or a String
  | SwInt	Int		-- nothing or an Int
164 165 166 167 168 169 170 171 172 173 174 175
\end{code}

\begin{code}
data CoreToDo		-- These are diff core-to-core passes,
			-- which may be invoked in any order,
  			-- as many times as you like.

  = CoreDoSimplify	-- The core-to-core simplifier.
	(SimplifierSwitch -> SwitchResult)
			-- Each run of the simplifier can take a different
			-- set of simplifier-specific flags.
  | CoreDoFloatInwards
176
  | CoreDoFloatOutwards Bool	-- True <=> float lambdas to top level
177 178 179 180
  | CoreLiberateCase
  | CoreDoPrintCore
  | CoreDoStaticArgs
  | CoreDoStrictness
181
  | CoreDoWorkerWrapper
182
  | CoreDoSpecialising
183
  | CoreDoUSPInf
184
  | CoreDoCPResult
185
  | CoreDoGlomBinds
186
  | CoreCSE
187 188

  | CoreDoNothing 	 -- useful when building up lists of these things
189 190 191 192
\end{code}

\begin{code}
data StgToDo
193
  = StgDoMassageForProfiling  -- should be (next to) last
194 195 196 197 198 199 200
  -- There's also setStgVarInfo, but its absolute "lastness"
  -- is so critical that it is hardwired in (no flag).
  | D_stg_stats
\end{code}

\begin{code}
data SimplifierSwitch
201 202
  = MaxSimplifierIterations Int
  | SimplInlinePhase Int
203
  | DontApplyRules
204
  | NoCaseOfCase
205
  | SimplLetToCase
206 207
\end{code}

208 209 210 211 212 213 214 215 216 217
%************************************************************************
%*									*
\subsection{Dynamic command-line options}
%*									*
%************************************************************************

\begin{code}
data DynFlag

   -- debugging flags
218
   = Opt_D_dump_absC
219 220 221 222 223 224 225 226 227 228 229 230 231 232
   | Opt_D_dump_asm
   | Opt_D_dump_cpranal
   | Opt_D_dump_deriv
   | Opt_D_dump_ds
   | Opt_D_dump_flatC
   | Opt_D_dump_foreign
   | Opt_D_dump_inlinings
   | Opt_D_dump_occur_anal
   | Opt_D_dump_parsed
   | Opt_D_dump_realC
   | Opt_D_dump_rn
   | Opt_D_dump_simpl
   | Opt_D_dump_simpl_iterations
   | Opt_D_dump_spec
233
   | Opt_D_dump_sat
234 235 236 237 238 239 240 241 242 243 244 245
   | Opt_D_dump_stg
   | Opt_D_dump_stranal
   | Opt_D_dump_tc
   | Opt_D_dump_types
   | Opt_D_dump_rules
   | Opt_D_dump_usagesp
   | Opt_D_dump_cse
   | Opt_D_dump_worker_wrapper
   | Opt_D_dump_rn_trace
   | Opt_D_dump_rn_stats
   | Opt_D_dump_stix
   | Opt_D_dump_simpl_stats
246
   | Opt_D_dump_InterpSyn
247
   | Opt_D_dump_BCOs
248 249 250
   | Opt_D_source_stats
   | Opt_D_verbose_core2core
   | Opt_D_verbose_stg2stg
251
   | Opt_D_dump_hi
252 253 254 255 256 257
   | Opt_D_dump_hi_diffs
   | Opt_D_dump_minimal_imports
   | Opt_DoCoreLinting
   | Opt_DoStgLinting
   | Opt_DoUSPLinting

258 259 260 261 262 263 264 265 266 267 268 269 270 271 272
   | Opt_WarnDuplicateExports
   | Opt_WarnHiShadows
   | Opt_WarnIncompletePatterns
   | Opt_WarnMissingFields
   | Opt_WarnMissingMethods
   | Opt_WarnMissingSigs
   | Opt_WarnNameShadowing
   | Opt_WarnOverlappingPatterns
   | Opt_WarnSimplePatterns
   | Opt_WarnTypeDefaults
   | Opt_WarnUnusedBinds
   | Opt_WarnUnusedImports
   | Opt_WarnUnusedMatches
   | Opt_WarnDeprecations

273 274 275 276
   -- language opts
   | Opt_AllowOverlappingInstances
   | Opt_AllowUndecidableInstances
   | Opt_GlasgowExts
277
   | Opt_Generics
278
   | Opt_NoImplicitPrelude 
279 280 281

   -- misc
   | Opt_ReportCompile
282 283
   deriving (Eq)

284
data DynFlags = DynFlags {
285 286
  coreToDo   :: [CoreToDo],
  stgToDo    :: [StgToDo],
287 288
  hscLang    :: HscLang,
  hscOutName :: String,  -- name of the file in which to place output
289
  verbosity  :: Int,	 -- verbosity level
290
  flags      :: [DynFlag]
291
 }
292

293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309
defaultDynFlags = DynFlags {
  coreToDo = [], stgToDo = [], 
  hscLang = HscC, hscOutName = "", 
  verbosity = 0, flags = []
  }

{- 
    Verbosity levels:
	
    0	|   print errors & warnings only
    1   |   minimal verbosity: print "compiling M ... done." for each module.
    2   |   equivalent to -dshow-passes
    3   |   equivalent to existing "ghc -v"
    4   |   "ghc -v -ddump-most"
    5   |   "ghc -v -ddump-all"
-}

310 311
dopt :: DynFlag -> DynFlags -> Bool
dopt f dflags  = f `elem` (flags dflags)
312

313
dopt_CoreToDo :: DynFlags -> [CoreToDo]
314
dopt_CoreToDo = coreToDo
315

316
dopt_StgToDo :: DynFlags -> [StgToDo]
317 318
dopt_StgToDo = stgToDo

319 320 321
dopt_OutName :: DynFlags -> String
dopt_OutName = hscOutName

322
data HscLang
323 324 325
  = HscC
  | HscAsm
  | HscJava
326
  | HscInterpreted
327
    deriving (Eq, Show)
328 329 330

dopt_HscLang :: DynFlags -> HscLang
dopt_HscLang = hscLang
331 332
\end{code}

333 334
%************************************************************************
%*									*
335
\subsection{Classifying command-line options}
336 337 338 339
%*									*
%************************************************************************

\begin{code}
340 341 342 343
-- v_Statis_hsc_opts is here to avoid a circular dependency with
-- main/DriverState.
GLOBAL_VAR(v_Static_hsc_opts, [], [String])

sof's avatar
sof committed
344 345 346 347 348
lookUp	       	 :: FAST_STRING -> Bool
lookup_int     	 :: String -> Maybe Int
lookup_def_int   :: String -> Int -> Int
lookup_def_float :: String -> Float -> Float
lookup_str       :: String -> Maybe String
349

350 351 352 353
unpacked_static_opts = unsafePerformIO (readIORef v_Static_hsc_opts)
packed_static_opts   = map _PK_ unpacked_static_opts

lookUp     sw = sw `elem` packed_static_opts
354
	
355
lookup_str sw = firstJust (map (startsWith sw) unpacked_static_opts)
356 357 358

lookup_int sw = case (lookup_str sw) of
		  Nothing -> Nothing
359
		  Just xx -> Just (read xx)
360

361 362 363 364
lookup_def_int sw def = case (lookup_str sw) of
			    Nothing -> def		-- Use default
		  	    Just xx -> read xx

sof's avatar
sof committed
365 366 367 368
lookup_def_float sw def = case (lookup_str sw) of
			    Nothing -> def		-- Use default
		  	    Just xx -> read xx

sof's avatar
sof committed
369 370 371 372 373 374 375 376 377 378 379

{-
 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.

unpacked_opts :: [String]
unpacked_opts =
  concat $
  map (expandAts) $
380
  map _UNPK_ argv  -- NOT ARGV any more: v_Static_hsc_opts
sof's avatar
sof committed
381 382 383 384
  where
   expandAts ('@':fname) = words (unsafePerformIO (readFile fname))
   expandAts l = [l]
-}
385 386
\end{code}

387 388 389 390 391
%************************************************************************
%*									*
\subsection{Static options}
%*									*
%************************************************************************
392

393
\begin{code}
394 395 396
-- debugging opts
opt_PprStyle_NoPrags		= lookUp  SLIT("-dppr-noprags")
opt_PprStyle_Debug		= lookUp  SLIT("-dppr-debug")
397
opt_PprStyle_RawTypes		= lookUp  SLIT("-dppr-rawtypes")
398 399 400 401 402 403 404 405 406 407 408 409
opt_PprUserLength	        = lookup_def_int "-dppr-user-length" 5 --ToDo: give this a name

-- profiling opts
opt_AutoSccsOnAllToplevs	= lookUp  SLIT("-fauto-sccs-on-all-toplevs")
opt_AutoSccsOnExportedToplevs	= lookUp  SLIT("-fauto-sccs-on-exported-toplevs")
opt_AutoSccsOnIndividualCafs	= lookUp  SLIT("-fauto-sccs-on-individual-cafs")
opt_AutoSccsOnDicts		= lookUp  SLIT("-fauto-sccs-on-dicts")
opt_SccProfilingOn		= lookUp  SLIT("-fscc-profiling")
opt_DoTickyProfiling		= lookUp  SLIT("-fticky-ticky")

-- language opts
opt_AllStrict			= lookUp  SLIT("-fall-strict")
410
opt_NoMonomorphismRestriction	= lookUp  SLIT("-fno-monomorphism-restriction")
411 412 413 414 415
opt_DictsStrict			= lookUp  SLIT("-fdicts-strict")
opt_IrrefutableTuples		= lookUp  SLIT("-firrefutable-tuples")
opt_MaxContextReductionDepth	= lookup_def_int "-fcontext-stack" mAX_CONTEXT_REDUCTION_DEPTH
opt_NumbersStrict		= lookUp  SLIT("-fnumbers-strict")
opt_Parallel			= lookUp  SLIT("-fparallel")
416
opt_SMP				= lookUp  SLIT("-fsmp")
417 418

-- optimisation opts
419 420
opt_DoSemiTagging		= lookUp  SLIT("-fsemi-tagging")
opt_FoldrBuildOn		= lookUp  SLIT("-ffoldr-build-on")
421
opt_LiberateCaseThreshold	= lookup_def_int "-fliberate-case-threshold" (10::Int)
422 423 424
opt_StgDoLetNoEscapes		= lookUp  SLIT("-flet-no-escape")
opt_UnfoldCasms		        = lookUp SLIT("-funfold-casms-in-hi-file")
opt_UsageSPOn           	= lookUp  SLIT("-fusagesp-on")
425
opt_UnboxStrictFields		= lookUp  SLIT("-funbox-strict-fields")
426

427
{-
428
   The optional '-inpackage=P' flag tells what package
429 430 431 432 433 434 435
   we are compiling this module for.
   The Prelude, for example is compiled with '-package prelude'
-}
opt_InPackage			= case lookup_str "-inpackage=" of
				    Just p  -> _PK_ p
				    Nothing -> SLIT("Main")	-- The package name if none is specified

436 437
opt_EmitCExternDecls	        = lookUp  SLIT("-femit-extern-decls")
opt_EnsureSplittableC		= lookUp  SLIT("-fglobalise-toplev-names")
438
opt_GranMacros			= lookUp  SLIT("-fgransim")
439
opt_HiVersion			= read cProjectVersionInt :: Int
440
opt_HistorySize			= lookup_def_int "-fhistory-size" 20
sof's avatar
sof committed
441
opt_IgnoreAsserts               = lookUp  SLIT("-fignore-asserts")
442
opt_IgnoreIfacePragmas		= lookUp  SLIT("-fignore-interface-pragmas")
443
opt_NoHiCheck                   = lookUp  SLIT("-fno-hi-version-check")
444 445
opt_OmitBlackHoling		= lookUp  SLIT("-dno-black-holing")
opt_OmitInterfacePragmas	= lookUp  SLIT("-fomit-interface-pragmas")
446

447 448 449 450 451 452 453 454 455
-- Simplifier switches
opt_SimplNoPreInlining		= lookUp SLIT("-fno-pre-inlining")
	-- NoPreInlining is there just to see how bad things
	-- get if you don't do it!
opt_SimplDoEtaReduction		= lookUp SLIT("-fdo-eta-reduction")
opt_SimplDoLambdaEtaExpansion	= lookUp SLIT("-fdo-lambda-eta-expansion")
opt_SimplCaseOfCase		= lookUp SLIT("-fcase-of-case")
opt_SimplCaseMerge		= lookUp SLIT("-fcase-merge")
opt_SimplPedanticBottoms	= lookUp SLIT("-fpedantic-bottoms")
456
opt_SimplExcessPrecision	= lookUp SLIT("-fexcess-precision")
457 458

-- Unfolding control
459 460
opt_UF_HiFileThreshold		= lookup_def_int "-funfolding-interface-threshold" (45::Int)
opt_UF_CreationThreshold	= lookup_def_int "-funfolding-creation-threshold"  (45::Int)
461 462
opt_UF_UseThreshold		= lookup_def_int "-funfolding-use-threshold"	   (8::Int)	-- Discounts can be big
opt_UF_FunAppDiscount		= lookup_def_int "-funfolding-fun-discount"	   (6::Int)	-- It's great to inline a fn
463
opt_UF_KeenessFactor		= lookup_def_float "-funfolding-keeness-factor"	   (1.5::Float)
464
opt_UF_UpdateInPlace		= lookUp  SLIT("-funfolding-update-in-place")
465

466
opt_UF_CheapOp  = ( 1 :: Int)	-- Only one instruction; and the args are charged for
467
opt_UF_DearOp   = ( 4 :: Int)
468 469
			
opt_NoPruneDecls		= lookUp SLIT("-fno-prune-decls")
470
opt_NoPruneTyDecls		= lookUp SLIT("-fno-prune-tydecls")
471 472
opt_Static			= lookUp SLIT("-static")
opt_Unregisterised		= lookUp SLIT("-funregisterised")
473 474
\end{code}

475 476 477 478 479 480 481
%************************************************************************
%*									*
\subsection{List of static hsc flags}
%*									*
%************************************************************************

\begin{code}
482
isStaticHscFlag f =
483
  f `elem` [
484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521
	"fauto-sccs-on-all-toplevs",
	"fauto-sccs-on-exported-toplevs",
	"fauto-sccs-on-individual-cafs",
	"fauto-sccs-on-dicts",
	"fscc-profiling",
	"fticky-ticky",
	"fall-strict",
	"fdicts-strict",
	"firrefutable-tuples",
	"fnumbers-strict",
	"fparallel",
	"fsmp",
	"fsemi-tagging",
	"ffoldr-build-on",
	"flet-no-escape",
	"funfold-casms-in-hi-file",
	"fusagesp-on",
	"funbox-strict-fields",
	"femit-extern-decls",
	"fglobalise-toplev-names",
	"fgransim",
	"fignore-asserts",
	"fignore-interface-pragmas",
	"fno-hi-version-check",
	"dno-black-holing",
	"fomit-interface-pragmas",
	"fno-pre-inlining",
	"fdo-eta-reduction",
	"fdo-lambda-eta-expansion",
	"fcase-of-case",
	"fcase-merge",
	"fpedantic-bottoms",
	"fexcess-precision",
	"funfolding-update-in-place",
	"freport-compile",
	"fno-prune-decls",
	"fno-prune-tydecls",
	"static",
522 523
	"funregisterised"
	]
524
  || any (flip prefixMatch f) [
525 526 527 528 529 530 531 532
	"fcontext-stack",
	"fliberate-case-threshold",
	"fhistory-size",
	"funfolding-interface-threshold",
	"funfolding-creation-threshold",
	"funfolding-use-threshold",
	"funfolding-fun-discount",
	"funfolding-keeness-factor"
533 534 535
     ]
\end{code}

536 537
%************************************************************************
%*									*
538
\subsection{Switch ordering}
539 540 541
%*									*
%************************************************************************

542
These things behave just like enumeration types.
543 544 545

\begin{code}
instance Eq SimplifierSwitch where
546
    a == b = tagOf_SimplSwitch a ==# tagOf_SimplSwitch b
547 548

instance Ord SimplifierSwitch where
549 550
    a <  b  = tagOf_SimplSwitch a <# tagOf_SimplSwitch b
    a <= b  = tagOf_SimplSwitch a <=# tagOf_SimplSwitch b
551

sof's avatar
sof committed
552

553 554 555 556 557
tagOf_SimplSwitch (SimplInlinePhase _)		= _ILIT(1)
tagOf_SimplSwitch (MaxSimplifierIterations _)	= _ILIT(2)
tagOf_SimplSwitch DontApplyRules		= _ILIT(3)
tagOf_SimplSwitch SimplLetToCase		= _ILIT(4)
tagOf_SimplSwitch NoCaseOfCase			= _ILIT(5)
558

559
-- If you add anything here, be sure to change lAST_SIMPL_SWITCH_TAG, too!
560

561
lAST_SIMPL_SWITCH_TAG = 5
562 563 564 565
\end{code}

%************************************************************************
%*									*
566
\subsection{Switch lookup}
567 568 569 570 571
%*									*
%************************************************************************

\begin{code}
isAmongSimpl :: [SimplifierSwitch] -> SimplifierSwitch -> SwitchResult
572 573
isAmongSimpl on_switches		-- Switches mentioned later occur *earlier*
					-- in the list; defaults right at the end.
574 575
  = let
	tidied_on_switches = foldl rm_dups [] on_switches
576 577
		-- The fold*l* ensures that we keep the latest switches;
		-- ie the ones that occur earliest in the list.
578 579 580 581 582 583

	sw_tbl :: Array Int SwitchResult
	sw_tbl = (array	(0, lAST_SIMPL_SWITCH_TAG) -- bounds...
			all_undefined)
		 // defined_elems

sof's avatar
sof committed
584
	all_undefined = [ (i, SwBool False) | i <- [0 .. lAST_SIMPL_SWITCH_TAG ] ]
585 586 587 588

	defined_elems = map mk_assoc_elem tidied_on_switches
    in
    -- (avoid some unboxing, bounds checking, and other horrible things:)
589
#if __GLASGOW_HASKELL__ < 405
sof's avatar
sof committed
590
    case sw_tbl of { Array bounds_who_needs_'em stuff ->
591 592 593
#else
    case sw_tbl of { Array _ _ stuff ->
#endif
594 595
    \ switch ->
	case (indexArray# stuff (tagOf_SimplSwitch switch)) of
596
#if __GLASGOW_HASKELL__ < 400
sof's avatar
sof committed
597
	  Lift v -> v
598
#elif __GLASGOW_HASKELL__ < 403
599
	  (# _, v #) -> v
600 601
#else
	  (# v #) -> v
602
#endif
603 604
    }
  where
605
    mk_assoc_elem k@(MaxSimplifierIterations lvl)
606 607 608 609 610
	= (iBox (tagOf_SimplSwitch k), SwInt lvl)
    mk_assoc_elem k@(SimplInlinePhase n)
	= (iBox (tagOf_SimplSwitch k), SwInt n)
    mk_assoc_elem k
	= (iBox (tagOf_SimplSwitch k), SwBool True) -- I'm here, Mom!
611 612 613 614 615 616 617 618

    -- cannot have duplicates if we are going to use the array thing
    rm_dups switches_so_far switch
      = if switch `is_elem` switches_so_far
    	then switches_so_far
	else switch : switches_so_far
      where
	sw `is_elem` []     = False
619
	sw `is_elem` (s:ss) = (tagOf_SimplSwitch sw) ==# (tagOf_SimplSwitch s)
620 621 622
			    || sw `is_elem` ss
\end{code}

623

624 625
%************************************************************************
%*									*
626
\subsection{Misc functions for command-line options}
627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643
%*									*
%************************************************************************


\begin{code}
switchIsOn :: (switch -> SwitchResult) -> switch -> Bool

switchIsOn lookup_fn switch
  = case (lookup_fn switch) of
      SwBool False -> False
      _	    	   -> True

intSwitchSet :: (switch -> SwitchResult)
	     -> (Int -> switch)
	     -> Maybe Int

intSwitchSet lookup_fn switch
644
  = case (lookup_fn (switch (panic "intSwitchSet"))) of
645 646 647
      SwInt int -> Just int
      _	    	-> Nothing
\end{code}
648 649

\begin{code}
650 651
startsWith :: String -> String -> Maybe String
-- startsWith pfx (pfx++rest) = Just rest
652 653 654 655 656 657

startsWith []     str = Just str
startsWith (c:cs) (s:ss)
  = if c /= s then Nothing else startsWith cs ss
startsWith  _	  []  = Nothing

658
endsWith  :: String -> String -> Maybe String
659 660 661 662 663
endsWith cs ss
  = case (startsWith (reverse cs) (reverse ss)) of
      Nothing -> Nothing
      Just rs -> Just (reverse rs)
\end{code}