[commit: ghc] : Make StaticFlags actualy work as command line arguments (02566ff)

Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : 

http://hackage.haskell.org/trac/ghc/changeset/02566ff2deb086ac55f14e50152f955e6e303dc8

>---------------------------------------------------------------

commit 02566ff2deb086ac55f14e50152f955e6e303dc8
Author: Max Bolingbroke <[email protected]>
Date:   Mon Jan 30 15:54:13 2012 +0000

    Make StaticFlags actualy work as command line arguments

>---------------------------------------------------------------

 compiler/main/StaticFlagParser.hs                 |    3 +-
 compiler/main/StaticFlags.hs                      |    3 +
 compiler/supercompile/Supercompile/StaticFlags.hs |   60 ++++++++++-----------
 3 files changed, 34 insertions(+), 32 deletions(-)

diff --git a/compiler/main/StaticFlagParser.hs b/compiler/main/StaticFlagParser.hs
index 07eb214..60686f8 100644
--- a/compiler/main/StaticFlagParser.hs
+++ b/compiler/main/StaticFlagParser.hs
@@ -205,7 +205,8 @@ isStaticFlag f =
     "funfolding-dict-threshold",
     "funfolding-use-threshold",
     "funfolding-fun-discount",
-    "funfolding-keeness-factor"
+    "funfolding-keeness-factor",
+    "fsupercompiler"
      ]
 
 unregFlags :: [Located String]
diff --git a/compiler/main/StaticFlags.hs b/compiler/main/StaticFlags.hs
index cfbd4ba..f975581 100644
--- a/compiler/main/StaticFlags.hs
+++ b/compiler/main/StaticFlags.hs
@@ -93,6 +93,9 @@ module StaticFlags (
     -- For the parser
     addOpt, removeOpt, addWay, getWayFlags, v_opt_C_ready,
 
+    -- For the supercompiler, which parses its static flags elsewhere
+    lookUp, lookup_def_int, lookup_str,
+    
     -- Saving/restoring globals
     saveStaticFlagGlobals, restoreStaticFlagGlobals
   ) where
diff --git a/compiler/supercompile/Supercompile/StaticFlags.hs b/compiler/supercompile/Supercompile/StaticFlags.hs
index b7947f6..e120307 100644
--- a/compiler/supercompile/Supercompile/StaticFlags.hs
+++ b/compiler/supercompile/Supercompile/StaticFlags.hs
@@ -2,58 +2,56 @@ module Supercompile.StaticFlags where
 
 import Data.Char (toLower)
 import Data.Maybe
-import Data.List (stripPrefix)
 
