ghc/compiler/main/DriverFlags.hs

   1 -----------------------------------------------------------------------------
   2 -- $Id: DriverFlags.hs,v 1.4 2000/10/16 14:26:26 simonmar Exp $
   3 --
   4 -- Driver flags
   5 --
   6 -- (c) Simon Marlow 2000
   7 --
   8 -----------------------------------------------------------------------------
   9
  10 module DriverFlags where
  11
  12 #include "HsVersions.h"
  13
  14 import PackageMaintenance
  15 import DriverState
  16 import DriverUtil
  17 import CmdLineOpts
  18 import Config
  19 import Util
  20 import CmdLineOpts
  21
  22 import Exception
  23 import IOExts
  24 import IO
  25 import System
  26 import Char
  27
  28 -----------------------------------------------------------------------------
  29 -- Flags
  30
  31 -- Flag parsing is now done in stages:
  32 --
  33 --     * parse the initial list of flags and remove any flags understood
  34 --       by the driver only.  Determine whether we're in multi-compilation
  35 --       or single-compilation mode.
  36 --
  37 --     * gather the list of "static" hsc flags, and assign them to the global
  38 --       static hsc flags variable.
  39 --
  40 --     * build the inital DynFlags from the remaining flags.
  41 --
  42 --     * complain if we've got any flags left over.
  43 --
  44 --     * for each source file: grab the OPTIONS, and build a new DynFlags
  45 --       to pass to the compiler.
  46
  47 -----------------------------------------------------------------------------
  48 -- Process command-line
  49
  50 data OptKind
  51         = NoArg (IO ())                     -- flag with no argument
  52         | HasArg (String -> IO ())          -- flag has an argument (maybe prefix)
  53         | SepArg (String -> IO ())          -- flag has a separate argument
  54         | Prefix (String -> IO ())          -- flag is a prefix only
  55         | OptPrefix (String -> IO ())       -- flag may be a prefix
  56         | AnySuffix (String -> IO ())       -- flag is a prefix, pass whole arg to fn
  57         | PassFlag  (String -> IO ())       -- flag with no arg, pass flag to fn
  58         | PrefixPred (String -> Bool) (String -> IO ())
  59         | AnySuffixPred (String -> Bool) (String -> IO ())
  60
  61 processArgs :: [(String,OptKind)] -> [String] -> [String]
  62    -> IO [String]  -- returns spare args
  63 processArgs _spec [] spare = return (reverse spare)
  64 processArgs spec args@(arg@('-':_):args') spare = do
  65   case findArg spec arg of
  66     Just (rest,action) ->
  67       do args' <- processOneArg action rest args
  68          processArgs spec args' spare
  69     Nothing ->
  70       processArgs spec args' (arg:spare)
  71 processArgs spec (arg:args) spare =
  72   processArgs spec args (arg:spare)
  73
  74 processOneArg :: OptKind -> String -> [String] -> IO [String]
  75 processOneArg action rest (dash_arg@('-':arg):args) =
  76   case action of
  77         NoArg  io ->
  78                 if rest == ""
  79                         then io >> return args
  80                         else unknownFlagErr dash_arg
  81
  82         HasArg fio ->
  83                 if rest /= ""
  84                         then fio rest >> return args
  85                         else case args of
  86                                 [] -> unknownFlagErr dash_arg
  87                                 (arg1:args1) -> fio arg1 >> return args1
  88
  89         SepArg fio ->
  90                 case args of
  91                         [] -> unknownFlagErr dash_arg
  92                         (arg1:args1) -> fio arg1 >> return args1
  93
  94         Prefix fio ->
  95                 if rest /= ""
  96                         then fio rest >> return args
  97                         else unknownFlagErr dash_arg
  98
  99         PrefixPred p fio ->
 100                 if rest /= ""
 101                         then fio rest >> return args
 102                         else unknownFlagErr dash_arg
 103
 104         OptPrefix fio       -> fio rest >> return args
 105
 106         AnySuffix fio       -> fio dash_arg >> return args
 107
 108         AnySuffixPred p fio -> fio dash_arg >> return args
 109
 110         PassFlag fio  ->
 111                 if rest /= ""
 112                         then unknownFlagErr dash_arg
 113                         else fio dash_arg >> return args
 114
 115 findArg :: [(String,OptKind)] -> String -> Maybe (String,OptKind)
 116 findArg spec arg
 117   = case [ (remove_spaces rest, k)
 118          | (pat,k) <- spec, Just rest <- [my_prefix_match pat arg],
 119            arg_ok k arg rest ]
 120     of
 121         []      -> Nothing
 122         (one:_) -> Just one
 123
 124 arg_ok (NoArg _)            rest arg = null rest
 125 arg_ok (HasArg _)           rest arg = True
 126 arg_ok (SepArg _)           rest arg = null rest
 127 arg_ok (Prefix _)           rest arg = not (null rest)
 128 arg_ok (PrefixPred p _)     rest arg = not (null rest) && p rest
 129 arg_ok (OptPrefix _)        rest arg = True
 130 arg_ok (PassFlag _)         rest arg = null rest
 131 arg_ok (AnySuffix _)        rest arg = not (null rest)
 132 arg_ok (AnySuffixPred p _)  rest arg = not (null rest) && p arg
 133
 134 -----------------------------------------------------------------------------
 135 -- Static flags
 136
 137 -- note that ordering is important in the following list: any flag which
 138 -- is a prefix flag (i.e. HasArg, Prefix, OptPrefix, AnySuffix) will override
 139 -- flags further down the list with the same prefix.
 140
 141 static_flags =
 142   [  ------- help -------------------------------------------------------
 143      ( "?"              , NoArg long_usage)
 144   ,  ( "-help"          , NoArg long_usage)
 145
 146
 147       ------- version ----------------------------------------------------
 148   ,  ( "-version"        , NoArg (do hPutStrLn stdout (cProjectName
 149                                       ++ ", version " ++ version_str)
 150                                      exitWith ExitSuccess))
 151   ,  ( "-numeric-version", NoArg (do hPutStrLn stdout version_str
 152                                      exitWith ExitSuccess))
 153
 154       ------- verbosity ----------------------------------------------------
 155   ,  ( "v"              , NoArg (writeIORef verbose True) )
 156   ,  ( "n"              , NoArg (writeIORef dry_run True) )
 157
 158         ------- recompilation checker --------------------------------------
 159   ,  ( "recomp"         , NoArg (writeIORef recomp True) )
 160   ,  ( "no-recomp"      , NoArg (writeIORef recomp False) )
 161
 162         ------- ways --------------------------------------------------------
 163   ,  ( "prof"           , NoArg (addNoDups ways WayProf) )
 164   ,  ( "unreg"          , NoArg (addNoDups ways WayUnreg) )
 165   ,  ( "dll"            , NoArg (addNoDups ways WayDll) )
 166   ,  ( "ticky"          , NoArg (addNoDups ways WayTicky) )
 167   ,  ( "parallel"       , NoArg (addNoDups ways WayPar) )
 168   ,  ( "gransim"        , NoArg (addNoDups ways WayGran) )
 169   ,  ( "smp"            , NoArg (addNoDups ways WaySMP) )
 170   ,  ( "debug"          , NoArg (addNoDups ways WayDebug) )
 171         -- ToDo: user ways
 172
 173         ------ Debugging ----------------------------------------------------
 174   ,  ( "dppr-noprags",     PassFlag (add opt_C) )
 175   ,  ( "dppr-debug",       PassFlag (add opt_C) )
 176   ,  ( "dppr-user-length", AnySuffix (add opt_C) )
 177       -- rest of the debugging flags are dynamic
 178
 179         ------- Interface files ---------------------------------------------
 180   ,  ( "hi"             , NoArg (writeIORef produceHi True) )
 181   ,  ( "nohi"           , NoArg (writeIORef produceHi False) )
 182
 183         --------- Profiling --------------------------------------------------
 184   ,  ( "auto-dicts"     , NoArg (add opt_C "-fauto-sccs-on-dicts") )
 185   ,  ( "auto-all"       , NoArg (add opt_C "-fauto-sccs-on-all-toplevs") )
 186   ,  ( "auto"           , NoArg (add opt_C "-fauto-sccs-on-exported-toplevs") )
 187   ,  ( "caf-all"        , NoArg (add opt_C "-fauto-sccs-on-individual-cafs") )
 188          -- "ignore-sccs"  doesn't work  (ToDo)
 189
 190   ,  ( "no-auto-dicts"  , NoArg (add anti_opt_C "-fauto-sccs-on-dicts") )
 191   ,  ( "no-auto-all"    , NoArg (add anti_opt_C "-fauto-sccs-on-all-toplevs") )
 192   ,  ( "no-auto"        , NoArg (add anti_opt_C "-fauto-sccs-on-exported-toplevs") )
 193   ,  ( "no-caf-all"     , NoArg (add anti_opt_C "-fauto-sccs-on-individual-cafs") )
 194
 195         ------- Miscellaneous -----------------------------------------------
 196   ,  ( "no-link-chk"    , NoArg (return ()) ) -- ignored for backwards compat
 197
 198         ------- Output Redirection ------------------------------------------
 199   ,  ( "odir"           , HasArg (writeIORef output_dir  . Just) )
 200   ,  ( "o"              , SepArg (writeIORef output_file . Just) )
 201   ,  ( "osuf"           , HasArg (writeIORef output_suf  . Just) )
 202   ,  ( "hisuf"          , HasArg (writeIORef hi_suf) )
 203   ,  ( "tmpdir"         , HasArg (writeIORef v_TmpDir . (++ "/")) )
 204   ,  ( "ohi"            , HasArg (\s -> case s of
 205                                           "-" -> writeIORef hi_on_stdout True
 206                                           _   -> writeIORef output_hi (Just s)) )
 207         -- -odump?
 208
 209   ,  ( "keep-hc-file"   , AnySuffix (\_ -> writeIORef keep_hc_files True) )
 210   ,  ( "keep-s-file"    , AnySuffix (\_ -> writeIORef keep_s_files  True) )
 211   ,  ( "keep-raw-s-file", AnySuffix (\_ -> writeIORef keep_raw_s_files  True) )
 212   ,  ( "keep-tmp-files" , AnySuffix (\_ -> writeIORef keep_tmp_files True) )
 213
 214   ,  ( "split-objs"     , NoArg (if can_split
 215                                     then do writeIORef split_object_files True
 216                                             add opt_C "-fglobalise-toplev-names"
 217 -- TODO!!!!!                                add opt_c "-DUSE_SPLIT_MARKERS"
 218                                     else hPutStrLn stderr
 219                                             "warning: don't know how to  split \
 220                                             \object files on this architecture"
 221                                 ) )
 222
 223         ------- Include/Import Paths ----------------------------------------
 224   ,  ( "i"              , OptPrefix (addToDirList import_paths) )
 225   ,  ( "I"              , Prefix    (addToDirList include_paths) )
 226
 227         ------- Libraries ---------------------------------------------------
 228   ,  ( "L"              , Prefix (addToDirList library_paths) )
 229   ,  ( "l"              , Prefix (add cmdline_libraries) )
 230
 231         ------- Packages ----------------------------------------------------
 232   ,  ( "package-name"   , HasArg (\s -> add opt_C ("-inpackage="++s)) )
 233
 234   ,  ( "package"        , HasArg (addPackage) )
 235   ,  ( "syslib"         , HasArg (addPackage) ) -- for compatibility w/ old vsns
 236
 237   ,  ( "-list-packages"  , NoArg (listPackages) )
 238   ,  ( "-add-package"    , NoArg (newPackage) )
 239   ,  ( "-delete-package" , SepArg (deletePackage) )
 240
 241         ------- Specific phases  --------------------------------------------
 242   ,  ( "pgmL"           , HasArg (writeIORef pgm_L) )
 243   ,  ( "pgmP"           , HasArg (writeIORef pgm_P) )
 244   ,  ( "pgmc"           , HasArg (writeIORef pgm_c) )
 245   ,  ( "pgmm"           , HasArg (writeIORef pgm_m) )
 246   ,  ( "pgms"           , HasArg (writeIORef pgm_s) )
 247   ,  ( "pgma"           , HasArg (writeIORef pgm_a) )
 248   ,  ( "pgml"           , HasArg (writeIORef pgm_l) )
 249
 250   ,  ( "optdep"         , HasArg (add opt_dep) )
 251   ,  ( "optl"           , HasArg (add opt_l) )
 252   ,  ( "optdll"         , HasArg (add opt_dll) )
 253
 254         ------ Warning opts -------------------------------------------------
 255   ,  ( "W"              , NoArg (writeIORef warning_opt W_) )
 256   ,  ( "Wall"           , NoArg (writeIORef warning_opt W_all) )
 257   ,  ( "Wnot"           , NoArg (writeIORef warning_opt W_not) )
 258   ,  ( "w"              , NoArg (writeIORef warning_opt W_not) )
 259
 260         ----- Linker --------------------------------------------------------
 261   ,  ( "static"         , NoArg (writeIORef static True) )
 262
 263         ------ Compiler flags -----------------------------------------------
 264   ,  ( "O2-for-C"          , NoArg (writeIORef opt_minus_o2_for_C True) )
 265   ,  ( "O"                 , OptPrefix (setOptLevel) )
 266
 267   ,  ( "fasm"              , OptPrefix (\_ -> writeIORef hsc_lang HscAsm) )
 268
 269   ,  ( "fvia-c"            , NoArg (writeIORef hsc_lang HscC) )
 270   ,  ( "fvia-C"            , NoArg (writeIORef hsc_lang HscC) )
 271
 272   ,  ( "fno-asm-mangling"  , NoArg (writeIORef do_asm_mangling False) )
 273
 274   ,  ( "fmax-simplifier-iterations",
 275                 Prefix (writeIORef opt_MaxSimplifierIterations . read) )
 276
 277   ,  ( "fusagesp"          , NoArg (do writeIORef opt_UsageSPInf True
 278                                        add opt_C "-fusagesp-on") )
 279
 280   ,  ( "fexcess-precision" , NoArg (do writeIORef excess_precision True
 281                                        add opt_C "-fexcess-precision"))
 282
 283         -- flags that are "active negatives"
 284   ,  ( "fno-implicit-prelude"   , PassFlag (add opt_C) )
 285   ,  ( "fno-prune-tydecls"      , PassFlag (add opt_C) )
 286   ,  ( "fno-prune-instdecls"    , PassFlag (add opt_C) )
 287   ,  ( "fno-pre-inlining"       , PassFlag (add opt_C) )
 288
 289         -- All other "-fno-<blah>" options cancel out "-f<blah>" on the hsc cmdline
 290   ,  ( "fno-",                  PrefixPred (\s -> isStaticHscFlag ("f"++s))
 291                                     (\s -> add anti_opt_C ("-f"++s)) )
 292
 293         -- Pass all remaining "-f<blah>" options to hsc
 294   ,  ( "f",                     AnySuffixPred (isStaticHscFlag) (add opt_C) )
 295   ]
 296
 297 -----------------------------------------------------------------------------
 298 -- parse the dynamic arguments
 299
 300 GLOBAL_VAR(v_DynFlags, error "no dynFlags", DynFlags)
 301
 302 setDynFlag f = do
 303    dfs <- readIORef v_DynFlags
 304    writeIORef v_DynFlags dfs{ flags = f : flags dfs }
 305
 306 unSetDynFlag f = do
 307    dfs <- readIORef v_DynFlags
 308    writeIORef v_DynFlags dfs{ flags = filter (/= f) (flags dfs) }
 309
 310 dynamic_flags = [
 311
 312      ( "cpp",           NoArg  (updateState (\s -> s{ cpp_flag = True })) )
 313   ,  ( "#include",      HasArg (addCmdlineHCInclude) )
 314
 315   ,  ( "optL",          HasArg (addOpt_L) )
 316   ,  ( "optP",          HasArg (addOpt_P) )
 317   ,  ( "optc",          HasArg (addOpt_c) )
 318   ,  ( "optm",          HasArg (addOpt_m) )
 319   ,  ( "opta",          HasArg (addOpt_a) )
 320
 321         ------ HsCpp opts ---------------------------------------------------
 322   ,  ( "D",             Prefix (\s -> addOpt_P ("-D'"++s++"'") ) )
 323   ,  ( "U",             Prefix (\s -> addOpt_P ("-U'"++s++"'") ) )
 324
 325         ------ Debugging ----------------------------------------------------
 326   ,  ( "dstg-stats",    NoArg (writeIORef opt_StgStats True) )
 327
 328   ,  ( "ddump_all",              NoArg (setDynFlag Opt_D_dump_all) )
 329   ,  ( "ddump_most",             NoArg (setDynFlag Opt_D_dump_most) )
 330   ,  ( "ddump_absC",             NoArg (setDynFlag Opt_D_dump_absC) )
 331   ,  ( "ddump_asm",              NoArg (setDynFlag Opt_D_dump_asm) )
 332   ,  ( "ddump_cpranal",          NoArg (setDynFlag Opt_D_dump_cpranal) )
 333   ,  ( "ddump_deriv",            NoArg (setDynFlag Opt_D_dump_deriv) )
 334   ,  ( "ddump_ds",               NoArg (setDynFlag Opt_D_dump_ds) )
 335   ,  ( "ddump_flatC",            NoArg (setDynFlag Opt_D_dump_flatC) )
 336   ,  ( "ddump_foreign",          NoArg (setDynFlag Opt_D_dump_foreign) )
 337   ,  ( "ddump_inlinings",        NoArg (setDynFlag Opt_D_dump_inlinings) )
 338   ,  ( "ddump_occur_anal",       NoArg (setDynFlag Opt_D_dump_occur_anal) )
 339   ,  ( "ddump_parsed",           NoArg (setDynFlag Opt_D_dump_parsed) )
 340   ,  ( "ddump_realC",            NoArg (setDynFlag Opt_D_dump_realC) )
 341   ,  ( "ddump_rn",               NoArg (setDynFlag Opt_D_dump_rn) )
 342   ,  ( "ddump_simpl",            NoArg (setDynFlag Opt_D_dump_simpl) )
 343   ,  ( "ddump_simpl_iterations", NoArg (setDynFlag Opt_D_dump_simpl_iterations) )
 344   ,  ( "ddump_spec",             NoArg (setDynFlag Opt_D_dump_spec) )
 345   ,  ( "ddump_stg",              NoArg (setDynFlag Opt_D_dump_stg) )
 346   ,  ( "ddump_stranal",          NoArg (setDynFlag Opt_D_dump_stranal) )
 347   ,  ( "ddump_tc",               NoArg (setDynFlag Opt_D_dump_tc) )
 348   ,  ( "ddump_types",            NoArg (setDynFlag Opt_D_dump_types) )
 349   ,  ( "ddump_rules",            NoArg (setDynFlag Opt_D_dump_rules) )
 350   ,  ( "ddump_usagesp",          NoArg (setDynFlag Opt_D_dump_usagesp) )
 351   ,  ( "ddump_cse",              NoArg (setDynFlag Opt_D_dump_cse) )
 352   ,  ( "ddump_worker_wrapper",   NoArg (setDynFlag Opt_D_dump_worker_wrapper) )
 353   ,  ( "dshow_passes",           NoArg (setDynFlag Opt_D_show_passes) )
 354   ,  ( "ddump_rn_trace",         NoArg (setDynFlag Opt_D_dump_rn_trace) )
 355   ,  ( "ddump_rn_stats",         NoArg (setDynFlag Opt_D_dump_rn_stats) )
 356   ,  ( "ddump_stix",             NoArg (setDynFlag Opt_D_dump_stix) )
 357   ,  ( "ddump_simpl_stats",      NoArg (setDynFlag Opt_D_dump_simpl_stats) )
 358   ,  ( "dsource_stats",          NoArg (setDynFlag Opt_D_source_stats) )
 359   ,  ( "dverbose_core2core",     NoArg (setDynFlag Opt_D_verbose_core2core) )
 360   ,  ( "dverbose_stg2stg",       NoArg (setDynFlag Opt_D_verbose_stg2stg) )
 361   ,  ( "ddump_hi_diffs",         NoArg (setDynFlag Opt_D_dump_hi_diffs) )
 362   ,  ( "ddump_minimal_imports",  NoArg (setDynFlag Opt_D_dump_minimal_imports) )
 363   ,  ( "DoCoreLinting",          NoArg (setDynFlag Opt_DoCoreLinting) )
 364   ,  ( "DoStgLinting",           NoArg (setDynFlag Opt_DoStgLinting) )
 365   ,  ( "DoUSPLinting",           NoArg (setDynFlag Opt_DoUSPLinting) )
 366
 367         ------ Machine dependant (-m<blah>) stuff ---------------------------
 368
 369   ,  ( "monly-2-regs",  NoArg (updateState (\s -> s{stolen_x86_regs = 2}) ))
 370   ,  ( "monly-3-regs",  NoArg (updateState (\s -> s{stolen_x86_regs = 3}) ))
 371   ,  ( "monly-4-regs",  NoArg (updateState (\s -> s{stolen_x86_regs = 4}) ))
 372
 373         ------ Compiler flags -----------------------------------------------
 374
 375   ,  ( "fglasgow-exts", NoArg (setDynFlag Opt_GlasgowExts) )
 376
 377   ,  ( "fallow-overlapping-instances",
 378                 NoArg (setDynFlag Opt_AllowOverlappingInstances) )
 379
 380   ,  ( "fallow-undecidable-instances",
 381                 NoArg (setDynFlag Opt_AllowUndecidableInstances) )
 382  ]
 383
 384 -----------------------------------------------------------------------------
 385 -- convert sizes like "3.5M" into integers
 386
 387 decodeSize :: String -> Integer
 388 decodeSize str
 389   | c == ""              = truncate n
 390   | c == "K" || c == "k" = truncate (n * 1000)
 391   | c == "M" || c == "m" = truncate (n * 1000 * 1000)
 392   | c == "G" || c == "g" = truncate (n * 1000 * 1000 * 1000)
 393   | otherwise            = throwDyn (OtherError ("can't decode size: " ++ str))
 394   where (m, c) = span pred str
 395         n      = read m  :: Double
 396         pred c = isDigit c || c == '.'
 397
 398 floatOpt :: IORef Double -> String -> IO ()
 399 floatOpt ref str
 400   = writeIORef ref (read str :: Double)
 401
 402 -----------------------------------------------------------------------------
 403 -- Build the Hsc static command line opts
 404
 405 build_hsc_opts :: IO [String]
 406 build_hsc_opts = do
 407   opt_C_ <- getStaticOpts opt_C         -- misc hsc opts
 408
 409         -- warnings
 410   warn_level <- readIORef warning_opt
 411   let warn_opts =  case warn_level of
 412                         W_default -> standardWarnings
 413                         W_        -> minusWOpts
 414                         W_all     -> minusWallOpts
 415                         W_not     -> []
 416
 417         -- optimisation
 418   minus_o <- readIORef opt_level
 419   optimisation_opts <-
 420         case minus_o of
 421             0 -> hsc_minusNoO_flags
 422             1 -> hsc_minusO_flags
 423             2 -> hsc_minusO2_flags
 424             _ -> error "unknown opt level"
 425             -- ToDo: -Ofile
 426
 427         -- STG passes
 428   ways_ <- readIORef ways
 429   let stg_massage | WayProf `elem` ways_ =  "-fmassage-stg-for-profiling"
 430                   | otherwise            = ""
 431
 432   stg_stats <- readIORef opt_StgStats
 433   let stg_stats_flag | stg_stats = "-dstg-stats"
 434                      | otherwise = ""
 435
 436   let stg_opts = [ stg_massage, stg_stats_flag, "-flet-no-escape" ]
 437         -- let-no-escape always on for now
 438
 439         -- take into account -fno-* flags by removing the equivalent -f*
 440         -- flag from our list.
 441   anti_flags <- getStaticOpts anti_opt_C
 442   let basic_opts = opt_C_ ++ warn_opts ++ optimisation_opts ++ stg_opts
 443       filtered_opts = filter (`notElem` anti_flags) basic_opts
 444
 445   verb <- is_verbose
 446   let hi_vers = "-fhi-version="++cProjectVersionInt
 447
 448   static <- (do s <- readIORef static; if s then return "-static" else return "")
 449
 450   l <- readIORef hsc_lang
 451   let lang = case l of
 452                 HscC    -> "-olang=C"
 453                 HscAsm  -> "-olang=asm"
 454                 HscJava -> "-olang=java"
 455
 456   -- get hi-file suffix
 457   hisuf <- readIORef hi_suf
 458
 459   -- hi-suffix for packages depends on the build tag.
 460   package_hisuf <-
 461         do tag <- readIORef build_tag
 462            if null tag
 463                 then return "hi"
 464                 else return (tag ++ "_hi")
 465
 466   import_dirs <- readIORef import_paths
 467   package_import_dirs <- getPackageImportPath
 468
 469   let hi_map = "-himap=" ++
 470                 makeHiMap import_dirs hisuf
 471                          package_import_dirs package_hisuf
 472                          split_marker
 473
 474       hi_map_sep = "-himap-sep=" ++ [split_marker]
 475
 476   return
 477         (
 478         filtered_opts
 479         ++ [ hi_vers, static, verb, lang, hi_map, hi_map_sep ]
 480         )
 481
 482 makeHiMap
 483   (import_dirs         :: [String])
 484   (hi_suffix           :: String)
 485   (package_import_dirs :: [String])
 486   (package_hi_suffix   :: String)
 487   (split_marker        :: Char)
 488   = foldr (add_dir hi_suffix)
 489         (foldr (add_dir package_hi_suffix) "" package_import_dirs)
 490         import_dirs
 491   where
 492      add_dir hisuf dir str = dir ++ "%." ++ hisuf ++ split_marker : str