[project @ 2000-11-09 12:54:08 by simonmar]
[ghc-hetmet.git] / ghc / compiler / main / CmdLineOpts.lhs
index d0e8859..a1012cd 100644 (file)
@@ -14,71 +14,24 @@ module CmdLineOpts (
        DynFlag(..),    -- needed non-abstractly by DriverFlags
        DynFlags(..),
 
+       v_Static_hsc_opts,
+
        intSwitchSet,
        switchIsOn,
        isStaticHscFlag,
 
-       -- debugging opts
-       dopt_D_dump_absC,
-       dopt_D_dump_asm,
-       dopt_D_dump_cpranal,
-       dopt_D_dump_cse,
-       dopt_D_dump_deriv,
-       dopt_D_dump_ds,
-       dopt_D_dump_flatC,
-       dopt_D_dump_foreign,
-       dopt_D_dump_hi_diffs,
-       dopt_D_dump_inlinings,
-       dopt_D_dump_occur_anal,
-       dopt_D_dump_parsed,
-       dopt_D_dump_realC,
-       dopt_D_dump_rn,
-       dopt_D_dump_rules,
-       dopt_D_dump_simpl,
-       dopt_D_dump_simpl_iterations,
-       dopt_D_dump_simpl_stats,
-       dopt_D_dump_spec,
-       dopt_D_dump_stg,
-       dopt_D_dump_stranal,
-       dopt_D_dump_tc,
-       dopt_D_dump_types,
-        dopt_D_dump_usagesp,
-       dopt_D_dump_worker_wrapper,
-       dopt_D_show_passes,
-       dopt_D_dump_rn_trace,
-       dopt_D_dump_rn_stats,
-        dopt_D_dump_stix,
-       dopt_D_dump_minimal_imports,
-       dopt_D_source_stats,
-       dopt_D_verbose_core2core,
-       dopt_D_verbose_stg2stg,
-       dopt_DoCoreLinting,
-       dopt_DoStgLinting,
-        dopt_DoUSPLinting,
-
        opt_PprStyle_NoPrags,
+       opt_PprStyle_RawTypes,
        opt_PprUserLength,
        opt_PprStyle_Debug,
 
+       dopt,
+
        -- other dynamic flags
        dopt_CoreToDo,
        dopt_StgToDo,
-
-       -- warning opts
-       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,
+       dopt_HscLang,
+       dopt_OutName,
 
        -- profiling opts
        opt_AutoSccsOnAllToplevs,
@@ -92,10 +45,6 @@ module CmdLineOpts (
        opt_AllStrict,
        opt_DictsStrict,
         opt_MaxContextReductionDepth,
-        dopt_AllowOverlappingInstances,
-       dopt_AllowUndecidableInstances,
-       dopt_GlasgowExts,
-       opt_Generics,
        opt_IrrefutableTuples,
        opt_NumbersStrict,
        opt_Parallel,
@@ -137,28 +86,20 @@ module CmdLineOpts (
        opt_IgnoreAsserts,
        opt_IgnoreIfacePragmas,
         opt_NoHiCheck,
-       opt_NoImplicitPrelude,
        opt_OmitBlackHoling,
        opt_OmitInterfacePragmas,
        opt_NoPruneTyDecls,
        opt_NoPruneDecls,
-       opt_ReportCompile,
        opt_Static,
        opt_Unregisterised,
-       opt_Verbose,
-
-       -- Code generation
-       opt_UseVanillaRegs,
-       opt_UseFloatRegs,
-       opt_UseDoubleRegs,
-       opt_UseLongRegs
+       opt_Verbose
     ) where
 
 #include "HsVersions.h"
 
 import Array   ( array, (//) )
 import GlaExts
-import Argv
+import IOExts  ( IORef, readIORef )
 import Constants       -- Default values for some flags
 import Util
 import FastTypes
@@ -237,7 +178,7 @@ data CoreToDo               -- These are diff core-to-core passes,
   | CoreDoWorkerWrapper
   | CoreDoSpecialising
   | CoreDoUSPInf
-  | CoreDoCPResult 
+  | CoreDoCPResult
   | CoreDoGlomBinds
   | CoreCSE
 
@@ -312,76 +253,58 @@ data DynFlag
    | Opt_DoStgLinting
    | Opt_DoUSPLinting
 
+   | 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
+
    -- language opts
    | Opt_AllowOverlappingInstances
    | Opt_AllowUndecidableInstances
    | Opt_GlasgowExts
+   | Opt_Generics
+   | Opt_NoImplicitPrelude 
+
+   -- misc
+   | Opt_ReportCompile
    deriving (Eq)
 
 data DynFlags = DynFlags {
-  coreToDo :: CoreToDo,
-  stgToDo  :: StgToDo,
-  hscLang  :: HscLang,
-  flags    :: [DynFlag]
+  coreToDo   :: [CoreToDo],
+  stgToDo    :: [StgToDo],
+  hscLang    :: HscLang,
+  hscOutName :: String,  -- name of the file in which to place output
+  flags      :: [DynFlag]
  }
 
-boolOpt :: DynFlag -> DynFlags -> Bool
-boolOpt f dflags  = f `elem` (flags dflags)
-
-dopt_D_dump_all              = boolOpt Opt_D_dump_all
-dopt_D_dump_most             = boolOpt Opt_D_dump_most
-dopt_D_dump_absC             = boolOpt Opt_D_dump_absC
-dopt_D_dump_asm              = boolOpt Opt_D_dump_asm
-dopt_D_dump_cpranal          = boolOpt Opt_D_dump_cpranal
-dopt_D_dump_deriv            = boolOpt Opt_D_dump_deriv
-dopt_D_dump_ds               = boolOpt Opt_D_dump_ds
-dopt_D_dump_flatC            = boolOpt Opt_D_dump_flatC
-dopt_D_dump_foreign          = boolOpt Opt_D_dump_foreign
-dopt_D_dump_inlinings        = boolOpt Opt_D_dump_inlinings
-dopt_D_dump_occur_anal       = boolOpt Opt_D_dump_occur_anal
-dopt_D_dump_parsed           = boolOpt Opt_D_dump_parsed
-dopt_D_dump_realC            = boolOpt Opt_D_dump_realC
-dopt_D_dump_rn               = boolOpt Opt_D_dump_rn
-dopt_D_dump_simpl            = boolOpt Opt_D_dump_simpl
-dopt_D_dump_simpl_iterations = boolOpt Opt_D_dump_simpl_iterations
-dopt_D_dump_spec             = boolOpt Opt_D_dump_spec
-dopt_D_dump_stg              = boolOpt Opt_D_dump_stg
-dopt_D_dump_stranal          = boolOpt Opt_D_dump_stranal
-dopt_D_dump_tc               = boolOpt Opt_D_dump_tc
-dopt_D_dump_types            = boolOpt Opt_D_dump_types
-dopt_D_dump_rules            = boolOpt Opt_D_dump_rules
-dopt_D_dump_usagesp          = boolOpt Opt_D_dump_usagesp
-dopt_D_dump_cse              = boolOpt Opt_D_dump_cse
-dopt_D_dump_worker_wrapper   = boolOpt Opt_D_dump_worker_wrapper
-dopt_D_show_passes           = boolOpt Opt_D_show_passes
-dopt_D_dump_rn_trace         = boolOpt Opt_D_dump_rn_trace
-dopt_D_dump_rn_stats         = boolOpt Opt_D_dump_rn_stats
-dopt_D_dump_stix             = boolOpt Opt_D_dump_stix
-dopt_D_dump_simpl_stats      = boolOpt Opt_D_dump_simpl_stats
-dopt_D_source_stats          = boolOpt Opt_D_source_stats
-dopt_D_verbose_core2core     = boolOpt Opt_D_verbose_core2core
-dopt_D_verbose_stg2stg       = boolOpt Opt_D_verbose_stg2stg
-dopt_D_dump_hi_diffs         = boolOpt Opt_D_dump_hi_diffs
-dopt_D_dump_minimal_imports  = boolOpt Opt_D_dump_minimal_imports
-dopt_DoCoreLinting           = boolOpt Opt_DoCoreLinting
-dopt_DoStgLinting            = boolOpt Opt_DoStgLinting
-dopt_DoUSPLinting            = boolOpt Opt_DoUSPLinting
-
-dopt_AllowOverlappingInstances = boolOpt Opt_AllowOverlappingInstances
-dopt_AllowUndecidableInstances = boolOpt Opt_AllowUndecidableInstances
-dopt_GlasgowExts               = boolOpt Opt_GlasgowExts
-
-dopt_CoreToDo :: DynFlags -> CoreToDo
+dopt :: DynFlag -> DynFlags -> Bool
+dopt f dflags  = f `elem` (flags dflags)
+
+dopt_CoreToDo :: DynFlags -> [CoreToDo]
 dopt_CoreToDo = coreToDo
 
-dopt_StgToDo :: DynFlags -> StgToDo
+dopt_StgToDo :: DynFlags -> [StgToDo]
 dopt_StgToDo = stgToDo
 
+dopt_OutName :: DynFlags -> String
+dopt_OutName = hscOutName
+
 data HscLang
   = HscC
   | HscAsm
   | HscJava
-  deriving Eq
+  | HscInterpreted
+    deriving Eq
 
 dopt_HscLang :: DynFlags -> HscLang
 dopt_HscLang = hscLang
@@ -394,15 +317,22 @@ dopt_HscLang = hscLang
 %************************************************************************
 
 \begin{code}
+-- v_Statis_hsc_opts is here to avoid a circular dependency with
+-- main/DriverState.
+GLOBAL_VAR(v_Static_hsc_opts, [], [String])
+
 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
 
-lookUp     sw = sw `elem` argv
+unpacked_static_opts = unsafePerformIO (readIORef v_Static_hsc_opts)
+packed_static_opts   = map _PK_ unpacked_static_opts
+
+lookUp     sw = sw `elem` packed_static_opts
        
-lookup_str sw = firstJust (map (startsWith sw) unpacked_opts)
+lookup_str sw = firstJust (map (startsWith sw) unpacked_static_opts)
 
 lookup_int sw = case (lookup_str sw) of
                  Nothing -> Nothing
@@ -412,15 +342,10 @@ lookup_def_int sw def = case (lookup_str sw) of
                            Nothing -> def              -- Use default
                            Just xx -> read xx
 
-lookup_def_char sw def = case (lookup_str sw) of
-                           Just (xx:_) -> xx
-                           _           -> def          -- Use default
-
 lookup_def_float sw def = case (lookup_str sw) of
                            Nothing -> def              -- Use default
                            Just xx -> read xx
 
-unpacked_opts = map _UNPK_ argv
 
 {-
  Putting the compiler options into temporary at-files
@@ -432,7 +357,7 @@ unpacked_opts :: [String]
 unpacked_opts =
   concat $
   map (expandAts) $
-  map _UNPK_ argv
+  map _UNPK_ argv  -- NOT ARGV any more: v_Static_hsc_opts
   where
    expandAts ('@':fname) = words (unsafePerformIO (readFile fname))
    expandAts l = [l]
@@ -449,24 +374,9 @@ unpacked_opts =
 -- debugging opts
 opt_PprStyle_NoPrags           = lookUp  SLIT("-dppr-noprags")
 opt_PprStyle_Debug             = lookUp  SLIT("-dppr-debug")
+opt_PprStyle_RawTypes          = lookUp  SLIT("-dppr-rawtypes")
 opt_PprUserLength              = lookup_def_int "-dppr-user-length" 5 --ToDo: give this a name
 
--- warning opts
-opt_WarnDuplicateExports       = lookUp  SLIT("-fwarn-duplicate-exports")
-opt_WarnHiShadows              = lookUp  SLIT("-fwarn-hi-shadowing")
-opt_WarnIncompletePatterns     = lookUp  SLIT("-fwarn-incomplete-patterns")
-opt_WarnMissingFields          = lookUp  SLIT("-fwarn-missing-fields")
-opt_WarnMissingMethods         = lookUp  SLIT("-fwarn-missing-methods")
-opt_WarnMissingSigs            = lookUp  SLIT("-fwarn-missing-signatures")
-opt_WarnNameShadowing          = lookUp  SLIT("-fwarn-name-shadowing")
-opt_WarnOverlappingPatterns    = lookUp  SLIT("-fwarn-overlapping-patterns")
-opt_WarnSimplePatterns         = lookUp  SLIT("-fwarn-simple-patterns")
-opt_WarnTypeDefaults           = lookUp  SLIT("-fwarn-type-defaults")
-opt_WarnUnusedBinds            = lookUp  SLIT("-fwarn-unused-binds")
-opt_WarnUnusedImports          = lookUp  SLIT("-fwarn-unused-imports")
-opt_WarnUnusedMatches          = lookUp  SLIT("-fwarn-unused-matches")
-opt_WarnDeprecations           = lookUp  SLIT("-fwarn-deprecations")
-
 -- profiling opts
 opt_AutoSccsOnAllToplevs       = lookUp  SLIT("-fauto-sccs-on-all-toplevs")
 opt_AutoSccsOnExportedToplevs  = lookUp  SLIT("-fauto-sccs-on-exported-toplevs")
@@ -478,7 +388,6 @@ opt_DoTickyProfiling                = lookUp  SLIT("-fticky-ticky")
 -- language opts
 opt_AllStrict                  = lookUp  SLIT("-fall-strict")
 opt_DictsStrict                        = lookUp  SLIT("-fdicts-strict")
-opt_Generics                   = lookUp  SLIT("-fgenerics")
 opt_IrrefutableTuples          = lookUp  SLIT("-firrefutable-tuples")
 opt_MaxContextReductionDepth   = lookup_def_int "-fcontext-stack" mAX_CONTEXT_REDUCTION_DEPTH
 opt_NumbersStrict              = lookUp  SLIT("-fnumbers-strict")
@@ -495,7 +404,7 @@ opt_UsageSPOn               = lookUp  SLIT("-fusagesp-on")
 opt_UnboxStrictFields          = lookUp  SLIT("-funbox-strict-fields")
 
 {-
-   The optional '-inpackage=P' flag tells what package 
+   The optional '-inpackage=P' flag tells what package
    we are compiling this module for.
    The Prelude, for example is compiled with '-package prelude'
 -}
@@ -511,7 +420,6 @@ opt_HistorySize                     = lookup_def_int "-fhistory-size" 20
 opt_IgnoreAsserts               = lookUp  SLIT("-fignore-asserts")
 opt_IgnoreIfacePragmas         = lookUp  SLIT("-fignore-interface-pragmas")
 opt_NoHiCheck                   = lookUp  SLIT("-fno-hi-version-check")
-opt_NoImplicitPrelude          = lookUp  SLIT("-fno-implicit-prelude")
 opt_OmitBlackHoling            = lookUp  SLIT("-dno-black-holing")
 opt_OmitInterfacePragmas       = lookUp  SLIT("-fomit-interface-pragmas")
 
@@ -537,21 +445,11 @@ opt_UF_UpdateInPlace              = lookUp  SLIT("-funfolding-update-in-place")
 opt_UF_CheapOp  = ( 1 :: Int)  -- Only one instruction; and the args are charged for
 opt_UF_DearOp   = ( 4 :: Int)
                        
-opt_ReportCompile               = lookUp SLIT("-freport-compile")
 opt_NoPruneDecls               = lookUp SLIT("-fno-prune-decls")
 opt_NoPruneTyDecls             = lookUp SLIT("-fno-prune-tydecls")
 opt_Static                     = lookUp SLIT("-static")
 opt_Unregisterised             = lookUp SLIT("-funregisterised")
 opt_Verbose                    = lookUp SLIT("-v")
-
-opt_UseVanillaRegs | opt_Unregisterised = 0
-                  | otherwise          = mAX_Real_Vanilla_REG
-opt_UseFloatRegs   | opt_Unregisterised = 0
-                  | otherwise          = mAX_Real_Float_REG
-opt_UseDoubleRegs  | opt_Unregisterised = 0
-                  | otherwise          = mAX_Real_Double_REG
-opt_UseLongRegs    | opt_Unregisterised = 0
-                  | otherwise          = mAX_Real_Long_REG
 \end{code}
 
 %************************************************************************
@@ -561,74 +459,59 @@ opt_UseLongRegs    | opt_Unregisterised = 0
 %************************************************************************
 
 \begin{code}
-isStaticHscFlag f = 
+isStaticHscFlag f =
   f `elem` [
-       "-fwarn-duplicate-exports",
-       "-fwarn-hi-shadowing",
-       "-fwarn-incomplete-patterns",
-       "-fwarn-missing-fields",
-       "-fwarn-missing-methods",
-       "-fwarn-missing-signatures",
-       "-fwarn-name-shadowing",
-       "-fwarn-overlapping-patterns",
-       "-fwarn-simple-patterns",
-       "-fwarn-type-defaults",
-       "-fwarn-unused-binds",
-       "-fwarn-unused-imports",
-       "-fwarn-unused-matches",
-       "-fwarn-deprecations",
-       "-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",
-       "-fgenerics",
-       "-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",
-       "-fno-implicit-prelude",
-       "-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",
-       "-funregisterised",
-       "-v" ]
+       "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",
+       "fno-implicit-prelude",
+       "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",
+       "funregisterised",
+       "v" ]
   || any (flip prefixMatch f) [
-       "-fcontext-stack",
-       "-fliberate-case-threshold",
-       "-fhi-version=",
-       "-fhistory-size",
-       "-funfolding-interface-threshold",
-       "-funfolding-creation-threshold",
-       "-funfolding-use-threshold",
-       "-funfolding-fun-discount",
-       "-funfolding-keeness-factor"
+       "fcontext-stack",
+       "fliberate-case-threshold",
+       "fhi-version=",
+       "fhistory-size",
+       "funfolding-interface-threshold",
+       "funfolding-creation-threshold",
+       "funfolding-use-threshold",
+       "funfolding-fun-discount",
+       "funfolding-keeness-factor"
      ]
 \end{code}
 
@@ -701,7 +584,7 @@ isAmongSimpl on_switches            -- Switches mentioned later occur *earlier*
 #endif
     }
   where
-    mk_assoc_elem k@(MaxSimplifierIterations lvl) 
+    mk_assoc_elem k@(MaxSimplifierIterations lvl)
        = (iBox (tagOf_SimplSwitch k), SwInt lvl)
     mk_assoc_elem k@(SimplInlinePhase n)
        = (iBox (tagOf_SimplSwitch k), SwInt n)
@@ -719,11 +602,6 @@ isAmongSimpl on_switches           -- Switches mentioned later occur *earlier*
                            || sw `is_elem` ss
 \end{code}
 
-Default settings for simplifier switches
-
-\begin{code}
-defaultSimplSwitches = [MaxSimplifierIterations        1]
-\end{code}
 
 %************************************************************************
 %*                                                                     *