content: {-# LANGUAGE CPP #-}
  module FlagsDecode(
               exitWithUsage,
               exitWithHelp, exitWithHelpHidden,
  
               Decoded(..),
               decodeArgs,
  
               updateFlags,
  
               defaultFlags,
               decodeFlags,
               adjustFinalFlags,
  
               showFlags, showFlagsRaw,
               showFlagsLst, showFlagsAllLst,
               getFlagValueString,
          ) where
  
  import Data.List(nub, sort, intercalate, intersperse, partition)
  import qualified Data.Map as M
  import qualified Data.Set as S
  import qualified Control.Exception as CE
  import System.IO.Error(ioeGetErrorString)
  import System.IO.Unsafe(unsafePerformIO)
  import System.IO(hPutStr, hPutStrLn, stderr, stdout)
  import System.FilePath(normalise, dropTrailingPathSeparator)
  import System.Directory(getDirectoryContents, canonicalizePath)
  import Control.Monad(when)
  import Data.Char(isAlpha, isDigit, toUpper)
  
  import Data.List.Split(splitWhen)
  import Version(bluespec)
  import Backend
  import FileNameUtil(hasDotSuf, takeSuf,
                      bscSrcSuffix, bsvSrcSuffix, bseSrcSuffix,
                      cSuffix, cxxSuffix, cppSuffix, ccSuffix,
                      objSuffix, arSuffix,
                      verSuffix, verSuffix2, verSuffix3, verSuffix4, verSuffix5,
                      vhdlSuffix, vhdlSuffix2,
                      abinSuffix)
  
  -- For error messages
  import Error(internalError, EMsg, WMsg, ErrMsg(..),
               ErrorHandle, bsError, bsWarning, exitFail, exitOK)
  import Position(Position, cmdPosition)
  import VFileName
  import Verilog(vIsValidIdent)
  import Flags
  
  catchIO :: IO a -> (IOError -> IO a) -> IO a
  catchIO = CE.catch
  
  -- -------------------------
  -- File name testing
  
  -- These could be FileUtil.hs
  -- and used in place of calls to hasDotSuffix in other places
  -- (like bsc.hs and Depend.hs)
  
  isSrcFile :: String -> Bool
  isSrcFile s = isBlueSrcFile s
             || isABinFile s
             || isHDLSrcFile s
             || isCSrcFile s
  
  isBlueSrcFile :: String -> Bool
  isBlueSrcFile s = hasDotSuf bscSrcSuffix s
                 || hasDotSuf bsvSrcSuffix s
                 || hasDotSuf bseSrcSuffix s
  
  isABinFile :: String -> Bool
  isABinFile s = hasDotSuf abinSuffix s
  
  isHDLSrcFile :: String -> Bool
  isHDLSrcFile s = isVerSrcFile s
                || isVhdlSrcFile s
  
  isVerSrcFile :: String -> Bool
  isVerSrcFile s = hasDotSuf verSuffix s
                || hasDotSuf verSuffix2 s
                || hasDotSuf verSuffix3 s
                || hasDotSuf verSuffix4 s
                || hasDotSuf verSuffix5 s
  
  isVhdlSrcFile :: String -> Bool
  isVhdlSrcFile s = hasDotSuf vhdlSuffix s
                 || hasDotSuf vhdlSuffix2 s
  
  isCSrcFile :: String -> Bool
  isCSrcFile s = hasDotSuf cSuffix s
              || hasDotSuf cxxSuffix s
              || hasDotSuf cppSuffix s
              || hasDotSuf ccSuffix s
              || hasDotSuf objSuffix s
              || hasDotSuf arSuffix s
  
  -- -------------------------
  -- Usage message for BSC
  
  -- Usage:
  --   bsc -help                                to get help
  --   bsc [flags] file.bsv                     to partially compile a Bluespec file
  --   bsc [flags] -verilog -g mod file.bsv     to compile a module to Verilog
  --   bsc [flags] -verilog -g mod -u file.bsv  to recursively compile modules to Verilog
  --   bsc [flags] -verilog -e topmodule        to link Verilog into a simulation model
  --   bsc [flags] -sim -g mod file.bsv         to compile to a Bluesim object
  --   bsc [flags] -sim -g mod -u file.bsv      to recursively compile to Bluesim objects
  --   bsc [flags] -sim -e topmodule            to link objects into a Bluesim binary
  --   bsc [flags] -systemc -e topmodule        to link objects into a SystemC model
  
  usage :: String -> String
  usage prog =
    let mkUsage (cl,desc) =
            let lcol = "  " ++ prog ++ " " ++ cl
            in (take 41 (lcol ++ (repeat ' '))) ++ "  " ++ desc ++ "\n"
    in "Usage:\n" ++ concatMap mkUsage examples
    where examples =
              [ ("-help","to get help")
              , ("[flags] file." ++ bsvSrcSuffix, "to partially compile a Bluespec file")
              , ("[flags] -verilog -g mod file." ++ bsvSrcSuffix, "to compile a module to Verilog")
              , ("[flags] -verilog -g mod -u file." ++ bsvSrcSuffix, "to recursively compile modules to Verilog")
              , ("[flags] -verilog -e topmodule", "to link Verilog into a simulation model")
              , ("[flags] -sim -g mod file." ++ bsvSrcSuffix, "to compile to a Bluesim object")
              , ("[flags] -sim -g mod -u file." ++ bsvSrcSuffix, "to recursively compile to Bluesim objects")
              , ("[flags] -sim -e topmodule", "to link objects into a Bluesim binary")
              , ("[flags] -systemc -e topmodule", "to link objects into a SystemC model")
              ]
  
  exitWithUsage :: ErrorHandle -> String -> IO ()
  exitWithUsage errh prog =
      hPutStr stderr (usage prog) >> exitFail errh
  
  -- -------------------------
  -- Decoded use case for BSC based on the flags
  
  data Decoded = DHelp Flags       -- Display the public help message
               | DHelpHidden Flags -- Display the full help message
               | DUsage            -- Display the usage message
               | DError [EMsg]     -- Report a list of errors
                 -- No source is given, but print-flag or verbose
                 -- flags were specified, so this is not an error and
                 -- no usage message or error is required
               | DNoSrc Flags
                 -- Bluespec source file
               | DBlueSrc Flags String
                 -- entry, Verilog objects to be linked, and any ABin and C files
               | DVerLink Flags String [VFileName] [String] [String]
                 -- entry, ABin files and C files to be generated and linked
               | DSimLink Flags String [String] [String]
  
  decodeArgs :: String -> [String] -> String -> ([WMsg], Decoded)
  decodeArgs prog args cdir =
      let (sets, warnings0, errors0, flags0, anames) =
              decodeFlags args ([], [], [], defaultFlags cdir)
          -- do some final adjustments
          (warnings, errors, flags) = adjustFinalFlags warnings0 errors0 flags0
      in if "help-hidden" `elem` sets
         then (warnings, DHelpHidden flags)
         else if "h" `elem` sets || "help" `elem` sets
              then (warnings, DHelp flags)
              else if (null errors)
                   then if (null anames)
                        then if ((printFlags flags) ||
                                 (printFlagsHidden flags) ||
                                 (printFlagsRaw flags))
                             then (warnings, DNoSrc flags)
                             else -- We allow the file names to be omitted if the
                                  -- backend and entry point are both specified
                                  case (entry flags) of
                                    (Just e) | (backend flags == Just Verilog)
                                      -> (warnings, DVerLink flags e [] [] [])
                                    (Just e) | (backend flags == Just Bluesim)
                                      -> (warnings, DSimLink flags e [] [])
                                    _ -> if (verbose flags)
                                         then -- handle -v without compilation
                                              (warnings, DNoSrc flags)
                                         else (warnings, DUsage)
                        else case (partition isBlueSrcFile anames) of
                               ([name], []) -> (warnings, checkBSrcFlags flags name)
                               ([name], names) ->
                                   -- This is the case of a Bluespec source name accompanied
                                   -- by more things which are not Bluespec source names.
                                   -- If any of those are flags, we issue an error that flags
                                   -- must go before source files.
                                   -- We used to attempt to support the "-e" flag along with
                                   -- "-g" via the "-u" flag (which would do the recompile),
                                   -- but it has been removed.  The feature could be added
                                   -- back, if it is properly implemented and regressed.
                                   -- Instead, we error that there is unrecognized text on
                                   -- the command-line.  (We could report this for the
                                   -- entire list "names", but that could be too much.
                                   -- We just report the first encountered unknown text.)
                                   let known_ext_names = filter isSrcFile names
                                   in  (warnings, checkNamesForFlag names $
                                                if (not (null known_ext_names))
                                                then -- XXX should we check that the user wasn't
                                                     -- XXX trying to link, but accidentally
                                                     -- XXX typed .bs or .bsv?
                                                    DError
                                                    [(cmdPosition,
                                                      ELinkFilesWithSrc name known_ext_names)]
                                                else DError [(cmdPosition,
                                                              EUnrecognizedCmdLineText (head names))])
                               -- Backwards support for optional -verilog.
                               ([], names) | all isHDLSrcFile names ->
                                   -- generation flag not supported during linking
                                   if (not (null (genName flags)))
                                   then (warnings, DError [(cmdPosition,
                                                            EGenNamesForLinking (genName flags))])
                                   else -- Verilog need not be specified, but another backend better not be
                                        case (backend flags) of
                                          Just be | be /= Verilog
                                            -> (warnings, DError [(cmdPosition,
                                                                   EWrongBackend "Verilog" "Bluesim")])
                                          _ -> case (entry flags) of
                                                    Nothing -> (warnings, DError [(cmdPosition, ENoEntryPoint)])
                                                    Just top ->
                                                        -- set the Verilog flag and go back into
                                                        -- the standard flow (so that any other
                                                        -- checks of the link flags are performed)
                                                        let flags' = flags { backend = Just Verilog }
                                                        in  (warnings, checkLinkFlags flags' names)
                               -- Catch-all for linking
                               ([], names) -> (warnings, checkLinkFlags flags names)
                               -- Multiple src files
                               -- XXX Do we want a different error if the user was linking
                               -- XXX and accidentally included multiple BSV files?
                               (bnames, _) -> (warnings, DError [(cmdPosition, EMultipleSrcFiles)])
                   else (warnings, DError errors)
  
  
  -- check that the flags are OK for compiling Bluespec src file
  checkBSrcFlags :: Flags -> String -> Decoded
  checkBSrcFlags flags filename =
      -- if generate is requested, require a backend
      if not (null (genName flags)) && (backend flags == Nothing)
      then DError [(cmdPosition, ENoBackendCodeGen (genName flags))]
      else
      -- error if entry point is given
      case (entry flags) of
        Just e -> DError [(cmdPosition, EEntryForCodeGen e)]
        Nothing ->
          -- The -remove-dollar flag only applies to the Verilog backend
          if (removeVerilogDollar flags && (backend flags /= Just Verilog))
          then DError [(cmdPosition, EDollarNoVerilog)]
          else
          -- If the user hasn't allowed Bluesim/Verilog to diverge,
          -- then don't-cares can only be 2-state values
          if (not (optUndet flags) &&
              ( (unSpecTo flags == "X") || (unSpecTo flags == "Z") ))
          then DError [(cmdPosition, ENoOptUndetNoXZ (unSpecTo flags))]
          else
          -- Everything is OK for source compilation
          DBlueSrc flags filename
  
  
  -- check that the flags are OK for linking generated files
  -- filenames is guaranteed to be nonEmpty (and not contain .bs/.bsv files)
  checkLinkFlags :: Flags -> [String] -> Decoded
  checkLinkFlags flags names =
      let (anames, names') = partition isABinFile names
          (hdlnames, names'') = partition isHDLSrcFile names'
          (cnames, bad_names) = partition isCSrcFile names''
          errBadName name =
              if not (elem '.' name)
              then (cmdPosition, ENoSrcExt name)
              else (cmdPosition, EUnknownSrcExt (takeSuf name))
          bad_name_errs = map errBadName bad_names
      in  -- check for flags
          checkNamesForFlag bad_names $
          -- report bad file extensions
          if not (null bad_names)
          then DError bad_name_errs
          else
          -- generation flag not supported during linking
          if not (null (genName flags))
          then DError [(cmdPosition, EGenNamesForLinking (genName flags))]
          else
          if (removeVerilogDollar flags)
          then DError [(cmdPosition, EDollarLink)]
          else
          -- Verilog backend
          if (backend flags == Just Verilog)
          then -- An entry point must be specified
               case (entry flags) of
                   Nothing -> DError [(cmdPosition, ENoEntryPoint)]
                   Just top ->
                       -- Everything is OK for Verilog linking
                       DVerLink flags top (map VFileName hdlnames)
                                  anames cnames
          else
          -- Bluesim backend
          if (backend flags == Just Bluesim)
          then -- Only 2-state values are allowed for don't-cares
               if ( (unSpecTo flags == "X") || (unSpecTo flags == "Z") )
               then DError [(cmdPosition, EBluesimNoXZ (unSpecTo flags))]
               else
               -- Verilog files cannot be provided
               if not (null hdlnames)
               then DError [(cmdPosition, EVerilogFilesWithSimBackend hdlnames)]
               else
               -- An entry point must be specified
               case (entry flags) of
                   Nothing -> DError [(cmdPosition, ENoEntryPoint)]
                   Just top ->
                       -- Everything is OK for Bluesim linking
                       DSimLink flags top anames cnames
          -- error if no backend chosen
          else DError [(cmdPosition, ENoBackendLinking)]
  
  
  -- and, if so, error that flags must go before source files
  checkNamesForFlag :: [String] -> Decoded -> Decoded
  checkNamesForFlag bad_names dflt_result =
      let
          -- function to find the first non-match in "names"
          findFirst f (x:xs) = if (f x) then x else findFirst f xs
          findFirst f [] = internalError "decodeArgs.findFirst"
      in
          if (any isFlag bad_names)
          then DError [(cmdPosition,
                        EFlagAfterSrc (findFirst isFlag bad_names))]
          else dflt_result
  
  -- -------------------------
  
  -- This is used to parse the "option" pragma, which allows specifying
  -- command-line options specific to one module (changing optimizations
  -- or other generation behaviors).
  -- XXX If there's a way to record the positions of the strings, that would
  -- XXX be better to report, but at least we report the module's position
  -- XXX in the code, rather than giving "cmdPosition" as the location.
  updateFlags :: ErrorHandle -> Position -> [String] -> Flags -> IO Flags
  updateFlags errh mod_pos args0 flags = do
          let args = concatMap words args0
          let (_, warnings, errs, flags', unknown) = decodeFlags args ([], [], [], flags)
          let updPos (_, m) = (mod_pos, m)
          when ((not . null) warnings) $ bsWarning errh (map updPos warnings)
          case (errs, unknown) of
            ([], []) -> return flags'
            ([], s:_) -> bsError errh [(mod_pos, EUnknownFlag s)]
            (msgs, _) -> bsError errh (map updPos msgs)
  
  -- -------------------------
  -- Help Message
  
  exitWithHelp :: ErrorHandle -> String -> [String] -> String -> IO ()
  exitWithHelp errh prog args cd =
      hPutStrLn stdout (helpMessage Visible prog args cd) >>
      exitOK errh
  
  exitWithHelpHidden :: ErrorHandle -> String -> [String] -> String -> IO ()
  exitWithHelpHidden errh prog args cd =
      hPutStrLn stdout (helpMessage Hidden prog args cd) >>
      exitOK errh
  
  helpMessage :: HideExpose -> String -> [String] -> String -> String
  helpMessage showHidden prog args cd =
      let flags = defaultFlags cd
      in
          unlines ([
          usage prog,
          "Compiler flags:"]
          ++
          sort (describeFlags showHidden)
          ++
          ["",
          "Most flags may be preceded by a `no-' to reverse the effect.",
          "Flags later on the command line override earlier ones.",
           "Path strings such as the import path may contain the character"
          ,"`%' representing the current " ++ bluespec ++ " directory, as well as"
          ,"`+' representing the current value of the path.",
          "Lists of error or warning tags may take the values `ALL' and `NONE'.",
          "",
          "Default flags:",
          bluespec ++ " directory: " ++ bluespecDir flags,
          "import path: " ++ unPath (ifcPath flags)
          ] ++
          if (Hidden == showHidden) then
                  ["",
                   "Dump/kill after various passes:"] ++
                   -- describe the dump flags
                   (map (("-d" ++) . drop 2 . show)
                          ([minBound .. maxBound ] :: [DumpFlag])) ++
                  ["",
                   "Dump to a file with -dpass=filename;" ++
                     "filename may contain the following digraphs:",
                   "  %f    file being compiled (without path or extension)",
                   "  %p    package name",
                   "  %m    module name" ++
                     " (empty for passes not involved in code generation)",
                   "  %%    the % character",
                   "% followed by any other character yields that character",
                   "You may substitute -KILL for -d" ++
                     " to stop compilation after the named pass",
                   "",
                   "The following trace flags are also available:",
                   unwords (map ("-"++) (sort traceflags))
                  ]
           else
                  []
          )
  
  describeFlags :: HideExpose -> [String]
  describeFlags showHidden =
      let getDataFromInfo :: String -> FlagType -> String
          getDataFromInfo f (Arg a1 _ _)     = f ++ " " ++ a1
          getDataFromInfo f (Arg2 a1 a2 _ _) = f ++ " " ++ a1 ++ " " ++ a2
          getDataFromInfo f (PassThrough a _ _) = f ++ " " ++ a
          getDataFromInfo f _                = f
      in
          sort [ "-" ++ flag ++ replicate (22 - length flag) ' ' ++ " " ++ desc |
                 (f, (ft, desc, isHidden)) <- externalFlags,
  -- Deprecated flags are never shown
                 (showHidden == isHidden) || (Visible == isHidden),
                 let flag = getDataFromInfo f ft ]
  
  -- -------------------------
  -- Trace flags
  --
  -- These are flags which are allowed on the command-line but are ignored
  -- by the flag decoding.  BSC stages can query their existence by looking
  -- for them in the "progArgs".  This allows for quick-and-dirty adding of
  -- trace flags, without the overhead of updating the Flags structure, etc.
  
  traceflags :: [String]
  traceflags = [
            "debug-eval-free-vars",
            "no-use-layout",
            "trace-aopt",
            "trace-apaths",
            "trace-bs-mcd",
            "trace-cfmap",
            "trace-cfmaps",
            "trace-conAp",
            "trace-ctxreduce",
            "trace-debug",
            "trace-eval-steps",
            "trace-eval-types",
            "trace-eval-if",
            "trace-eval-nf",
            "trace-eval-trans",
            "trace-full",
            "trace-fun-expand",
            "trace-genbin",
            "trace-heap",
            "trace-heap-alloc",
            "trace-heap-size",
            "trace-inst-tree",
            "trace-instance-overlap",
            "trace-kind-inference",
            "trace-lift",
            "trace-mergesched",
            "trace-mutatormap",
            "trace-ncsets",
            "trace-no-urgency-edge",
            "trace-port-types",
            "trace-profile",
            "trace-pcmap",
            "trace-pcmaps",
            "trace-ralloc",
            "trace-uugraph",
            "trace-scgraph",
            "trace-seqgraph",
            "trace-sched-steps",
            "trace-schedinfo",
            "trace-scmap",
            "trace-scmaps",
            "trace-skip-trim",
            "trace-simplify",
            "trace-smt-conv",
            "trace-smt-test",
            "trace-state-loc",
            "trace-syn",
            "trace-tcvar",
            "trace-tc-reducepred",
            "trace-tc-satisfy",
            "trace-type",
            "trace-type-expl",
            "trace-type-extsubst",
            "trace-usemap",
            "trace-disjoint-tests",
            "trace-a-definitions",
            "trace-clock",
            "trace-def-cache",
            "hack-disable-urgency-warnings",
            "hack-gate-clock-inputs",
            "hack-gate-default-clock",
            "hack-strict-inst-tree",
            "outlaw-sv-kws-as-classic-ids",
            "show-qualifiers",
            "show-raw-id",
            "warn-meth-arg-mismatch"
           ]
  
  -- -------------------------
  -- Default flag values
  
  defaultFlags :: String -> Flags
  defaultFlags bluespecdir = Flags {
          aggImpConds = False,
          allowIncoherentMatches = False,
          backend = Nothing,
          bdir = Nothing,
          biasMethodScheduling = False,
          bluespecDir = bluespecdir,
          cIncPath = [],
          cLibPath = [],
          cLibs = [],
          cDebug = False,
          cFlags = [],
          cxxFlags = [],
          cppFlags = [],
          linkFlags = [],
          cdir = Nothing,
          cpp = False,
          defines = [],
          demoteErrors = SomeMsgs [],
          disableAssertions = False,
          passThroughAssertions = False,
          doICheck = True,
          dumpAll = False,
          dumps = [],
          enablePoisonPills = False,
          entry = Nothing,
          expandATSlimit = 20,
          expandIf = False,
          fdir = Nothing,
          finalcleanup = 1,
          genABin = False,
          genABinVerilog = False,
          genName = [],
          genSysC = False,
          -- The ifcPath value will be produced from the raw value,
          -- by replacing the default-path token with the appropriate value
          -- once all the flag values are known, and adding bdir to the front,
          -- in adjustFinalFlags.
          ifcPathRaw = [ defaultPathToken ],
          -- ifcPath = [],
          -- XXX this value is for properly constructing the help message
          ifcPath = [ "."
                    , bluespecdir ++ "/Libraries"
                    ],
          infoDir = Nothing,
          inlineBool = True,
          inlineISyntax = True,
          inlineSimple = False,
          keepAddSize = False,
          keepFires = False,
          keepInlined = False,
          kill = Nothing,
          ifLift = True,
          maxTIStackDepth = 1000,
          methodBVI = False,
          methodConf = False,
          methodConditions = False,
          neatNames = False,
          oFile = "a.out",
          optAggInline = True,
          optATS = True,
          optAndOr = True,
          optBitConst = False,
          optBool = False,
          optFinalPass = True,
          optIfMux = False,
          optIfMuxSize = 256,
          optJoinDefs = True,
          optMux = True,
          optMuxExpand = False,
          optMuxConst = True,
          optSched = True,
          optUndet = False,
          crossInfo = False,
          parallelSimLink = 1,
          printFlags = False,
          printFlagsHidden = False,
          printFlagsRaw = False,
          preprocessOnly = False,
          promoteWarnings = SomeMsgs [],
          readableMux = True,
          redStepsWarnInterval = 100000,
          redStepsMaxIntervals = 10,
          relaxMethodEarliness = True,
          removeEmptyRules = True,
          removeFalseRules = True,
          removeInoutConnect = True,
          removePrimModules = True,
          removeCReg = True,
          removeReg = True,
          removeRWire = True,
          removeCross = True,
          removeStarvedRules = False,
          removeUnusedMods = False,
          removeVerilogDollar = False,
          resetName = "RST_N",
          resource = RFoff,
          rstGate = False,
          ruleNameCheck = True,
          satBackend = SAT_Yices,
          schedConds = False,
          schedDOT = False,
          schedQueries = [],
          showCSyntax = False,
          showCodeGen = False,
          showElabProgress = False,
          showIESyntax = False,
          showISyntax = False,
          showModuleUse = False,
          showRangeConflict = False,
          showSchedule = False,
          showStats = False,
          showUpds = True,
          simplifyCSyntax = False,
          strictMethodSched = True,
          suppressWarnings = SomeMsgs [],
          synthesize = False,
          systemVerilogTasks = False,
          tclShowHidden = False,
          testAssert = False,
          timeStamps = True,
          showVersion = True,
          unsafeAlwaysRdy = False,
          unSpecTo = "A",
          updCheck = False,
          useDPI = False,
          useNegate = True,
          usePrelude = True,
          useProvisoSAT = True,
          stdlibNames = False,
          v95 = False,
          vFlags = [],
          vdir = Nothing,
          -- The vPath value will be produced from the raw value,
          -- by replacing the default-path token with the appropriate value
          -- once the full ifcPath is known, and adding vdir to the front,
          -- in adjustFinalFlags.
          vPathRaw = [ defaultPathToken ],
          vPath = [],
          vpp = True,
          vsim = Nothing,
          verbosity = Normal,
          verilogDeclareAllFirst = True,
          verilogFilter = [],
          warnActionShadowing = True,
          warnMethodUrgency = True,
          warnUndetPred = False
          }
  
  -- Default path value replaced in adjustFinalFlags
  defaultPathToken :: String
  defaultPathToken = "$DEFAULT_PATH"
  
  -- -------------------------
  -- decodeFlags
  --
  -- Function to parse a list of command-line arguments as flags
  
  -- Returns a list of error messages, the result of processing flags,
  -- and a list of non-flags (the trace flags) which were set.
  decodeFlags :: [String] -> ([String],[WMsg], [EMsg], Flags) -> ([String],[WMsg], [EMsg], Flags, [String])
  decodeFlags (('-':'-':s):ss) (sets, warnings, bad, flags) | (length s > 1) && (head s /= '-') =
      -- accept --option as a synonym for -option (for long options)
      decodeFlags (('-':s):ss) (sets, warnings, bad, flags)
  decodeFlags (s@('-':'d':d):ss) (sets, warnings, bad, flags) | (isDumpName d) =
      case reads ("DF" ++ d) of
      [(df, "")]
        -> decodeFlags ss (sets, warnings, bad, flags { dumps = (df, Nothing) : dumps flags })
      [(df, '=':file)]
        -> decodeFlags ss (sets, warnings, bad, flags { dumps = (df, Just file) : dumps flags })
      _ -> internalError ("decodeFlags: isDumpName: " ++ ('d':d))
  decodeFlags (s@('-':'K':'I':'L':'L':d):ss) (sets, warnings, bad, flags) =
      case (reads ("DF" ++ d), kill flags) of
      ([(df, "")], Nothing)
        -> decodeFlags ss (sets,warnings, bad, flags { kill = (Just (df, Nothing)) })
      ([(df, '=':package_or_mod_name)], Nothing)
        -> decodeFlags ss (sets,warnings, bad, flags { kill = (Just (df, Just package_or_mod_name)) })
      ([(df, "")], Just prev)
        -> let eDupKill = (cmdPosition, EDupKillFlag ("-KILL" ++ d) ("-KILL" ++ drop 2 (show prev)))
           in  decodeFlags ss (sets,warnings, eDupKill : bad, flags)
      _ -> decodeFlags ss (sets,warnings, badflag ("KILL"++d) bad, flags)
  decodeFlags (('-':s):ss) (sets,warnings, bad, flags) =
      if take 3 s == "no-" then
        let drop3s = drop 3 s in
        case lookup drop3s flagsTable of
          Nothing ->  decodeFlags ss (sets, warnings, badflag s bad, flags)
          Just flagtype ->
            case flagtype of
  -- this will report "Deprecated flag -foo" even if "-no-foo" is specified.
  -- We do this to prevent the helpful message from being confusing.
              Toggle doflag _ -> decodeFlags ss
                   (drop3s:sets, (getDeprecation drop3s warnings), bad, doflag flags False)
              _ -> let eNonToggle = (cmdPosition, ENotToggleFlag ('-':drop3s))
                   in  decodeFlags ss (sets,warnings, eNonToggle : bad, flags)
      else
        case lookup s flagsTable of
          Nothing -> decodeFlags ss (sets, warnings, badflag s bad, flags)
          Just flagtype -> let
              perhaps_warn :: [WMsg]
              perhaps_warn = getDeprecation s warnings
  -- We give a DEPRECATED warning even if the flag is otherwise used INcorrectly.
  -- Of course we give a DEPRECATED warning if the flag is used correctly.
            in
            case flagtype of
              Toggle doflag _ -> decodeFlags ss (s:sets, perhaps_warn, bad, doflag flags True)
              NoArg dofunc _ ->
                if (null ss) || (isFlag (head ss)) || (isSrcFile (head ss)) then
                  case (dofunc flags) of
                    Left flags' -> decodeFlags ss (s:sets, perhaps_warn, bad, flags')
                    Right emsg -> decodeFlags ss (sets, perhaps_warn, emsg:bad, flags)
                else
                    let eHasArg = (cmdPosition, ENoArgFlag ('-':s))
                    in  decodeFlags ss (sets,perhaps_warn, eHasArg : bad, flags)
              Arg _ dofunc _ ->
                let eExpectsArg = (cmdPosition, EOneArgFlag ('-':s))
                in  case ss of
                      (s2:ss') ->
                        if (isFlag s2) then
                          decodeFlags ss (sets, perhaps_warn, eExpectsArg : bad, flags)
                        else
                          case (dofunc flags s2) of
                              Left flags' -> decodeFlags ss' (s:sets, perhaps_warn, bad, flags')
                              Right emsg -> decodeFlags ss' (sets, perhaps_warn, emsg:bad, flags)
                      [] -> decodeFlags ss (sets, perhaps_warn, eExpectsArg : bad, flags)
  
              Arg2 _ _ dofunc _ ->
                let eExpectsArg2 = (cmdPosition, ETwoArgFlag ('-':s))
                in  case ss of
                      (s2:s3:ss') ->
                        if (isFlag s2) || (isFlag s3) then
                          decodeFlags ss (sets, perhaps_warn, eExpectsArg2 : bad, flags)
                        else
                          case (dofunc flags s2 s3) of
                              Left flags' -> decodeFlags ss' (s:sets, perhaps_warn, bad, flags')
                              Right emsg -> decodeFlags ss' (sets, perhaps_warn, emsg:bad, flags)
                      -- for the cases when there's only 1 or 0 elements left
                      _ -> decodeFlags ss (sets, perhaps_warn, eExpectsArg2 : bad, flags)
              PassThrough _ dofunc _ ->
                let eExpectsArg = (cmdPosition, EOneArgFlag ('-':s))
                in  case ss of
                      (s2:ss') ->
                          case (dofunc flags s2) of
                            Left flags' -> decodeFlags ss' (s:sets, perhaps_warn, bad, flags')
                            Right emsg -> decodeFlags ss' (sets, perhaps_warn, emsg:bad, flags)
                      [] -> decodeFlags ss (sets, perhaps_warn, eExpectsArg : bad, flags)
  
              Alias f2 -> decodeFlags (("-"++f2):ss) (sets, perhaps_warn, bad, flags)
              Resource rf -> decodeFlags ss (s:sets, perhaps_warn, bad, flags { resource = rf })
  decodeFlags ss (sets, warnings, bad, flags) = (sets, warnings, bad, flags, ss)
  
  
  isFlag :: String -> Bool
  isFlag ('-':_) = True
  isFlag _ = False
  
  isDumpName :: String -> Bool
  isDumpName s =
      case ((reads ("DF" ++ s)) :: [(DumpFlag, String)]) of
        [(df, "")] -> True
        [(df, '=':_)] -> True
        _ -> False
  
  -- If the argument is not in the nonflags (the trace flags),
  -- then it is added to the list of bad strings, otherwise the
  -- list of bad strings is returned unchanged.
  badflag ::String -> [EMsg] -> [EMsg]
  badflag s bad
      | s `elem` traceflags = bad
      | otherwise = ((cmdPosition, EUnknownFlag ('-':s)) : bad)
  
  getDeprecation :: String -> [WMsg] -> [WMsg]
  -- second argument gives all the error messages so far
  getDeprecation s bad = case (lookup s externalFlags) of
           Just (_, _, (Deprecated message))
                -> (cmdPosition, (WDeprecatedFlag s message)) : bad
           Just (_, _, _) -> bad
           _ -> internalError ("inconsistency in flag decoding")
  
  -- -------------------------
  -- adjustFinalFlags
  --
  -- Function to be used after "decodeFlags", to check the well-formedness
  -- of the flags as a whole. (Decoding can only check flags as it goes.)
  
  canonDir :: String -> Either String String
  canonDir d =
      let handler ioe = return $ Left $ ioeGetErrorString ioe
          ioFn = do -- on some systems, canonicalise path doesn't error
                    -- so we explicitly check
                    _ <- getDirectoryContents d
                    -- Some versions of "canonicalizePath" don't drop the trailing path separator
                    canon_d <- canonicalizePath d >>= return . dropTrailingPathSeparator
                    return $ Right canon_d
      in  unsafePerformIO $ catchIO ioFn handler
  
  filterPath :: [String] -> [String] -> [String]
  filterPath rem_dirs0 path =
      let normFn d = either (const (normalise d)) id $ canonDir d
          rem_dirs = map normFn rem_dirs0
          keepDir d = (normFn d) `notElem` rem_dirs
      in  filter keepDir path
  
  checkPath :: String -> String -> [String] -> Maybe String ->
               ([String], [WMsg], [EMsg])
  checkPath path_flag_str dir_flag_str path mdir =
      let
          foldFn :: (M.Map String String, S.Set String, M.Map String (S.Set String), [String]) ->
                    String ->
                    (M.Map String String, S.Set String, M.Map String (S.Set String), [String])
          foldFn (fail_map, seen_set, dup_map, nub_path) dir
              | (dir == defaultPathToken) =
              -- skip default tokens
              (fail_map, seen_set, dup_map, (dir:nub_path))
          foldFn (fail_map, seen_set, dup_map, nub_path) dir =
              case (canonDir dir) of
                Left err_str ->
                    let -- at least normalise as much as possible,
                        -- so that we don't report duplicate warnings
                        dir' = normalise dir
                        fail_map' = M.insert dir' err_str fail_map
                    in (fail_map', seen_set, dup_map, nub_path)
                Right canon_dir ->
                    if (canon_dir `S.member` seen_set)
                    then let dup_map' = M.insertWith (S.union)
                                            canon_dir (S.singleton dir) dup_map
                         in  (fail_map, seen_set, dup_map', nub_path)
                    else let seen_set' = S.insert canon_dir seen_set
                         in  (fail_map, seen_set', dup_map, (dir:nub_path))
  
          (access_fail_map, path_seen_set, path_dups_map, rev_nub_path) =
              foldl foldFn (M.empty, S.empty, M.empty, []) path
  
          -- we use a map, to remove duplicate warnings
          access_warnings =
              let mkWarn (d, str) =
                      (cmdPosition, WOpenPathDirFailure path_flag_str d str)
              in  map mkWarn (M.toList access_fail_map)
  
          path_dups =
              -- use the canonical name
              M.keys path_dups_map
          (access_errors, dir_is_dup) =
              case (mdir) of
                Nothing -> ([], False)
                Just dir ->
                    case (canonDir dir) of
                      Left err_str ->
                          let emsg = (cmdPosition,
                                      EOpenOutputDirFailure dir_flag_str dir err_str)
                              -- attempt to still determine if it's a duplicate
                              dir' = normalise dir
                          in  ([emsg], dir' `S.member` path_seen_set)
                      Right canon_dir ->
                          ([], canon_dir `S.member` path_seen_set)
          dup_warnings =
              if (not (null path_dups))
              then [(cmdPosition, WDuplicatePathDirs path_flag_str dir_flag_str
                                      dir_is_dup path_dups)]
              else []
      in
         (reverse rev_nub_path, access_warnings ++ dup_warnings, access_errors)
  
  -- combine the warnings from two passes
  -- XXX this seems more readable than returning the raw warning data and
  -- XXX constructing the warnings at the end
  combinePathWarnings :: [WMsg] -> [WMsg]
  combinePathWarnings warns0 =
      let
          -- assume cmdPosition
          foldFn (_, WDuplicatePathDirs s1 s2 b ds) (ws, dup_map) =
             let combFn (b1, ds1) (b2, ds2) = (b1 || b2, S.union ds1 ds2)
             in  (ws, M.insertWith combFn (s1, s2) (b, S.fromList ds) dup_map)
          foldFn w (ws, dup_map) = (w:ws, dup_map)
  
          mkDupWarn ((s1,s2), (b, ds)) =
             (cmdPosition, WDuplicatePathDirs s1 s2 b (S.toList ds))
  
          (other_warns, dup_map) = foldr foldFn ([], M.empty) warns0
          dup_warns = map mkDupWarn (M.toList dup_map)
      in
          other_warns ++ dup_warns
  
  -- make some adjustments to flags, once all values are visible
  adjustFinalFlags :: [WMsg] -> [EMsg] -> Flags -> ([WMsg], [EMsg], Flags)
  adjustFinalFlags warns0 errs0 flags0 =
      let
          bspecdir = (bluespecDir flags0)
  
          checkDir :: String -> Maybe String -> ([WMsg], [EMsg])
          checkDir dir_flag_str mdir =
              case mdir of
                Nothing -> ([], [])
                Just dir ->
                    case (canonDir dir) of
                      Right _ -> ([], [])
                      Left err_str ->
                          let emsg = (cmdPosition,
                                      EOpenOutputDirFailure dir_flag_str dir err_str)
                          in  ([], [emsg])
  
          -- ==========
          -- -p / -bdir checks
  
          -- add bdir to the head of the import path.
          -- replace the default path with the Prelude and Libraries locations
  
          -- XXX make sure this is in sync with the default value (ifcPath)
          -- XXX displayed in the help message
          def_bpath = [ "."
                      , bspecdir ++ "/Libraries"
                      ]
          bdir_path = case (bdir flags0) of
                        Just dir -> [dir]
                        Nothing  -> []
  
          bpathraw = ifcPathRaw flags0
          -- warn about duplicates in the raw path
          (bpathraw_nub, b_warns1, b_errs1) =
              checkPath "p" "bdir" bpathraw Nothing
  
          -- construct the visible path
          bpath = bdir_path ++
                  replacePathToken defaultPathToken bpathraw_nub def_bpath
  
          -- warn about duplicates introduced from the default (?)
          (bpath_nub, b_warns2, b_errs2) =
              checkPath "p" "bdir" bpath (bdir flags0)
  
          -- combine the errors and warnings
          b_warns = combinePathWarnings (b_warns1 ++ b_warns2)
          b_errs = b_errs1 ++ b_errs2
  
          -- update flags with the new path, removing duplicates
          flags1 = flags0 { ifcPathRaw = bpathraw_nub, ifcPath = bpath_nub }
  
          -- ==========
          -- -vsearch / -vdir checks
  
          -- add vdir to the head of the Verilog search path
          -- otherwise, add "."
          -- replace the default vsearch path token with
          -- the Verilog and Libraries locations if the token is
          -- still in the vPath.
          -- if vdir is not used, include every place in ifcPath, too.
          -- XXX The ifcPath should be included with "." at the head
          -- XXX because it's also conceptually the default "vdir".
          -- XXX Don't use "."! Use ifcPath plus the directory of all
          -- XXX source files provided on the command line!
  
          prim_path  = [bspecdir ++ "/Verilog"]
          azure_path = [bspecdir ++ "/Libraries"]
          (vdir_path,ifc_path) =
              case (vdir flags1) of
                Just dir -> ([dir],[])
                Nothing ->
                    -- use "." as the vdir
                    -- return the ifc path without "." (to avoid duplicates)
                    -- and remove the azure path (to place at the end?)
                    (["."], filterPath (".":azure_path) (ifcPath flags1))
          def_vpath = ifc_path ++ azure_path ++ prim_path
  
          vpathraw = vPathRaw flags1
          -- warn about duplicates in the raw path
          (vpathraw_nub, v_warns1, v_errs1) =
              checkPath "vsearch" "vdir" vpathraw Nothing
  
          -- construct the visible path
          vpath = vdir_path ++
                  replacePathToken defaultPathToken vpathraw_nub def_vpath
  
          -- warn about duplicates introduced from the default (?)
          (vpath_nub, v_warns2, v_errs2) =
              checkPath "vsearch" "vdir" vpath (vdir flags1)
  
          -- combine the errors and warnings
          (v_warns, v_errs) =
              let ws = combinePathWarnings (v_warns1 ++ v_warns2)
                  es = v_errs1 ++ v_errs2
              in  -- only warn, not error, if the vdir flag won't be used
                  if (backend flags1 == Just Verilog)
                  then (ws, es)
                  else (ws ++ es, [])
  
          -- update flags with the new path, removing duplicates
          flags2 = flags1 { vPathRaw = vpathraw_nub, vPath = vpath_nub }
  
          -- ==========
          -- -simdir
  
          (s_warns, s_errs) =
              let (ws, es) = checkDir "simdir" (cdir flags2)
              in  -- only warn, not error, if the simdir flag won't be used
                  if (backend flags2 == Just Bluesim)
                  then (ws, es)
                  else (ws ++ es, [])
  
          -- ==========
          -- -info-dir
  
          (i_warns, i_errs) = checkDir "info-dir" (infoDir flags2)
  
          -- ==========
          -- -fdir
  
          (f_warns, f_errs) = checkDir "fdir" (fdir flags2)
  
          -- ==========
  
          -- XXX Check the -i path?
  
          -- ==========
      in
          (warns0 ++ b_warns ++ v_warns ++ s_warns ++ i_warns ++ f_warns,
           errs0 ++ b_errs ++ v_errs ++ s_errs ++ i_errs ++ f_errs,
           flags2)
  
  -- -------------------------
  -- External Flag Info
  --
  -- The user-visible flag information, and how that maps to the internal flags
  
  type FlagInfo = (FlagType, FlagDescr, HideExpose )
  
  -- The first argument is a function that executes the flag,
  -- The second argument is a function which displays the current value.
  data FlagType =
        Toggle (Flags -> Bool -> Flags)   (Maybe (Flags -> (Bool,Bool)))
          -- sets a boolean internal flag; can be used with "-no"
          -- (Bool,Bool) result is (value,always_show)
      | NoArg  (Flags -> Either Flags EMsg)  (Maybe (Flags -> Bool))
          -- non-toggle flags with no argument
      | Arg  String  (Flags -> String -> Either Flags EMsg) (Maybe ArgReturnType)
          -- flags with one argument
      | Arg2  String  String  (Flags -> String -> String -> Either Flags EMsg) (Maybe Arg2ReturnType)
          -- flags with two arguments
      | PassThrough String  (Flags -> String -> Either Flags EMsg) (Maybe ArgReturnType)
          -- flags with one argument which can be another flag
      | Alias  String
          -- alias for another flag
      | Resource  ResourceFlag
  
  type FlagDescr = String
  
  -- the String argument to Deprecated gives some useful message of
  -- what to do instead
  data HideExpose = Hidden | Visible | Deprecated String
                  deriving (Eq)
  
  data ArgReturnType = FRTString (Flags -> String)
                     | FRTMaybeString (Flags -> Maybe String)
                     | FRTListString (Flags -> [String])
  
  newtype Arg2ReturnType = FRTListPairString (Flags -> [(String,String)])
  
  flagsTable :: [(String, FlagType)]
  flagsTable = [(s,ft) | (s,(ft,_,_)) <- externalFlags]
  
  showIfTrue :: (Flags -> Bool) -> Maybe (Flags -> (Bool,Bool))
  showIfTrue fn = Just (\flags -> (fn flags,False))
  
  showIfEq :: (Eq a) => (Flags -> a) -> a -> Maybe (Flags -> Bool)
  showIfEq fn v = Just (\flags -> fn flags == v)
  
  showPath :: (Flags -> [String]) -> Maybe ArgReturnType
  showPath path_fn =
      let argFn flags = let p = unPath (path_fn flags)
                        in  if (p == "+") then Nothing else Just p
      in  Just (FRTMaybeString argFn)
  
  showMsgList :: (Flags -> MsgListFlag) -> Maybe ArgReturnType
  showMsgList fn =
      let argFn flags = case (fn flags) of
                          AllMsgs -> Just "ALL"
                          SomeMsgs [] -> Nothing
                          SomeMsgs msgs -> Just (unMsgList msgs)
      in  Just (FRTMaybeString argFn)
  
  externalFlags :: [(String, FlagInfo)]
  externalFlags = [
          ("aggressive-conditions",
           (Toggle (\f x -> f {aggImpConds=x}) (showIfTrue aggImpConds),
            "construct implicit conditions aggressively", Visible)),
  
          ("bdir",
           (Arg "dir" (\f s -> Left (f {bdir = Just s}))
                                          (Just (FRTMaybeString bdir)),
            "output directory for .bo and .ba files", Visible)),
  
          ("bias-method-scheduling",
           (Toggle (\f x -> f {biasMethodScheduling=x}) (showIfTrue biasMethodScheduling),
            "schedule methods before rules when possible", Hidden)),
  
          ("check-assert",
           (Toggle (\f x -> f {testAssert=x}) (showIfTrue testAssert),
            "test assertions with the Assert library", Visible)),
  
          ("continue-after-errors",
           (Toggle (\f x -> f {enablePoisonPills=x}) (showIfTrue enablePoisonPills),
            "aggressively continue compilation after an error has been detected", Visible)),
  
          ("cpp",
           (Toggle (\f x -> f {cpp=x}) (showIfTrue cpp),
            "preprocess the source with the C preprocessor", Visible)),
  
          ("cross-info",
           (Toggle (\f x -> f {crossInfo=x}) (showIfTrue crossInfo),
            "apply heuristics for preserving source code positions", Hidden)),
  
          ("D",
           (Arg "macro" (\f s -> Left (f {defines = defines f ++ [s]})) (Just (FRTListString defines)),
            "define a macro for the BSV or Verilog preprocessor", Visible)),
  
          ("demote-errors",
           (Arg "list"
                (\f s -> let updFn f s = f {demoteErrors = s}
                         in  addToMsgList f "-demote-errors" s demoteErrors updFn)
                (showMsgList demoteErrors),
            "treat a list of errors as warnings (`:' sep list of tags)", Visible)),
  
          ("dall",
           (NoArg (\f -> Left $ f {dumpAll=True}) (Just dumpAll),
            "dump after all passes", Hidden)),
  
          ("bug-icheck",
           (Toggle (\f x -> f {doICheck=x}) (showIfTrue doICheck),
            "type check internal representation", Hidden)),
  
          ("bug-debug",
           (Toggle (\f x -> f {cDebug=x}) (showIfTrue cDebug),
            "enable C debugging / profiling", Hidden)),
  
          ("ignore-assertions",
           (NoArg (\f -> Left $ f {disableAssertions=True}) (Just disableAssertions),
            "disable all assertions", Hidden)),
  
          ("passthrough-assertions",
           (NoArg (\f -> Left $ f {passThroughAssertions=True}) (Just passThroughAssertions),
            "pass SV assertions through to RTL", Hidden)),
  
          ("e",
           (Arg "module" (\f s -> Left (f {entry = Just s})) (Just (FRTMaybeString entry)),
            "top-level module for simulation", Visible)),
  
          ("elab",
           (Toggle (\f x -> f {genABin=x}) (showIfTrue genABin),
            "generate a .ba file after elaboration and scheduling", Visible)),
  
          ("elab-verilog",
           (Toggle (\f x -> f {genABinVerilog=x}) (showIfTrue genABinVerilog),
            "include generated Verilog in .ba files", Hidden)),
  
          ("expand-ATS-limit",
           (Arg "n"
            (\f s -> case (mread s) of
                       Nothing  -> Right (cmdPosition, EIntegerArgFlag "-expand-ATS-limit")
                       Just arg -> Left (f {expandATSlimit = arg}))
            (Just (FRTString (show . expandATSlimit))),
            "maximum depth of lookups when expanding ATS definitions", Hidden)),
  
          ("expand-if",
           (Toggle (\f x -> f {expandIf=x, aggImpConds=x}) (showIfTrue expandIf),
            "expand \"if\" in actions", Deprecated "Use \"-split-if\" instead.")),
  
          ("split-if",
           (Toggle (\f x -> f {expandIf=x, aggImpConds=x}) (showIfTrue expandIf),
            "split \"if\" in actions", Visible)),
  
          ("fdir",
           (Arg "dir" (\f s -> Left (f {fdir = Just s}))
                      (Just (FRTMaybeString fdir)),
            "working directory for relative file paths during elaboration",
            Visible)),
  
          ("final-cleanup",
           (Arg "level"
               (\f s -> case (mread s) of
                            Nothing -> Right (cmdPosition, EIntegerArgFlag "-final-cleanup")
                            Just arg -> Left (f {finalcleanup = arg}))
               (Just (FRTString (show .  finalcleanup))),
            "do another cleanup before Verilog generations", Hidden)),
  
          ("g",
           (Arg "module" (\f s -> Left (f {genName = genName f ++ [s]})) (Just (FRTListString genName)),
            "generate code for `module' (requires -sim or -verilog)", Visible)),
  
          ("help",
           (NoArg Left Nothing,
            "generate help message", Visible)),
  
          ("help-hidden",
           (NoArg Left Nothing,
            "generate help message (including hidden flags)", Hidden)),
  
          ("i",
           (Arg "dir" (\f s -> Left (f {bluespecDir = s})) (Just (FRTString bluespecDir)),
            "override $BLUESPECDIR", Visible)),
  
          ("I",
           (Arg "path" (\f s -> Left (f {cIncPath = cIncPath f ++ [s]})) (Just (FRTListString cIncPath)),
            "include path for compiling foreign C/C++ source", Visible)),
  
          ("info-dir",
           (Arg "dir" (\f s -> Left (f {infoDir = Just s})) (Just (FRTMaybeString infoDir)),
            "output directory for informational files", Visible)),
  
          ("incoherent-instance-matches",
           (Toggle (\f x -> f {allowIncoherentMatches=x}) (showIfTrue allowIncoherentMatches),
            "allow incoherent typeclass instance matches by default", Hidden)),
  
          ("inline-bool",
           (Toggle (\f x -> f {inlineBool=x}) (showIfTrue inlineBool),
            "inline Boolean operations", Hidden)),
  
          ("inline-isyntax",
           (Toggle (\f x -> f {inlineISyntax=x}) (showIfTrue inlineISyntax),
            "do internal inlining", Hidden)),
  
          ("inline-simple",
           (Toggle (\f x -> f {inlineSimple=x}) (showIfTrue inlineSimple),
            "inline simple ATS definitions", Hidden)),
  
          ("keep-add-size",
           (Toggle (\f x -> f {keepAddSize=x}) (showIfTrue keepAddSize),
            "do not zero extend arguments to add/sub", Hidden)),
  
          ("keep-fires",
           (Toggle (\f x -> f {keepFires=x}) (showIfTrue keepFires),
            "preserve CAN_FIRE and WILL_FIRE signals", Visible)),
  
          ("keep-inlined-boundaries",
           (Toggle (\f x -> f {keepInlined=x}) (showIfTrue keepInlined),
            "preserve inlined register and wire boundaries", Visible)),
  
          ("keep-method-conds",
           (Toggle (\f x -> f {methodConditions=x}) (showIfTrue methodConditions),
            "preserve as signals predicates on method calls inside rules", Hidden)),
  
          ("L",
           (Arg "path" (\f s -> Left (f {cLibPath = cLibPath f ++ [s]})) (Just (FRTListString cLibPath)),
            "library path for linking foreign C/C++ objects", Visible)),
  
          ("l",
           (Arg "library" (\f s -> Left (f {cLibs = cLibs f ++ [s]})) (Just (FRTListString cLibs)),
            "library to use when linking foreign C/C++ objects", Visible)),
  
          ("lift",
           (Toggle (\f x -> f {ifLift=x}) (showIfTrue ifLift),
            "lift method calls in \"if\" actions", Visible)),
  
          ("max-tcheck-stack-depth",
           (Arg "depth"
               (\f s -> case (mread s) of
                            Nothing -> Right (cmdPosition, EIntegerArgFlag "-max-tcheck-stack-depth")
                            Just arg -> Left (f {maxTIStackDepth = arg}))
               (Just (FRTString (show . maxTIStackDepth))),
            "maximum stack depth for fundep and SAT analysis in typecheck", Hidden)),
  
          ("o",
           (Arg "name" (\f s -> Left (f {oFile = s})) (Just (FRTString oFile)),
            "name of generated executable", Visible)),
  
          ("O",
           (Toggle (\f x -> f {optBool=x}) (showIfTrue optBool),
            "turn on various optimizations", Hidden)),
  
          ("opt-AndOr",
           (Toggle (\f x -> f {optAndOr=x}) (showIfTrue optAndOr),
            "An aggressive optimization of And Or expressions", Hidden)),
  
          ("opt-ATS",
           (Toggle (\f x -> f {optATS=x}) (showIfTrue optATS),
            "simplify ATS", Hidden)),
  
          ("opt-aggressive-inline",
           (Toggle (\f x -> f {optAggInline=x}) (showIfTrue optAggInline),
            "aggressive inline of verilog assignments", Hidden)),
  
          ("opt-bit-const",
           (Toggle (\f x -> f {optBitConst=x}) (showIfTrue optBitConst),
            "simplify bit operations with constants", Hidden)),
  
          ("opt-bool",
           (Toggle (\f x -> f {optBool=x}) (showIfTrue optBool),
            "use BDD simplifier on booleans (slow but good)", Hidden)),
  
          ("opt-final-pass",
           (Toggle (\f x -> f {optFinalPass=x}) (showIfTrue optFinalPass),
            "final pass optimization to unnest expression (et al)", Hidden)),
  
          ("opt-if-mux",
           (Toggle (\f x -> f {optIfMux=x}) (showIfTrue optIfMux),
            "turn nested \"if\" into one mux", Hidden)),
  
          ("opt-if-mux-size",
            (Arg "n"
                 (\f s -> case (mread s) of
                            Nothing  -> Right (cmdPosition, EIntegerArgFlag "-opt-if-mux-size")
                            Just arg -> Left (f {optIfMuxSize = arg}))
                 (Just (FRTString (show . optIfMuxSize))),
            "maximum mux size to inline when doing -opt-if-mux", Hidden)),
  
          ("opt-join-defs",
           (Toggle (\f x -> f {optJoinDefs=x}) (showIfTrue optJoinDefs),
            "join identical definitions", Hidden)),
  
          ("opt-mux",
           (Toggle (\f x -> f {optMux=x}) (showIfTrue optMux),
            "simplify muxes", Hidden)),
  
          ("opt-mux-expand",
           (Toggle (\f x -> f {optMuxExpand=x}) (showIfTrue optMuxExpand),
            "simplify muxes by blasting constants", Hidden)),
  
          ("opt-mux-const",
           (Toggle (\f x -> f {optMuxConst=x}) (showIfTrue optMuxConst),
            "simplify constants in muxes aggressively", Hidden)),
  
          ("opt-sched",
           (Toggle (\f x -> f {optSched=x}) (showIfTrue optSched),
            "simplify scheduler expressions", Hidden)),
  
          ("opt-undetermined-vals",
           (Toggle (\f x -> f {optUndet=x}) (showIfTrue optUndet),
            "aggressive optimization of undetermined values", Visible)),
  
          ("p",
           (Arg "path" (\f s -> Left (f {ifcPathRaw = splitPath' f s ifcPathRaw})) (showPath ifcPathRaw),
            "directory path (`:' sep.) for source and intermediate files", Visible)),
  
          ("parallel-sim-link",
           (Arg "jobs"
                (\f s -> case (mread s) of
                           Just j | (j > 0) -> Left (f {parallelSimLink=j})
                           _ -> Right (cmdPosition, EPositiveIntegerArgFlag "-parallel-sim-link"))
                (Just (FRTString (show . parallelSimLink))),
            "specify the # of simultaneous jobs when linking Bluesim", Visible)),
  
          ("print-flags",
           (Toggle (\f x -> f {printFlags=x}) (showIfTrue printFlags),
            "print flag values after command-line parsing", Visible)),
  
          ("print-flags-hidden",
           (Toggle (\f x -> f {printFlagsHidden=x}) (showIfTrue printFlagsHidden),
            "print all flag values after command-line parsing", Hidden)),
  
          ("print-flags-raw",
           (Toggle (\f x -> f {printFlagsRaw=x}) (showIfTrue printFlagsRaw),
            "print raw flag values after command-line parsing", Hidden)),
  
          ("promote-warnings",
           (Arg "list"
                (\f s -> let updFn f s = f {promoteWarnings = s}
                         in  addToMsgList f "-promote-warnings" s promoteWarnings updFn)
                (showMsgList promoteWarnings),
            "treat a list of warnings as errors (`:' sep list of tags)", Visible)),
  
          ("E",
           (NoArg (\f -> Left $ f {preprocessOnly=True}) (Nothing),
            "run just the preprocessor, dumping result to stdout", Visible)),
  
          ("readable-mux",
           (Toggle (\f x -> f {readableMux=x}) (showIfTrue readableMux),
            "use readable muxes in generated RTL", Hidden)),
  
          ("remove-empty-rules",
           (Toggle (\f x -> f {removeEmptyRules=x}) (showIfTrue removeEmptyRules),
            "remove rules whose bodies have no actions", Visible)),
  
          ("remove-false-rules",
           (Toggle (\f x -> f {removeFalseRules=x}) (showIfTrue removeFalseRules),
            "remove rules whose condition is provably false", Visible)),
  
          ("remove-starved-rules",
           (Toggle (\f x -> f {removeStarvedRules=x}) (showIfTrue removeStarvedRules),
            "remove rules that are never fired by the generated schedule", Visible)),
  
          ("remove-prim-modules",
           (Toggle (\f x -> f {removePrimModules=x}) (showIfTrue removePrimModules),
            "remove primitives that are local modules", Hidden)),
  
          ("inline-inout-connect",
           (Toggle (\f x -> f {removeInoutConnect=x}) (showIfTrue removeInoutConnect),
            "flatten InoutConnect module uses in the generated Verilog", Hidden)),
  
          ("inline-creg",
           (Toggle (\f x -> f {removeCReg=x}) (showIfTrue removeCReg),
            "flatten CReg* module uses in the generated Verilog", Hidden)),
  
          ("inline-reg",
           (Toggle (\f x -> f {removeReg=x}) (showIfTrue removeReg),
            "flatten Reg* module uses in the generated Verilog", Hidden)),
  
          ("inline-rwire",
           (Toggle (\f x -> f {removeRWire=x}) (showIfTrue removeRWire),
            "flatten RWire module uses in the generated Verilog", Hidden)),
  
          ("inline-cross",
           (Toggle (\f x -> f {removeCross=x}) (showIfTrue removeCross),
            "flatten NullCrossing module uses in the generated Verilog", Hidden)),
  
          ("relax-method-earliness",
           (Toggle (\f x -> f {relaxMethodEarliness=x}) (showIfTrue relaxMethodEarliness),
            "Allows rules to be scheduled before method calls", Hidden)),
  
          ("remove-unused-modules",
           (Toggle (\f x -> f {removeUnusedMods=x}) (showIfTrue removeUnusedMods),
            "remove unconnected modules from the Verilog", Visible)),
  
          ("resource-off",
           (Resource RFoff,
            "fail on insufficient resources", Visible)),
  
          ("resource-simple",
           (Resource RFsimple,
            "reschedule on insufficient resources", Visible)),
  
          ("remove-dollar",
           (Toggle (\f x -> f { removeVerilogDollar = x }) (showIfTrue removeVerilogDollar),
            "remove dollar signs from Verilog identifiers", Visible)),
  
          ("reset-prefix",
           (Arg "name" (\f s -> -- check for legal verilog name
                         if vIsValidIdent s
                            -- update both the flag and set a defined for the verilog/main.v
                         then Left f { resetName = s,
                                       defines = defines f ++ ["BSV_RESET_NAME=" ++ s] }
                         else Right (cmdPosition, EPortNotValidIdent s))
            (Just (FRTString resetName)),
            "reset name or prefix for generated modules",
            Visible)),
  
          ("rst-gate",
           (Toggle (\f x -> f {rstGate=x}) (showIfTrue rstGate),
            "gate rule fire signals with reset", Hidden)),
  
          ("rule-name-check",
           (Toggle (\f x -> f {ruleNameCheck=x}) (showIfTrue ruleNameCheck),
            "check that rule names are unique (when disabled unique numbers are assigned)", Hidden)),
  
  
          ("system-verilog-tasks",
           (Toggle (\f x -> f {systemVerilogTasks=x}) (showIfTrue systemVerilogTasks),
           "preserve SystemVerilog tasks (e.g. $error) in output code", Hidden)),
  
          ("sched-conditions",
           (Toggle (\f x -> f {schedConds=x}) (showIfTrue schedConds),
            "include method conditions when computing rule conflicts", Hidden)),
  
          ("sched-dot",
           (Toggle (\f x -> f {schedDOT=x}) (showIfTrue schedDOT),
            "generate .dot files with schedule information", Visible)),
  
          ("show-compiles",
           (Toggle (\f x -> f {showUpds=x}) (showIfTrue showUpds),
            "show recompilations", Visible)),
  
          ("show-csyntax",
           (Toggle (\f x -> f {showCSyntax = x}) (showIfTrue showCSyntax),
            "show CSyntax", Hidden)),
  
          ("show-elab-progress",
           (Toggle (\f x -> f {showElabProgress = x}) (showIfTrue showElabProgress),
            "display trace as modules, rules, methods are elaborated", Visible)),
  
          ("show-expanded-isyntax",
           (Toggle (\f x -> f {showIESyntax = x}) (showIfTrue showIESyntax),
            "show expanded ISyntax", Hidden)),
  
          ("show-isyntax",
           (Toggle (\f x -> f {showISyntax = x}) (showIfTrue showISyntax),
            "show ISyntax", Hidden)),
  
          ("show-method-bvi",
           (Toggle (\f x -> f {methodBVI=x}) (showIfTrue methodBVI),
            "show BVI format method schedule information in the generated code", Visible)),
  
          ("show-method-conf",
           (Toggle (\f x -> f {methodConf=x}) (showIfTrue methodConf),
            "show method conflict information in the generated code", Visible)),
  
          ("show-module-use",
           (Toggle (\f x -> f {showModuleUse=x}) (showIfTrue showModuleUse),
            "output instantiated Verilog modules names", Visible)),
  
          ("show-range-conflict",
           (Toggle (\f x -> f {showRangeConflict = x}) (showIfTrue showSchedule),
            "show predicates when reporting a parallel-composability error", Visible)),
  
          ("show-rule-rel",
           (Arg2 "r1" "r2" (\f s1 s2 -> Left (f {schedQueries = (s1,s2) : schedQueries f}))
               (Just (FRTListPairString schedQueries)),
            "display scheduling information about rules r1 and r2", Visible)),
  
          ("show-rule-rel-all",
           (NoArg (\f -> Left $ f { schedQueries = [("*","*")] }) (Nothing),
            "display scheduling information about all rules", Hidden)),
  
          ("show-schedule",
           (Toggle (\f x -> f {showSchedule = x}) (showIfTrue showSchedule),
            "show generated schedule", Visible)),
  
          ("show-stats",
           (Toggle (\f x -> f {showStats=x}) (showIfTrue showStats),
            "show package statistics", Visible)),
  
          ("show-timestamps",
           (Toggle (\f x -> f {timeStamps=x}) (showIfTrue timeStamps),
            "include timestamps in generated files", Visible)),
  
          ("show-version",
           (Toggle (\f x -> f {showVersion=x}) (showIfTrue showVersion),
            "include compiler version in generated files", Visible)),
  
          ("sim",
           let setFn f = case setBackend f Bluesim of
                           Left f' -> Left f' { genABin = True }
                           Right e -> Right e
               getFn f = backend f == Just Bluesim
           in  (NoArg setFn (Just getFn),
                "compile BSV generating Bluesim object", Visible)),
  
          ("simdir",
           (Arg "dir" (\f s -> Left (f {cdir = Just s})) (Just (FRTMaybeString cdir)),
            "output directory for Bluesim intermediate files", Visible)),
  
          ("sat-stp",
           (NoArg (\f -> Left $ f { satBackend = SAT_STP })
                  (showIfEq satBackend SAT_STP),
            "use STP SMT for disjoint testing and SAT", Visible)),
  
          ("sat-yices",
           (NoArg (\f -> Left $ f { satBackend = SAT_Yices })
                  (showIfEq satBackend SAT_Yices),
            "use Yices SMT for disjoint testing and SAT", Visible)),
  
          ("steps",
           (Arg "n"
               (\f s -> case (mread s) of
                            Nothing -> Right (cmdPosition, EIntegerArgFlag "-steps")
                            Just arg -> Left (f {redStepsWarnInterval = arg,
                                                 redStepsMaxIntervals = 1 }))
               (Just (FRTString (show . redSteps))),
            "terminate elaboration after this many function unfolding steps", Visible)),
  
          ("steps-warn-interval",
           (Arg "n"
               (\f s -> case (mread s) of
                            Nothing -> Right (cmdPosition, EIntegerArgFlag "-steps-warn-interval")
                            Just arg -> Left (f {redStepsWarnInterval = arg}))
               (Just (FRTString (show . redStepsWarnInterval))),
            "issue a warning each time this many unfolding steps are executed", Visible)),
  
          ("steps-max-intervals",
           (Arg "n"
               (\f s -> case (mread s) of
                            Nothing -> Right (cmdPosition, EIntegerArgFlag "-steps-max-intervals")
                            Just arg -> Left (f {redStepsMaxIntervals = arg}))
               (Just (FRTString (show . redStepsMaxIntervals))),
            "terminate elaboration after this number of unfolding messages", Visible)),
  
          ("simplify-csyntax",
           (Toggle (\f x -> f {simplifyCSyntax=x}) (showIfTrue simplifyCSyntax),
            "simplify Concrete Syntax", Hidden)),
  
          ("strict-method-scheduling",
           (Toggle (\f x -> f {strictMethodSched=x}) (showIfTrue strictMethodSched),
            "compute method relationships allowing for conditional execution", Hidden)),
  
          ("suppress-warnings",
           (Arg "list"
                (\f s -> let updFn f s = f {suppressWarnings = s}
                         in  addToMsgList f "-suppress-warnings" s suppressWarnings updFn)
                (showMsgList suppressWarnings),
            "ignore a list of warnings (`:' sep list of tags)", Visible)),
  
          ("show-all-warnings",
           (NoArg (\f -> Left (f {suppressWarnings = SomeMsgs []})) (Nothing),
            "clear the list of warnings to ignore",
            Deprecated "Use \"-suppress-warnings NONE\" instead.")),
  
          ("synthesize",
           (Toggle (\f x -> f {synthesize=x, optBitConst=x}) (showIfTrue synthesize),
            "synthesize all primitives into simple boolean ops", Hidden)),
  
          ("systemc",
           let setFn f = case setBackend f Bluesim of
                           Left f' -> Left f' { genABin = True, genSysC = True }
                           Right e -> Right e
           in  (NoArg setFn (Just genSysC),
                "generate a SystemC model", Visible)),
  
          ("tcl-show-hidden",
           (Toggle (\f x -> f {tclShowHidden=x}) (showIfTrue tclShowHidden),
            "show hidden levels of instance hierarchy in bluetcl", Hidden)),
  
          ("u",
           (Toggle (\f x -> f {updCheck=x}) (showIfTrue updCheck),
            "check and recompile packages that are not up to date", Visible)),
  
          ("unsafe-always-ready",
           (Toggle (\f x -> f {unsafeAlwaysRdy=x}) (showIfTrue unsafeAlwaysRdy),
            "downgrade always_ready errors to warnings", Hidden)),
  
          ("unspecified-to",
           (Arg "val" (\f s -> case s of
                           "0" -> Left ( f {unSpecTo = s } )
                           "1" -> Left ( f {unSpecTo = s } )
                           "X" -> Left ( f {unSpecTo = s } )
                           "x" -> Left ( f {unSpecTo = map toUpper s } )
                           "A" -> Left ( f {unSpecTo = s } )
                           "a" -> Left ( f {unSpecTo = map toUpper s } )
                           "Z" -> Left ( f {unSpecTo = s } )
                           "z" -> Left ( f {unSpecTo = map toUpper s } )
                           _   -> Right (cmdPosition, EBadArgFlag "-unspecified-to" s ["0","1","X","Z","A"]))
                (Just (FRTString (unSpecTo))),
           "remaining unspecified values are set to: 'X', '0', '1', 'Z', or 'A'", Visible)),
  
          -- This should be Toggle, but instead, -no-use-layout is a
          -- trace flag and this exists just to be seen in the help message.
          -- It will be obsoleted eventually anyway.
          ("use-layout",
           (NoArg Left Nothing,
            "use layout rule", Hidden)),
  
          ("use-dpi",
           (Toggle (\f x -> f {useDPI=x}) (showIfTrue useDPI),
            "use DPI instead of VPI in generated Verilog", Visible)),
  
          ("use-negate",
           (Toggle (\f x -> f {useNegate=x}) (showIfTrue useNegate),
            "use negate in Verilog code", Hidden)),
  
          ("use-prelude",
           (Toggle (\f x -> f {usePrelude=x}) (showIfTrue usePrelude),
            "automatically import Prelude", Hidden)),
  
          ("use-proviso-sat",
           (Toggle (\f x -> f {useProvisoSAT=x}) (showIfTrue useProvisoSAT),
            "use SAT solver to resolve numeric provisos", Hidden)),
  
          ("stdlib-names",
           (Toggle (\f x -> f {stdlibNames=x}) (showIfTrue stdlibNames),
            "the source file is from the standard library", Hidden)),
  
          ("v95",
           (Toggle (\f x -> f {v95=x}) (showIfTrue v95),
            "generate strict Verilog 95 code", Visible)),
  
          ("vdir",
           (Arg "dir" (\f s -> Left (f {vdir = Just s})) (Just (FRTMaybeString vdir)),
            "output directory for .v files", Visible)),
  
          ("verbose",
           (NoArg (Left . moreTalkative) (Just verbose),
            "be more talkative", Visible)),
          ("v",
           (Alias "verbose", "same as -verbose", Visible)),
  
          ("quiet",
           (NoArg (Left . lessTalkative) (Just quiet),
            "be less talkative", Visible)),
          ("q",
           (Alias "quiet", "same as -quiet", Visible)),
  
          ("verilog",
           let setFn f = setBackend f Verilog
               getFn f = backend f == Just Verilog
           in  (NoArg setFn (Just getFn),
                "compile BSV generating Verilog file", Visible)),
  
          ("verilog-filter",
           (Arg "cmd" (\f s -> Left (f {verilogFilter = s:verilogFilter f}))
                (Just (FRTListString (reverse . verilogFilter))),
                "invoke a command to post-process the generated Verilog", Visible)),
  
          ("vsearch",
           (Arg "path" (\f s -> Left (f {vPathRaw = splitPath' f s vPathRaw})) (showPath vPathRaw),
            "search path (`:' sep.) for Verilog files", Visible)),
  
          ("vsim",
           let setFn f s = case setBackend f Verilog of
                             Left f' -> Left $ f' {vsim = Just s}
                             Right e -> Right e
               getFn = FRTMaybeString vsim
           in  (Arg "simulator" setFn (Just getFn),
                "specify which Verilog simulator to use", Visible)),
  
          ("verilog-declare-first",
           (Toggle (\f x -> f {verilogDeclareAllFirst=x}) (showIfTrue verilogDeclareAllFirst),
           "in generated Verilog, declare all signals first", Hidden)),
  
          ("vpp",
           (Toggle (\f x -> f {vpp=x}) (showIfTrue vpp),
            "preprocess the source with the SystemVerilog preprocessor", Hidden)),
  
          ("warn-action-shadowing",
           (Toggle (\f x -> f {warnActionShadowing=x}) (showIfTrue warnActionShadowing),
            "warn when a rule's action is overwritten by a later rule", Visible)),
  
          ("warn-method-urgency",
           (Toggle (\f x -> f {warnMethodUrgency=x}) (showIfTrue warnMethodUrgency),
            "warn when a method's urgency is arbitrarily chosen", Visible)),
  
          ("warn-undet-predicate",
           (Toggle (\f x -> f {warnUndetPred=x}) (showIfTrue warnUndetPred),
            "warn when a rule or method predicate has an undetermined value", Hidden)),
  
          ("Werror",
           (NoArg
              (\f -> let updFn f s = f {promoteWarnings = s}
                     in  addToMsgList f "-promote-warnings" "ALL" promoteWarnings updFn)
              Nothing,
            "make warnings to errors",
            Deprecated "Use \"-promote-warnings ALL\" instead.")),
  
          ("Xc",
           (PassThrough "arg" (\f s -> Left (f {cFlags = cFlags f ++ [s]})) (Just (FRTListString cFlags)),
            "pass argument to the C compiler", Visible)),
  
          ("Xc++",
           (PassThrough "arg" (\f s -> Left (f {cxxFlags = cxxFlags f ++ [s]})) (Just (FRTListString cxxFlags)),
            "pass argument to the C++ compiler", Visible)),
  
          ("Xcpp",
           (PassThrough "arg"
                        (\f s -> Left (f {cppFlags = cppFlags f ++ [s]}))
                        (Just (FRTListString cppFlags)),
            "pass argument to the C preprocessor", Visible)),
  
          ("Xl",
           (PassThrough "arg" (\f s -> Left (f {linkFlags = linkFlags f ++ [s]})) (Just (FRTListString linkFlags)),
            "pass argument to the C/C++ linker", Visible)),
  
          ("Xv",
           (PassThrough "arg" (\f s -> Left (f {vFlags = vFlags f ++ [s]})) (Just (FRTListString vFlags)),
            "pass argument to the Verilog link process", Visible))
          ]
  
  -- -------------------------
  -- Support for -print-flags
  
  showFlagsLst :: Flags -> [[String]]
  showFlagsLst flags =
      let showHidden = printFlagsHidden flags
          -- filter out the hidden if necessary
          flagsToBeShown = [ (f,ft) | (f,(ft,_,isHidden)) <- externalFlags,
                                      showHidden || (Visible == isHidden)]
          pprintedFlags = map (showFlag False flags) flagsToBeShown
      in (sort) pprintedFlags
  
  showFlagsAllLst :: Flags -> [[String]]
  showFlagsAllLst flags =
      let -- everything but deprecated
          flagsToBeShown = [ (f,ft) | (f,(ft,_,he)) <- externalFlags,
                                      he == Visible || he == Hidden]
          pprintedFlags = map (showFlag True flags) flagsToBeShown
      in sort pprintedFlags
  
  showFlags :: Flags -> String
  showFlags flags =
      let  pprintedFlags :: [[String]]
           pprintedFlags = filter ((/=) [] ) $ showFlagsLst flags
           showFlagStr :: [String] -> String
           showFlagStr ss = "     " ++ unwords (intersperse " " ss)
      in  unlines ("Flags:" : map showFlagStr pprintedFlags)
  
  showFlag :: Bool -> Flags -> (String, FlagType) -> [String]
  showFlag False flags (f, (Toggle _ (Just showf))) =
      case (showf flags) of
        (True,_)      -> [('-':f)]
        (False,True)  -> ["-no-" ++ f]
        (False,False) -> []
  showFlag True flags (f, (Toggle _ (Just showf))) =
      case (showf flags) of
        (True,_)      -> [('-':f)]
        (False,True)  -> ["-no-" ++ f]
        (False,False) -> ["-no-" ++ f]
  
  showFlag _ flags (f, (NoArg _ (Just showf))) =
      if (showf flags) then [('-':f)] else []
  showFlag _ flags (f, (Arg _ _ (Just rt))) = showFlagArg flags f rt
  showFlag _ flags (f, (Arg2 _ _ _ (Just (FRTListPairString showf)))) =
      map (\(a,b) -> ('-':f) ++ " " ++ a ++ " " ++ b) (showf flags)
  showFlag _ flags (f, (Resource sf)) =
      if (resource flags) == sf then [('-':f)] else []
  showFlag _ flags (f, (PassThrough _ _ (Just rt))) = showFlagArg flags f rt
  showFlag _ flags _ = []
  
  -- create the show string for one-arg flags which have a show function
  showFlagArg :: Flags -> String -> ArgReturnType -> [String]
  showFlagArg flags f (FRTString showf) =
      [('-':f), showf flags]
  showFlagArg flags f (FRTMaybeString showf) =
      case (showf flags) of
          Just arg -> [('-':f), arg]
          Nothing -> []
  showFlagArg flags f (FRTListString showf) =
    concatMap (\x -> ['-':f, x]) (showf flags)
  
  -- -------------------------
  -- Support for -print-flags-raw
  
  -- This shows the raw flags, rather than showing them in terms of the
  -- externally visible flags.  Use showFlags to display the flags in
  -- user-understandable terms.
  showFlagsRaw :: Flags -> String
  showFlagsRaw flags =
      let render (k, v) = "\t" ++ k ++ " = " ++ v
          fields =
           [("aggImpConds", show (aggImpConds flags)),
            ("allowIncoherentMatches", show (allowIncoherentMatches flags)),
            ("backend", show (backend flags)),
            ("bdir", show (bdir flags)),
            ("biasMethodScheduling", show (biasMethodScheduling flags)),
            ("bluespecDir", show (bluespecDir flags)),
            ("cDebug", show (cDebug flags)),
            ("cFlags", show (cFlags flags)),
            ("cIncPath", show (cIncPath flags)),
            ("cLibPath", show (cLibPath flags)),
            ("cLibs", show (cLibs flags)),
            ("cdir", show (cdir flags)),
            ("cpp", show (cpp flags)),
            ("cppFlags", show (cppFlags flags)),
            ("crossInfo", show (crossInfo flags)),
            ("cxxFlags", show (cxxFlags flags)),
            ("defines", show (defines flags)),
            ("demoteErrors", show (demoteErrors flags)),
            ("disableAssertions", show (disableAssertions flags)),
            ("doICheck", show (doICheck flags)),
            ("dumpAll", show (dumpAll flags)),
            ("dumps", show (dumps flags)),
            ("enablePoisonPills", show (enablePoisonPills flags)),
            ("entry", show (entry flags)),
            ("expandATSlimit", show (expandATSlimit flags)),
            ("expandIf", show (expandIf flags)),
            ("extraVerbose", show (extraVerbose flags)),
            ("fdir", show (fdir flags)),
            ("finalcleanup", show (finalcleanup flags)),
            ("genABin", show (genABin flags)),
            ("genABinVerilog", show (genABinVerilog flags)),
            ("genName", show (genName flags)),
            ("genSysC", show (genSysC flags)),
            ("ifLift", show (ifLift flags)),
            ("ifcPath", show (ifcPath flags)),
            ("ifcPathRaw", show (ifcPathRaw flags)),
            ("infoDir", show (infoDir flags)),
            ("inlineBool", show (inlineBool flags)),
            ("inlineISyntax", show (inlineISyntax flags)),
            ("inlineSimple", show (inlineSimple flags)),
            ("keepAddSize", show (keepAddSize flags)),
            ("keepFires", show (keepFires flags)),
            ("keepInlined", show (keepInlined flags)),
            ("kill", show (kill flags)),
            ("linkFlags", show (linkFlags flags)),
            ("maxTIStackDepth", show (maxTIStackDepth flags)),
            ("methodBVI", show (methodBVI flags)),
            ("methodConditions", show (methodConditions flags)),
            ("methodConf", show (methodConf flags)),
            ("neatNames", show (neatNames flags)),
            ("oFile", show (oFile flags)),
            ("optATS", show (optATS flags)),
            ("optAggInline", show (optAggInline flags)),
            ("optAndOr", show (optAndOr flags)),
            ("optBitConst", show (optBitConst flags)),
            ("optBool", show (optBool flags)),
            ("optFinalPass", show (optFinalPass flags)),
            ("optIfMux", show (optIfMux flags)),
            ("optIfMuxSize", show (optIfMuxSize flags)),
            ("optJoinDefs", show (optJoinDefs flags)),
            ("optMux", show (optMux flags)),
            ("optMuxConst", show (optMuxConst flags)),
            ("optMuxExpand", show (optMuxExpand flags)),
            ("optSched", show (optSched flags)),
            ("optUndet", show (optUndet flags)),
            ("parallelSimLink", show (parallelSimLink flags)),
            ("passThroughAssertions", show (passThroughAssertions flags)),
            ("preprocessOnly", show (preprocessOnly flags)),
            ("printFlags", show (printFlags flags)),
            ("printFlagsHidden", show (printFlagsHidden flags)),
            ("printFlagsRaw", show (printFlagsRaw flags)),
            ("promoteWarnings", show (promoteWarnings flags)),
            ("readableMux", show (readableMux flags)),
            ("redStepsMaxIntervals", show (redStepsMaxIntervals flags)),
            ("redStepsWarnInterval", show (redStepsWarnInterval flags)),
            ("relaxMethodEarliness", show (relaxMethodEarliness flags)),
            ("removeCReg", show (removeCReg flags)),
            ("removeCross", show (removeCross flags)),
            ("removeEmptyRules", show (removeEmptyRules flags)),
            ("removeFalseRules", show (removeFalseRules flags)),
            ("removeInoutConnect", show (removeInoutConnect flags)),
            ("removePrimModules", show (removePrimModules flags)),
            ("removeRWire", show (removeRWire flags)),
            ("removeReg", show (removeReg flags)),
            ("removeStarvedRules", show (removeStarvedRules flags)),
            ("removeUnusedMods", show (removeUnusedMods flags)),
            ("removeVerilogDollar", show (removeVerilogDollar flags)),
            ("resetName", show (resetName flags)),
            ("resource", show (resource flags)),
            ("rstGate", show (rstGate flags)),
            ("ruleNameCheck", show (ruleNameCheck flags)),
            ("satBackend", show (satBackend flags)),
            ("schedConds", show (schedConds flags)),
            ("schedDOT", show (schedDOT flags)),
            ("schedQueries", show (schedQueries flags)),
            ("showCSyntax", show (showCSyntax flags)),
            ("showCodeGen", show (showCodeGen flags)),
            ("showElabProgress", show (showElabProgress flags)),
            ("showIESyntax", show (showIESyntax flags)),
            ("showISyntax", show (showISyntax flags)),
            ("showModuleUse", show (showModuleUse flags)),
            ("showRangeConflict", show (showRangeConflict flags)),
            ("showSchedule", show (showSchedule flags)),
            ("showStats", show (showStats flags)),
            ("showUpds", show (showUpds flags)),
            ("showVersion", show (showVersion flags)),
            ("simplifyCSyntax", show (simplifyCSyntax flags)),
            ("strictMethodSched", show (strictMethodSched flags)),
            ("suppressWarnings", show (suppressWarnings flags)),
            ("synthesize", show (synthesize flags)),
            ("systemVerilogTasks", show (systemVerilogTasks flags)),
            ("tclShowHidden", show (tclShowHidden flags)),
            ("testAssert", show (testAssert flags)),
            ("timeStamps", show (timeStamps flags)),
            ("unsafeAlwaysRdy", show (unsafeAlwaysRdy flags)),
            ("unSpecTo", show (unSpecTo flags)),
            ("updCheck", show (updCheck flags)),
            ("useDPI", show (useDPI flags)),
            ("useNegate", show (useNegate flags)),
            ("usePrelude", show (usePrelude flags)),
            ("useProvisoSAT", show (useProvisoSAT flags)),
            ("v95", show (v95 flags)),
            ("vFlags", show (vFlags flags)),
            ("vPath", show (vPath flags)),
            ("vPathRaw", show (vPathRaw flags)),
            ("vdir", show (vdir flags)),
            ("verbose", show (verbose flags)),
            ("verilogDeclareAllFirst", show (verilogDeclareAllFirst flags)),
            ("verilogFilter", show (verilogFilter flags)),
            ("vpp", show (vpp flags)),
            ("vsim", show (vsim flags)),
            ("warnActionShadowing", show (warnActionShadowing flags)),
            ("warnMethodUrgency", show (warnMethodUrgency flags)),
            ("warnUndetPred", show (warnUndetPred flags))
           ]
          in "Flags {\n" ++
                 (intercalate ",\n" (map render fields)) ++
             "\n}"
  
  -- -------------------------
  -- Support for querying the flags in bluetcl
  
  getFlagValueString :: Flags -> String -> IO [String]
  getFlagValueString flags key = do
    case (lookup key flagsTable) of
      Nothing -> ioError $ userError ("Unknown flag \"" ++ key ++ "\" when looking up it value" )
      Just ft -> return $ flagTypeToString flags key ft
  
  -- This is similar to showFlag, but it is more verbose -no options are shown
  flagTypeToString :: Flags -> String -> FlagType -> [String]
  flagTypeToString flags key (Toggle _ Nothing)  = []
  flagTypeToString flags key (Toggle _ (Just f)) =
    [if (fst (f flags)) then ("-" ++ key) else ("-no-" ++ key)]
  flagTypeToString flags key ft = showFlag False flags (key,ft)
  
  
  -- -------------------------
  -- Path Utilities
  -- (colon-separated list with special symbols % and +)
  
  makePath :: String -> [String]
  makePath = splitWhen (==':')
  
  unPath :: [String] -> String
  unPath path =
      let convToken s = if (s == defaultPathToken) then "+" else s
      in intercalate ":" (map convToken path)
  
  splitPath :: String -> [String] -> String -> [String]
  splitPath bspecdir old_path s =
      let -- break on colons
          paths0 = makePath s
          -- expand symbols, and remove empty dirs
          paths = let expandPercent c = if (c == '%') then bspecdir else [c]
                      expandDir "+" = old_path
                      expandDir ""  = []
                      expandDir d   = [concatMap expandPercent d]
                  in  concatMap expandDir paths0
      in
          paths
  
  splitPath' :: Flags -> String -> (Flags -> [String]) -> [String]
  splitPath' f s m = splitPath (bluespecDir f) (m f) s
  
  replacePathToken :: String -> [String] -> [String] -> [String]
  replacePathToken tok xs new = concatMap (helper new tok) xs
    where helper ys x x' | x == x'   = ys
                         | otherwise = [x']
  
  -- -------------------------
  -- Colon-separated List of error message tags,
  -- allowing NONE and ALL as possible values
  
  makeMsgList :: String -> [String]
  makeMsgList = splitWhen (==':')
  
  unMsgList :: [String] -> String
  unMsgList = intercalate ":"
  
  checkMsgList :: String -> [String] -> Either EMsg [String]
  checkMsgList flag_name tags =
      let
          checkOneTag :: String -> Maybe String
          checkOneTag (ty:num@[_,_,_,_])
              | isAlpha ty && all isDigit num = Just ((toUpper ty):num)
          checkOneTag _ = Nothing
  
          mkErr badtag = (cmdPosition, EMsgListArgFlag flag_name badtag)
  
          -- XXX This only reports one invalid string (first from the end)
          foldfn tag res@(Left _) = res
          foldfn tag (Right acc) = case (checkOneTag tag) of
                                     Nothing -> Left (mkErr tag)
                                     Just tag' -> Right (tag':acc)
      in
          foldr foldfn (Right []) tags
  
  addToMsgList :: Flags -> String -> String -> (Flags -> MsgListFlag) ->
                  (Flags -> MsgListFlag -> Flags) -> Either Flags EMsg
  addToMsgList flags flag_name arg_str flagFn updFn =
      case arg_str of
        "ALL" -> Left $ updFn flags (AllMsgs)
        "NONE" -> Left $ updFn flags (SomeMsgs [])
        _ -> let -- divide into separate strings, remove empty
                 new_list0 = makeMsgList arg_str
             in  case (checkMsgList flag_name new_list0) of
                   Left errs -> Right errs
                   Right new_list ->
                       let res_list =
                               case (flagFn flags) of
                                 AllMsgs -> AllMsgs
                                 SomeMsgs cur_list ->
                                     -- put it together and remove duplicates
                                     SomeMsgs $ nub (cur_list ++ new_list)
                       in  Left $ updFn flags res_list
  
  -- -------------------------
  -- Other Utilities
  
  mread :: Read a => String -> Maybe a
  mread s =
      case reads s of
      [(x, "")] -> Just x
      _ -> Nothing
  
  setBackend :: Flags -> Backend -> Either Flags EMsg
  setBackend flags new_be =
      case backend flags of
        Just old_be | old_be /= new_be
          -> Right (cmdPosition, ETooManyBackends)
        _ -> Left $ flags { backend = Just new_be }
  
  -- -------------------------
  