{-# LANGUAGE BangPatterns, CPP #-}
module Main_bsc(main, hmain) where

-- Haskell libs
import Prelude
import System.Environment(getArgs, getProgName)
import System.Process(runInteractiveProcess, waitForProcess)
import System.Process(system)
import System.Exit(ExitCode(ExitFailure, ExitSuccess))
import System.IO(hFlush, stdout, hPutStr, stderr, hGetContents, hClose, hSetBuffering, BufferMode(LineBuffering))
import System.IO(hSetEncoding, latin1)
import System.Posix.Files(fileMode,  unionFileModes, ownerExecuteMode, groupExecuteMode, setFileMode, getFileStatus, fileAccess)
import System.Directory(getDirectoryContents, doesFileExist, getCurrentDirectory)
import System.Time(getClockTime, ClockTime(TOD)) -- XXX: from old-time package
import Data.Char(isSpace, toLower, ord)
import Data.List(intersect, nub, partition, intersperse, sort,
            isPrefixOf, isSuffixOf, unzip5, intercalate)
import Data.Time.Clock.POSIX(getPOSIXTime)
import Data.Maybe(isJust, isNothing {-, fromMaybe-})
import Numeric(showOct)

import Control.Monad(when, unless, filterM, liftM, foldM)
import ErrorTCompat(runErrorT)
import Control.Concurrent(forkIO)
import Control.Concurrent.MVar(newEmptyMVar, putMVar, takeMVar)
import qualified Control.Exception as CE
import qualified Data.Map as M

import ListMap(lookupWithDefault)
import SCC(scc)

-- utility libs
import ParseOp
import PFPrint
import Util(headOrErr, fromJustOrErr, joinByFst, quote)
import FileNameUtil(baseName, hasDotSuf, dropSuf, dirName, mangleFileName,
                    mkAName, mkVName, mkVPICName, mkVPIArrayCName,
                    mkNameWithoutSuffix,
                    mkSoName, mkObjName, mkMakeName,
                    bscSrcSuffix, bseSrcSuffix, binSuffix,
                    hSuffix, cSuffix, cxxSuffix, cppSuffix, ccSuffix,
                    objSuffix, useSuffix,
                    genFileName, createEncodedFullFilePath,
                    getFullFilePath, getRelativeFilePath)
import FileIOUtil(writeFileCatch, readFileMaybe, removeFileCatch)
import TopUtils
import SystemCheck(doSystemCheck)
import BuildSystem
import IOUtil(getEnvDef)

-- compiler libs
--import FStringCompat
import Exceptions(bsCatch)
import Flags(
        Flags(..),
        DumpFlag(..),
        hasDump,
        verbose, extraVerbose, quiet)
import FlagsDecode(
        Decoded(..),
        decodeArgs,
        updateFlags,
        showFlags,
        showFlagsRaw,
        exitWithUsage,
        exitWithHelp,
        exitWithHelpHidden)
import Error(internalError, ErrMsg(..),
             ErrorHandle, initErrorHandle, setErrorHandleFlags,
             bsError, bsWarning, bsMessage,
             exitFail, exitOK, exitFailWith)
import Position(noPosition, cmdPosition)
import CVPrint
import Id
import Backend
import Pragma
import VModInfo(VPathInfo, VPort)
import Deriving(derive)
import SymTab
import MakeSymTab(mkSymTab, cConvInst)
import TypeCheck(cCtxReduceIO, cTypeCheck)
import PoisonUtils(mkPoisonedCDefn)
import GenSign(genUserSign, genEverythingSign)
import Simplify(simplify)
import ISyntax(IPackage(..), IModule(..),
               IEFace(..), IDef(..), IExpr(..), fdVars)
import ISyntaxUtil(iMkRealBool, iMkLitSize, iMkString{-, itSplit -}, isTrue)
import InstNodes(getIStateLocs, flattenInstTree)
import IConv(iConvPackage, iConvDef)
import FixupDefs(fixupDefs, updDef)
import ISyntaxCheck(tCheckIPackage, tCheckIModule)
import ISimplify(iSimplify)
import BinUtil(BinMap, HashMap, readImports, replaceImports)
import GenBin(genBinFile)
import GenWrap(genWrap, WrapInfo(..))
import GenFuncWrap(genFuncWrap, addFuncWrap)
import GenForeign(genForeign)
import IExpand(iExpand)
import IExpandUtils(HeapData)
import ITransform(iTransform)
import IInline(iInline)
import IInlineFmt(iInlineFmt)
import Params(iParams)
import ASyntax(APackage(..), ASPackage(..),
               ppeAPackage,
               getAPackageFieldInfos)
import ASyntaxUtil(getForeignCallNames)
import ACheck(aMCheck, aSMCheck, aSignalCheck, aSMethCheck)
import AConv(aConv)
import IDropRules(iDropRules)
import ARankMethCalls(aRankMethCalls)
import AState(aState)
import ARenameIO(aRenameIO)
import ASchedule(AScheduleInfo(..), AScheduleErrInfo(..), aSchedule)
import AAddScheduleDefs(aAddScheduleDefs)
import APaths(aPathsPreSched, aPathsPostSched)
import AProofs(aCheckProofs)
import ADropDefs(aDropDefs)
import AOpt(aOpt)
import AVerilog(aVerilog)
import AVeriQuirks(aVeriQuirks)
import VIOProps(VIOProps, getIOProps)
import VFinalCleanup(finalCleanup)
import Synthesize(aSynthesize)
import ABin(ABin(..), ABinModInfo(..), ABinForeignFuncInfo(..),
           ABinModSchedErrInfo(..))
import ABinUtil(readAndCheckABin, readAndCheckABinPathCatch, getABIHierarchy,
                assertNoSchedErr)
import GenABin(genABinFile)
import ForeignFunctions(ForeignFunction(..), ForeignFuncMap,
                        mkImportDeclarations)
import VPIWrappers(genVPIWrappers, genVPIRegistrationArray)
import DPIWrappers(genDPIWrappers)
import SimCCBlock
import SimExpand(simExpand, simCheckPackage)
import SimPackage(SimSystem(..))
import SimPackageOpt(simPackageOpt)
import SimMakeCBlocks(simMakeCBlocks)
import SimCOpt(simCOpt)
import SimBlocksToC(simBlocksToC)
import SystemCWrapper(checkSystemCIfc, wrapSystemC)
import SimFileUtils(analyzeBluesimDependencies)
import Verilog(VProgram(..), vGetMainModName, getVeriInsts)
import Depend
import Version(bscVersionStr, copyright, buildnum)
import Classic
import ILift(iLift)
import ACleanup(aCleanup)
import ATaskSplice(aTaskSplice)
import ADumpSchedule (MethodDumpInfo, aDumpSchedule, aDumpScheduleErr,
                      dumpMethodInfo, dumpMethodBVIInfo)
import ANoInline (aNoInline)
import AAddSchedAssumps(aAddSchedAssumps,aAddCFConditionWires)
import ARemoveAssumps(aRemoveAssumps)
import ADropUndet(aDropUndet)
import SAT(checkSATFlags)
import InlineWires(aInlineWires)
import InlineCReg(aInlineCReg)
import LambdaCalc(convAPackageToLambdaCalc)
import SAL(convAPackageToSAL)

import VVerilogDollar
import ISplitIf(iSplitIf)
import VFileName

--import Debug.Trace

main :: IO ()
main = do
    hSetBuffering stdout LineBuffering
    hSetBuffering stderr LineBuffering
    hSetEncoding stdout latin1
    hSetEncoding stderr latin1
    args <- getArgs
    -- bsc can raise exception,  catch them here  print the message and exit out.
    bsCatch (hmain args)

-- Use with hugs top level
hmain :: [String] -> IO ()
hmain args = do
    pprog <- getProgName
    cdir <- getEnvDef "BLUESPECDIR" dfltBluespecDir
    bscopts <- getEnvDef "BSC_OPTIONS" ""
    let args' = words bscopts ++ args
    -- reconstruct original command line (modulo whitespace)
    -- add a newline at the end so it is offset
    let cmdLine = concat ("Invoking command line:\n" : (intersperse " " (pprog:args'))) ++ "\n"
    let showPreamble flags = do
          when (verbose flags) $ putStrLnF (bscVersionStr True)
          when (verbose flags) $ putStrLnF copyright
          when ((verbose flags) || (printFlags flags)) $ putStrLnF cmdLine
          when ((printFlags flags) || (printFlagsHidden flags)) $
                putStrLnF (showFlags flags)
          when (printFlagsRaw flags) $ putStrLnF (showFlagsRaw flags)
    let (warnings, decoded) = decodeArgs (baseName pprog) args' cdir
    errh <- initErrorHandle
    let doWarnings = when ((not . null) warnings) $ bsWarning errh warnings
        setFlags = setErrorHandleFlags errh
    case decoded of
        DHelp flags ->
            do { setFlags flags; doWarnings;
                 exitWithHelp errh pprog args' cdir }
        DHelpHidden flags ->
            do { setFlags flags; doWarnings;
                 exitWithHelpHidden errh pprog args' cdir }
        DUsage -> exitWithUsage errh pprog
        DError msgs -> bsError errh msgs
        DNoSrc flags ->
            -- XXX we want to allow "bsc -v" and similar calls
            -- XXX to print version, etc, but if there are other flags
            -- XXX on the command-line we probably should report an error
            do { setFlags flags; doWarnings; showPreamble flags;
                 exitOK errh }
        DBlueSrc flags src ->
            do { setFlags flags; doWarnings; showPreamble flags;
                 main' errh flags src;
                 exitOK errh }
        DVerLink flags top verSrcFiles abinFiles cSrcFiles ->
            do { setFlags flags; doWarnings; showPreamble flags;
                 vLink errh flags top verSrcFiles abinFiles cSrcFiles;
                 exitOK errh }
        DSimLink flags top abinFiles cSrcFiles ->
            do { setFlags flags; doWarnings; showPreamble flags;
                 simLink errh flags top abinFiles cSrcFiles;
                 exitOK errh }


main' :: ErrorHandle -> Flags -> String -> IO ()
main' errh flags name =  do
    tStart <- getNow

    flags' <- checkSATFlags errh flags

    -- check system requirements
    doSystemCheck errh

    let comp = if updCheck flags'
               then compile_with_deps
               else compile_no_deps

    success <- comp errh flags' name

    -- final verbose message
    _ <- timestampStr flags' "total" tStart

    if success then
      return ()
     else
       exitFail errh

compile_with_deps :: ErrorHandle -> Flags -> String -> IO (Bool)
compile_with_deps errh flags name = do
    let
        verb = showUpds flags && not (quiet flags)
        -- the flags to "compileFile" when re-compiling depended modules
        flags_depend = flags { updCheck = False,
                               genName = [],
                               showCodeGen = verb }
        -- the flags to "compileFile" when re-compiling this module
        flags_this = flags_depend { genName = genName flags }
        comp (success, binmap0, hashmap0) fn = do
            when (verb) $ putStrLnF ("compiling " ++ fn)
            let fl = if (fn == name)
                     then flags_this
                     else flags_depend
            (cur_success, binmap, hashmap)
                <- compileFile errh fl binmap0 hashmap0 fn
            return (cur_success && success, binmap, hashmap)
    when (verb) $ putStrLnF "checking package dependencies"

    t <- getNow
    let dumpnames = (baseName (dropSuf name), "", "")

    -- get the list of depended files which need recompiling
    start flags DFdepend
    fs <- chkDeps errh flags name
    _ <- dump errh flags t DFdepend dumpnames fs

    -- compile them
    (ok, _, _) <- foldM comp (True, M.empty, M.empty) fs

    when (verb) $
      if ok then
          putStrLnF "All packages are up to date."
      else putStrLnF "All packages compiled (some with errors)."

    return ok

compile_no_deps :: ErrorHandle -> Flags -> String -> IO (Bool)
compile_no_deps errh flags name = do
  (ok, _, _) <- compileFile errh flags M.empty M.empty name
  return ok

-- returns whether the compile errored or not
compileFile :: ErrorHandle -> Flags -> BinMap HeapData -> HashMap -> String ->
               IO (Bool, BinMap HeapData, HashMap)
compileFile errh flags binmap hashmap name_orig = do
    pwd <- getCurrentDirectory
    let name = (createEncodedFullFilePath name_orig pwd)
        name_rel = (getRelativeFilePath name)

    let syntax = (if      hasDotSuf bscSrcSuffix name then CLASSIC
                  else if hasDotSuf bseSrcSuffix name then ESE
                  else BSV)
    setSyntax syntax

    t <- getNow
    let dumpnames = (baseName (dropSuf name), "", "")

    start flags DFcpp
    file <- doCPP errh flags name
    _ <- dumpStr errh flags t DFcpp dumpnames file

    -- ===== the break point between file manipulation and compilation

    -- We don't start and dump this stage because that is handled inside
    -- the "parseSrc" function (since BSV parsing has multiple stages)
    (pkg@(CPackage i _ _ _ _ _), t)
        <- parseSrc (syntax == CLASSIC) errh flags True name file
    when (getIdString i /= baseName (dropSuf name)) $
         bsWarning errh
             [(noPosition, WFilePackageNameMismatch name_rel (pfpString i))]

    -- dump CSyntax
    when (showCSyntax flags) (putStrLnF (show pkg))
    -- dump stats
    stats flags DFparsed pkg

    let dumpnames = (baseName (dropSuf name), getIdString (unQualId i), "")
    compilePackage errh flags dumpnames t binmap hashmap name pkg

-------------------------------------------------------------------------

compilePackage ::
    ErrorHandle ->
    Flags ->
    DumpNames ->
    TimeInfo ->
    BinMap HeapData ->
    HashMap ->
    String ->
    CPackage ->
    IO (Bool, BinMap HeapData, HashMap)
compilePackage
    errh
    flags                -- user switches
    dumpnames
    tStart
    binmap0
    hashmap0
    name -- String --
    min@(CPackage pkgId _ _ _ _ _) = do

    clkTime <- getClockTime
    epochTime <- getPOSIXTime

    -- Values needed for the Environment module
    let env =
            [("compilerVersion",iMkString $ bscVersionStr True),
             ("date",                iMkString $ show clkTime),
             ("epochTime",      iMkLitSize 32 $ floor epochTime),
             ("buildVersion",   iMkLitSize 32 $ buildnum),
             ("genPackageName", iMkString $ getIdBaseString pkgId),
             ("testAssert",        iMkRealBool $ testAssert flags)
            ]

    start flags DFimports
    -- Read imported signatures
    (mimp@(CPackage _ _ imps _ _ _), binmap, hashmap)
        <- readImports errh flags binmap0 hashmap0 min
    when (hasDump flags DFimports) $
      let imps' = [ppReadable s |  (CImpSign _ _ s) <- imps]
      in mapM_ (putStr) imps'
         --mapM_ (\ (CImpSign _ _ s) -> putStr (ppReadable s)) imps
    t <- dump errh flags tStart DFimports dumpnames mimp

    start flags DFopparse
    mop <- parseOps errh mimp
    t <- dump errh flags t DFopparse dumpnames mop

    -- Generate a global symbol table
    --
    -- Later stages will introduce new symbols that will need to be added
    -- to the symbol table.  Rather than worry about properly inserting
    -- the new symbols, we just build the symbol table fresh each time.
    -- So this is the first of several times that the table is built.
    -- We can't delay the building of the table until after all symbols
    -- are known, because these next stages need a table of the current
    -- symbols.
    --
    start flags DFsyminitial
    symt00 <- mkSymTab errh mop
    t <- dump errh flags t DFsyminitial dumpnames symt00

    -- whether we are doing code generation for modules
    let generating = backend flags /= Nothing

    -- Turn `noinline' into module definitions
    start flags DFgenfuncwrap
    (mfwrp, symt0, funcs) <- genFuncWrap errh flags generating mop symt00
    t <- dump errh flags t DFgenfuncwrap dumpnames mfwrp

    -- Generate wrapper for Verilog interface.
    start flags DFgenwrap
    (mwrp, gens) <- genWrap errh flags (genName flags) generating mfwrp symt0
    t <- dump errh flags t DFgenwrap dumpnames mwrp

    -- Rebuild the symbol table because GenWrap added new types
    -- and typeclass instances for those types
    start flags DFsympostgenwrap
    symt1 <- mkSymTab errh mwrp
    t <- dump errh flags t DFsympostgenwrap dumpnames symt1

    -- Re-add function definitions for `noinline'
    mfawrp <- addFuncWrap errh symt1 funcs mwrp

    -- Turn deriving into instance declarations
    start flags DFderiving
    mder <- derive errh flags symt1 mfawrp
    t <- dump errh flags t DFderiving dumpnames mder

    -- Rebuild the symbol table because Deriving added new instances
    start flags DFsympostderiving
    symt11 <- mkSymTab errh mder
    t <- dump errh flags t DFsympostderiving dumpnames symt11

    -- Reduce the contexts as far as possible
    start flags DFctxreduce
    mctx <- cCtxReduceIO errh flags symt11 mder
    t <- dump errh flags t DFctxreduce dumpnames mctx

    -- Rebuild the symbol table because CtxReduce has possibly changed
    -- the types of top-level definitions
    start flags DFsympostctxreduce
    symt <- mkSymTab errh mctx
    t <- dump errh flags t DFsympostctxreduce dumpnames symt

    -- Turn instance declarations into ordinary definitions
    start flags DFconvinst
    let minst = cConvInst errh symt mctx
    t <- dump errh flags t DFconvinst dumpnames minst

    -- Type check and insert dictionaries
    start flags DFtypecheck
    (mod, tcErrors) <- cTypeCheck errh flags symt minst
    --putStr (ppReadable mod)
    t <- dump errh flags t DFtypecheck dumpnames mod

    --when (early flags) $ return ()
    let prefix = dirName name ++ "/"

    -- Generate wrapper info for foreign function imports
    -- (this always happens, even when not generating for modules)
    start flags DFgenforeign
    foreign_func_info <- genForeign errh flags prefix mod
    t <- dump errh flags t DFgenforeign dumpnames foreign_func_info

    -- Generate VPI wrappers for foreign function imports
    start flags DFgenVPI
    blurb <- mkGenFileHeader flags
    let ffuncs = map snd foreign_func_info
    vpi_wrappers <- if (backend flags /= Just Verilog)
                    then return []
                    else if (useDPI flags)
                         then genDPIWrappers errh flags "./" blurb ffuncs
                         else genVPIWrappers errh flags "./" blurb ffuncs
    t <- dump errh flags t DFgenVPI dumpnames vpi_wrappers

    -- Simplify a little
    start flags DFsimplified
    let mod' = simplify flags mod
    t <- dump errh flags t DFsimplified dumpnames mod'
    stats flags DFsimplified mod'

    --------------------------------------------
    -- Convert to internal abstract syntax
    --------------------------------------------
    start flags DFinternal
    imod <- iConvPackage errh flags symt mod'
    t <- dump errh flags t DFinternal dumpnames imod
    when (showISyntax flags) (putStrLnF (show imod))
    iPCheck flags symt imod "internal"
    stats flags DFinternal imod

    -- Read binary interface files
    start flags DFbinary
    let (_, _, impsigs, binmods0, pkgsigs) =
            let findFn i = fromJustOrErr "bsc: binmap" $ M.lookup i binmap
                sorted_ps = [ getIdString i
                               | CImpSign _ _ (CSignature i _ _ _) <- imps ]
            in  unzip5 $ map findFn sorted_ps

    -- injects the "magic" variables genC and genVerilog
    -- should probably be done via primitives
    -- XXX does this interact with signature matching
    -- or will it be caught by flag-matching?
    let adjEnv ::
            [(String, IExpr a)] ->
            (IPackage a) ->
            (IPackage a)
        adjEnv env (IPackage i lps ps ds)
                            | getIdString i == "Prelude" =
                    IPackage i lps ps (map adjDef ds)
            where
                adjDef (IDef i t x p) =
                    case lookup (getIdString (unQualId i)) env of
                        Just e ->  IDef i t e p
                        Nothing -> IDef i t x p
        adjEnv _ p = p

    let
        -- adjust the "raw" packages and then add back their signatures
        -- so they can be put into the current IPackage for linking info
        binmods = zip (map (adjEnv env) binmods0) pkgsigs

    t <- dump errh flags t DFbinary dumpnames binmods

    -- For "genModule" we construct a symbol table that includes all defs,
    -- not just those that are user visible.
    -- XXX This is needed for inserting RWire primitives in AAddSchedAssumps
    -- XXX but is it needed anywhere else?
    start flags DFsympostbinary
    -- XXX The way we construct the symtab is to replace the user-visible
    -- XXX imports with the full imports.
    let mint = replaceImports mctx impsigs
    internalSymt <- mkSymTab errh mint
    t <- dump errh flags t DFsympostbinary dumpnames mint

    start flags DFfixup
    let (imodf, alldefsList) = fixupDefs imod binmods
    let alldefs = M.fromList [(i, e) | IDef i _ e _ <- alldefsList]
    iPCheck flags symt imodf "fixup"
    t <- dump errh flags t DFfixup dumpnames imodf

    start flags DFisimplify
    let imods :: IPackage HeapData
        imods = iSimplify imodf
    iPCheck flags symt imods "isimplify"
    t <- dump errh flags t DFisimplify dumpnames imods
    stats flags DFisimplify imods

    let orderGens :: IPackage HeapData -> [WrapInfo] -> [WrapInfo]
        orderGens (IPackage pid _ _ ds) gs =
                --trace (ppReadable (gis, g, os)) $
                                              map get os
          where gis = [ qualId pid i
                                | (WrapInfo i _ _ _ _ _) <- gs ]
                tr = [ (qualId pid i_, qualId pid i)
                                | (WrapInfo i _ _ i_ _ _) <- gs ]
                ds' = [ IDef (lookupWithDefault tr i i) t e p
                                | IDef i t e p <- ds, i `notElem` gis ]
                is = [ i | IDef i _ _ _ <- ds' ]
                g  = [ (i, fdVars e `intersect` is) | IDef i _ e _ <- ds' ]
                iis = scc g
                os = concat iis `intersect` gis
                get i = headOrErr "bsc.orderGens: no WrapInfo"
                                  [ x | x@(WrapInfo i' _ _ _ _ _) <- gs,
                                                unQualId i == i' ]
        ordgens :: [WrapInfo]
        ordgens = orderGens imods gens

    when (verbose flags) $
        putStr ("modules: " ++
                    ppReadable [ i | (WrapInfo { mod_nm = i }) <- ordgens ] ++
                    "\n")

    let getDef :: IPackage a -> Id -> IDef a
        getDef (IPackage _ _ _ ds) i =
           case [ d | d@(IDef i' _ _ _) <- ds, unQualId i == unQualId i' ] of
                [ d ] -> d
                _ -> internalError ("No definition for " ++ pfpString i)

    -- Generate code for all requested modules
    -- TODO this function gen should be defined outside the compilePackage body
    -- Note: This accumulates the new IPackage on each iteration, but it
    --   doesn't update "alldefs"; this is likely OK because it is only used
    --   to build undefined values (in IExpand) and to insert RWires
    --   (in AAddSchedAssumps)
    let gen :: (IPackage HeapData, Bool) -> [WrapInfo] -> IO (IPackage HeapData, Bool)
        gen (im, !success) []  = return (im, success)
        gen (im, !success) (wi@(WrapInfo { mod_nm = i, wrapped_mod = i' }) : xs) = do
            let (filename, pkgname, _) = dumpnames
                dumpnames' = (filename, pkgname, getIdString (unQualId i))
                fwrapper = i `elem` map (\ (i, _, _, _, _) -> i) funcs

            let
                -- in the Maybe monad
                ex_filt ex = do (CE.ErrorCall s) <- (CE.fromException ex)::(Maybe CE.ErrorCall)
                                return s
                def_comp = do
                  def <- genModule errh wi fwrapper flags dumpnames'
                             prefix (getIdBaseString pkgId)
                             internalSymt alldefs (getDef im i')
                  return (def, True)
                ex_comp s = do
                  hFlush stdout >> hPutStr stderr s
                  -- XXX exitFail will do the pre-exit actions again
                  when (not (enablePoisonPills flags)) $ exitFail errh
                  return (mkPoisonedCDefn i (orig_cqt wi), False)

            (def, ok) <- CE.catchJust ex_filt def_comp ex_comp

            -- wrappercomp has substages, so record the overall start time
            tStartWrapper <- getNow

            start flags DFwrappercomp
            when (extraVerbose flags) $
                putStr ("definition of " ++
                        getIdString i ++
                        ":\n" ++
                        ppReadable def ++
                        "\n\n")

            -- "ok2" indicates whether there was a type-checking error
            -- but multiple-error-reporting chose to keep going;
            -- since it will already appear as a user error, no need for
            -- an internal error
            (idef, ok2) <- compileCDefToIDef errh flags dumpnames' symt imods def

            t <- getNow
            start flags DFfixup
            -- Replace the pre-synthesis definition for a module with its
            -- post-synthesis definition, and update the package's cyclic
            -- references
            -- XXX Note that alldefs is not updated here.  This works
            -- XXX because the defs we use from it will not have changed.
            let im' = updDef idef im binmods
            t <- dump errh flags t DFfixup dumpnames' im'

            t <- dump errh flags tStartWrapper DFwrappercomp dumpnames' idef
            -- recurse for each module in [WrapInfo]
            gen (im', success && ok && ok2) xs


    (imodr, success) <- gen (imods, True) ordgens

    t <- getNow
    -- Finally, generate interface files
    start flags DFwriteBin

    -- Generate the user-visible type signature
    bi_sig <- genUserSign errh symt mctx
    -- Generate a type signature where everything is visible
    bo_sig <- genEverythingSign errh symt mctx

    -- Generate binary version of the internal tree .bo file
    let bin_filename = putInDir (bdir flags) name binSuffix
    genBinFile errh bin_filename bi_sig bo_sig imodr

    -- Print one message for the two files
    let rel_binname = getRelativeFilePath bin_filename
    when (verbose flags) $
         putStrLnF ("Compiled package file created: " ++ rel_binname)
    t <- dumpStr errh flags t DFwriteBin dumpnames bin_filename

    -- XXX We could add the generated .bo directly to the maps,
    -- XXX but we lack the hash (which is generated when reading in a file)
    -- let binfile = (rel_binname, bi_sig, bo_sig, modr, ...)
    --     binmap' = ...
    --     hashmap' = ...

    return (success && not tcErrors, binmap, hashmap)


genModule ::
    ErrorHandle ->
    WrapInfo ->
    Bool ->
    Flags ->
    DumpNames ->
    String -> -- prefix
    String -> -- source package name
    SymTab ->
    M.Map Id (IExpr HeapData) ->
    IDef HeapData ->
    IO (CDefn)

-- [IDef HeapData], VSchedInfo, VPathInfo, VWireInfo, [VFieldInfo], [VPort])
genModule
    errh
    wi
    fwrapper
    flags0
    dumpnames
    prefix
    srcName
    symt
    alldefs
    def  =

  do
    let pps = wi_prags wi
        def_pos = let (IDef i _ _ _) = def
                  in  getPosition i
    flags <- updateFlags errh def_pos [ s | PPoptions ss <- pps, s <- ss ] flags0

    let modstr = getIdString (unQualId (mod_nm wi))

    when (verbose flags) $ putStrLnF ("*****")
    when (showCodeGen flags || verbose flags) $ putStrLnF ("code generation for " ++ modstr ++ " starts")
    t <- getNow

    -- "run" it
    start flags DFexpanded
    imod0 <- iExpand errh flags symt alldefs fwrapper pps def
    iMCheck flags symt imod0 "expanded"
    t <- dump errh flags t DFexpanded dumpnames imod0
    when (showIESyntax flags) (putStrLnF (show imod0))
    stats flags DFexpanded imod0

    progArgs <- getArgs
    when ("-trace-state-loc" `elem` progArgs) $ do
      let (inst_locs, rule_locs) = getIStateLocs imod0
      putStrLn "Instance state locs"
      putStr (ppReadable inst_locs)
      putStrLn "Rule state locs"
      putStr (ppReadable rule_locs)

    start flags DFinlineFmt
    imod_fmt <- iInlineFmt errh imod0
    iMCheck flags symt imod_fmt "Fmt inline"
    t <- dump errh flags t DFinlineFmt dumpnames imod_fmt
    stats flags DFinlineFmt imod_fmt

    -- Inline defs
    start flags DFinline
    let imod_inline@(IModule { imod_interface = ifc }) =
            if inlineISyntax flags
            then (iInline (inlineSimple flags) imod_fmt)
            else imod_fmt
    iMCheck flags symt imod_inline "inline"
    t <- dump errh flags t DFinline dumpnames imod_inline
    stats flags DFinline imod_inline

    start flags DFtransform
    let imod_trans = iTransform errh flags "__i" imod_inline
    iMCheck flags symt imod_trans "transform"
    t <- dump errh flags t DFtransform dumpnames imod_trans
    stats flags DFtransform imod_trans

    -- Split rules containing if statements
    start flags DFsplitIf
    let imod_splitif = iSplitIf flags imod_trans
    iMCheck flags symt imod_splitif "splitIf"
    t <- dump errh flags t DFsplitIf dumpnames imod_splitif
    stats flags DFsplitIf imod_splitif

    -- Lift where possible
    start flags DFlift
    let imod_lift = iLift errh flags imod_splitif
    iMCheck flags symt imod_lift "lift"
    t <- dump errh flags t DFlift dumpnames imod_lift
    stats flags DFlift imod_lift

    -- Transform to simpler form (take 2)
    start flags DFtransform
    let imod_trans2 = iTransform errh flags "__j" imod_lift
    iMCheck flags symt imod_trans2 "transform"
    t <- dump errh flags t DFtransform dumpnames imod_trans2
    stats flags DFtransform imod_trans2

    -- Inline expressions for submodule instantiation parameters
    -- Or separate them into localparam defs instead of wire defs
    start flags DFiparams
    imod_param <- iParams errh imod_trans2
    t <- dump errh flags t DFiparams dumpnames imod_param

    start flags DFidroprules
    imod_drop <- iDropRules errh flags imod_param
    stats flags DFidroprules imod_drop
    t <- dump errh flags t DFidroprules dumpnames imod_drop

    -- Generate ATS
    -- ATS stands for "Abstract Transition System" from James C. Hoe's Ph.D. thesis
    start flags DFATS
    amod <- aConv errh pps flags imod_drop
    aCheck flags amod "ATS"
    t <- dump errh flags t DFATS dumpnames amod
    amod == amod `seq` return ()
    t <- if (isJust $ lookup DFATSexpand $ dumps flags)
         then dumpStr errh flags t DFATSexpand dumpnames $
              pretty 120 100 $ ppeAPackage (expandATSlimit flags) PDReadable amod
         else return t
    stats flags DFATS amod

    let flat_inst_tree = flattenInstTree (apkg_inst_tree amod)
    when ("-hack-strict-inst-tree" `elem` progArgs) $ do
      when (any isNothing (map snd (concatMap snd flat_inst_tree))) $
        internalError ("Bad inst tree:\n " ++ ppReadable flat_inst_tree)

    when ("-trace-inst-tree" `elem` progArgs) $ do
      putStrLn "Instantiation tree"
      putStr (ppReadable (apkg_inst_tree amod))
--      putStrLn "Instantiation tree"
--      putStr (ppReadable flat_inst_tree)

-- append ranks to method names and calls for "performance guarantees"
    start flags DFATSperfspec
    amod_ranked <- aRankMethCalls errh pps amod
    aCheck flags amod_ranked "ATSperfspec"
    t <- dump errh flags t DFATSperfspec dumpnames amod_ranked

-- splice in the identifiers set by ActionValue tasks into the ATaskAction calls
    start flags DFATSsplice
    let amod_splice = aTaskSplice amod_ranked
    aCheck flags amod_splice "ATSsplice"
    t <- dump errh flags t DFATSsplice dumpnames amod_splice
    stats flags DFATSsplice amod_splice

-- clean up ATS (merge any ME calls to the same action in the same rule)
    start flags DFATSclean
    amod_clean <- aCleanup errh flags amod_splice
    aCheck flags amod_clean "ATSclean"
    t <- dump errh flags t DFATSclean dumpnames amod_clean

    start flags DFdumpLambdaCalculus
    lc_pkg <- convAPackageToLambdaCalc errh flags amod_clean
    t <- dump errh flags t DFdumpLambdaCalculus dumpnames lc_pkg

    start flags DFdumpSAL
    sal_ctx <- convAPackageToSAL errh flags amod_clean
    t <- dump errh flags t DFdumpSAL dumpnames sal_ctx

    -- Build path graph for everything except rules
    start flags DFpathsPreSched
    (pathGraphInfo, urgency_pairs) <- aPathsPreSched errh flags amod_clean
    t <- dump errh flags t DFpathsPreSched dumpnames pathGraphInfo

    -- Schedule
    start flags DFschedule
    (schedule_info, amod_sched)
        <- do res <- aSchedule errh flags prefix urgency_pairs pps amod_clean
              case res of
                Right r -> return r
                Left schedule_info -> do
                    t <- dump errh flags t DFschedule dumpnames
                             (asei_schedule schedule_info)
                    -- dump the schedule, if requested
                    t <- if (showSchedule flags)
                         then do start flags DFdumpschedule
                                 aDumpScheduleErr errh flags prefix
                                                  amod_clean schedule_info
                                 dump errh flags t DFdumpschedule dumpnames ()
                         else return t
                    -- generate a .ba file, if requested
                    t <- if (genABin flags)
                         then writeABinSchedErr errh pps flags dumpnames t
                                  prefix modstr srcName (orig_cqt wi)
                                  schedule_info amod_clean
                         else return t
                    exitFail errh
    t <- dump errh flags t DFschedule dumpnames (asi_schedule schedule_info)
    stats flags DFschedule amod_sched
    start flags DFresources
    t <- dump errh flags t DFresources dumpnames
         (asi_resource_alloc_table schedule_info)
    start flags DFvschedinfo
    t <- dump errh flags t DFvschedinfo dumpnames (asi_v_sched_info schedule_info)

    -- Add CAN_FIRE and WILL_FIRE defs based on the schedule
    start flags DFscheduledefs
    amod_scheduled <- aAddScheduleDefs flags
                                       pps
                                       amod_sched
                                       schedule_info
    t <- dump errh flags t DFscheduledefs dumpnames amod_scheduled

    start flags DFdumpschedule
    -- only difference from amod_scheduled to amod_dump is some rules removed
    (amod_dump, schedule_info_updated, methodConflict)
        <- aDumpSchedule errh flags pps prefix amod_scheduled schedule_info
    let schedule_final = asi_schedule schedule_info_updated
    let ms = (amod_dump, schedule_final)
    t <- dump errh flags t DFdumpschedule dumpnames ms

    -- prove any proof obligations accumulated at this point
    start flags DFcheckproofs
    -- the obligations are removed from the module
    (amod_check, ok) <- aCheckProofs errh flags amod_dump
    t <- dump errh flags t DFcheckproofs dumpnames ok

    -- Add scheduler edges to the path graph
    -- (we assume that pathGraphInfo is consistent with amod_checked, because
    -- at most only a few rules have been removed since amod_clean)
    start flags DFpathsPostSched
    vPathInfo <- aPathsPostSched flags pps amod_check pathGraphInfo schedule_final
    t <- dump errh flags t DFpathsPostSched dumpnames vPathInfo

    -- lift all no-inline func calls and assign instance names to them
    start flags DFnoinline
    let amod_noinline = aNoInline flags amod_check
    t <- dump errh flags t DFnoinline dumpnames amod_noinline

    -- add scheduling assumptions (ME, CF, etc.) to APackage (in two steps)
    start flags DFaddSchedAssumps
    (amod_wires, sched_info')
        <- aAddCFConditionWires errh symt alldefs flags
                                amod_noinline schedule_info_updated
    let (amod_assumps, sched_info'') =
            aAddSchedAssumps amod_wires schedule_final sched_info'
    aCheck flags amod_assumps "addSchedAssumps"
    t <- dump errh flags t DFaddSchedAssumps dumpnames
             (amod_assumps,
              asi_method_uses_map sched_info'',
              asi_resource_alloc_table sched_info'')

    -- move assumption actions into rule bodies
    start flags DFremoveAssumps
    let amod_no_assumps = aRemoveAssumps amod_assumps
    aCheck flags amod_no_assumps "aRemoveAssumps"
    t <- dump errh flags t DFremoveAssumps dumpnames amod_no_assumps

    -- drop ASAny with "chosen" values
    -- just before the split because other paths add new expressions
    -- and because we might choose more undets in pathsPostSched
    start flags DFdropundet
    let amod_no_undet = aDropUndet errh flags amod_no_assumps
    t <- dump errh flags t DFdropundet dumpnames amod_no_undet

    -- the amod doesn't change beyond this point
    let amod_final = amod_no_undet

    -- save wireinfo
    let wireinfo = apkg_external_wires amod_final
    let fieldinfo = getAPackageFieldInfos amod_final

    blurb <- mkGenFileHeader flags
    let methodConflictBlurb :: [String] -- string printed in top of Verilog file
        methodConflictBlurb
            | methodConf flags =
                ["Method conflict info:"]
                ++ lines (pretty 78 78 (vcat (dumpMethodInfo flags methodConflict)) )
            | otherwise = []

    let methodConflictBVI :: [String] -- string printed in top of Verilog file
        methodConflictBVI
            | methodBVI flags =
                ["BVI format method schedule info:"]
                ++ lines (pretty 78 78 (vcat (dumpMethodBVIInfo methodConflict)) )
            | otherwise = []
    -- Additional info from the Verilog backend
    -- * veriPortProps =
    --           IO properties which can be included as attributes in the
    --           Cmoduleverilog (import-BVI)
    --           XXX it would be nice if the Bluesim backend had the same info
    -- * vprog = the Verilog data structure, for recording in the .ba file,
    --           so that it's available to bluetcl
    (t, veriPortProps, vprog)
        <- if (backend flags == Just Verilog)
           then do (t', ips, v)
                       <- genModuleVerilog
                             errh pps flags dumpnames t prefix modstr
                             blurb methodConflictBlurb methodConflictBVI
                             vPathInfo sched_info'' amod_final
                   return (t', ips, Just v)
           else return (t, [], Nothing)

    t <- if (genABin flags)
         then writeABin errh pps flags dumpnames t prefix
                  modstr srcName (orig_cqt wi)
                  sched_info'' methodConflict vPathInfo
                  amod_final vprog
         else return t

    -- Wrapper generation
    start flags DFwrappergen

    -- ids of value methods with constant True output
    -- (any rdy signals in this list don't need to be wired up
    -- in the wrapper; it can assume a value of 1)
    let true_ifc_ids  = [ i | IEFace i _ (Just (e, t)) _ _ _ <- ifc, isTrue e || isAlwaysRdy pps i ]
    def <- (deffun wi)
                 fwrapper
                 wireinfo
                 (asi_v_sched_info schedule_info)
                 vPathInfo
                 veriPortProps
                 symt
                 fieldinfo
                 true_ifc_ids

    -- mainly because hypering the def will force any embedded exceptions
    t <- dump errh flags t DFwrappergen dumpnames def
    return (def)


writeABin :: ErrorHandle -> [PProp] -> Flags -> DumpNames -> TimeInfo ->
             String -> String -> String -> CQType ->
             AScheduleInfo -> MethodDumpInfo -> VPathInfo ->
             APackage -> Maybe VProgram -> IO (TimeInfo)
writeABin errh pps flags dumpnames t prefix modstr srcName oqt
          sched_info methodConflict vPathInfo amod vprog =
    do
       start flags DFwriteABin

       -- Don't generate .ba file if the backend is Bluesim and the
       -- module has features not supported by Bluesim.
       -- XXX For Verilog, this currently does nothing, but it could be
       -- XXX made to taint the .ba and issue a warning.
       amod_for_abin
           <- simCheckPackage errh (backend flags == Just Bluesim) amod

       -- generate the abin file
       let afilename = mkAName (bdir flags) prefix modstr
           afilename_rel = getRelativeFilePath afilename
           backend = apkg_backend amod_for_abin
           abinPrintPrefix =
              case (backend) of
                  Nothing -> "Elaborated module file created: "
                  Just be ->
                      "Elaborated " ++ ppString be ++ " module file created: "
           modinfo = ABinModInfo {
                          abmi_path = prefix,
                          abmi_src_name = srcName,
                          --abmi_time = now,
                          abmi_apkg        = amod_for_abin,
                          abmi_aschedinfo  = sched_info,
                          abmi_pps         = pps,
                          abmi_oqt         = oqt,
                          abmi_method_dump = methodConflict,
                          abmi_pathinfo = vPathInfo,
                          abmi_flags       = flags,
                          abmi_vprogram    = if (genABinVerilog flags)
                                             then vprog else Nothing
                     }
           abin = ABinMod modinfo (bscVersionStr True)
       genABinFile errh afilename abin
       unless (quiet flags) $ putStrLnF $ abinPrintPrefix ++ afilename_rel
       dump errh flags t DFwriteABin dumpnames afilename


writeABinSchedErr :: ErrorHandle -> [PProp] -> Flags -> DumpNames -> TimeInfo ->
                     String -> String -> String -> CQType ->
                     AScheduleErrInfo -> APackage -> IO (TimeInfo)
writeABinSchedErr errh pps flags dumpnames t prefix modstr srcName oqt
                  sched_info amod =
    do
       start flags DFwriteABin

       -- generate the abin file
       let afilename = mkAName (bdir flags) prefix modstr
           afilename_rel = getRelativeFilePath afilename
           abinPrintPrefix = "Elaborated error module file created: "
           modinfo = ABinModSchedErrInfo {
                          abmsei_path          = prefix,
                          abmsei_src_name      = srcName,
                          abmsei_apkg          = amod,
                          abmsei_aschederrinfo = sched_info,
                          abmsei_pps           = pps,
                          abmsei_oqt           = oqt,
                          abmsei_flags         = flags
                     }
           abin = ABinModSchedErr modinfo (bscVersionStr True)
       genABinFile errh afilename abin
       unless (quiet flags) $ putStrLnF $ abinPrintPrefix ++ afilename_rel
       dump errh flags t DFwriteABin dumpnames afilename


-- ===============
-- genModuleVerilog

genModuleVerilog :: ErrorHandle
                 -> [PProp]
                 -> Flags
                 -> DumpNames
                 -> TimeInfo
                 -> String -- prefix
                 -> String -- top module name
                 -> [String] -- header blurb lines
                 -> [String] -- method conflict blurb lines
                 -> [String] -- method bvi format blurb lines
                 -> VPathInfo -- used to create path info blurb lines
                 -> AScheduleInfo
                 -> APackage
                 -> IO (TimeInfo,
                        [VPort],   -- port properties for the import-BVI
                        VProgram)  -- generated Verilog
genModuleVerilog errh pprops flags dumpnames time0 prefix moduleName
                 blurb methodConflictBlurb methodConflictBVI vPathInfo scheduleInfo
                 atsPackage =
    do
       -- Read in foreign function info from .ba files for
       -- all foreign functions used in the design, and build a
       -- map to be used when generating verilog
       start flags DFforeignMap
       let foreign_func_names = getForeignCallNames atsPackage
           readABin ffname =
               let err = (noPosition,
                          EMissingABinForeignFuncFile ffname moduleName)
               in  readAndCheckABinPathCatch errh
                       (verbose flags) (ifcPath flags) (Just Verilog)
                       ffname err
       abis <- mapM readABin foreign_func_names
       ff_map <- buildForeignFunctionMap errh abis
       t <- dump errh flags time0 DFforeignMap dumpnames ff_map

       -- Generate muxes etc.
       start flags DFastate
       asmod <- aState errh flags pprops scheduleInfo atsPackage
       -- after aState, method calls should no longer exist
       asMethCheck flags asmod "astate"
       t <- dump errh flags t DFastate dumpnames asmod
       stats flags DFastate asmod

       -- Get rid of wires (and warn about BypassWire where necessary)
       start flags DFrwire
       let (asmodNoWires, wireWarnings, wireErrors)
               | removeRWire flags = aInlineWires flags asmod
               | otherwise = (asmod, [], [])
       when (not (null wireWarnings)) $ bsWarning errh wireWarnings
       when (not (null wireErrors))   $ bsError errh wireErrors
       asCheck flags asmodNoWires "ainlinewires"
       t <- dump errh flags t DFrwire dumpnames asmodNoWires
       stats flags DFrwire asmodNoWires

       -- Inline CReg modules (replacing with Reg modules)
       start flags DFcreg
       let asmodNoCReg
               | removeCReg flags = aInlineCReg asmodNoWires
               | otherwise = asmodNoWires
       asCheck flags asmodNoCReg "ainlinecreg"
       t <- dump errh flags t DFcreg dumpnames asmodNoCReg
       stats flags DFrwire asmodNoCReg

       -- Rename submodule ports from the method-notation to the actual
       -- Verilog port names
       start flags DFrenameio
       let armod = aRenameIO flags asmodNoCReg
       asCheck flags armod "renameio"
       t <- dump errh flags t DFrenameio dumpnames armod
       stats flags DFrenameio armod

       -- drop unused defs
       start flags DFadropdefs
       let adropmod = aDropDefs armod
       asCheck flags adropmod "adropdefs"
       t <- dump errh flags t DFadropdefs dumpnames adropmod
       stats flags DFadropdefs adropmod

       -- Improve
       start flags DFaopt
       aomod <- aOpt errh flags adropmod
       asCheck flags aomod "aopt"
       t <- dump errh flags t DFaopt dumpnames aomod
       stats flags DFaopt aomod

       -- Expand some primitives
       start flags DFsynthesize
       let asynmod = (aSynthesize flags aomod)
       asCheck flags asynmod "asynthesize"
       -- Check that referenced signal names exist
       asSignalCheck flags asynmod "synthesize"
       t <- dump errh flags t DFsynthesize dumpnames asynmod
       stats flags DFsynthesize asynmod

       -- Transform to adapt to Verilog quirks
       start flags DFveriquirks
       let aqmod = aVeriQuirks flags asynmod
       -- this check is too strict on plus operator output size
       -- XXX fix the check, don't disable it
       when (not (keepAddSize flags))
            (asCheck flags aqmod "veriquirks")
       t <- dump errh flags t DFveriquirks dumpnames aqmod
       stats flags DFveriquirks aqmod

       -- Transform to adapt to Verilog quirks
       start flags DFfinalcleanup
       let aumod =  finalCleanup flags aqmod
       -- this check is too strict on plus operator output size
       -- XXX fix the check, don't disable it
       when (not (keepAddSize flags))
            (asCheck flags aumod "finalcleanup")
       t <- dump errh flags t DFfinalcleanup dumpnames aumod
       stats flags DFfinalcleanup aumod

       start flags DFIOproperties
       let (ioprops, ips) = getIOProps flags aumod
       t <- dump errh flags t DFIOproperties dumpnames ioprops

       -- Generate Verilog
       start flags DFverilog
       -- This is monadic because it can report an error
       vprog0 <- aVerilog errh flags pprops aumod ff_map
       t <- dump errh flags t DFverilog dumpnames vprog0

       -- Remove dollar signs from Verilog identifiers
       start flags DFverilogDollar
       let vprog = if (removeVerilogDollar flags)
                   then (removeDollarsFromVerilog vprog0)
                   else vprog0
       t <- dump errh flags t DFverilogDollar dumpnames vprog

       -- Write the Verilog files
       start flags DFwriteVerilog
       vfilenames <- writeVerilog errh flags prefix
                         blurb methodConflictBlurb methodConflictBVI ioprops vPathInfo
                         vprog
       t <- dump errh flags t DFwriteVerilog dumpnames vfilenames

       -- Return
       -- * the port properties (to be included in the import-BVI)
       -- * the Verilog structure (for accessing in bluetcl)
       return (t, ips, vprog)


-- Write a Verilog program to file (along with its use file)
writeVerilog :: ErrorHandle -> Flags -> String ->
                [String] -> [String] -> [String] -> VIOProps -> VPathInfo ->
                VProgram -> IO ([VFileName])
writeVerilog errh flags prefix
             blurb methodConflictBlurb methodConflictBVI ioprops vPathInfo
             vprog =
    do
       let modName :: String
           modName = (vGetMainModName vprog)

       -- Make the filename (full path, but with the relative prefix encoded)
       vName_init <- genFileName mkVName (vdir flags) prefix modName
       -- The relative filename, for reporting to the user
       let vNameRel = (getRelativeFilePath vName_init)
       -- The final name used to write the file (full path)
       let vName = VFileName (getFullFilePath vName_init)

       -- Names for the use file
       let useNameRel = dropSuf vNameRel ++ "." ++ useSuffix
           useName = dropSuf (vfnString vName) ++ "." ++ useSuffix

       -- Comments at the top of the Verilog file
       let pathInfoBlurb = lines (pp80 vPathInfo)
           ioblurb = "" : "Ports:" : lines (pp80 ioprops)
           comment = commentV (blurb ++ methodConflictBlurb ++ methodConflictBVI ++
                               ioblurb ++
                               pathInfoBlurb ++ [""])

       -- The contents of the Verilog file
       let vstring = comment ++ pp80 vprog

       writeVFileCatch errh flags vName vstring
       unless (quiet flags) $ putStrLnF ("Verilog file created: " ++ vNameRel)

       -- if generating a use file
       when (showModuleUse flags) $ do
           writeFileCatch errh useName (unlines (getVeriInsts vprog))
           unless (quiet flags) $ putStrLnF ("Use file created: " ++ useNameRel)

       return [vName]


writeVFileCatch :: ErrorHandle -> Flags -> VFileName -> String -> IO ()
writeVFileCatch errh flags (VFileName fn) s = do
    let dropTrailingBlanks :: String -> String
        dropTrailingBlanks s | null s           = s
                             | isSpace $ last s = dropTrailingBlanks $ init s
                             | otherwise        = s
        --
        s' = unlines $  map dropTrailingBlanks $ lines s
    writeFileCatch errh fn s'
    let applyFilter :: String -> IO ()
        applyFilter command = do
          let cmdstr = command ++ " " ++ fn
          when (verbose flags) $
            unless (quiet flags) $ putStrLnF ("Executing Verilog filter " ++ quote cmdstr)
          code <- system cmdstr
          case code of
            ExitSuccess     -> return ()
            (ExitFailure n) -> bsError errh [(cmdPosition, EVerilogFilterError command fn n)]
    mapM_ applyFilter $ reverse $ verilogFilter flags

-- ===============
-- genModuleC

-- might as well inline this into simLink (no need to be separate)
genModuleC :: ErrorHandle
           -> Flags
           -> DumpNames
           -> TimeInfo
           -> String
           -> [(String, ABin)]
           -> IO (TimeInfo, [String], [String], TimeInfo)
genModuleC errh flags dumpnames time0 toplevel abis =
    do
       pwd <- getCurrentDirectory
       let name = createEncodedFullFilePath "placeholder" pwd
           prefix = (dirName name) ++ "/"

       -- create SimSystem which contains SimPackages and SimSchedules
       start flags DFsimExpand
       sim_system <- simExpand errh flags toplevel abis
       time <- dump errh flags time0 DFsimExpand dumpnames sim_system

       -- extract file dependency structure and determine if any
       -- existing bluesim packages can reuse existing object files
       start flags DFsimDepend
       reused <- analyzeBluesimDependencies flags sim_system prefix
       time <- dump errh flags time DFsimDepend dumpnames reused

       -- optimize the SimPackages and SimSchedules
       start flags DFsimPackageOpt
       sim_system_opt <- simPackageOpt errh flags sim_system
       time <- dump errh flags time DFsimPackageOpt dumpnames sim_system_opt

       -- convert SimPackages and SimSchedules to SimCCBlocks and SimCCScheds
       start flags DFsimMakeCBlocks
       let (simblocks, simCCscheds, clk_groups, gate_info, top_id) =
                simMakeCBlocks flags sim_system_opt
       let simBlockInfo = (simblocks, simCCscheds, clk_groups, gate_info)
       time <- dump errh flags time DFsimMakeCBlocks dumpnames simBlockInfo

       -- optimize the SimCCBlocks and SimCCScheds
       start flags DFsimCOpt
       let (simblocks_opt, simCCscheds_opt, clk_groups_opt, gate_info_opt) =
               simCOpt flags
                       (ssys_instmap sim_system_opt)
                       (simblocks, simCCscheds, clk_groups, gate_info)
       let simBlockInfo = (simblocks_opt, simCCscheds_opt, clk_groups_opt, gate_info_opt)
       time <- dump errh flags time DFsimCOpt dumpnames simBlockInfo

       -- get the map of ForeignFunctions
       let ff_map = ssys_ffuncmap sim_system_opt

       blurb <- mkGenFileHeader flags
       let mkEncodedName s = genFileName mkNameWithoutSuffix (cdir flags) prefix s
           -- write CCSyntax to file and return the relative file name
           writeFileC :: String -> String -> IO String
           writeFileC name file = do
             t_start <- getNow
             start flags DFwriteC
             encoded_name <- mkEncodedName name
             let full_name = getFullFilePath encoded_name
                 rel_name = getRelativeFilePath encoded_name
             writeFileCatch errh full_name ((commentC blurb) ++ file)
             _<- dumpStr errh flags t_start DFwriteC dumpnames name
             return rel_name

       -- convert SimCCBlocks and SimCCScheds to CCSyntax
       start flags DFsimBlocksToC
       let sb_map = M.fromList $ map (\sb -> (sb_id sb,sb))
                                     (simblocks_opt ++ primBlocks)
           creation_time = time

       block_names <- simBlocksToC flags
                                   creation_time
                                   top_id
                                   (ssys_default_clk sim_system_opt)
                                   (ssys_default_rst sim_system_opt)
                                   sb_map
                                   ff_map
                                   reused
                                   simblocks_opt
                                   simCCscheds_opt
                                   clk_groups_opt
                                   gate_info_opt
                                   writeFileC

       -- generate a header with imported function declarations
       let import_header =
             if M.null ff_map
             then []
             else [("imported_BDPI_functions.h",
                    ppReadable (mkImportDeclarations ff_map))]

       imp_names <- mapM (uncurry writeFileC) import_header

       let core_names = imp_names ++ block_names

       time <- dumpStr errh flags time DFsimBlocksToC dumpnames (unlines core_names)

       -- if generation target is SystemC, generate the wrapper file too
       start flags DFgenSystemC
       when (genSysC flags) $
            do bsMessage errh [(cmdPosition, MRestrictions "creating SystemC models" "the -systemc option")]
               checkSystemCIfc errh flags sim_system_opt
       sysc_files <- if (genSysC flags)
                     then wrapSystemC flags sim_system_opt
                     else return []
       time <- dump errh flags time DFgenSystemC dumpnames sysc_files

       sysc_names <- mapM (uncurry writeFileC) sysc_files

       let names = core_names ++ sysc_names

       reused_names <- mapM (\s -> do let cxx = mkObjName Nothing "" s
                                      n <- mkEncodedName cxx
                                      return $ getRelativeFilePath n)
                            reused

       -- XXX return the headers separate from the files which need to be
       -- XXX compiled
       return (time, names, reused_names, creation_time)

-- ===============
-- SimLink

simLink :: ErrorHandle -> Flags -> String -> [String] -> [String] -> IO ()
simLink errh flags toplevel afilenames cfilenames = do
    tStart <- getNow
    let t = tStart

    -- XXX (file, package, module) names for %-substitution in dump filenames
    let dumpnames = ("","","")

    -- in case the user listed the same file twice
    -- (they could still have given two .ba for the same module,
    -- and simExpand will check for that)
    let afilenames_unique = nub afilenames
    let cfilenames_unique = nub cfilenames

    -- check that .c and .o files listed on the command-line exist
    missing <- missingUserFiles flags cfilenames_unique
    when (not (null missing)) $
        bsError errh
            [(cmdPosition, EMissingUserFile f ["."]) | f <- missing]
    t <- timestampStr flags "confirm C files exist" t

    -- read in the abin files (check hash and that they are C files)
    start flags DFreadelab
    let read_abin_fn = readAndCheckABin errh (Just Bluesim)
    abis <- mapM read_abin_fn afilenames_unique
    t <- dump errh flags t DFreadelab dumpnames (map fst abis)

    -- generate the files, get back a list of files to be compiled
    -- and a list of files which have already been compiled
    (t, to_compile, to_reuse, creation_time)
        <- genModuleC errh flags dumpnames t toplevel abis
    let t_before_compilations = t

    -- print a message to the user that we are reusing the files
    ofiles_reused <- mapM (reuseBluesimCFile flags) to_reuse

    -- XXX in the absence of genModuleC returning separate lists of header
    -- XXX files and actual C files to be compiled, partition them here
    let ({-hfiles-}_, gen_cfiles) = partition (hasDotSuf hSuffix) to_compile
    let (user_cfiles, user_ofiles) =
            partition (\f -> hasDotSuf cSuffix f   ||
                             hasDotSuf cxxSuffix f ||
                             hasDotSuf cppSuffix f ||
                             hasDotSuf ccSuffix f
                      )
                      cfilenames_unique

    start flags DFbluesimcompile
    let jobs = parallelSimLink flags
    (gen_ofiles, compiled_user_ofiles) <-
        if (jobs > 1)
        then do
          compileParallelCFiles errh flags False
              toplevel gen_cfiles user_cfiles
        else do
          ofiles0 <- mapM (compileBluesimCFile errh flags) gen_cfiles
          t <- timestampStr flags "compile generated C++ files" t

          ofiles1 <- mapM (compileUserCFile errh flags False) user_cfiles
          t <- timestampStr flags "compile user-provided C/C++ files" t

          return (ofiles0, ofiles1)
    let ofiles = gen_ofiles ++
                 user_ofiles ++ compiled_user_ofiles ++
                 ofiles_reused
    t <- dump errh flags t_before_compilations DFbluesimcompile dumpnames
              ofiles

    -- if not generating a SystemC model, link to a Bluesim executable
    start flags DFbluesimlink
    when (not (genSysC flags)) $
      cxxLink errh flags toplevel ofiles creation_time
    t <- dump errh flags t DFbluesimlink dumpnames toplevel

    -- final verbose message
    _ <- timestampStr flags "total" tStart

    return ()

-- Reuse a Bluesim generated object file
-- returns the name of the object file being reused
reuseBluesimCFile :: Flags -> String -> IO String
reuseBluesimCFile flags oName = do
    -- show is used for quoting
    systemc <- liftM show $ getEnvDef "SYSTEMC" ""
    let engine = if (genSysC flags) && ("_systemc" `isSuffixOf` (dropSuf oName))
                 then "SystemC"
                 else "Bluesim"
        oNameRel = getRelativeFilePath oName
    -- we lie here and mention both header and object (un-mangled name)
    let msg = engine ++ " object reused: " ++ (dropSuf oNameRel) ++
              ".{" ++ hSuffix ++ "," ++ objSuffix ++ "}"
    unless (quiet flags) $ putStrLnF msg
    return oName

-- compile a Bluesim generated CXX file
-- returns the name of the object file created
compileBluesimCFile :: ErrorHandle -> Flags -> String -> IO String
compileBluesimCFile errh flags cName = do
    (cmd, oName, msg) <- cmdCompileBluesimCFile flags cName
    execCmd errh flags cmd
    unless (quiet flags) $ putStrLnF msg
    return oName

-- construct the command for compiling a Bluesim CXX file
-- and return the name of the object file
-- and the message to display to the user
-- (this is shared by the serial and parallel compilation paths)
cmdCompileBluesimCFile :: Flags -> String -> IO (String, String, String)
cmdCompileBluesimCFile flags cName = do
    systemc <- getEnvDef "SYSTEMC" ""
    let engine = if (genSysC flags) && ("_systemc" `isSuffixOf` (dropSuf cName))
                 then "SystemC"
                 else "Bluesim"
    let oName = mkObjName Nothing "" (dropSuf cName)
    -- show is used for quoting
    let incflags = ["-I" ++ show (bluespecDir flags) ++ "/Bluesim"] ++
                   (if ((engine == "SystemC") && (systemc /= ""))
                    then ["-I" ++ show systemc ++ "/include"]
                    else [])
        -- Generated C++ code may reference uninitialized variables when it
        -- is known to be safe.
        switches = incflags ++
                   [ "-Wno-uninitialized"
                   , "-fpermissive"
                   , "-fPIC"
                   , "-c"
                   , "-o"
                   , show (mangleFileName oName)
                   ]
        -- show is used for quoting
        opts = map show (cxxFlags flags)
        files = [show (mangleFileName cName)]
    cmd <- cmdCXXCompile flags (opts ++ switches) files
    let cNameRel = getRelativeFilePath cName
    -- we lie here and mention both header and object (un-mangled name)
    let msg = engine ++ " object created: " ++ (dropSuf cNameRel) ++
              ".{" ++ hSuffix ++ "," ++ objSuffix ++ "}"
    return (cmd, oName, msg)

-- returns the name of the object file created
compileVPICFile :: ErrorHandle -> Flags -> String -> IO String
compileVPICFile errh flags cName = do
    let oName = mkObjName Nothing "" (dropSuf cName)
    -- show is used for quoting
    let incflags = map (("-I"++) . show) (cIncPath flags) ++
                   ["-I" ++ show (bluespecDir flags) ++ "/VPI"]
        switches = incflags ++
                   [ "-fpermissive"
                   , "-fPIC"
                   , "-c"
                   , "-o"
                   , show (mangleFileName oName)
                   ]
        files = [show (mangleFileName cName)]
    let compileFn = if hasDotSuf cSuffix cName
                    then cCompile
                    else cxxCompile
    -- show is used for quoting
    let opts = map show $ if hasDotSuf cSuffix cName
                          then cFlags flags
                          else cxxFlags flags
    compileFn errh flags (opts ++ switches) files
    let cNameRel = getRelativeFilePath cName
    let msg = "VPI object created: " ++
              (mkObjName Nothing "" (dropSuf cNameRel))
    unless (quiet flags) $ putStrLnF msg
    return oName

-- returns the name of the object file created
compileUserCFile :: ErrorHandle -> Flags -> Bool -> String -> IO String
compileUserCFile errh flags forVerilog cName = do
    (cmd, oName, msg) <- cmdCompileUserCFile flags forVerilog cName
    execCmd errh flags cmd
    unless (quiet flags) $ putStrLnF msg
    return oName

-- construct the command for compiling a user C or CXX file
-- and return the name of the object file
-- and the message to display to the user
-- (this is shared by the serial and parallel compilation paths)
cmdCompileUserCFile :: Flags -> Bool -> String -> IO (String, String, String)
cmdCompileUserCFile flags forVerilog cName = do
    let oName = mkObjName Nothing "" (dropSuf cName)
    -- show is used for quoting
    let incflags = map (("-I"++) . show) (cIncPath flags)
        switches = incflags ++
                   [ "-fpermissive"
                   , "-fPIC"
                   , "-c"
                   , "-o"
                   , show (mangleFileName oName)
                   ]
        files = [show (mangleFileName cName)]
    let cmdCompileFn = if hasDotSuf cSuffix cName
                       then cmdCCompile
                       else cmdCXXCompile
    -- show is used for quoting
    let opts = map show $ if hasDotSuf cSuffix cName
                          then cFlags flags
                          else cxxFlags flags
    cmd <- cmdCompileFn flags (opts ++ switches) files
    let cNameRel = getRelativeFilePath cName
    let msg = "User object created: " ++
              (mkObjName Nothing "" (dropSuf cNameRel))
    return (cmd, oName, msg)

-- Compile Bluesim and user C/C++ files in parallel, using "make"
compileParallelCFiles :: ErrorHandle -> Flags -> Bool ->
                         String -> [String] -> [String] ->
                         IO ([String], [String])
-- avoid having "make" report "nothing to be done"
compileParallelCFiles errh flags forVerilog toplevel [] [] = return ([], [])
compileParallelCFiles errh flags forVerilog toplevel gen_cNames user_cNames = do
    let mkBluesimRule cName = do
          (cmd, oName, msg) <- cmdCompileBluesimCFile flags cName
          let esc_oName = escMakeTarget oName
              esc_cmd = escMakeRecipe cmd
              esc_msg = escMakeRecipe msg
          -- we use "PHONY" to force recompilation
          -- we use singlequotes on the echos, to avoid interpreting strings
          let rule = ".PHONY: " ++ esc_oName ++ "\n" ++
                     esc_oName ++ ":\n" ++
                     (if (quiet flags) then ""
                      else "\t@echo exec: '" ++ esc_cmd ++ "'\n") ++
                     "\t@" ++ esc_cmd ++ "\n" ++
                     (if (quiet flags) then ""
                      else "\t@echo '" ++ esc_msg ++ "'\n")
          return (oName, rule, esc_oName)
    let mkUserRule cName = do
          (cmd, oName, msg) <- cmdCompileUserCFile flags forVerilog cName
          let esc_oName = escMakeTarget oName
              esc_cmd = escMakeRecipe cmd
              esc_msg = escMakeRecipe msg
          -- we use "PHONY" to force recompilation
          -- we use singlequotes on the echos, to avoid interpreting strings
          let rule = ".PHONY: " ++ esc_oName ++ "\n" ++
                     esc_oName ++ ":\n" ++
                     (if (quiet flags) then ""
                      else "\t@echo exec: '" ++ esc_cmd ++ "'\n") ++
                     "\t@" ++ esc_cmd ++ "\n" ++
                     (if (quiet flags) then ""
                      else "\t@echo '" ++ esc_msg ++ "'\n")
          return (oName, rule, esc_oName)
    (gen_oNames, gen_rules, gen_esc_oNames)
        <- mapM mkBluesimRule gen_cNames >>= return . unzip3
    (user_oNames, user_rules, user_esc_oNames)
        <- mapM mkUserRule user_cNames >>= return . unzip3
    let all_target = "all: " ++
                     intercalate " " (gen_esc_oNames ++ user_esc_oNames)

    -- write the makefile
    pwd <- getCurrentDirectory
    let pwdpath = createEncodedFullFilePath "placeholder" pwd
        prefix = (dirName pwdpath) ++ "/"
        basename = "compile_" ++ toplevel
    fname_init <- genFileName mkMakeName (cdir flags) prefix basename
    let fname = getFullFilePath fname_init
        fcontents = intercalate "\n" $
                        [all_target] ++ [""] ++
                        gen_rules ++ [""] ++
                        user_rules
    writeFileCatch errh fname fcontents

    -- execute make
    let jobs = parallelSimLink flags
        -- show is used for quoting
        switches = ["-f", show fname, "-j", show jobs]
        targets = ["all"]
    cmd <- cmdMake flags switches targets
    execCmd errh flags cmd

    -- delete the makefile unless in debug mode
    when (not (cDebug flags)) $
         removeFileCatch errh fname

    -- return the generated object file names
    return (gen_oNames, user_oNames)

-- Escape file names for use in a Makefile
escMakeTarget :: String -> String
escMakeTarget tname =
    let doEscape '#' = True
        doEscape ',' = True
        doEscape ':' = True
        doEscape ';' = True
        doEscape '=' = True
        doEscape '%' = True
        doEscape '$' = True
        doEscape c = isSpace c
        escChar c accum_str =
            if (doEscape c)
            then "\\0" ++ showOct (ord c) accum_str
            else (c:accum_str)
    in  foldr escChar "" tname

-- Escape commands for use in a Makefile
escMakeRecipe :: String -> String
escMakeRecipe cmd =
    let -- hash in a command is OK
        escChar '$' accum_str = "\044" ++ accum_str
        escChar c accum_str = (c:accum_str)
    in  foldr escChar "" cmd

-- Construct the Make command
cmdMake :: Flags -> [String] -> [String] -> IO String
cmdMake flags sws targets = do
    make <- getEnvDef "MAKE" dfltMake
    -- MAKEFLAGS is a reserved variable that 'make' uses for recursive calls;
    -- it should not be explicitly added to calls to 'make'
    --makeflags <- getEnvDef "MAKEFLAGS" dfltMAKEFLAGS
    let debug_flags = ""
    bsc_makeflags <- getEnvDef "BSC_MAKEFLAGS" dfltBSC_MAKEFLAGS
    let cmd = unwords $ [ make, debug_flags, bsc_makeflags ] ++
                        sws ++ targets
    return cmd

-- Call the C compiler (typically to generate .o from .c)
--   sws = switches (like -c, -o)
--   fs  = filenames
cCompile :: ErrorHandle -> Flags -> [String] -> [String] -> IO ()
cCompile errh flags sws fs = do
    cmd <- cmdCCompile flags sws fs
    execCmd errh flags cmd

-- Construct the C compiler command (typically to generate .o from .c)
--   sws = switches (like -c, -o)
--   fs  = filenames
cmdCCompile :: Flags -> [String] -> [String] -> IO String
cmdCCompile flags sws fs = do
    comp <- getEnvDef "CC" dfltCCompile
    cflags <- getEnvDef "CFLAGS" dfltCFLAGS
    let debug_flags = if (cDebug flags) then "-g" else ""
    bsc_cflags <- getEnvDef "BSC_CFLAGS" dfltBSC_CFLAGS
    let cmd = unwords $ [ comp, cflags, debug_flags, bsc_cflags ] ++ sws ++ fs
    return cmd

-- Call the C++ compiler (typically to generate .o from .cxx)
--   sws = switches (like -c, -o)
--   fs  = filenames
cxxCompile :: ErrorHandle -> Flags -> [String] -> [String] -> IO ()
cxxCompile errh flags sws fs = do
    cmd <- cmdCXXCompile flags sws fs
    execCmd errh flags cmd

-- Construct the C++ compiler command (typically to generate .o from .cxx)
--   sws = switches (like -c, -o)
--   fs  = filenames
cmdCXXCompile :: Flags -> [String] -> [String] -> IO String
cmdCXXCompile flags sws fs = do
    comp <- getEnvDef "CXX" dfltCxxCompile
    cflags <- getEnvDef "CXXFLAGS" dfltCXXFLAGS
    let debug_flags = if (cDebug flags) then "-g" else ""
    bsc_cflags <- getEnvDef "BSC_CXXFLAGS" dfltBSC_CXXFLAGS
    let cmd = unwords $ [ comp, cflags, debug_flags, bsc_cflags ] ++ sws ++ fs
    return cmd

-- Execute the command constructed by one of the above functions
execCmd :: ErrorHandle -> Flags -> String -> IO ()
execCmd errh flags cmd = do
    when (verbose flags) $ putStrLnF ("exec: " ++ cmd)
    rc <- system cmd
    case rc of
        ExitSuccess   -> return ()
        ExitFailure n -> exitFailWith errh n


-- link object files into a shared library
cxxLink :: ErrorHandle -> Flags -> String -> [String] -> TimeInfo -> IO ()
cxxLink errh flags toplevel names creation_time = do
    -- Construct the Bluesim object names
    let bsimLibDir = (bluespecDir flags) ++ "/Bluesim/"
        bsim_names = [ bsimLibDir ++ "lib" ++ name ++ ".a"
                     | name <- ["bskernel", "bsprim"] ]

    -- The schedule.o object should come after libkernel.a
    -- in the link order.  We remove it from names and let
    -- cFiles put it in the correct place.
    let isSchedule n = (baseName n == ("model_" ++ toplevel ++ ".o"))
        (schedule_name, other_names) = partition isSchedule names
        compile_names =
            other_names ++
            schedule_name ++
            bsim_names
    -- link the objects into a .so file
    when (verbose flags) $ putStrLnF "linking"
    let outFile = oFile flags
        soFile = if (dirName outFile) == "."
                 then mkSoName Nothing "" (baseName outFile)
                 else mkSoName (Just (dirName outFile)) "" (baseName outFile)
        -- show is used for quoting
        libdirflags = (map (("-L"++) . show) (cLibPath flags))
        userlibs = map (("-l"++) . show) (cLibs flags)
        exportmap = let binfmt = map toLower (binFmtToString getBinFmtType)
                    in  show $ (bluespecDir flags) ++ "/Bluesim/" ++
                               "bs_" ++ binfmt ++ "_export_map.txt"
        -- this flag doesn't seem to work, so we use a separate call to "strip"
        stripflags = [] -- if (cDebug flags) then [] else ["-Wl,-x"]
        switches =
          case getBinFmtType of
            ELF   -> ["-shared", "-fPIC", "-Wl,-Bsymbolic"] ++ libdirflags ++
                     ["-Wl,--version-script=" ++ exportmap] ++ stripflags ++
                     ["-o", soFile]
            MachO -> ["-dynamiclib", "-fPIC"] ++ libdirflags ++
                     ["-exported_symbols_list", exportmap] ++ stripflags ++
                     ["-o", soFile]
        -- show is used for quoting
        opts = map show $ linkFlags flags
        files = map show compile_names ++ ["-lm"] ++ userlibs
    cxxCompile errh flags (opts ++ switches) files
    when (not (cDebug flags)) $ cleanseSharedLib errh flags soFile
    unless (quiet flags) $ putStrLnF ("Simulation shared library created: " ++ soFile)
    -- Write a script to execute bluesim.tcl with the .so file argument
    let bluesim_cmd = "$BLUESPECDIR/tcllib/bluespec/bluesim.tcl"
        (TimeInfo _ (TOD t _)) = creation_time
        time_flags = if (timeStamps flags)
                     then [ "--creation_time", show t]
                     else []
    writeFileCatch errh outFile $
                   unlines [ "#!/bin/sh"
                           , ""
                           , "BLUESPECDIR=`echo 'puts $env(BLUESPECDIR)' | bluetcl`"
                           , ""
                           , "for arg in $@"
                           , "do"
                           , "  if (test \"$arg\" = \"-h\")"
                           , "  then"
                           , "    " ++ (unwords ["exec", bluesim_cmd, "$0.so", toplevel, "--script_name", "`basename $0`", "-h"])
                           , "  fi"
                           , "done"
                           , unwords $ ["exec", bluesim_cmd, "$0.so", toplevel, "--script_name", "`basename $0`"] ++ time_flags ++ ["\"$@\""]
                           ]
    stat <- getFileStatus outFile
    let mode = fileMode stat
        mode' = foldl1 unionFileModes [mode, ownerExecuteMode, groupExecuteMode]
    setFileMode outFile mode'
    unless (quiet flags) $ putStrLnF ("Simulation executable created: " ++ outFile)

-- strip unwanted symbols from a .so file
cleanseSharedLib :: ErrorHandle -> Flags -> String -> IO ()
cleanseSharedLib errh flags soFile = do
    let switches = case getBinFmtType of
                      ELF    -> ["-x"]
                      MachO  -> ["-u", "-x"]
        cmd = unwords $ ["strip"] ++ switches ++ [soFile]
    when (verbose flags) $ putStrLnF ("exec: " ++ cmd)
    rc <- system cmd
    case rc of
        ExitSuccess   -> return ()
        ExitFailure n -> exitFailWith errh n

-- ===============
-- vLink

vLink :: ErrorHandle -> Flags ->
         String -> [VFileName] -> [String] -> [String] -> IO ()
vLink errh flags topmod_name vfilenames0 afilenames cfilenames = do
    tStart <- getNow
    let t = tStart

    -- XXX (file, package, module) names for %-substitution in dump filenames
    let dumpnames = ("","","")

    pwd <- getCurrentDirectory
    let name = createEncodedFullFilePath "placeholder" pwd
        prefix = (dirName name) ++ "/"

    -- in case the user listed the same file twice
    let afilenames_unique = nub afilenames
    let cfilenames_unique = nub cfilenames

    -- check that .c and .o files listed on the command-line exist
    missing <- missingUserFiles flags cfilenames_unique
    when (not (null missing)) $
        bsError errh
            [(cmdPosition, EMissingUserFile f ["."]) | f <- missing]
    t <- timestampStr flags "confirm C files exist" t

    -- read in the abin files (check hash and that they are Verilog files)
    start flags DFreadelab
    let read_abin_fn = readAndCheckABin errh (Just Verilog)
    user_abis <- mapM read_abin_fn afilenames_unique

    -- see if .ba files exist for the top-level of this design
    let prim_names = map sb_name primBlocks
    mhier0 <- runErrorT $
              getABIHierarchy errh
                  (verbose flags) (ifcPath flags) (Just Verilog)
                  prim_names topmod_name user_abis

    mhier <- case mhier0 of
                  Left msgs -> return (Left msgs)
                  Right (a, b, c, d, e, f, emodinfos) -> do
                      mres <- runErrorT (assertNoSchedErr emodinfos)
                      case mres of
                        Left msgs -> return (Left msgs)
                        Right modinfos -> return $
                                          Right (a, b, c, d, e, f, modinfos)

    (ffuncs, mod_abmis) <-
        case (mhier) of
          Left _ -> do
            -- this design doesn't exist as .ba file
            --traceM("Elaboration files not loaded for this design")
            -- resort to what we know from the command line

            when ((null user_abis) && (not (null cfilenames))) $
                 bsError errh [(cmdPosition, EVPIFilesWithNoABin cfilenames)]

            -- identify which are ffunc and which are mods
            let (ffunc_abis, mod_abis) =
                    let isFF (ABinForeignFunc {}) = True
                        isFF _                    = False
                    in  partition (isFF . snd) user_abis

            -- confirm that there are no duplicate imports of
            -- the same link name
            let -- pair the ffunc name with the filename, for error reporting
                ff_pairs =
                    [ (name, filename)
                    | (filename, a@(ABinForeignFunc {})) <- ffunc_abis
                    , let name = ff_name (abffi_foreign_func (ab_ffuncinfo a))
                    ]
                ff_duplicates = filter ((>1) . length . snd) (joinByFst ff_pairs)
            case (ff_duplicates) of
              [] -> return ()
              ((link_id, file_names):_) ->
                  let link_name = getIdString link_id
                  in  bsError errh
                          [(cmdPosition,
                            EMultipleABinFilesForName link_name file_names)]

            -- XXX Until we allow re-generation of Verilog files,
            -- XXX the module .ba files are unused
            when (not (null (mod_abis))) $
                bsWarning errh
                    [(cmdPosition, WExtraABinFiles (map fst mod_abis))]

            let ffuncs = [ abffi_foreign_func abfi
                           | (_, (ABinForeignFunc abfi _)) <- ffunc_abis ]
                abmis  = [ (filename, abmi)
                           | (filename, (ABinMod abmi _)) <- mod_abis ]
            return (ffuncs, abmis)

          Right (_, _, _, ffuncmap, filemap, _, mod_infos) -> do
            --traceM("Elaboration files loaded for this design")
            let user_ffuncs = M.elems ffuncmap
                findModFilename m =
                    case (M.lookup m filemap) of
                      Just filename -> filename
                      Nothing -> internalError ("findModFilename: " ++
                                                ppReadable m)
                abmis = [ (findModFilename modname, abmi)
                          | (modname, (abmi, _)) <- mod_infos ]
            return (user_ffuncs, abmis)

    t <- dump errh flags t DFreadelab dumpnames
             (map (pfpString . ff_name) ffuncs ++ map fst mod_abmis)

{-
    -- generate Verilog for the module abis
    -- XXX only if the verilog doesn't exist or is older
    -- XXX print a message about reusing a file?
    (t, gen_vfilenames) <-
        if (updCheck flags)
        then vGenMods t flags mod_abmis
        else return (t, [])
    let vfilenames = vfilenames0  ++ gen_vfilenames
-}
    let vfilenames = vfilenames0

    -- generate files for the foreign functions
    start flags DFcompileVPI
    (t, ofiles) <- vGenFFuncs errh flags t prefix cfilenames_unique ffuncs
    t <- dump errh flags t DFcompileVPI dumpnames ofiles

    -- pass the info to vSimLink: array, location of files, -I, -L, -l
    start flags DFveriloglink
    vSimLink errh flags topmod_name prefix vfilenames ofiles
    t <- dump errh flags t DFveriloglink dumpnames
             ((map vfnString vfilenames) ++ ofiles)

    -- final verbose message
    _ <- timestampStr flags "total" tStart

    return ()

-- ===============

-- build a verilog simulator by calling bsc_build_vsim_simname with appropriate
-- arguments (where simname is the relevant simulator)
-- simname is determined from (in order of decreasing priority):
--   - the command-line flag -vsim
--   - the environment variable BSC_VERILOG_SIM
--   - any auto-detected simulator
vSimLink ::  ErrorHandle -> Flags ->
             String -> String -> [VFileName] -> [String] -> IO ()
vSimLink errh flags toplevel prefix vfiles ofiles = do
    build_script <- getVerilogSim errh flags
    let bsdir = bluespecDir flags
        libdirflags = map ("-L "++) (cLibPath flags)
        userlibs = map ("-l "++) (cLibs flags)
        macrodefs = map ("-D " ++) (defines flags)
        pathlibs = map ("-y "++) (vPath flags)
        outFile = oFile flags
        veriflags = map ("-Xv "++) (vFlags flags)
        linkerflags = map ("-Xl "++) (linkFlags flags)
        verboseflag = if (verbose flags) then ["-verbose"] else []
        dpiflag = if (useDPI flags) then ["-dpi"] else []
        args = (["link"
                , outFile
                , toplevel ] ++
                verboseflag ++
                dpiflag ++
                libdirflags ++
                userlibs ++
                linkerflags ++
                macrodefs ++
                pathlibs ++
                veriflags ++
                veriFiles bsdir ++
                (map vfnString vfiles) ++
                ofiles)
        cmd = unwords (build_script : args)
    when (verbose flags) $ putStrLnF ("exec: " ++ cmd)
    rc <- system cmd
    case rc of
        ExitSuccess -> unless (quiet flags) $ putStrLnF ("Verilog binary file created: " ++ outFile)
        ExitFailure n -> exitFailWith errh n

veriFiles :: String -> [String]
veriFiles path =
        map ((path ++ "/Verilog/") ++) ["main.v"]

-- return the path to a Verilog simulator or die with an error
getVerilogSim :: ErrorHandle -> Flags -> IO String
getVerilogSim errh flags = do
    vsim_env <- getEnvDef "BSC_VERILOG_SIM" ""
    let vsim_name_flags_or_env = maybe vsim_env id (vsim flags)
    vsim_name <- if vsim_name_flags_or_env == ""
                 then do avail_vsims <- findAllAvailableSims flags
                         if (null avail_vsims)
                          then return ""
                          else return $ head avail_vsims
                 else return vsim_name_flags_or_env
    when (vsim_name == "") $ give_error flags vsim_name
    let vsim_path | any (== '/') vsim_name = vsim_name
                  | otherwise = (bluespecDir flags ++ "/exec/bsc_build_vsim_" ++
                                 vsim_name)
    valid_path <- doesFileExist vsim_path
    when (not valid_path) $ give_error flags vsim_name
    isExec <- fileAccess vsim_path False False True
    when (not isExec) $ give_error flags vsim_name
    return vsim_path
  where give_error flags vsim_name =
            do avail_vsims <- findAllAvailableSims flags
               let no_sims_err = (cmdPosition, EUnknownVerilogSim vsim_name (sort avail_vsims) True)
               bsError errh [no_sims_err]

-- find all available simulators
findAllAvailableSims :: Flags -> IO [String]
findAllAvailableSims flags =
    do let script_dir = bluespecDir flags ++ "/exec"
       all_files <- getDirectoryContents script_dir
       let sim_scripts = filter ("bsc_build_vsim_" `isPrefixOf`) all_files
       sim_script_results <- mapM (checkSimScript script_dir) sim_scripts
       let successful_sim_scripts = map snd (filter fst sim_script_results)
       return (nub successful_sim_scripts)
    `CE.catch` return_empty_list
    where
    return_empty_list :: CE.SomeException -> IO [String]
    return_empty_list e = return []

-- XXX: replace this implementation with one using readProcessWithExitCode
-- XXX: once everyone is using GHC >= 6.10.
checkSimScript :: String -> String -> IO (Bool,String)
checkSimScript dir script =
    do (hin, hout, _, pid) <- runInteractiveProcess (dir ++ "/" ++ script) ["detect"] Nothing Nothing
       outMVar <- newEmptyMVar
       out <- hGetContents hout
       _ <- forkIO $ CE.evaluate (length out) >> putMVar outMVar ()
       hClose hin
       takeMVar outMVar
       hClose hout
       status <- waitForProcess pid
       let canonical_sim_name = takeWhile (not.isSpace) out
       return ((status == ExitSuccess),canonical_sim_name)

-- ===============

vGenFFuncs :: ErrorHandle -> Flags -> TimeInfo -> String ->
              [String] -> [ForeignFunction] ->
              IO (TimeInfo, [String])
vGenFFuncs errh flags t prefix cfilenames_unique [] = return (t,[])
vGenFFuncs errh flags t prefix cfilenames_unique ffuncs = do
      t <-
        if (useDPI flags) then return t
        else do
          -- generate the vpi_startup_array file
          blurb <- mkGenFileHeader flags
          genVPIRegistrationArray errh flags prefix blurb ffuncs
          timestampStr flags "generate VPI registration array" t

      -- compile user-supplied C files
      let (cfiles1, ofiles1) = partition (\f -> hasDotSuf cSuffix f   ||
                                                hasDotSuf cxxSuffix f ||
                                                hasDotSuf cppSuffix f ||
                                                hasDotSuf ccSuffix f
                                         )
                                         cfilenames_unique
      ofiles2 <- mapM (compileUserCFile errh flags True) cfiles1
      t <- timestampStr flags "compile user-provided C files" t

{-
      -- XXX If any of BSC's pre-compiled .ba libraries has a VPI wrapper
      -- XXX that goes along with it, they would need to included here?
      do let to = fromMaybe "." (vdir flags)
         mapM_ (\src -> do let dst = to ++ "/" ++ (baseName src)
                           copyFileCatch errh src dst)
               vpi_wrapper_c_h_files
-}

      (t, ofiles3) <-
        if (useDPI flags) then return (t, [])
        else do
          -- compile all necessary vpi wrapper files
          let mkVPIFileName s = mkVPICName (vdir flags) prefix s
              vpifiles = map (mkVPIFileName . getIdString . ff_name) ffuncs ++
                         [ mkVPIArrayCName (vdir flags) prefix ]
          files <- mapM (compileVPICFile errh flags) vpifiles
          t <- timestampStr flags "compile VPI wrapper files" t
          return (t, files)

      return (t, ofiles1 ++ ofiles2 ++ ofiles3)

-- ===============

{-
vGenMods :: TimeInfo -> Flags -> [(String, ABinModInfo)] ->
            IO (TimeInfo, [VFileName])
vGenMods t0 flags abmis = do
    -- function to generate an individual module
    let genV (t, vfilenames_so_far) (filename, abmi@(ABinModInfo {})) = do
            let modId = apkg_name (abmi_apkg abmi)
                modstr = getIdString (unQualId modId)
            -- XXX should the file and package name be set?
            let dumpnames = ("", "", modstr)
            -- verbose message
            when (verbose flags) $ putStrLnF ("*****")
            when (showCodeGen flags || verbose flags) $
                putStrLnF ("Verilog generation for " ++ modstr ++ " starts")
            -- prepare directory info
            pwd <- getCurrentDirectory
            let filename' = createEncodedFullFilePath filename pwd
                prefix = dirName filename' ++ "/"
            -- call into the regular flow
            blurb <- mkGenFileHeader flags
            let apkg = abmi_apkg abmi
                pps = abmi_pps abmi
                methodConflict = abmi_method_dump abmi
                methodConflictBlurb
                  | methodConf flags =
                      ["Method conflict info:"]
                      ++ lines (pretty 78 78
                                   (vcat (dumpMethodInfo flags methodConflict)))
                  | otherwise = []
                pathinfo = abmi_pathinfo abmi
                aschedinfo = abmi_aschedinfo abmi
            (t, _, _) <-
                genModuleVerilog pps flags dumpnames t prefix modstr
                    blurb methodConflictBlurb pathinfo aschedinfo apkg
            -- result
            return (t, vfilenames ++ vfilenames_so_far)

    -- generate the Verilog files
    foldM genV (t0,[]) abmis
-}

-- ===============

missingUserFiles :: Flags -> [String] -> IO [String]
missingUserFiles flags cSrcFiles = filterM cantFind cSrcFiles
  where cantFind f = do x <- readFileMaybe f
                        return $ isNothing x

-- ===============

compileCDefToIDef :: ErrorHandle -> Flags -> DumpNames -> SymTab ->
                     IPackage a -> CDefn -> IO (IDef a, Bool)
compileCDefToIDef errh flags dumpnames symt ipkg def =
 do
    let pkgid = ipkg_name ipkg
    let cpkg0 = CPackage pkgid (Left []) [] [] [def] []
    t <- getNow

    start flags DFctxreduce
    cpkg_ctx <- cCtxReduceIO errh flags symt cpkg0
    t <- dump errh flags t DFctxreduce dumpnames cpkg_ctx

    start flags DFtypecheck
    (cpkg_chk, tcErrors) <- cTypeCheck errh flags symt cpkg_ctx
    t <- dump errh flags t DFtypecheck dumpnames cpkg_chk

    start flags DFsimplified
    let cpkg_simp@(CPackage _ _ _ _ [def'] _) = simplify flags cpkg_chk
    t <- dump errh flags t DFsimplified dumpnames cpkg_simp

    start flags DFinternal
    let idef = iConvDef errh flags symt ipkg def'
    t <- dump errh flags t DFinternal dumpnames idef

    return (idef, not tcErrors)

-- ===============

iPCheck :: Flags -> SymTab -> IPackage a -> String -> IO ()
iPCheck flags symt ipkg desc = --hyper ipkg $
        if doICheck flags && not (tCheckIPackage flags symt ipkg)
            then internalError (
                "internal typecheck failed (iPCheck after " ++
                desc ++ ")")
            else
                if (verbose flags)
                    then putStrLnF "types OK"
                    else return ()

iMCheck :: Flags -> SymTab -> IModule a -> String -> IO ()
iMCheck flags symt imod desc =
    if doICheck flags && not (tCheckIModule flags symt imod)
        then internalError (
                "internal typecheck failed (iMCheck after " ++
                desc ++ ")")
        else
            if (verbose flags)
                then putStrLnF "types OK"
                else return ()

aCheck :: Flags -> APackage -> String -> IO ()
aCheck flags amod desc =
    if doICheck flags && not (aMCheck amod)
        then internalError (
                "internal typecheck failed (aCheck after " ++
                desc ++ ")")
        else
            if (verbose flags)
                then putStrLnF "types OK"
                else return ()

asCheck :: Flags -> ASPackage -> String -> IO ()
asCheck flags asmod desc
    | doICheck flags && not (aSMCheck asmod) =
        internalError ("internal typecheck failed (asCheck after "
                       ++ desc ++ ")")
    | verbose flags = putStrLnF "types OK"
    | otherwise = return ()

asMethCheck :: Flags -> ASPackage -> String -> IO ()
asMethCheck flags asmod desc =
    if (doICheck flags && not (aSMethCheck asmod))
    then internalError ("internal method check failed (asMethCheck after "
                        ++ desc ++ ")")
    else return ()  --putStrLnF "method check OK"

asSignalCheck :: Flags -> ASPackage -> String -> IO ()
asSignalCheck flags asmod desc =
    let undefined_names = aSignalCheck asmod
    in  if (doICheck flags) && (length undefined_names > 0)
        then internalError
                 ("internal signal check failed (asSignalCheck after "
                  ++ desc ++ "): " ++ ppReadable undefined_names)
        else if (verbose flags)
             then putStrLnF "signals OK"
             else return ()

-- ===============

-- builds a map from link name to ForeignFunction
buildForeignFunctionMap :: ErrorHandle -> [(String,ABin)] -> IO ForeignFuncMap
buildForeignFunctionMap errh abis = build abis M.empty
  where build [] ff_map = return ff_map
        build ((name, (ABinMod {})):_) _ =
          bsError errh [(noPosition, EWrongABinTypeExpectedForeignFunc name "")]
        build ((name, abi):abis) ff_map =
          do let ff = abffi_foreign_func (ab_ffuncinfo abi)
                 ff_map' = M.insert (getIdString (ff_name ff)) ff ff_map
             build abis ff_map'