From: sewardj Date: Thu, 26 Oct 2000 16:21:02 +0000 (+0000) Subject: [project @ 2000-10-26 16:21:02 by sewardj] X-Git-Tag: Approximately_9120_patches~3500 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=266d38920b7292bd75d959b3c2c263a2b025da17;p=ghc-hetmet.git [project @ 2000-10-26 16:21:02 by sewardj] Compile everything up to Main. The Really Entertaining News (tm) is that there are still modules beyond Main to fix up :-) --- diff --git a/ghc/compiler/main/DriverFlags.hs b/ghc/compiler/main/DriverFlags.hs index d973a93..284ea8e 100644 --- a/ghc/compiler/main/DriverFlags.hs +++ b/ghc/compiler/main/DriverFlags.hs @@ -1,5 +1,5 @@ ----------------------------------------------------------------------------- --- $Id: DriverFlags.hs,v 1.8 2000/10/24 16:08:16 simonmar Exp $ +-- $Id: DriverFlags.hs,v 1.9 2000/10/26 16:21:02 sewardj Exp $ -- -- Driver flags -- @@ -152,68 +152,68 @@ static_flags = exitWith ExitSuccess)) ------- verbosity ---------------------------------------------------- - , ( "v" , NoArg (writeIORef verbose True) ) - , ( "n" , NoArg (writeIORef dry_run True) ) + , ( "v" , NoArg (writeIORef v_Verbose True) ) + , ( "n" , NoArg (writeIORef v_Dry_run True) ) ------- recompilation checker -------------------------------------- - , ( "recomp" , NoArg (writeIORef recomp True) ) - , ( "no-recomp" , NoArg (writeIORef recomp False) ) + , ( "recomp" , NoArg (writeIORef v_Recomp True) ) + , ( "no-recomp" , NoArg (writeIORef v_Recomp False) ) ------- ways -------------------------------------------------------- - , ( "prof" , NoArg (addNoDups ways WayProf) ) - , ( "unreg" , NoArg (addNoDups ways WayUnreg) ) - , ( "dll" , NoArg (addNoDups ways WayDll) ) - , ( "ticky" , NoArg (addNoDups ways WayTicky) ) - , ( "parallel" , NoArg (addNoDups ways WayPar) ) - , ( "gransim" , NoArg (addNoDups ways WayGran) ) - , ( "smp" , NoArg (addNoDups ways WaySMP) ) - , ( "debug" , NoArg (addNoDups ways WayDebug) ) + , ( "prof" , NoArg (addNoDups v_Ways WayProf) ) + , ( "unreg" , NoArg (addNoDups v_Ways WayUnreg) ) + , ( "dll" , NoArg (addNoDups v_Ways WayDll) ) + , ( "ticky" , NoArg (addNoDups v_Ways WayTicky) ) + , ( "parallel" , NoArg (addNoDups v_Ways WayPar) ) + , ( "gransim" , NoArg (addNoDups v_Ways WayGran) ) + , ( "smp" , NoArg (addNoDups v_Ways WaySMP) ) + , ( "debug" , NoArg (addNoDups v_Ways WayDebug) ) -- ToDo: user ways ------ Debugging ---------------------------------------------------- - , ( "dppr-noprags", PassFlag (add opt_C) ) - , ( "dppr-debug", PassFlag (add opt_C) ) - , ( "dppr-user-length", AnySuffix (add opt_C) ) + , ( "dppr-noprags", PassFlag (add v_Opt_C) ) + , ( "dppr-debug", PassFlag (add v_Opt_C) ) + , ( "dppr-user-length", AnySuffix (add v_Opt_C) ) -- rest of the debugging flags are dynamic ------- Interface files --------------------------------------------- - , ( "hi" , NoArg (writeIORef produceHi True) ) - , ( "nohi" , NoArg (writeIORef produceHi False) ) + , ( "hi" , NoArg (writeIORef v_ProduceHi True) ) + , ( "nohi" , NoArg (writeIORef v_ProduceHi False) ) --------- Profiling -------------------------------------------------- - , ( "auto-dicts" , NoArg (add opt_C "-fauto-sccs-on-dicts") ) - , ( "auto-all" , NoArg (add opt_C "-fauto-sccs-on-all-toplevs") ) - , ( "auto" , NoArg (add opt_C "-fauto-sccs-on-exported-toplevs") ) - , ( "caf-all" , NoArg (add opt_C "-fauto-sccs-on-individual-cafs") ) + , ( "auto-dicts" , NoArg (add v_Opt_C "-fauto-sccs-on-dicts") ) + , ( "auto-all" , NoArg (add v_Opt_C "-fauto-sccs-on-all-toplevs") ) + , ( "auto" , NoArg (add v_Opt_C "-fauto-sccs-on-exported-toplevs") ) + , ( "caf-all" , NoArg (add v_Opt_C "-fauto-sccs-on-individual-cafs") ) -- "ignore-sccs" doesn't work (ToDo) - , ( "no-auto-dicts" , NoArg (add anti_opt_C "-fauto-sccs-on-dicts") ) - , ( "no-auto-all" , NoArg (add anti_opt_C "-fauto-sccs-on-all-toplevs") ) - , ( "no-auto" , NoArg (add anti_opt_C "-fauto-sccs-on-exported-toplevs") ) - , ( "no-caf-all" , NoArg (add anti_opt_C "-fauto-sccs-on-individual-cafs") ) + , ( "no-auto-dicts" , NoArg (add v_Anti_opt_C "-fauto-sccs-on-dicts") ) + , ( "no-auto-all" , NoArg (add v_Anti_opt_C "-fauto-sccs-on-all-toplevs") ) + , ( "no-auto" , NoArg (add v_Anti_opt_C "-fauto-sccs-on-exported-toplevs") ) + , ( "no-caf-all" , NoArg (add v_Anti_opt_C "-fauto-sccs-on-individual-cafs") ) ------- Miscellaneous ----------------------------------------------- , ( "no-link-chk" , NoArg (return ()) ) -- ignored for backwards compat ------- Output Redirection ------------------------------------------ - , ( "odir" , HasArg (writeIORef output_dir . Just) ) - , ( "o" , SepArg (writeIORef output_file . Just) ) - , ( "osuf" , HasArg (writeIORef output_suf . Just) ) - , ( "hisuf" , HasArg (writeIORef hi_suf) ) + , ( "odir" , HasArg (writeIORef v_Output_dir . Just) ) + , ( "o" , SepArg (writeIORef v_Output_file . Just) ) + , ( "osuf" , HasArg (writeIORef v_Output_suf . Just) ) + , ( "hisuf" , HasArg (writeIORef v_Hi_suf) ) , ( "tmpdir" , HasArg (writeIORef v_TmpDir . (++ "/")) ) , ( "ohi" , HasArg (\s -> case s of - "-" -> writeIORef hi_on_stdout True - _ -> writeIORef output_hi (Just s)) ) + "-" -> writeIORef v_Hi_on_stdout True + _ -> writeIORef v_Output_hi (Just s)) ) -- -odump? - , ( "keep-hc-file" , AnySuffix (\_ -> writeIORef keep_hc_files True) ) - , ( "keep-s-file" , AnySuffix (\_ -> writeIORef keep_s_files True) ) - , ( "keep-raw-s-file", AnySuffix (\_ -> writeIORef keep_raw_s_files True) ) - , ( "keep-tmp-files" , AnySuffix (\_ -> writeIORef keep_tmp_files True) ) + , ( "keep-hc-file" , AnySuffix (\_ -> writeIORef v_Keep_hc_files True) ) + , ( "keep-s-file" , AnySuffix (\_ -> writeIORef v_Keep_s_files True) ) + , ( "keep-raw-s-file", AnySuffix (\_ -> writeIORef v_Keep_raw_s_files True) ) + , ( "keep-tmp-files" , AnySuffix (\_ -> writeIORef v_Keep_tmp_files True) ) , ( "split-objs" , NoArg (if can_split - then do writeIORef split_object_files True - add opt_C "-fglobalise-toplev-names" + then do writeIORef v_Split_object_files True + add v_Opt_C "-fglobalise-toplev-names" -- TODO!!!!! add opt_c "-DUSE_SPLIT_MARKERS" else hPutStrLn stderr "warning: don't know how to split \ @@ -221,15 +221,15 @@ static_flags = ) ) ------- Include/Import Paths ---------------------------------------- - , ( "i" , OptPrefix (addToDirList import_paths) ) - , ( "I" , Prefix (addToDirList include_paths) ) + , ( "i" , OptPrefix (addToDirList v_Import_paths) ) + , ( "I" , Prefix (addToDirList v_Include_paths) ) ------- Libraries --------------------------------------------------- - , ( "L" , Prefix (addToDirList library_paths) ) - , ( "l" , Prefix (add cmdline_libraries) ) + , ( "L" , Prefix (addToDirList v_Library_paths) ) + , ( "l" , Prefix (add v_Cmdline_libraries) ) ------- Packages ---------------------------------------------------- - , ( "package-name" , HasArg (\s -> add opt_C ("-inpackage="++s)) ) + , ( "package-name" , HasArg (\s -> add v_Opt_C ("-inpackage="++s)) ) , ( "package" , HasArg (addPackage) ) , ( "syslib" , HasArg (addPackage) ) -- for compatibility w/ old vsns @@ -239,59 +239,59 @@ static_flags = , ( "-delete-package" , SepArg (deletePackage) ) ------- Specific phases -------------------------------------------- - , ( "pgmL" , HasArg (writeIORef pgm_L) ) - , ( "pgmP" , HasArg (writeIORef pgm_P) ) - , ( "pgmc" , HasArg (writeIORef pgm_c) ) - , ( "pgmm" , HasArg (writeIORef pgm_m) ) - , ( "pgms" , HasArg (writeIORef pgm_s) ) - , ( "pgma" , HasArg (writeIORef pgm_a) ) - , ( "pgml" , HasArg (writeIORef pgm_l) ) - - , ( "optdep" , HasArg (add opt_dep) ) - , ( "optl" , HasArg (add opt_l) ) - , ( "optdll" , HasArg (add opt_dll) ) + , ( "pgmL" , HasArg (writeIORef v_Pgm_L) ) + , ( "pgmP" , HasArg (writeIORef v_Pgm_P) ) + , ( "pgmc" , HasArg (writeIORef v_Pgm_c) ) + , ( "pgmm" , HasArg (writeIORef v_Pgm_m) ) + , ( "pgms" , HasArg (writeIORef v_Pgm_s) ) + , ( "pgma" , HasArg (writeIORef v_Pgm_a) ) + , ( "pgml" , HasArg (writeIORef v_Pgm_l) ) + + , ( "optdep" , HasArg (add v_Opt_dep) ) + , ( "optl" , HasArg (add v_Opt_l) ) + , ( "optdll" , HasArg (add v_Opt_dll) ) ------ Warning opts ------------------------------------------------- - , ( "W" , NoArg (writeIORef warning_opt W_) ) - , ( "Wall" , NoArg (writeIORef warning_opt W_all) ) - , ( "Wnot" , NoArg (writeIORef warning_opt W_not) ) - , ( "w" , NoArg (writeIORef warning_opt W_not) ) + , ( "W" , NoArg (writeIORef v_Warning_opt W_) ) + , ( "Wall" , NoArg (writeIORef v_Warning_opt W_all) ) + , ( "Wnot" , NoArg (writeIORef v_Warning_opt W_not) ) + , ( "w" , NoArg (writeIORef v_Warning_opt W_not) ) ----- Linker -------------------------------------------------------- - , ( "static" , NoArg (writeIORef static True) ) + , ( "static" , NoArg (writeIORef v_Static True) ) ------ Compiler flags ----------------------------------------------- , ( "O2-for-C" , NoArg (writeIORef v_minus_o2_for_C True) ) , ( "O" , OptPrefix (setOptLevel) ) - , ( "fasm" , OptPrefix (\_ -> writeIORef hsc_lang HscAsm) ) + , ( "fasm" , OptPrefix (\_ -> writeIORef v_Hsc_Lang HscAsm) ) - , ( "fvia-c" , NoArg (writeIORef hsc_lang HscC) ) - , ( "fvia-C" , NoArg (writeIORef hsc_lang HscC) ) + , ( "fvia-c" , NoArg (writeIORef v_Hsc_Lang HscC) ) + , ( "fvia-C" , NoArg (writeIORef v_Hsc_Lang HscC) ) - , ( "fno-asm-mangling" , NoArg (writeIORef do_asm_mangling False) ) + , ( "fno-asm-mangling" , NoArg (writeIORef v_Do_asm_mangling False) ) , ( "fmax-simplifier-iterations", Prefix (writeIORef v_MaxSimplifierIterations . read) ) , ( "fusagesp" , NoArg (do writeIORef v_UsageSPInf True - add opt_C "-fusagesp-on") ) + add v_Opt_C "-fusagesp-on") ) - , ( "fexcess-precision" , NoArg (do writeIORef excess_precision True - add opt_C "-fexcess-precision")) + , ( "fexcess-precision" , NoArg (do writeIORef v_Excess_precision True + add v_Opt_C "-fexcess-precision")) -- flags that are "active negatives" - , ( "fno-implicit-prelude" , PassFlag (add opt_C) ) - , ( "fno-prune-tydecls" , PassFlag (add opt_C) ) - , ( "fno-prune-instdecls" , PassFlag (add opt_C) ) - , ( "fno-pre-inlining" , PassFlag (add opt_C) ) + , ( "fno-implicit-prelude" , PassFlag (add v_Opt_C) ) + , ( "fno-prune-tydecls" , PassFlag (add v_Opt_C) ) + , ( "fno-prune-instdecls" , PassFlag (add v_Opt_C) ) + , ( "fno-pre-inlining" , PassFlag (add v_Opt_C) ) -- All other "-fno-" options cancel out "-f" on the hsc cmdline , ( "fno-", PrefixPred (\s -> isStaticHscFlag ("f"++s)) - (\s -> add anti_opt_C ("-f"++s)) ) + (\s -> add v_Anti_opt_C ("-f"++s)) ) -- Pass all remaining "-f" options to hsc - , ( "f", AnySuffixPred (isStaticHscFlag) (add opt_C) ) + , ( "f", AnySuffixPred (isStaticHscFlag) (add v_Opt_C) ) ] ----------------------------------------------------------------------------- @@ -427,7 +427,7 @@ floatOpt ref str buildStaticHscOpts :: IO [String] buildStaticHscOpts = do - opt_C_ <- getStaticOpts opt_C -- misc hsc opts + opt_C_ <- getStaticOpts v_Opt_C -- misc hsc opts -- optimisation minus_o <- readIORef v_OptLevel @@ -444,14 +444,14 @@ buildStaticHscOpts = do -- take into account -fno-* flags by removing the equivalent -f* -- flag from our list. - anti_flags <- getStaticOpts anti_opt_C + anti_flags <- getStaticOpts v_Anti_opt_C let basic_opts = opt_C_ ++ optimisation_opts ++ stg_opts filtered_opts = filter (`notElem` anti_flags) basic_opts verb <- is_verbose let hi_vers = "-fhi-version="++cProjectVersionInt - static <- (do s <- readIORef static; if s then return "-static" - else return "") + static <- (do s <- readIORef v_Static; if s then return "-static" + else return "") return ( filtered_opts ++ [ hi_vers, static, verb ] ) diff --git a/ghc/compiler/main/DriverMkDepend.hs b/ghc/compiler/main/DriverMkDepend.hs index 2f45506..525d70e 100644 --- a/ghc/compiler/main/DriverMkDepend.hs +++ b/ghc/compiler/main/DriverMkDepend.hs @@ -1,5 +1,5 @@ ----------------------------------------------------------------------------- --- $Id: DriverMkDepend.hs,v 1.2 2000/10/17 13:22:10 simonmar Exp $ +-- $Id: DriverMkDepend.hs,v 1.3 2000/10/26 16:21:02 sewardj Exp $ -- -- GHC Driver -- @@ -32,17 +32,17 @@ import Maybe -- mkdependHS -- flags -GLOBAL_VAR(dep_makefile, "Makefile", String); -GLOBAL_VAR(dep_include_prelude, False, Bool); -GLOBAL_VAR(dep_ignore_dirs, [], [String]); -GLOBAL_VAR(dep_suffixes, [], [String]); -GLOBAL_VAR(dep_warnings, True, Bool); +GLOBAL_VAR(v_Dep_makefile, "Makefile", String); +GLOBAL_VAR(v_Dep_include_prelude, False, Bool); +GLOBAL_VAR(v_Dep_ignore_dirs, [], [String]); +GLOBAL_VAR(v_Dep_suffixes, [], [String]); +GLOBAL_VAR(v_Dep_warnings, True, Bool); -- global vars -GLOBAL_VAR(dep_makefile_hdl, error "dep_makefile_hdl", Maybe Handle); -GLOBAL_VAR(dep_tmp_file, error "dep_tmp_file", String); -GLOBAL_VAR(dep_tmp_hdl, error "dep_tmp_hdl", Handle); -GLOBAL_VAR(dep_dir_contents, error "dep_dir_contents", [(String,[String])]); +GLOBAL_VAR(v_Dep_makefile_hdl, error "dep_makefile_hdl", Maybe Handle); +GLOBAL_VAR(v_Dep_tmp_file, error "dep_tmp_file", String); +GLOBAL_VAR(v_Dep_tmp_hdl, error "dep_tmp_hdl", Handle); +GLOBAL_VAR(v_Dep_dir_contents, error "dep_dir_contents", [(String,[String])]); depStartMarker = "# DO NOT DELETE: Beginning of Haskell dependencies" depEndMarker = "# DO NOT DELETE: End of Haskell dependencies" @@ -50,39 +50,39 @@ depEndMarker = "# DO NOT DELETE: End of Haskell dependencies" -- for compatibility with the old mkDependHS, we accept options of the form -- -optdep-f -optdep.depend, etc. dep_opts = [ - ( "s", SepArg (add dep_suffixes) ), - ( "f", SepArg (writeIORef dep_makefile) ), - ( "w", NoArg (writeIORef dep_warnings False) ), - ( "-include-prelude", NoArg (writeIORef dep_include_prelude True) ), - ( "X", Prefix (addToDirList dep_ignore_dirs) ), - ( "-exclude-directory=", Prefix (addToDirList dep_ignore_dirs) ) + ( "s", SepArg (add v_Dep_suffixes) ), + ( "f", SepArg (writeIORef v_Dep_makefile) ), + ( "w", NoArg (writeIORef v_Dep_warnings False) ), + ( "-include-prelude", NoArg (writeIORef v_Dep_include_prelude True) ), + ( "X", Prefix (addToDirList v_Dep_ignore_dirs) ), + ( "-exclude-directory=", Prefix (addToDirList v_Dep_ignore_dirs) ) ] beginMkDependHS :: IO () beginMkDependHS = do -- slurp in the mkdependHS-style options - flags <- getStaticOpts opt_dep + flags <- getStaticOpts v_Opt_dep _ <- processArgs dep_opts flags [] -- open a new temp file in which to stuff the dependency info -- as we go along. dep_file <- newTempName "dep" - writeIORef dep_tmp_file dep_file + writeIORef v_Dep_tmp_file dep_file tmp_hdl <- openFile dep_file WriteMode - writeIORef dep_tmp_hdl tmp_hdl + writeIORef v_Dep_tmp_hdl tmp_hdl -- open the makefile - makefile <- readIORef dep_makefile + makefile <- readIORef v_Dep_makefile exists <- doesFileExist makefile if not exists then do - writeIORef dep_makefile_hdl Nothing + writeIORef v_Dep_makefile_hdl Nothing return () else do makefile_hdl <- openFile makefile ReadMode - writeIORef dep_makefile_hdl (Just makefile_hdl) + writeIORef v_Dep_makefile_hdl (Just makefile_hdl) -- slurp through until we get the magic start string, -- copying the contents into dep_makefile @@ -111,28 +111,28 @@ beginMkDependHS = do -- cache the contents of all the import directories, for future -- reference. - import_dirs <- readIORef import_paths + import_dirs <- readIORef v_Import_paths pkg_import_dirs <- getPackageImportPath import_dir_contents <- mapM getDirectoryContents import_dirs pkg_import_dir_contents <- mapM getDirectoryContents pkg_import_dirs - writeIORef dep_dir_contents + writeIORef v_Dep_dir_contents (zip import_dirs import_dir_contents ++ zip pkg_import_dirs pkg_import_dir_contents) -- ignore packages unless --include-prelude is on - include_prelude <- readIORef dep_include_prelude + include_prelude <- readIORef v_Dep_include_prelude when (not include_prelude) $ - mapM_ (add dep_ignore_dirs) pkg_import_dirs + mapM_ (add v_Dep_ignore_dirs) pkg_import_dirs return () endMkDependHS :: IO () endMkDependHS = do - makefile <- readIORef dep_makefile - makefile_hdl <- readIORef dep_makefile_hdl - tmp_file <- readIORef dep_tmp_file - tmp_hdl <- readIORef dep_tmp_hdl + makefile <- readIORef v_Dep_makefile + makefile_hdl <- readIORef v_Dep_makefile_hdl + tmp_file <- readIORef v_Dep_tmp_file + tmp_hdl <- readIORef v_Dep_tmp_hdl -- write the magic marker into the tmp file hPutStrLn tmp_hdl depEndMarker @@ -166,9 +166,9 @@ endMkDependHS = do findDependency :: String -> ModImport -> IO (Maybe (String, Bool)) findDependency mod imp = do - dir_contents <- readIORef dep_dir_contents - ignore_dirs <- readIORef dep_ignore_dirs - hisuf <- readIORef hi_suf + dir_contents <- readIORef v_Dep_dir_contents + ignore_dirs <- readIORef v_Dep_ignore_dirs + hisuf <- readIORef v_Hi_suf let (imp_mod, is_source) = diff --git a/ghc/compiler/main/DriverPipeline.hs b/ghc/compiler/main/DriverPipeline.hs index 502a849..022b707 100644 --- a/ghc/compiler/main/DriverPipeline.hs +++ b/ghc/compiler/main/DriverPipeline.hs @@ -1,5 +1,5 @@ ----------------------------------------------------------------------------- --- $Id: DriverPipeline.hs,v 1.7 2000/10/26 14:38:42 simonmar Exp $ +-- $Id: DriverPipeline.hs,v 1.8 2000/10/26 16:21:02 sewardj Exp $ -- -- GHC Driver -- @@ -38,6 +38,7 @@ import Module import CmdLineOpts import Config import Util +import MkIface ( pprIface ) import Posix import Directory @@ -131,12 +132,12 @@ genPipeline genPipeline todo stop_flag filename = do - split <- readIORef split_object_files - mangle <- readIORef do_asm_mangling - lang <- readIORef hsc_lang - keep_hc <- readIORef keep_hc_files - keep_raw_s <- readIORef keep_raw_s_files - keep_s <- readIORef keep_s_files + split <- readIORef v_Split_object_files + mangle <- readIORef v_Do_asm_mangling + lang <- readIORef v_Hsc_Lang + keep_hc <- readIORef v_Keep_hc_files + keep_raw_s <- readIORef v_Keep_raw_s_files + keep_s <- readIORef v_Keep_s_files let ----------- ----- ---- --- -- -- - - - @@ -273,7 +274,7 @@ pipeLoop ((phase, keep, o_suffix):phases) where outputFileName last_phase keep suffix - = do o_file <- readIORef output_file + = do o_file <- readIORef v_Output_file if last_phase && not do_linking && use_ofile && isJust o_file then case o_file of Just s -> return s @@ -287,7 +288,7 @@ pipeLoop ((phase, keep, o_suffix):phases) -- Unlit phase run_phase Unlit _basename _suff input_fn output_fn - = do unlit <- readIORef pgm_L + = do unlit <- readIORef v_Pgm_L unlit_flags <- getOpts opt_L run_something "Literate pre-processor" ("echo '# 1 \"" ++input_fn++"\"' > "++output_fn++" && " @@ -304,11 +305,11 @@ run_phase Cpp _basename _suff input_fn output_fn do_cpp <- readState cpp_flag if do_cpp then do - cpp <- readIORef pgm_P + cpp <- readIORef v_Pgm_P hscpp_opts <- getOpts opt_P - hs_src_cpp_opts <- readIORef hs_source_cpp_opts + hs_src_cpp_opts <- readIORef v_Hs_source_cpp_opts - cmdline_include_paths <- readIORef include_paths + cmdline_include_paths <- readIORef v_Include_paths pkg_include_dirs <- getPackageIncludePath let include_paths = map (\p -> "-I"++p) (cmdline_include_paths ++ pkg_include_dirs) @@ -339,18 +340,18 @@ run_phase MkDependHS basename suff input_fn _output_fn = do deps <- mapM (findDependency basename) imports - osuf_opt <- readIORef output_suf + osuf_opt <- readIORef v_Output_suf let osuf = case osuf_opt of Nothing -> "o" Just s -> s - extra_suffixes <- readIORef dep_suffixes + extra_suffixes <- readIORef v_Dep_suffixes let suffixes = osuf : map (++ ('_':osuf)) extra_suffixes ofiles = map (\suf -> basename ++ '.':suf) suffixes objs <- mapM odir_ify ofiles - hdl <- readIORef dep_tmp_hdl + hdl <- readIORef v_Dep_tmp_hdl -- std dependeny of the object(s) on the source file hPutStrLn hdl (unwords objs ++ " : " ++ basename ++ '.':suff) @@ -358,7 +359,7 @@ run_phase MkDependHS basename suff input_fn _output_fn = do let genDep (dep, False {- not an hi file -}) = hPutStrLn hdl (unwords objs ++ " : " ++ dep) genDep (dep, True {- is an hi file -}) = do - hisuf <- readIORef hi_suf + hisuf <- readIORef v_Hi_suf let dep_base = remove_suffix '.' dep deps = (dep_base ++ hisuf) : map (\suf -> dep_base ++ suf ++ '_':hisuf) extra_suffixes @@ -398,12 +399,12 @@ run_phase Hsc basename suff input_fn output_fn -- what gcc does, and it's probably what you want. let current_dir = getdir basename - paths <- readIORef include_paths - writeIORef include_paths (current_dir : paths) + paths <- readIORef v_Include_paths + writeIORef v_Include_paths (current_dir : paths) -- figure out where to put the .hi file - ohi <- readIORef output_hi - hisuf <- readIORef hi_suf + ohi <- readIORef v_Output_hi + hisuf <- readIORef v_Hi_suf let hifile = case ohi of Nothing -> current_dir ++ {-ToDo: modname!!-}basename ++ hisuf @@ -418,7 +419,7 @@ run_phase Hsc basename suff input_fn output_fn -- changed (which the compiler itself figures out). -- Setting source_unchanged to "" tells the compiler that M.o is out of -- date wrt M.hs (or M.o doesn't exist) so we must recompile regardless. - do_recomp <- readIORef recomp + do_recomp <- readIORef v_Recomp todo <- readIORef v_GhcMode o_file <- odir_ify (basename ++ '.':phaseInputExt Ln) source_unchanged <- @@ -451,7 +452,6 @@ run_phase Hsc basename suff input_fn output_fn Nothing -- no iface emptyModuleEnv -- HomeSymbolTable emptyModuleEnv -- HomeIfaceTable - emptyModuleEnv -- PackageIfaceTable pcs case result of { @@ -461,31 +461,11 @@ run_phase Hsc basename suff input_fn output_fn HscOK details maybe_iface maybe_stub_h maybe_stub_c _maybe_interpreted_code pcs -> do - -- generate the interface file - case maybe_iface of - Nothing -> -- compilation not required - do run_something "Touching object file" ("touch " ++ o_file) - return False - - Just iface -> do - -- discover the filename for the .hi file in a roundabout way - let mod = moduleString (mi_module iface) - ohi <- readIORef output_hi - hifile <- case ohi of - Just fn -> fn - Nothing -> do hisuf <- readIORef hi_suf - return (current_dir ++ - '/'mod ++ '.':hisuf) - -- write out the interface... - if_hdl <- openFile hifile WriteMode - printForIface if_hdl (pprIface iface) - hClose if_hdl - -- deal with stubs maybe_stub_o <- dealWithStubs basename maybe_stub_h maybe_stub_c case maybe_stub_o of Nothing -> return () - Just stub_o -> add ld_inputs stub_o + Just stub_o -> add v_Ld_inputs stub_o return True } @@ -498,9 +478,9 @@ run_phase Hsc basename suff input_fn output_fn run_phase cc_phase _basename _suff input_fn output_fn | cc_phase == Cc || cc_phase == HCc - = do cc <- readIORef pgm_c + = do cc <- readIORef v_Pgm_c cc_opts <- (getOpts opt_c) - cmdline_include_dirs <- readIORef include_paths + cmdline_include_dirs <- readIORef v_Include_paths let hcc = cc_phase == HCc @@ -531,7 +511,7 @@ run_phase cc_phase _basename _suff input_fn output_fn ccout <- newTempName "ccout" - mangle <- readIORef do_asm_mangling + mangle <- readIORef v_Do_asm_mangling (md_c_flags, md_regd_c_flags) <- machdepCCOpts verb <- is_verbose @@ -542,7 +522,7 @@ run_phase cc_phase _basename _suff input_fn output_fn pkg_extra_cc_opts <- getPackageExtraCcOpts - excessPrecision <- readIORef excess_precision + excessPrecision <- readIORef v_Excess_precision run_something "C Compiler" (unwords ([ cc, "-x", "c", cc_help, "-o", output_fn ] @@ -569,7 +549,7 @@ run_phase cc_phase _basename _suff input_fn output_fn -- Mangle phase run_phase Mangle _basename _suff input_fn output_fn - = do mangler <- readIORef pgm_m + = do mangler <- readIORef v_Pgm_m mangler_opts <- getOpts opt_m machdep_opts <- if (prefixMatch "i386" cTARGETPLATFORM) @@ -588,13 +568,13 @@ run_phase Mangle _basename _suff input_fn output_fn -- Splitting phase run_phase SplitMangle _basename _suff input_fn _output_fn - = do splitter <- readIORef pgm_s + = do splitter <- readIORef v_Pgm_s -- this is the prefix used for the split .s files tmp_pfx <- readIORef v_TmpDir x <- getProcessID let split_s_prefix = tmp_pfx ++ "/ghc" ++ show x - writeIORef split_prefix split_s_prefix + writeIORef v_Split_prefix split_s_prefix addFilesToClean [split_s_prefix ++ "__*"] -- d:-) -- allocate a tmp file to put the no. of split .s files in (sigh) @@ -610,17 +590,17 @@ run_phase SplitMangle _basename _suff input_fn _output_fn -- save the number of split files for future references s <- readFile n_files let n = read s :: Int - writeIORef n_split_files n + writeIORef v_N_split_files n return True ----------------------------------------------------------------------------- -- As phase run_phase As _basename _suff input_fn output_fn - = do as <- readIORef pgm_a + = do as <- readIORef v_Pgm_a as_opts <- getOpts opt_a - cmdline_include_paths <- readIORef include_paths + cmdline_include_paths <- readIORef v_Include_paths let cmdline_include_flags = map (\p -> "-I"++p) cmdline_include_paths run_something "Assembler" (unwords (as : as_opts @@ -630,13 +610,13 @@ run_phase As _basename _suff input_fn output_fn return True run_phase SplitAs basename _suff _input_fn _output_fn - = do as <- readIORef pgm_a + = do as <- readIORef v_Pgm_a as_opts <- getOpts opt_a - split_s_prefix <- readIORef split_prefix - n <- readIORef n_split_files + split_s_prefix <- readIORef v_Split_prefix + n <- readIORef v_N_split_files - odir <- readIORef output_dir + odir <- readIORef v_Output_dir let real_odir = case odir of Nothing -> basename Just d -> d @@ -659,31 +639,31 @@ run_phase SplitAs basename _suff _input_fn _output_fn doLink :: [String] -> IO () doLink o_files = do - ln <- readIORef pgm_l + ln <- readIORef v_Pgm_l verb <- is_verbose - o_file <- readIORef output_file + o_file <- readIORef v_Output_file let output_fn = case o_file of { Just s -> s; Nothing -> "a.out"; } pkg_lib_paths <- getPackageLibraryPath let pkg_lib_path_opts = map ("-L"++) pkg_lib_paths - lib_paths <- readIORef library_paths + lib_paths <- readIORef v_Library_paths let lib_path_opts = map ("-L"++) lib_paths pkg_libs <- getPackageLibraries let pkg_lib_opts = map (\lib -> "-l"++lib) pkg_libs - libs <- readIORef cmdline_libraries + libs <- readIORef v_Cmdline_libraries let lib_opts = map ("-l"++) (reverse libs) -- reverse because they're added in reverse order from the cmd line pkg_extra_ld_opts <- getPackageExtraLdOpts -- probably _stub.o files - extra_ld_inputs <- readIORef ld_inputs + extra_ld_inputs <- readIORef v_Ld_inputs -- opts from -optl- - extra_ld_opts <- getStaticOpts opt_l + extra_ld_opts <- getStaticOpts v_Opt_l run_something "Linker" (unwords @@ -726,7 +706,8 @@ preprocess filename = compile :: Finder -- to find modules -> ModSummary -- summary, including source -> Maybe ModIface -- old interface, if available - -> HomeSymbolTable -- for home module ModDetails + -> HomeSymbolTable -- for home module ModDetails + -> HomeIfaceTable -- for home module Ifaces -> PersistentCompilerState -- persistent compiler state -> IO CompResult @@ -740,10 +721,11 @@ data CompResult | CompErrs PersistentCompilerState -- updated PCS -compile finder summary old_iface hst pcs = do - verb <- readIORef verbose - when verb (hPutStrLn stderr ("compile: compiling " ++ - name_of_summary summary)) +compile finder summary old_iface hst hit pcs = do + verb <- readIORef v_Verbose + when verb (hPutStrLn stderr + (showSDoc (text "compile: compiling" + <+> ppr (name_of_summary summary)))) init_dyn_flags <- readIORef v_InitDynFlags writeIORef v_DynFlags init_dyn_flags @@ -758,6 +740,7 @@ compile finder summary old_iface hst pcs = do processArgs dynamic_flags opts [] dyn_flags <- readIORef v_DynFlags + hsc_lang <- readIORef v_Hsc_Lang output_fn <- case hsc_lang of HscAsm -> newTempName (phaseInputExt As) HscC -> newTempName (phaseInputExt HCc) @@ -765,24 +748,25 @@ compile finder summary old_iface hst pcs = do HscInterpreted -> return (error "no output file") -- run the compiler - hsc_result <- hscMain dyn_flags summary old_iface output_fn hst pcs + hsc_result <- hscMain dyn_flags{ hscOutName = output_fn } + finder summary old_iface hst hit pcs case hsc_result of { HscFail pcs -> return (CompErrs pcs); HscOK details maybe_iface - maybe_stub_h maybe_stub_c maybe_interpreted_code pcs warns -> do + maybe_stub_h maybe_stub_c maybe_interpreted_code pcs -> do -- if no compilation happened, bail out early case maybe_iface of { - Nothing -> return (CompOK details Nothing pcs warns); + Nothing -> return (CompOK details Nothing pcs); Just iface -> do let (basename, _) = splitFilename (hs_file (ms_location summary)) maybe_stub_o <- dealWithStubs basename maybe_stub_h maybe_stub_c - stub_unlinked <- case maybe_stub_o of - Nothing -> [] - Just stub_o -> [ DotO stub_o ] + let stub_unlinked = case maybe_stub_o of + Nothing -> [] + Just stub_o -> [ DotO stub_o ] hs_unlinked <- case hsc_lang of @@ -791,8 +775,8 @@ compile finder summary old_iface hst pcs = do -- as our "unlinked" object. HscInterpreted -> case maybe_interpreted_code of - Just code -> return (Trees code) - Nothing -> panic "compile: no interpreted code" + Just (code,itbl_env) -> return [Trees code itbl_env] + Nothing -> panic "compile: no interpreted code" -- we're in batch mode: finish the compilation pipeline. _other -> do pipe <- genPipeline (StopBefore Ln) "" output_fn @@ -802,7 +786,7 @@ compile finder summary old_iface hst pcs = do let linkable = LM (moduleName (ms_mod summary)) (hs_unlinked ++ stub_unlinked) - return (CompOK details (Just (iface, linkable)) pcs warns) + return (CompOK details (Just (iface, linkable)) pcs) } } diff --git a/ghc/compiler/main/DriverState.hs b/ghc/compiler/main/DriverState.hs index 852c92c..49476af 100644 --- a/ghc/compiler/main/DriverState.hs +++ b/ghc/compiler/main/DriverState.hs @@ -1,5 +1,5 @@ ----------------------------------------------------------------------------- --- $Id: DriverState.hs,v 1.6 2000/10/24 16:08:16 simonmar Exp $ +-- $Id: DriverState.hs,v 1.7 2000/10/26 16:21:02 sewardj Exp $ -- -- Settings for the driver -- @@ -64,13 +64,13 @@ initDriverState = DriverState { opt_m = [], } -GLOBAL_VAR(driver_state, initDriverState, DriverState) +GLOBAL_VAR(v_Driver_state, initDriverState, DriverState) readState :: (DriverState -> a) -> IO a -readState f = readIORef driver_state >>= return . f +readState f = readIORef v_Driver_state >>= return . f updateState :: (DriverState -> DriverState) -> IO () -updateState f = readIORef driver_state >>= writeIORef driver_state . f +updateState f = readIORef v_Driver_state >>= writeIORef v_Driver_state . f addOpt_L a = updateState (\s -> s{opt_L = a : opt_L s}) addOpt_P a = updateState (\s -> s{opt_P = a : opt_P s}) @@ -93,51 +93,54 @@ cHaskell1Version = "5" -- i.e., Haskell 98 ----------------------------------------------------------------------------- -- Global compilation flags +GLOBAL_VAR(v_Static_hsc_opts, [], [String]) + -- location of compiler-related files -GLOBAL_VAR(topDir, clibdir, String) -GLOBAL_VAR(inplace, False, Bool) +GLOBAL_VAR(v_TopDir, clibdir, String) +GLOBAL_VAR(v_Inplace, False, Bool) -- Cpp-related flags -hs_source_cpp_opts = global +v_Hs_source_cpp_opts = global [ "-D__HASKELL1__="++cHaskell1Version , "-D__GLASGOW_HASKELL__="++cProjectVersionInt , "-D__HASKELL98__" , "-D__CONCURRENT_HASKELL__" ] +{-# NOINLINE v_Hs_source_cpp_opts #-} -- Verbose -GLOBAL_VAR(verbose, False, Bool) -is_verbose = do v <- readIORef verbose; if v then return "-v" else return "" +GLOBAL_VAR(v_Verbose, False, Bool) +is_verbose = do v <- readIORef v_Verbose; if v then return "-v" else return "" -- where to keep temporary files GLOBAL_VAR(v_TmpDir, cDEFAULT_TMPDIR, String ) -- Keep output from intermediate phases -GLOBAL_VAR(keep_hi_diffs, False, Bool) -GLOBAL_VAR(keep_hc_files, False, Bool) -GLOBAL_VAR(keep_s_files, False, Bool) -GLOBAL_VAR(keep_raw_s_files, False, Bool) -GLOBAL_VAR(keep_tmp_files, False, Bool) +GLOBAL_VAR(v_Keep_hi_diffs, False, Bool) +GLOBAL_VAR(v_Keep_hc_files, False, Bool) +GLOBAL_VAR(v_Keep_s_files, False, Bool) +GLOBAL_VAR(v_Keep_raw_s_files, False, Bool) +GLOBAL_VAR(v_Keep_tmp_files, False, Bool) -- Misc -GLOBAL_VAR(scale_sizes_by, 1.0, Double) -GLOBAL_VAR(dry_run, False, Bool) +GLOBAL_VAR(v_Scale_sizes_by, 1.0, Double) +GLOBAL_VAR(v_Dry_run, False, Bool) #if !defined(HAVE_WIN32_DLL_SUPPORT) || defined(DONT_WANT_WIN32_DLL_SUPPORT) -GLOBAL_VAR(static, True, Bool) +GLOBAL_VAR(v_Static, True, Bool) #else -GLOBAL_VAR(static, False, Bool) +GLOBAL_VAR(v_Static, False, Bool) #endif -GLOBAL_VAR(recomp, True, Bool) -GLOBAL_VAR(collect_ghc_timing, False, Bool) -GLOBAL_VAR(do_asm_mangling, True, Bool) -GLOBAL_VAR(excess_precision, False, Bool) +GLOBAL_VAR(v_Recomp, True, Bool) +GLOBAL_VAR(v_Collect_ghc_timing, False, Bool) +GLOBAL_VAR(v_Do_asm_mangling, True, Bool) +GLOBAL_VAR(v_Excess_precision, False, Bool) ----------------------------------------------------------------------------- -- Splitting object files (for libraries) -GLOBAL_VAR(split_object_files, False, Bool) -GLOBAL_VAR(split_prefix, "", String) -GLOBAL_VAR(n_split_files, 0, Int) +GLOBAL_VAR(v_Split_object_files, False, Bool) +GLOBAL_VAR(v_Split_prefix, "", String) +GLOBAL_VAR(v_N_split_files, 0, Int) can_split :: Bool can_split = prefixMatch "i386" cTARGETPLATFORM @@ -152,30 +155,30 @@ can_split = prefixMatch "i386" cTARGETPLATFORM ----------------------------------------------------------------------------- -- Compiler output options -GLOBAL_VAR(hsc_lang, if cGhcWithNativeCodeGen == "YES" && +GLOBAL_VAR(v_Hsc_Lang, if cGhcWithNativeCodeGen == "YES" && (prefixMatch "i386" cTARGETPLATFORM || prefixMatch "sparc" cTARGETPLATFORM) then HscAsm else HscC, HscLang) -GLOBAL_VAR(output_dir, Nothing, Maybe String) -GLOBAL_VAR(output_suf, Nothing, Maybe String) -GLOBAL_VAR(output_file, Nothing, Maybe String) -GLOBAL_VAR(output_hi, Nothing, Maybe String) +GLOBAL_VAR(v_Output_dir, Nothing, Maybe String) +GLOBAL_VAR(v_Output_suf, Nothing, Maybe String) +GLOBAL_VAR(v_Output_file, Nothing, Maybe String) +GLOBAL_VAR(v_Output_hi, Nothing, Maybe String) -GLOBAL_VAR(ld_inputs, [], [String]) +GLOBAL_VAR(v_Ld_inputs, [], [String]) odir_ify :: String -> IO String odir_ify f = do - odir_opt <- readIORef output_dir + odir_opt <- readIORef v_Output_dir case odir_opt of Nothing -> return f Just d -> return (newdir d f) osuf_ify :: String -> IO String osuf_ify f = do - osuf_opt <- readIORef output_suf + osuf_opt <- readIORef v_Output_suf case osuf_opt of Nothing -> return f Just s -> return (newsuf s f) @@ -183,9 +186,9 @@ osuf_ify f = do ----------------------------------------------------------------------------- -- Hi Files -GLOBAL_VAR(produceHi, True, Bool) -GLOBAL_VAR(hi_on_stdout, False, Bool) -GLOBAL_VAR(hi_suf, "hi", String) +GLOBAL_VAR(v_ProduceHi, True, Bool) +GLOBAL_VAR(v_Hi_on_stdout, False, Bool) +GLOBAL_VAR(v_Hi_suf, "hi", String) ----------------------------------------------------------------------------- -- Warnings & sanity checking @@ -222,7 +225,7 @@ minusWallOpts = minusWOpts ++ ] data WarningState = W_default | W_ | W_all | W_not -GLOBAL_VAR(warning_opt, W_default, WarningState) +GLOBAL_VAR(v_Warning_opt, W_default, WarningState) ----------------------------------------------------------------------------- -- Compiler optimisation options @@ -239,8 +242,8 @@ setOptLevel [c] | isDigit c = do setOptLevel s = unknownFlagErr ("-O"++s) go_via_C = do - l <- readIORef hsc_lang - case l of { HscAsm -> writeIORef hsc_lang HscC; + l <- readIORef v_Hsc_Lang + case l of { HscAsm -> writeIORef v_Hsc_Lang HscC; _other -> return () } GLOBAL_VAR(v_minus_o2_for_C, False, Bool) @@ -400,7 +403,7 @@ buildStgToDo = do | otherwise = [ ] -- STG passes - ways_ <- readIORef ways + ways_ <- readIORef v_Ways let flags2 | WayProf `elem` ways_ = StgDoMassageForProfiling : flags1 | otherwise = flags1 @@ -411,12 +414,12 @@ buildStgToDo = do split_marker = ':' -- not configurable (ToDo) -import_paths, include_paths, library_paths :: IORef [String] -GLOBAL_VAR(import_paths, ["."], [String]) -GLOBAL_VAR(include_paths, ["."], [String]) -GLOBAL_VAR(library_paths, [], [String]) +v_Import_paths, v_Include_paths, v_Library_paths :: IORef [String] +GLOBAL_VAR(v_Import_paths, ["."], [String]) +GLOBAL_VAR(v_Include_paths, ["."], [String]) +GLOBAL_VAR(v_Library_paths, [], [String]) -GLOBAL_VAR(cmdline_libraries, [], [String]) +GLOBAL_VAR(v_Cmdline_libraries, [], [String]) addToDirList :: IORef [String] -> String -> IO () addToDirList ref path @@ -426,55 +429,53 @@ addToDirList ref path ----------------------------------------------------------------------------- -- Packages -GLOBAL_VAR(path_package_config, error "path_package_config", String) +GLOBAL_VAR(v_Path_package_config, error "path_package_config", String) -- package list is maintained in dependency order -packages = global ["std", "rts", "gmp"] :: IORef [String] --- comma in value, so can't use macro, grrr -{-# NOINLINE packages #-} +GLOBAL_VAR(v_Packages, ("std":"rts":"gmp":[]), [String]) addPackage :: String -> IO () addPackage package - = do pkg_details <- readIORef package_details + = do pkg_details <- readIORef v_Package_details case lookupPkg package pkg_details of Nothing -> throwDyn (OtherError ("unknown package name: " ++ package)) Just details -> do - ps <- readIORef packages + ps <- readIORef v_Packages unless (package `elem` ps) $ do mapM_ addPackage (package_deps details) - ps <- readIORef packages - writeIORef packages (package:ps) + ps <- readIORef v_Packages + writeIORef v_Packages (package:ps) getPackageImportPath :: IO [String] getPackageImportPath = do - ps <- readIORef packages + ps <- readIORef v_Packages ps' <- getPackageDetails ps return (nub (concat (map import_dirs ps'))) getPackageIncludePath :: IO [String] getPackageIncludePath = do - ps <- readIORef packages + ps <- readIORef v_Packages ps' <- getPackageDetails ps return (nub (filter (not.null) (concatMap include_dirs ps'))) -- includes are in reverse dependency order (i.e. rts first) getPackageCIncludes :: IO [String] getPackageCIncludes = do - ps <- readIORef packages + ps <- readIORef v_Packages ps' <- getPackageDetails ps return (reverse (nub (filter (not.null) (concatMap c_includes ps')))) getPackageLibraryPath :: IO [String] getPackageLibraryPath = do - ps <- readIORef packages + ps <- readIORef v_Packages ps' <- getPackageDetails ps return (nub (concat (map library_dirs ps'))) getPackageLibraries :: IO [String] getPackageLibraries = do - ps <- readIORef packages + ps <- readIORef v_Packages ps' <- getPackageDetails ps - tag <- readIORef build_tag + tag <- readIORef v_Build_tag let suffix = if null tag then "" else '_':tag return (concat ( map (\p -> map (++suffix) (hs_libraries p) ++ extra_libraries p) ps' @@ -482,28 +483,28 @@ getPackageLibraries = do getPackageExtraGhcOpts :: IO [String] getPackageExtraGhcOpts = do - ps <- readIORef packages + ps <- readIORef v_Packages ps' <- getPackageDetails ps return (concatMap extra_ghc_opts ps') getPackageExtraCcOpts :: IO [String] getPackageExtraCcOpts = do - ps <- readIORef packages + ps <- readIORef v_Packages ps' <- getPackageDetails ps return (concatMap extra_cc_opts ps') getPackageExtraLdOpts :: IO [String] getPackageExtraLdOpts = do - ps <- readIORef packages + ps <- readIORef v_Packages ps' <- getPackageDetails ps return (concatMap extra_ld_opts ps') getPackageDetails :: [String] -> IO [Package] getPackageDetails ps = do - pkg_details <- readIORef package_details + pkg_details <- readIORef v_Package_details return [ pkg | p <- ps, Just pkg <- [ lookupPkg p pkg_details ] ] -GLOBAL_VAR(package_details, (error "package_details"), [Package]) +GLOBAL_VAR(v_Package_details, (error "package_details"), [Package]) lookupPkg :: String -> [Package] -> Maybe Package lookupPkg nm ps @@ -526,7 +527,7 @@ lookupPkg nm ps -- becomes the suffix used to find .hi files and libraries used in -- this compilation. -GLOBAL_VAR(build_tag, "", String) +GLOBAL_VAR(v_Build_tag, "", String) data WayName = WayProf @@ -556,7 +557,7 @@ data WayName | WayUser_B deriving (Eq,Ord) -GLOBAL_VAR(ways, [] ,[WayName]) +GLOBAL_VAR(v_Ways, [] ,[WayName]) -- ToDo: allow WayDll with any other allowed combination @@ -567,13 +568,13 @@ allowed_combinations = findBuildTag :: IO [String] -- new options findBuildTag = do - way_names <- readIORef ways + way_names <- readIORef v_Ways case sort way_names of - [] -> do writeIORef build_tag "" + [] -> do writeIORef v_Build_tag "" return [] [w] -> do let details = lkupWay w - writeIORef build_tag (wayTag details) + writeIORef v_Build_tag (wayTag details) return (wayOpts details) ws -> if ws `notElem` allowed_combinations @@ -585,7 +586,7 @@ findBuildTag = do tag = concat (map wayTag stuff) flags = map wayOpts stuff in do - writeIORef build_tag tag + writeIORef v_Build_tag tag return (concat flags) lkupWay w = @@ -666,19 +667,19 @@ way_details = ----------------------------------------------------------------------------- -- Programs for particular phases -GLOBAL_VAR(pgm_L, error "pgm_L", String) -GLOBAL_VAR(pgm_P, cRAWCPP, String) -GLOBAL_VAR(pgm_c, cGCC, String) -GLOBAL_VAR(pgm_m, error "pgm_m", String) -GLOBAL_VAR(pgm_s, error "pgm_s", String) -GLOBAL_VAR(pgm_a, cGCC, String) -GLOBAL_VAR(pgm_l, cGCC, String) +GLOBAL_VAR(v_Pgm_L, error "pgm_L", String) +GLOBAL_VAR(v_Pgm_P, cRAWCPP, String) +GLOBAL_VAR(v_Pgm_c, cGCC, String) +GLOBAL_VAR(v_Pgm_m, error "pgm_m", String) +GLOBAL_VAR(v_Pgm_s, error "pgm_s", String) +GLOBAL_VAR(v_Pgm_a, cGCC, String) +GLOBAL_VAR(v_Pgm_l, cGCC, String) -GLOBAL_VAR(opt_dep, [], [String]) -GLOBAL_VAR(anti_opt_C, [], [String]) -GLOBAL_VAR(opt_C, [], [String]) -GLOBAL_VAR(opt_l, [], [String]) -GLOBAL_VAR(opt_dll, [], [String]) +GLOBAL_VAR(v_Opt_dep, [], [String]) +GLOBAL_VAR(v_Anti_opt_C, [], [String]) +GLOBAL_VAR(v_Opt_C, [], [String]) +GLOBAL_VAR(v_Opt_l, [], [String]) +GLOBAL_VAR(v_Opt_dll, [], [String]) getStaticOpts :: IORef [String] -> IO [String] getStaticOpts ref = readIORef ref >>= return . reverse @@ -717,7 +718,7 @@ machdepCCOpts -- -fomit-frame-pointer : *must* in .hc files; because we're stealing -- the fp (%ebp) for our register maps. = do n_regs <- readState stolen_x86_regs - sta <- readIORef static + sta <- readIORef v_Static return ( [ if sta then "-DDONT_WANT_WIN32_DLL_SUPPORT" else "" ], [ "-fno-defer-pop", "-fomit-frame-pointer", "-DSTOLEN_X86_REGS="++show n_regs ] @@ -738,7 +739,7 @@ machdepCCOpts run_something phase_name cmd = do - verb <- readIORef verbose + verb <- readIORef v_Verbose when verb $ do putStr phase_name putStrLn ":" @@ -746,7 +747,7 @@ run_something phase_name cmd hFlush stdout -- test for -n flag - n <- readIORef dry_run + n <- readIORef v_Dry_run unless n $ do -- and run it! diff --git a/ghc/compiler/main/DriverUtil.hs b/ghc/compiler/main/DriverUtil.hs index 6282fd2..2a4a599 100644 --- a/ghc/compiler/main/DriverUtil.hs +++ b/ghc/compiler/main/DriverUtil.hs @@ -1,5 +1,5 @@ ----------------------------------------------------------------------------- --- $Id: DriverUtil.hs,v 1.3 2000/10/11 15:26:18 simonmar Exp $ +-- $Id: DriverUtil.hs,v 1.4 2000/10/26 16:21:02 sewardj Exp $ -- -- Utils for the driver -- @@ -30,10 +30,10 @@ import Monad short_usage = "Usage: For basic information, try the `--help' option." -GLOBAL_VAR(path_usage, "", String) +GLOBAL_VAR(v_Path_usage, "", String) long_usage = do - usage_path <- readIORef path_usage + usage_path <- readIORef v_Path_usage usage <- readFile usage_path dump usage exitWith ExitSuccess @@ -51,9 +51,9 @@ data BarfKind | OtherError String -- just prints the error message deriving Eq -GLOBAL_VAR(prog_name, "ghc", String) +GLOBAL_VAR(v_Prog_name, "ghc", String) -get_prog_name = unsafePerformIO (readIORef prog_name) -- urk! +get_prog_name = unsafePerformIO (readIORef v_Prog_name) -- urk! instance Show BarfKind where showsPrec _ e = showString get_prog_name . showString ": " . showBarf e diff --git a/ghc/compiler/main/Finder.lhs b/ghc/compiler/main/Finder.lhs index bc2a5f3..de53eee 100644 --- a/ghc/compiler/main/Finder.lhs +++ b/ghc/compiler/main/Finder.lhs @@ -37,33 +37,33 @@ source, interface, and object files for a module live. \begin{code} -- caches contents of package directories, never expunged -GLOBAL_VAR(pkgDirCache, Nothing, Maybe (FiniteMap String (PackageName, FilePath))) +GLOBAL_VAR(v_PkgDirCache, Nothing, Maybe (FiniteMap String (PackageName, FilePath))) -- caches contents of home directories, expunged whenever we -- create a new finder. -GLOBAL_VAR(homeDirCache, emptyFM, FiniteMap String FilePath) +GLOBAL_VAR(v_HomeDirCache, emptyFM, FiniteMap String FilePath) -- caches finder mapping, expunged whenever we create a new finder. -GLOBAL_VAR(finderMapCache, emptyFM, FiniteMap ModuleName Module) +GLOBAL_VAR(v_FinderMapCache, emptyFM, FiniteMap ModuleName Module) newFinder :: PackageConfigInfo -> IO Finder newFinder (PackageConfigInfo pkgs) = do -- expunge our caches - writeIORef homeDirCache emptyFM - writeIORef finderMapCache emptyFM + writeIORef v_HomeDirCache emptyFM + writeIORef v_FinderMapCache emptyFM -- populate the home dir cache, using the import path (the import path -- is changed by -i flags on the command line, and defaults to ["."]). - home_imports <- readIORef import_paths + home_imports <- readIORef v_Import_paths let extendFM fm path = do contents <- getDirectoryContents' path return (addListToFM fm (zip contents (repeat path))) home_map <- foldM extendFM emptyFM home_imports - writeIORef homeDirCache home_map + writeIORef v_HomeDirCache home_map -- populate the package cache, if necessary - pkg_cache <- readIORef pkgDirCache + pkg_cache <- readIORef v_PkgDirCache case pkg_cache of Nothing -> do @@ -77,7 +77,7 @@ newFinder (PackageConfigInfo pkgs) = do foldM addDir fm dirs pkg_map <- foldM extendFM emptyFM pkgs - writeIORef pkgDirCache (Just pkg_map) + writeIORef v_PkgDirCache (Just pkg_map) Just _ -> return () @@ -95,7 +95,7 @@ finder name = do maybeHomeModule :: ModuleName -> IO (Maybe (Module, ModuleLocation)) maybeHomeModule mod_name = do - home_cache <- readIORef homeDirCache + home_cache <- readIORef v_HomeDirCache let basename = moduleNameString mod_name hs = basename ++ ".hs" @@ -115,8 +115,8 @@ mkHomeModuleLocn mod_name basename source_fn = do -- figure out the .hi file name: it lives in the same dir as the -- source, unless there's a -ohi flag on the command line. - ohi <- readIORef output_hi - hisuf <- readIORef hi_suf + ohi <- readIORef v_Output_hi + hisuf <- readIORef v_Hi_suf let hifile = case ohi of Nothing -> basename ++ '.':hisuf Just fn -> fn @@ -135,14 +135,14 @@ mkHomeModuleLocn mod_name basename source_fn = do maybePackageModule :: ModuleName -> IO (Maybe (Module, ModuleLocation)) maybePackageModule mod_name = do - maybe_pkg_cache <- readIORef pkgDirCache + maybe_pkg_cache <- readIORef v_PkgDirCache case maybe_pkg_cache of { Nothing -> panic "maybePackageModule: no pkg_cache"; Just pkg_cache -> do -- hi-suffix for packages depends on the build tag. package_hisuf <- - do tag <- readIORef build_tag + do tag <- readIORef v_Build_tag if null tag then return "hi" else return (tag ++ "_hi") diff --git a/ghc/compiler/main/HscMain.lhs b/ghc/compiler/main/HscMain.lhs index 62b1cf2..b61356c 100644 --- a/ghc/compiler/main/HscMain.lhs +++ b/ghc/compiler/main/HscMain.lhs @@ -105,11 +105,10 @@ hscMain -> Maybe ModIface -- old interface, if available -> HomeSymbolTable -- for home module ModDetails -> HomeIfaceTable - -> PackageIfaceTable -> PersistentCompilerState -- IN: persistent compiler state -> IO HscResult -hscMain dflags finder summary maybe_old_iface hst hit pit pcs +hscMain dflags finder summary maybe_old_iface hst hit pcs = do { -- ????? source_unchanged :: Bool -- extracted from summary? let source_unchanged = trace "WARNING: source_unchanged?!" False @@ -126,11 +125,11 @@ hscMain dflags finder summary maybe_old_iface hst hit pit pcs | otherwise = hscNoRecomp ; what_next dflags finder summary maybe_checked_iface - hst hit pit pcs_ch + hst hit pcs_ch }} -hscNoRecomp dflags finder summary maybe_checked_iface hst hit pit pcs_ch +hscNoRecomp dflags finder summary maybe_checked_iface hst hit pcs_ch = do { -- we definitely expect to have the old interface available let old_iface = case maybe_checked_iface of @@ -168,7 +167,7 @@ hscNoRecomp dflags finder summary maybe_checked_iface hst hit pit pcs_ch }}}} -hscRecomp dflags finder summary maybe_checked_iface hst hit pit pcs_ch +hscRecomp dflags finder summary maybe_checked_iface hst hit pcs_ch = do { -- what target are we shooting for? let toInterp = dopt_HscLang dflags == HscInterpreted @@ -221,10 +220,9 @@ hscRecomp dflags finder summary maybe_checked_iface hst hit pit pcs_ch = case maybe_final_iface_and_sdoc of Just (fif, sdoc) -> Just fif; Nothing -> Nothing ; - -- SimonM does this, higher up - -- -- Write the interface file - -- writeIface finder maybe_final_iface - -- ; + -- Write the interface file + writeIface finder maybe_final_iface + ; -- do the rest of code generation/emission (maybe_stub_h_filename, maybe_stub_c_filename, maybe_ibinds) <- restOfCodeGeneration dflags toInterp summary diff --git a/ghc/compiler/main/Main.hs b/ghc/compiler/main/Main.hs index ce7e26d..bc5d04b 100644 --- a/ghc/compiler/main/Main.hs +++ b/ghc/compiler/main/Main.hs @@ -1,6 +1,6 @@ {-# OPTIONS -W -fno-warn-incomplete-patterns #-} ----------------------------------------------------------------------------- --- $Id: Main.hs,v 1.9 2000/10/26 14:38:42 simonmar Exp $ +-- $Id: Main.hs,v 1.10 2000/10/26 16:21:02 sewardj Exp $ -- -- GHC Driver program -- @@ -20,6 +20,8 @@ import DriverState import DriverFlags import DriverMkDepend import DriverUtil +import DriverPhases ( Phase(..) ) +import CmdLineOpts ( HscLang(..), DynFlags(..) ) import TmpFiles import Config import Util @@ -83,9 +85,9 @@ main = ) $ do -- make sure we clean up after ourselves - later (do forget_it <- readIORef keep_tmp_files + later (do forget_it <- readIORef v_Keep_tmp_files unless forget_it $ do - verb <- readIORef verbose + verb <- readIORef v_Verbose cleanTempFiles verb ) $ do -- exceptions will be blocked while we clean the temporary files, @@ -102,13 +104,13 @@ main = #endif pgm <- getProgName - writeIORef prog_name pgm + writeIORef v_Prog_name pgm argv <- getArgs -- grab any -B options from the command line first argv' <- setTopDir argv - top_dir <- readIORef topDir + top_dir <- readIORef v_TopDir let installed s = top_dir ++ s inplace s = top_dir ++ '/':cCURRENT_DIR ++ '/':s @@ -121,35 +123,35 @@ main = am_installed <- doesFileExist installed_pkgconfig if am_installed - then writeIORef path_package_config installed_pkgconfig + then writeIORef v_Path_package_config installed_pkgconfig else do am_inplace <- doesFileExist inplace_pkgconfig if am_inplace - then writeIORef path_package_config inplace_pkgconfig + then writeIORef v_Path_package_config inplace_pkgconfig else throwDyn (OtherError "can't find package.conf") -- set the location of our various files if am_installed - then do writeIORef path_usage (installed "ghc-usage.txt") - writeIORef pgm_L (installed "unlit") - writeIORef pgm_m (installed "ghc-asm") - writeIORef pgm_s (installed "ghc-split") + then do writeIORef v_Path_usage (installed "ghc-usage.txt") + writeIORef v_Pgm_L (installed "unlit") + writeIORef v_Pgm_m (installed "ghc-asm") + writeIORef v_Pgm_s (installed "ghc-split") - else do writeIORef path_usage (inplace (cGHC_DRIVER_DIR ++ "/ghc-usage.txt")) - writeIORef pgm_L (inplace cGHC_UNLIT) - writeIORef pgm_m (inplace cGHC_MANGLER) - writeIORef pgm_s (inplace cGHC_SPLIT) + else do writeIORef v_Path_usage (inplace (cGHC_DRIVER_DIR ++ "/ghc-usage.txt")) + writeIORef v_Pgm_L (inplace cGHC_UNLIT) + writeIORef v_Pgm_m (inplace cGHC_MANGLER) + writeIORef v_Pgm_s (inplace cGHC_SPLIT) -- read the package configuration - conf_file <- readIORef path_package_config + conf_file <- readIORef v_Path_package_config contents <- readFile conf_file - writeIORef package_details (read contents) + writeIORef v_Package_details (read contents) -- find the phase to stop after (i.e. -E, -C, -c, -S flags) (flags2, mode, stop_flag) <- getGhcMode argv' writeIORef v_GhcMode mode -- force lang to "C" if the -C flag was given - case mode of StopBefore HCc -> writeIORef hsc_lang HscC + case mode of StopBefore HCc -> writeIORef v_Hsc_Lang HscC _ -> return () -- process all the other arguments, and get the source files @@ -161,11 +163,12 @@ main = -- give the static flags to hsc static_opts <- buildStaticHscOpts - writeIORef static_hsc_opts static_opts + writeIORef v_Static_hsc_opts static_opts -- warnings - warn_level <- readIORef warning_opt - let warn_opts = case warn_level of + warn_level <- readIORef v_Warning_opt + + let warn_opts = case warn_level of W_default -> standardWarnings W_ -> minusWOpts W_all -> minusWallOpts @@ -177,7 +180,7 @@ main = core_todo <- buildCoreToDo stg_todo <- buildStgToDo - lang <- readIORef hsc_lang + lang <- readIORef v_Hsc_Lang writeIORef v_DynFlags DynFlags{ coreToDo = core_todo, stgToDo = stg_todo, @@ -189,14 +192,14 @@ main = srcs <- processArgs dynamic_flags non_static [] -- save the "initial DynFlags" away dyn_flags <- readIORef v_DynFlags - writeIORef v_InitDynFlags + writeIORef v_InitDynFlags dyn_flags -- complain about any unknown flags let unknown_flags = [ f | ('-':f) <- srcs ] mapM unknownFlagErr unknown_flags -- get the -v flag - verb <- readIORef verbose + verb <- readIORef v_Verbose when verb (do hPutStr stderr "Glasgow Haskell Compiler, Version " hPutStr stderr version_str @@ -215,7 +218,7 @@ main = pipelines <- mapM (genPipeline mode stop_flag) srcs let src_pipelines = zip srcs pipelines - o_file <- readIORef output_file + o_file <- readIORef v_Output_file if isJust o_file && mode /= DoLink && length srcs > 1 then throwDyn (UsageError "can't apply -o option to multiple source files") else do @@ -225,11 +228,11 @@ main = -- save the flag state, because this could be modified by OPTIONS pragmas -- during the compilation, and we'll need to restore it before starting -- the next compilation. - saved_driver_state <- readIORef driver_state + saved_driver_state <- readIORef v_Driver_state let compileFile (src, phases) = do r <- runPipeline phases src (mode==DoLink) True - writeIORef driver_state saved_driver_state + writeIORef v_Driver_state saved_driver_state return r o_files <- mapM compileFile src_pipelines @@ -243,8 +246,8 @@ setTopDir :: [String] -> IO [String] setTopDir args = do let (minusbs, others) = partition (prefixMatch "-B") args (case minusbs of - [] -> writeIORef topDir clibdir - some -> writeIORef topDir (drop 2 (last some))) + [] -> writeIORef v_TopDir clibdir + some -> writeIORef v_TopDir (drop 2 (last some))) return others beginMake = panic "`ghc --make' unimplemented" diff --git a/ghc/compiler/main/PackageMaintenance.hs b/ghc/compiler/main/PackageMaintenance.hs index 057326c..ebfb68f 100644 --- a/ghc/compiler/main/PackageMaintenance.hs +++ b/ghc/compiler/main/PackageMaintenance.hs @@ -1,5 +1,5 @@ ----------------------------------------------------------------------------- --- $Id: PackageMaintenance.hs,v 1.2 2000/10/11 15:26:18 simonmar Exp $ +-- $Id: PackageMaintenance.hs,v 1.3 2000/10/26 16:21:02 sewardj Exp $ -- -- GHC Driver program -- @@ -27,7 +27,7 @@ import Monad listPackages :: IO () listPackages = do - details <- readIORef package_details + details <- readIORef v_Package_details hPutStr stdout (listPkgs details) hPutChar stdout '\n' exitWith ExitSuccess @@ -35,7 +35,7 @@ listPackages = do newPackage :: IO () newPackage = do checkConfigAccess - details <- readIORef package_details + details <- readIORef v_Package_details hPutStr stdout "Reading package info from stdin... " stuff <- getContents let new_pkg = read stuff :: Package @@ -46,7 +46,7 @@ newPackage = do then throwDyn (OtherError ("package `" ++ name new_pkg ++ "' already installed")) else do - conf_file <- readIORef path_package_config + conf_file <- readIORef v_Path_package_config savePackageConfig conf_file maybeRestoreOldConfig conf_file $ do writeNewConfig conf_file ( ++ [new_pkg]) @@ -55,11 +55,11 @@ newPackage = do deletePackage :: String -> IO () deletePackage pkg = do checkConfigAccess - details <- readIORef package_details + details <- readIORef v_Package_details if (pkg `notElem` map name details) then throwDyn (OtherError ("package `" ++ pkg ++ "' not installed")) else do - conf_file <- readIORef path_package_config + conf_file <- readIORef v_Path_package_config savePackageConfig conf_file maybeRestoreOldConfig conf_file $ do writeNewConfig conf_file (filter ((/= pkg) . name)) @@ -67,7 +67,7 @@ deletePackage pkg = do checkConfigAccess :: IO () checkConfigAccess = do - conf_file <- readIORef path_package_config + conf_file <- readIORef v_Path_package_config access <- getPermissions conf_file unless (writable access) (throwDyn (OtherError "you don't have permission to modify the package configuration file")) @@ -86,7 +86,7 @@ maybeRestoreOldConfig conf_file io writeNewConfig :: String -> ([Package] -> [Package]) -> IO () writeNewConfig conf_file fn = do hPutStr stdout "Writing new package config file... " - old_details <- readIORef package_details + old_details <- readIORef v_Package_details h <- openFile conf_file WriteMode hPutStr h (dumpPackages (fn old_details)) hClose h