-import System.Environment
-import System.IO.Unsafe
+import FastString
+import StaticFlags
 
 
-{-# NOINLINE aRGS #-}
-aRGS :: [String]
-aRGS = unsafePerformIO getArgs
-
 parseEnum :: String -> a -> [(String, a)] -> a
-parseEnum prefix def opts = fromMaybe def $ listToMaybe [parse opt | arg <- aRGS, Just ('=':opt) <- [stripPrefix prefix arg]]
+parseEnum prefix def opts = maybe def parse $ lookup_str prefix
   where parse = fromJust . flip lookup opts . map toLower
 
 
+-- The StaticFlagsParser admits any option beginning with -fsupercompiler
+
+
 iNSTANCE_MATCHING :: Bool
---iNSTANCE_MATCHING = "--instance-matching" `elem` aRGS
-iNSTANCE_MATCHING = True
+iNSTANCE_MATCHING = not $ lookUp $ fsLit "-fsupercompiler-no-instance-matching"
 
 eAGER_SPLIT_VALUES :: Bool
 eAGER_SPLIT_VALUES = iNSTANCE_MATCHING -- For correctness given that we do instance matching
 --eAGER_SPLIT_VALUES = False
 
 rEFINE_ALTS :: Bool
-rEFINE_ALTS = True
+rEFINE_ALTS = not $ lookUp $ fsLit "-fsupercompiler-no-refine-alts"
 --rEFINE_ALTS = False
 
 dEEDS :: Bool
-dEEDS = "--deeds" `elem` aRGS
+dEEDS = lookUp $ fsLit "-fsupercompiler-deeds"
 --dEEDS = True
 
 bOUND_STEPS :: Bool
-bOUND_STEPS = "--bound-steps" `elem` aRGS
+bOUND_STEPS = lookUp $ fsLit "-fsupercompiler-bound-steps"
 --bOUND_STEPS = True
 
 -- For debugging very long-running supercompilation
 dEPTH_LIIMT :: Maybe Int
---dEPTH_LIIMT = Nothing
-dEPTH_LIIMT = Just 10
+dEPTH_LIIMT = Just (lookup_def_int "-fsupercompiler-depth-limit" maxBound)
+--dEPTH_LIIMT = Just 10
 
 pOSITIVE_INFORMATION :: Bool
---pOSITIVE_INFORMATION = False
-pOSITIVE_INFORMATION = True
+pOSITIVE_INFORMATION = lookUp $ fsLit "-fsupercompiler-positive-information"
+--pOSITIVE_INFORMATION = True
 
 data DeedsPolicy = FCFS | Proportional
                  deriving (Read)
 
 dEEDS_POLICY :: DeedsPolicy
-dEEDS_POLICY = parseEnum "--deeds-policy" Proportional [("fcfs", FCFS), ("proportional", Proportional)]
+dEEDS_POLICY = parseEnum "-fsupercompiler-deeds-policy" Proportional [("fcfs", FCFS), ("proportional", Proportional)]
 
 bLOAT_FACTOR :: Int
-bLOAT_FACTOR = fromMaybe 10 $ listToMaybe [read val | arg <- aRGS, Just val <- [stripPrefix "--bloat=" arg]]
+--bLOAT_FACTOR = fromMaybe 10 $ listToMaybe [read val | arg <- aRGS, Just val <- [stripPrefix "--bloat=" arg]]
+bLOAT_FACTOR = lookup_def_int "-fsupercompiler-bloat-factor" 10
  -- NB: need a bloat factor of at least 5 to get append/append fusion to work. The critical point is:
  --
  --  let (++) = ...
@@ -78,45 +76,45 @@ bLOAT_FACTOR = fromMaybe 10 $ listToMaybe [read val | arg <- aRGS, Just val <- [
 
 
 cALL_BY_NAME :: Bool
-cALL_BY_NAME = "--call-by-name" `elem` aRGS
+cALL_BY_NAME = lookUp $ fsLit "-fsupercompiler-call-by-name"
 
 
 dUPLICATE_VALUES_EVALUATOR, dUPLICATE_VALUES_SPLITTER :: Bool
-dUPLICATE_VALUES_EVALUATOR = "--duplicate-values-evaluator" `elem` aRGS
-dUPLICATE_VALUES_SPLITTER = "--duplicate-values-splitter" `elem` aRGS
+dUPLICATE_VALUES_EVALUATOR = lookUp $ fsLit "-fsupercompiler-duplicate-values-evaluator"
+dUPLICATE_VALUES_SPLITTER = lookUp $ fsLit "-fsupercompiler-duplicate-values-splitter"
 
 
 data TagBagType = TBT { tagBagPairwiseGrowth :: Bool }
                 deriving (Show)
 
 tAG_COLLECTION :: TagBagType
-tAG_COLLECTION = parseEnum "--tag-collection" (TBT False) [("bags", TBT False), ("bags-strong", TBT True)]
+tAG_COLLECTION = parseEnum "-fsupercompiler-tag-collection" (TBT False) [("bags", TBT False), ("bags-strong", TBT True)]
 
 
 data GeneralisationType = NoGeneralisation | AllEligible | DependencyOrder Bool | StackFirst
 
 gENERALISATION :: GeneralisationType
-gENERALISATION = parseEnum "--generalisation" StackFirst [("none", NoGeneralisation), ("all-eligible", AllEligible), ("first-reachable", DependencyOrder True), ("last-reachable", DependencyOrder False), ("stack-first", StackFirst)]
+gENERALISATION = parseEnum "-fsupercompiler-generalisation" StackFirst [("none", NoGeneralisation), ("all-eligible", AllEligible), ("first-reachable", DependencyOrder True), ("last-reachable", DependencyOrder False), ("stack-first", StackFirst)]
 
 oCCURRENCE_GENERALISATION :: Bool
-oCCURRENCE_GENERALISATION = not $ "--no-occurrence-generalisation" `elem` aRGS
+oCCURRENCE_GENERALISATION = not $ lookUp $ fsLit "-fsupercompiler-no-occurrence-generalisation"
 
 
 eVALUATE_PRIMOPS :: Bool
-eVALUATE_PRIMOPS = not $ "--no-primops" `elem` aRGS
+eVALUATE_PRIMOPS = not $ lookUp $ fsLit "-fsupercompiler-no-primops"
 
 sPECULATION :: Bool
-sPECULATION = not $ "--no-speculation" `elem` aRGS
+sPECULATION = not $ lookUp $ fsLit "-fsupercompiler-no-speculation"
 
 lOCAL_TIEBACKS :: Bool
-lOCAL_TIEBACKS = "--local-tiebacks" `elem` aRGS
+lOCAL_TIEBACKS = lookUp $ fsLit "-fsupercompiler-local-tiebacks"
 
 rEFINE_FULFILMENT_FVS :: Bool
-rEFINE_FULFILMENT_FVS = not $ "--no-refine-fulfilment-fvs" `elem` aRGS
+rEFINE_FULFILMENT_FVS = not $ lookUp $ fsLit "-fsupercompiler-no-refine-fulfilment-fvs"
 
 
 rEDUCE_ROLLBACK :: Bool
-rEDUCE_ROLLBACK = not $ "--no-reduce-rollback" `elem` aRGS
+rEDUCE_ROLLBACK = not $ lookUp $ fsLit "-fsupercompiler-no-reduce-rollback"
 
 sC_ROLLBACK :: Bool
-sC_ROLLBACK = not $ "--no-sc-rollback" `elem` aRGS
+sC_ROLLBACK = not $ lookUp $ fsLit "-fsupercompiler-no-sc-rollback"