DriverPipeline.hs 40.4 KB
Newer Older
1
2
3
4
-----------------------------------------------------------------------------
--
-- GHC Driver
--
5
-- (c) The University of Glasgow 2002
6
7
8
--
-----------------------------------------------------------------------------

rrt's avatar
rrt committed
9
10
#include "../includes/config.h"

11
module DriverPipeline (
12
13

	-- interfaces for the batch-mode driver
14
   genPipeline, runPipeline, pipeLoop,
15
16

	-- interfaces for the compilation manager (interpreted/batch-mode)
17
   preprocess, compile, CompResult(..),
18
19

	-- batch-mode linking interface
rrt's avatar
rrt committed
20
21
22
   doLink,
        -- DLL building
   doMkDLL
23
24
25
26
  ) where

#include "HsVersions.h"

27
import Packages
28
29
import CmTypes
import GetImports
30
31
32
import DriverState
import DriverUtil
import DriverMkDepend
33
import DriverPhases
34
import DriverFlags
sof's avatar
sof committed
35
import SysTools		( newTempName, addFilesToClean, getSysMan, copy )
36
import qualified SysTools	
37
import HscMain
38
import Finder
39
40
41
import HscTypes
import Outputable
import Module
42
import ErrUtils
43
import CmdLineOpts
44
import Config
45
import Panic
46
47
import Util

48
#ifdef GHCI
49
import Time 		( getClockTime )
50
#endif
51
52
import Directory
import System
53
54
55
56
57
58
59
import IOExts
import Exception

import IO
import Monad
import Maybe

rrt's avatar
rrt committed
60
61
import PackedString

62
63
64
65
-----------------------------------------------------------------------------
-- genPipeline
--
-- Herein is all the magic about which phases to run in which order, whether
rrt's avatar
rrt committed
66
-- the intermediate files should be in TMPDIR or in the current directory,
67
68
69
-- what the suffix of the intermediate files should be, etc.

-- The following compilation pipeline algorithm is fairly hacky.  A
rrt's avatar
rrt committed
70
-- better way to do this would be to express the whole compilation as a
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
-- data flow DAG, where the nodes are the intermediate files and the
-- edges are the compilation phases.  This framework would also work
-- nicely if a haskell dependency generator was included in the
-- driver.

-- It would also deal much more cleanly with compilation phases that
-- generate multiple intermediates, (eg. hsc generates .hc, .hi, and
-- possibly stub files), where some of the output files need to be
-- processed further (eg. the stub files need to be compiled by the C
-- compiler).

-- A cool thing to do would then be to execute the data flow graph
-- concurrently, automatically taking advantage of extra processors on
-- the host machine.  For example, when compiling two Haskell files
-- where one depends on the other, the data flow graph would determine
rrt's avatar
rrt committed
86
87
-- that the C compiler from the first compilation can be overlapped
-- with the hsc compilation for the second file.
88
89
90
91

data IntermediateFileType
  = Temporary
  | Persistent
92
  deriving (Eq, Show)
93
94

genPipeline
sof's avatar
sof committed
95
96
97
98
99
   :: GhcMode		 -- when to stop
   -> String		 -- "stop after" flag (for error messages)
   -> Bool		 -- True => output is persistent
   -> HscLang		 -- preferred output language for hsc
   -> (FilePath, String) -- original filename & its suffix 
100
101
102
103
104
105
   -> IO [ 		-- list of phases to run for this file
	     (Phase,
	      IntermediateFileType,  -- keep the output from this phase?
	      String)   	     -- output file suffix
         ]	

sof's avatar
sof committed
106
genPipeline todo stop_flag persistent_output lang (filename,suffix)
107
 = do
108
109
110
   split      <- readIORef v_Split_object_files
   mangle     <- readIORef v_Do_asm_mangling
   keep_hc    <- readIORef v_Keep_hc_files
sof's avatar
sof committed
111
#ifdef ILX
rrt's avatar
rrt committed
112
   keep_il    <- readIORef v_Keep_il_files
sof's avatar
sof committed
113
114
   keep_ilx   <- readIORef v_Keep_ilx_files
#endif
115
116
   keep_raw_s <- readIORef v_Keep_raw_s_files
   keep_s     <- readIORef v_Keep_s_files
117
   osuf       <- readIORef v_Object_suf
118
   hcsuf      <- readIORef v_HC_suf
119
120
121

   let
   ----------- -----  ----   ---   --   --  -  -  -
122
123
124
125
126
    start = startPhase suffix

      -- special case for mkdependHS: .hspp files go through MkDependHS
    start_phase | todo == DoMkDependHS && start == Hsc  = MkDependHS
	        | otherwise = start
127
128
129
130

    haskellish = haskellish_suffix suffix
    cish = cish_suffix suffix

131
       -- for a .hc file we need to force lang to HscC
132
133
    real_lang | start_phase == HCc || start_phase == Mangle = HscC
	      | otherwise                                   = lang
134
135
136

   let
   ----------- -----  ----   ---   --   --  -  -  -
137
138
139
140
141
142
143
144
145
146
    pipeline = preprocess ++ compile

    preprocess
	| haskellish = [ Unlit, Cpp, HsPp ]
	| otherwise  = [ ]

    compile
      | todo == DoMkDependHS = [ MkDependHS ]

      | cish = [ Cc, As ]
147
148
149

      | haskellish = 
       case real_lang of
150
151
	HscC    | split && mangle -> [ Hsc, HCc, Mangle, SplitMangle, SplitAs ]
	        | mangle          -> [ Hsc, HCc, Mangle, As ]
152
	        | split	       	  -> not_valid
153
	        | otherwise       -> [ Hsc, HCc, As ]
154

155
156
	HscAsm  | split           -> [ Hsc, SplitMangle, SplitAs ]
	        | otherwise       -> [ Hsc, As ]
157
158
159

	HscJava	| split	          -> not_valid
		| otherwise       -> error "not implemented: compiling via Java"
160
#ifdef ILX
rrt's avatar
rrt committed
161
	HscILX  | split           -> not_valid
162
		| otherwise       -> [ Hsc, Ilx2Il, Ilasm ]
163
#endif
164
	HscNothing		  -> [ Hsc, HCc ] -- HCc is a dummy stop phase
165
166
167
168

      | otherwise = [ ]  -- just pass this file through to the linker

	-- ToDo: this is somewhat cryptic
169
    not_valid = throwDyn (UsageError ("invalid option combination"))
170
171
172

    stop_phase = case todo of 
			StopBefore As | split -> SplitAs
173
#ifdef ILX
rrt's avatar
rrt committed
174
                                      | real_lang == HscILX -> Ilasm
175
#endif
176
177
178
			StopBefore phase      -> phase
			DoMkDependHS	      -> Ln
			DoLink                -> Ln
sof's avatar
sof committed
179
			DoMkDLL               -> Ln
180
181
182
   ----------- -----  ----   ---   --   --  -  -  -

	-- this shouldn't happen.
sof's avatar
sof committed
183
184
185
   when (start_phase /= Ln && start_phase `notElem` pipeline)
	(throwDyn (CmdLineError ("can't find starting phase for "
			         ++ filename)))
186
187
188
189
	-- if we can't find the phase we're supposed to stop before,
	-- something has gone wrong.  This test carefully avoids the
	-- case where we aren't supposed to do any compilation, because the file
	-- is already in linkable form (for example).
sof's avatar
sof committed
190
191
192
   when (start_phase `elem` pipeline && 
   	 (stop_phase /= Ln && stop_phase `notElem` pipeline))
        (throwDyn (UsageError 
193
194
195
		    ("flag `" ++ stop_flag
		     ++ "' is incompatible with source file `"
		     ++ filename ++ "'" ++ show pipeline ++ show stop_phase)))
196
   let
197
198
199
200
	-- .o and .hc suffixes can be overriden by command-line options:
      myPhaseInputExt Ln  | Just s <- osuf  = s
      myPhaseInputExt HCc | Just s <- hcsuf = s
      myPhaseInputExt other                 = phaseInputExt other
201

202
203
204
205
206
207
208
      annotatePipeline
	 :: [Phase]		-- raw pipeline
	 -> Phase		-- phase to stop before
     	 -> [(Phase, IntermediateFileType, String{-file extension-})]
      annotatePipeline []     _    = []
      annotatePipeline (Ln:_) _    = []
      annotatePipeline (phase:next_phase:ps) stop = 
209
     	  (phase, keep_this_output, myPhaseInputExt next_phase)
210
211
212
	     : annotatePipeline (next_phase:ps) stop
     	  where
     		keep_this_output
213
214
215
216
     		     | next_phase == stop 
                     = if persistent_output then Persistent else Temporary
     		     | otherwise
     		     = case next_phase of
217
218
219
220
     			     Ln -> Persistent
     			     Mangle | keep_raw_s -> Persistent
     			     As     | keep_s     -> Persistent
     			     HCc    | keep_hc    -> Persistent
221
#ifdef ILX
sof's avatar
sof committed
222
			     Ilx2Il | keep_ilx   -> Persistent
rrt's avatar
rrt committed
223
			     Ilasm  | keep_il    -> Persistent
224
#endif
225
226
227
228
229
230
     			     _other              -> Temporary

	-- add information about output files to the pipeline
	-- the suffix on an output file is determined by the next phase
	-- in the pipeline, so we add linking to the end of the pipeline
	-- to force the output from the final phase to be a .o file.
231
232

      annotated_pipeline = annotatePipeline (pipeline ++ [Ln]) stop_phase
233
234
235
236

      phase_ne p (p1,_,_) = (p1 /= p)
   ----------- -----  ----   ---   --   --  -  -  -

237
238
239
240
241
   return (
     takeWhile (phase_ne stop_phase ) $
     dropWhile (phase_ne start_phase) $
     annotated_pipeline
    )
242
243
244
245


runPipeline
  :: [ (Phase, IntermediateFileType, String) ] -- phases to run
sof's avatar
sof committed
246
  -> (String,String)		-- input file
247
248
  -> Bool			-- doing linking afterward?
  -> Bool			-- take into account -o when generating output?
sof's avatar
sof committed
249
  -> IO (String, String)	-- return final filename
250

sof's avatar
sof committed
251
252
253
runPipeline pipeline (input_fn,suffix) do_linking use_ofile
  = pipeLoop pipeline (input_fn,suffix) do_linking use_ofile basename suffix
  where (basename, _) = splitFilename input_fn
254
255

pipeLoop [] input_fn _ _ _ _ = return input_fn
apt's avatar
apt committed
256
pipeLoop (all_phases@((phase, keep, o_suffix):phases))
sof's avatar
sof committed
257
	(input_fn,real_suff) do_linking use_ofile orig_basename orig_suffix
258
259
260
261
  = do

     output_fn <- outputFileName (null phases) keep o_suffix

sof's avatar
sof committed
262
263
     mbCarryOn <- run_phase phase orig_basename orig_suffix
     			    input_fn output_fn 
264
265
	-- sometimes we bail out early, eg. when the compiler's recompilation
	-- checker has determined that recompilation isn't necessary.
sof's avatar
sof committed
266
267
     case mbCarryOn of
       Nothing -> do
apt's avatar
apt committed
268
	      let (_,keep,final_suffix) = last all_phases
sof's avatar
sof committed
269
	      ofile <- outputFileName True keep final_suffix
sof's avatar
sof committed
270
	      return (ofile, final_suffix)
sof's avatar
sof committed
271
          -- carry on ...
sof's avatar
sof committed
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
       Just fn -> do
		{-
		  Check to see whether we've reached the end of the
		  pipeline, but did so with an ineffective last stage.
		  (i.e., it returned the input_fn as the output filename).
		  
		  If we did and the output is persistent, copy the contents
		  of input_fn into the file where the pipeline's output is
		  expected to end up.
		-}
	      atEnd <- finalStage (null phases)
	      when (atEnd && fn == input_fn)
	      	   (copy "Saving away compilation pipeline's output"
		   	 input_fn
			 output_fn)
sof's avatar
sof committed
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
              {-
	       Notice that in order to keep the invariant that we can
	       determine a compilation pipeline's 'start phase' just
	       by looking at the input filename, the input filename
	       to the next stage/phase is associated here with the suffix
	       of the output file, *even* if it does not have that
	       suffix in reality.
	       
	       Why is this important? Because we may run a compilation
	       pipeline in stages (cf. Main.main.compileFile's two stages),
	       so when generating the next stage we need to be precise
	       about what kind of file (=> suffix) is given as input.

	       [Not having to generate a pipeline in stages seems like
	        the right way to go, but I've punted on this for now --sof]
	       
	      -}
              pipeLoop phases (fn, o_suffix) do_linking use_ofile
       			orig_basename orig_suffix
306
  where
sof's avatar
sof committed
307
308
309
310
     finalStage lastPhase = do
       o_file <- readIORef v_Output_file
       return (lastPhase && not do_linking && use_ofile && isJust o_file)

311
     outputFileName last_phase keep suffix
312
  	= do o_file <- readIORef v_Output_file
sof's avatar
sof committed
313
314
	     atEnd  <- finalStage last_phase
   	     if atEnd
315
316
317
318
   	       then case o_file of 
   		       Just s  -> return s
   		       Nothing -> error "outputFileName"
   	       else if keep == Persistent
319
   			   then odir_ify (orig_basename ++ '.':suffix)
320
321
   			   else newTempName suffix

sof's avatar
sof committed
322
323
324
325
326
327
328
329
330
run_phase :: Phase
	  -> String                -- basename of original input source
	  -> String		   -- its extension
	  -> FilePath		   -- name of file which contains the input to this phase.
	  -> FilePath              -- where to stick the result.
	  -> IO (Maybe FilePath)
	  	  -- Nothing => stop the compilation pipeline
		  -- Just fn => the result of this phase can be found in 'fn'
		  --            (this can either be 'input_fn' or 'output_fn').
331
332
333
334
-------------------------------------------------------------------------------
-- Unlit phase 

run_phase Unlit _basename _suff input_fn output_fn
335
  = do unlit_flags <- getOpts opt_L
rrt's avatar
rrt committed
336
       -- The -h option passes the file name for unlit to put in a #line directive
sof's avatar
sof committed
337
338
339
       SysTools.runUnlit (map SysTools.Option unlit_flags ++
       			  [ SysTools.Option     "-h"
 			  , SysTools.Option     input_fn
sof's avatar
sof committed
340
341
			  , SysTools.FileOption "" input_fn
			  , SysTools.FileOption "" output_fn
sof's avatar
sof committed
342
			  ])
sof's avatar
sof committed
343
       return (Just output_fn)
344
345
346
347

-------------------------------------------------------------------------------
-- Cpp phase 

348
run_phase Cpp basename suff input_fn output_fn
349
  = do src_opts <- getOptionsFromSource input_fn
350
       unhandled_flags <- processArgs dynamic_flags src_opts []
351
       checkProcessArgsResult unhandled_flags basename suff
352

353
       do_cpp <- dynFlag cppFlag
sof's avatar
sof committed
354
355
356
357
358
       if not do_cpp then
           -- no need to preprocess CPP, just pass input file along
	   -- to the next phase of the pipeline.
          return (Just input_fn)
	else do
359
	    hscpp_opts	    <- getOpts opt_P
360
       	    hs_src_cpp_opts <- readIORef v_Hs_source_cpp_opts
361

362
	    cmdline_include_paths <- readIORef v_Include_paths
363
	    pkg_include_dirs <- getPackageIncludePath
rrt's avatar
rrt committed
364
365
	    let include_paths = foldr (\ x xs -> "-I" : x : xs) []
				  (cmdline_include_paths ++ pkg_include_dirs)
366

367
	    verb <- getVerbFlag
rrt's avatar
rrt committed
368
	    (md_c_flags, _) <- machdepCCOpts
369

sof's avatar
sof committed
370
371
372
373
374
	    SysTools.runCpp ([SysTools.Option verb]
			    ++ map SysTools.Option include_paths
			    ++ map SysTools.Option hs_src_cpp_opts
			    ++ map SysTools.Option hscpp_opts
			    ++ map SysTools.Option md_c_flags
sof's avatar
sof committed
375
376
			    ++ [ SysTools.Option     "-x"
			       , SysTools.Option     "c"
377
378
379
380
381
382
383
384
385
			       , SysTools.Option     input_fn
	-- We hackily use Option instead of FileOption here, so that the file
	-- name is not back-slashed on Windows.  cpp is capable of
	-- dealing with / in filenames, so it works fine.  Furthermore
	-- if we put in backslashes, cpp outputs #line directives
	-- with *double* backslashes.   And that in turn means that
	-- our error messages get double backslashes in them.
	-- In due course we should arrange that the lexer deals
	-- with these \\ escapes properly.
sof's avatar
sof committed
386
			       , SysTools.Option     "-o"
sof's avatar
sof committed
387
			       , SysTools.FileOption "" output_fn
sof's avatar
sof committed
388
			       ])
sof's avatar
sof committed
389
	    return (Just output_fn)
390

sof's avatar
sof committed
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
-------------------------------------------------------------------------------
-- HsPp phase 
run_phase HsPp basename suff input_fn output_fn
  = do src_opts <- getOptionsFromSource input_fn
       unhandled_flags <- processArgs dynamic_flags src_opts []
       checkProcessArgsResult unhandled_flags basename suff

       let orig_fn = basename ++ '.':suff
       do_pp   <- dynFlag ppFlag
       if not do_pp then
           -- no need to preprocess, just pass input file along
	   -- to the next phase of the pipeline.
          return (Just input_fn)
	else do
	    hspp_opts	   <- getOpts opt_F
       	    hs_src_pp_opts <- readIORef v_Hs_source_pp_opts
	    SysTools.runPp ( [ SysTools.Option     orig_fn
			     , SysTools.Option     input_fn
			     , SysTools.FileOption "" output_fn
			     ] ++
			     map SysTools.Option hs_src_pp_opts ++
			     map SysTools.Option hspp_opts
			   )
	    return (Just output_fn)

416
417
418
-----------------------------------------------------------------------------
-- MkDependHS phase

sof's avatar
sof committed
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
run_phase MkDependHS basename suff input_fn output_fn 
 = do src <- readFile input_fn
      let (import_sources, import_normals, _) = getImports src
      let orig_fn = basename ++ '.':suff
      deps_sources <- mapM (findDependency True  orig_fn) import_sources
      deps_normals <- mapM (findDependency False orig_fn) import_normals
      let deps = deps_sources ++ deps_normals

      osuf_opt <- readIORef v_Object_suf
      let osuf = case osuf_opt of
		   Nothing -> phaseInputExt Ln
		   Just s  -> s

      extra_suffixes <- readIORef v_Dep_suffixes
      let suffixes = osuf : map (++ ('_':osuf)) extra_suffixes
          ofiles = map (\suf -> basename ++ '.':suf) suffixes

      objs <- mapM odir_ify ofiles

438
	-- Handle for file that accumulates dependencies 
sof's avatar
sof committed
439
      hdl <- readIORef v_Dep_tmp_hdl
440

441
	-- std dependency of the object(s) on the source file
sof's avatar
sof committed
442
443
444
445
446
447
448
449
450
      hPutStrLn hdl (unwords objs ++ " : " ++ basename ++ '.':suff)

      let genDep (dep, False {- not an hi file -}) = 
	     hPutStrLn hdl (unwords objs ++ " : " ++ dep)
          genDep (dep, True  {- is an hi file -}) = do
	     hisuf <- readIORef v_Hi_suf
	     let dep_base = remove_suffix '.' dep
	         deps = (dep_base ++ hisuf)
		        : map (\suf -> dep_base ++ suf ++ '_':hisuf) extra_suffixes
451
		  -- length objs should be == length deps
sof's avatar
sof committed
452
	     sequence_ (zipWith (\o d -> hPutStrLn hdl (o ++ " : " ++ d)) objs deps)
453

sof's avatar
sof committed
454
455
      sequence_ (map genDep [ d | Just d <- deps ])
      return (Just output_fn)
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477

-- add the lines to dep_makefile:
	   -- always:
		   -- this.o : this.hs

  	   -- if the dependency is on something other than a .hi file:
   		   -- this.o this.p_o ... : dep
   	   -- otherwise
   		   -- if the import is {-# SOURCE #-}
   			   -- this.o this.p_o ... : dep.hi-boot[-$vers]
   			   
   		   -- else
   			   -- this.o ...   : dep.hi
   			   -- this.p_o ... : dep.p_hi
   			   -- ...
   
   	   -- (where .o is $osuf, and the other suffixes come from
   	   -- the cmdline -s options).
   
-----------------------------------------------------------------------------
-- Hsc phase

478
479
-- Compilation of a single module, in "legacy" mode (_not_ under
-- the direction of the compilation manager).
480
run_phase Hsc basename suff input_fn output_fn
481
  = do
482
483
484
485
486
487
	
  -- we add the current directory (i.e. the directory in which
  -- the .hs files resides) to the import path, since this is
  -- what gcc does, and it's probably what you want.
	let current_dir = getdir basename
	
488
489
	paths <- readIORef v_Include_paths
	writeIORef v_Include_paths (current_dir : paths)
490
	
491
492
493
494
495
  -- figure out which header files to #include in a generated .hc file
	c_includes <- getPackageCIncludes
	cmdline_includes <- dynFlag cmdlineHcIncludes -- -#include options

	let cc_injects = unlines (map mk_include 
496
				 (c_includes ++ reverse cmdline_includes))
497
498
499
500
501
502
503
504
	    mk_include h_file = 
		case h_file of 
		   '"':_{-"-} -> "#include "++h_file
		   '<':_      -> "#include "++h_file
		   _          -> "#include \""++h_file++"\""

	writeIORef v_HCHeader cc_injects

505
506
507
508
  -- gather the imports and module name
        (srcimps,imps,mod_name) <- getImportsFromFile input_fn

  -- build a ModuleLocation to pass to hscMain.
sof's avatar
sof committed
509
	(mod, location')
sof's avatar
sof committed
510
	   <- mkHomeModuleLocn mod_name basename (basename ++ '.':suff)
511
512
513
514
515
516

  -- take -ohi into account if present
	ohi <- readIORef v_Output_hi
	let location | Just fn <- ohi = location'{ ml_hi_file = fn }
		     | otherwise      = location'

517
518
519
520
  -- figure out if the source has changed, for recompilation avoidance.
  -- only do this if we're eventually going to generate a .o file.
  -- (ToDo: do when generating .hc files too?)
  --
521
  -- Setting source_unchanged to True means that M.o seems
522
523
  -- to be up to date wrt M.hs; so no need to recompile unless imports have
  -- changed (which the compiler itself figures out).
524
  -- Setting source_unchanged to False tells the compiler that M.o is out of
525
  -- date wrt M.hs (or M.o doesn't exist) so we must recompile regardless.
sof's avatar
sof committed
526
527
528
529
530
531
532
	do_recomp   <- readIORef v_Recomp
	todo        <- readIORef v_GhcMode
	expl_o_file <- readIORef v_Output_file
        let o_file = 
		case expl_o_file of
		  Nothing -> unJust "source_unchanged" (ml_obj_file location)
		  Just x  -> x
533
534
	source_unchanged <- 
          if not (do_recomp && ( todo == DoLink || todo == StopBefore Ln ))
535
	     then return False
536
537
538
	     else do t1 <- getModificationTime (basename ++ '.':suff)
		     o_file_exists <- doesFileExist o_file
		     if not o_file_exists
539
		        then return False	-- Need to recompile
540
541
			else do t2 <- getModificationTime o_file
			        if t2 > t1
542
543
				  then return True
				  else return False
544

545
  -- get the DynFlags
546
        dyn_flags <- getDynFlags
547

548
549
        let dyn_flags' = dyn_flags { hscOutName = output_fn,
		   		     hscStubCOutName = basename ++ "_stub.c",
apt's avatar
apt committed
550
				     hscStubHOutName = basename ++ "_stub.h",
apt's avatar
apt committed
551
				     extCoreName = basename ++ ".hcr" }
552

553
  -- run the compiler!
554
        pcs <- initPersistentCompilerState
555
	result <- hscMain OneShot
556
                          dyn_flags' mod
557
			  location{ ml_hspp_file=Just input_fn }
558
			  source_unchanged
559
			  False
560
561
562
563
			  Nothing	 -- no iface
			  emptyModuleEnv -- HomeSymbolTable
			  emptyModuleEnv -- HomeIfaceTable
			  pcs
564
565
566

	case result of {

567
	    HscFail pcs -> throwDyn (PhaseFailed "hsc" (ExitFailure 1));
568

569
            HscNoRecomp pcs details iface -> do { SysTools.touch "Touching object file" o_file
sof's avatar
sof committed
570
						; return Nothing } ;
571

572
	    HscRecomp pcs details iface stub_h_exists stub_c_exists
573
		      _maybe_interpreted_code -> do
574

apt's avatar
apt committed
575
576
577
578
579
580
581
582
			    -- deal with stubs
			    maybe_stub_o <- compileStub dyn_flags' stub_c_exists
		  	    case maybe_stub_o of
		 	      Nothing -> return ()
		 	      Just stub_o -> add v_Ld_inputs stub_o
			    case hscLang dyn_flags of
                              HscNothing -> return Nothing
			      _ -> return (Just output_fn)
583
    }
584
585
586
587
588
589
590

-----------------------------------------------------------------------------
-- Cc phase

-- we don't support preprocessing .c files (with -E) now.  Doing so introduces
-- way too many hacks, and I can't say I've ever used it anyway.

591
run_phase cc_phase basename suff input_fn output_fn
592
   | cc_phase == Cc || cc_phase == HCc
593
   = do	cc_opts		     <- getOpts opt_c
rrt's avatar
rrt committed
594
       	cmdline_include_paths <- readIORef v_Include_paths
595
596
597
598
599
600
601

        let hcc = cc_phase == HCc

		-- add package include paths even if we're just compiling
		-- .c files; this is the Value Add(TM) that using
		-- ghc instead of gcc gives you :)
        pkg_include_dirs <- getPackageIncludePath
rrt's avatar
rrt committed
602
603
        let include_paths = foldr (\ x xs -> "-I" : x : xs) []
			      (cmdline_include_paths ++ pkg_include_dirs)
604

605
	mangle <- readIORef v_Do_asm_mangling
606
607
	(md_c_flags, md_regd_c_flags) <- machdepCCOpts

608
        verb <- getVerbFlag
609

610
	o2 <- readIORef v_minus_o2_for_C
611
612
613
614
615
	let opt_flag | o2        = "-O2"
		     | otherwise = "-O"

	pkg_extra_cc_opts <- getPackageExtraCcOpts

616
	split_objs <- readIORef v_Split_object_files
sof's avatar
sof committed
617
618
	let split_opt | hcc && split_objs = [ "-DUSE_SPLIT_MARKERS" ]
		      | otherwise         = [ ]
619

620
	excessPrecision <- readIORef v_Excess_precision
621
622
623
624
625
626
627
628
629

	-- force the C compiler to interpret this file as C when
	-- compiling .hc files, by adding the -x c option.
	let langopt
		| cc_phase == HCc = [ SysTools.Option "-x", SysTools.Option "c"]
		| otherwise       = [ ]

	SysTools.runCc (langopt ++
			[ SysTools.FileOption "" input_fn
sof's avatar
sof committed
630
			, SysTools.Option "-o"
sof's avatar
sof committed
631
			, SysTools.FileOption "" output_fn
sof's avatar
sof committed
632
633
634
			]
		       ++ map SysTools.Option (
		          md_c_flags
635
636
637
638
639
640
		       ++ (if cc_phase == HCc && mangle
		  	     then md_regd_c_flags
		  	     else [])
		       ++ [ verb, "-S", "-Wimplicit", opt_flag ]
		       ++ [ "-D__GLASGOW_HASKELL__="++cProjectVersionInt ]
		       ++ cc_opts
sof's avatar
sof committed
641
		       ++ split_opt
642
643
644
		       ++ (if excessPrecision then [] else [ "-ffloat-store" ])
		       ++ include_paths
		       ++ pkg_extra_cc_opts
sof's avatar
sof committed
645
		       ))
sof's avatar
sof committed
646
	return (Just output_fn)
647
648
649
650
651
652
653

	-- ToDo: postprocess the output from gcc

-----------------------------------------------------------------------------
-- Mangle phase

run_phase Mangle _basename _suff input_fn output_fn
654
655
656
657
658
659
  = do mangler_opts <- getOpts opt_m
       machdep_opts <- if (prefixMatch "i386" cTARGETPLATFORM)
		       then do n_regs <- dynFlag stolen_x86_regs
			       return [ show n_regs ]
		       else return []

sof's avatar
sof committed
660
       SysTools.runMangle (map SysTools.Option mangler_opts
sof's avatar
sof committed
661
662
		          ++ [ SysTools.FileOption "" input_fn
			     , SysTools.FileOption "" output_fn
sof's avatar
sof committed
663
664
			     ]
			  ++ map SysTools.Option machdep_opts)
sof's avatar
sof committed
665
       return (Just output_fn)
666
667
668
669

-----------------------------------------------------------------------------
-- Splitting phase

sof's avatar
sof committed
670
run_phase SplitMangle _basename _suff input_fn output_fn
671
672
673
674
  = do  -- tmp_pfx is the prefix used for the split .s files
	-- We also use it as the file to contain the no. of split .s files (sigh)
	split_s_prefix <- SysTools.newTempName "split"
	let n_files_fn = split_s_prefix
675

sof's avatar
sof committed
676
677
678
	SysTools.runSplit [ SysTools.FileOption "" input_fn
			  , SysTools.FileOption "" split_s_prefix
			  , SysTools.FileOption "" n_files_fn
sof's avatar
sof committed
679
			  ]
680
681
682
683
684
685
686
687
688

	-- Save the number of split files for future references
	s <- readFile n_files_fn
	let n_files = read s :: Int
	writeIORef v_Split_info (split_s_prefix, n_files)

	-- Remember to delete all these files
	addFilesToClean [ split_s_prefix ++ "__" ++ show n ++ ".s"
			| n <- [1..n_files]]
689

sof's avatar
sof committed
690
	return (Just output_fn)
691
692
693
694
695

-----------------------------------------------------------------------------
-- As phase

run_phase As _basename _suff input_fn output_fn
696
  = do	as_opts		      <- getOpts opt_a
697
        cmdline_include_paths <- readIORef v_Include_paths
698

sof's avatar
sof committed
699
700
701
	SysTools.runAs (map SysTools.Option as_opts
		       ++ [ SysTools.Option ("-I" ++ p) | p <- cmdline_include_paths ]
		       ++ [ SysTools.Option "-c"
sof's avatar
sof committed
702
		          , SysTools.FileOption "" input_fn
sof's avatar
sof committed
703
			  , SysTools.Option "-o"
sof's avatar
sof committed
704
			  , SysTools.FileOption "" output_fn
sof's avatar
sof committed
705
			  ])
sof's avatar
sof committed
706
	return (Just output_fn)
707

sof's avatar
sof committed
708
run_phase SplitAs basename _suff _input_fn output_fn
709
  = do  as_opts <- getOpts opt_a
710

711
	(split_s_prefix, n) <- readIORef v_Split_info
712

713
	odir <- readIORef v_Output_dir
714
	let real_odir = case odir of
715
				Nothing -> basename ++ "_split"
716
717
				Just d  -> d

718
719
	let assemble_file n
	      = do  let input_s  = split_s_prefix ++ "__" ++ show n ++ ".s"
720
721
722
		    let output_o = newdir real_odir 
					(basename ++ "__" ++ show n ++ ".o")
		    real_o <- osuf_ify output_o
sof's avatar
sof committed
723
724
725
		    SysTools.runAs (map SysTools.Option as_opts ++
		    		    [ SysTools.Option "-c"
				    , SysTools.Option "-o"
sof's avatar
sof committed
726
727
				    , SysTools.FileOption "" real_o
				    , SysTools.FileOption "" input_s
sof's avatar
sof committed
728
				    ])
729
730
	
	mapM_ assemble_file [1..n]
sof's avatar
sof committed
731
	return (Just output_fn)
732

rrt's avatar
rrt committed
733
734
735
736
737
738
739
#ifdef ILX
-----------------------------------------------------------------------------
-- Ilx2Il phase
-- Run ilx2il over the ILX output, getting an IL file

run_phase Ilx2Il _basename _suff input_fn output_fn
  = do	ilx2il_opts <- getOpts opt_I
rrt's avatar
rrt committed
740
741
742
743
        SysTools.runIlx2il (map SysTools.Option ilx2il_opts
                           ++ [ SysTools.Option "--no-add-suffix-to-assembly",
				SysTools.Option "mscorlib",
				SysTools.Option "-o",
sof's avatar
sof committed
744
745
				SysTools.FileOption "" output_fn,
				SysTools.FileOption "" input_fn ])
rrt's avatar
rrt committed
746
747
748
749
750
751
752
753
	return (Just output_fn)

-----------------------------------------------------------------------------
-- Ilasm phase
-- Run ilasm over the IL, getting a DLL

run_phase Ilasm _basename _suff input_fn output_fn
  = do	ilasm_opts <- getOpts opt_i
rrt's avatar
rrt committed
754
755
756
        SysTools.runIlasm (map SysTools.Option ilasm_opts
		           ++ [ SysTools.Option "/QUIET",
				SysTools.Option "/DLL",
sof's avatar
sof committed
757
758
				SysTools.FileOption "/OUT=" output_fn,
				SysTools.FileOption "" input_fn ])
rrt's avatar
rrt committed
759
760
761
762
	return (Just output_fn)

#endif -- ILX

763
764
765
766
767
768
769
770
771
772
773
774
775
-----------------------------------------------------------------------------
-- MoveBinary sort-of-phase
-- After having produced a binary, move it somewhere else and generate a
-- wrapper script calling the binary. Currently, we need this only in 
-- a parallel way (i.e. in GUM), because PVM expects the binary in a
-- central directory.
-- This is called from doLink below, after linking. I haven't made it
-- a separate phase to minimise interfering with other modules, and
-- we don't need the generality of a phase (MoveBinary is always
-- done after linking and makes only sense in a parallel setup)   -- HWL

run_phase_MoveBinary input_fn
  = do	
776
        sysMan   <- getSysMan
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
        pvm_root <- getEnv "PVM_ROOT"
        pvm_arch <- getEnv "PVM_ARCH"
        let 
           pvm_executable_base = "=" ++ input_fn
           pvm_executable = pvm_root ++ "/bin/" ++ pvm_arch ++ "/" ++ pvm_executable_base
        -- nuke old binary; maybe use configur'ed names for cp and rm?
        system ("rm -f " ++ pvm_executable)
        -- move the newly created binary into PVM land
        system ("cp -p " ++ input_fn ++ " " ++ pvm_executable)
        -- generate a wrapper script for running a parallel prg under PVM
        writeFile input_fn (mk_pvm_wrapper_script pvm_executable pvm_executable_base sysMan)
	return True

-- generates a Perl skript starting a parallel prg under PVM
mk_pvm_wrapper_script :: String -> String -> String -> String
mk_pvm_wrapper_script pvm_executable pvm_executable_base sysMan = unlines $
 [
  "eval 'exec perl -S $0 ${1+\"$@\"}'", 
  "  if $running_under_some_shell;",
  "# =!=!=!=!=!=!=!=!=!=!=!",
  "# This script is automatically generated: DO NOT EDIT!!!",
  "# Generated by Glasgow Haskell Compiler",
  "# ngoqvam choHbogh vaj' vIHoHnISbej !!!!",
  "#",
  "$pvm_executable      = '" ++ pvm_executable ++ "';",
  "$pvm_executable_base = '" ++ pvm_executable_base ++ "';",
  "$SysMan = '" ++ sysMan ++ "';",
  "",
  {- ToDo: add the magical shortcuts again iff we actually use them -- HWL
  "# first, some magical shortcuts to run "commands" on the binary",
  "# (which is hidden)",
  "if ($#ARGV == 1 && $ARGV[0] eq '+RTS' && $ARGV[1] =~ /^--((size|file|strip|rm|nm).*)/ ) {",
  "    local($cmd) = $1;",
  "    system("$cmd $pvm_executable");",
  "    exit(0); # all done",
  "}", -}
  "",
  "# Now, run the real binary; process the args first",
  "$ENV{'PE'} = $pvm_executable_base;", --  ++ pvm_executable_base,
  "$debug = '';",
  "$nprocessors = 0; # the default: as many PEs as machines in PVM config",
  "@nonPVM_args = ();",
  "$in_RTS_args = 0;",
  "",
  "args: while ($a = shift(@ARGV)) {",
  "    if ( $a eq '+RTS' ) {",
  "	$in_RTS_args = 1;",
  "    } elsif ( $a eq '-RTS' ) {",
  "	$in_RTS_args = 0;",
  "    }",
  "    if ( $a eq '-d' && $in_RTS_args ) {",
  "	$debug = '-';",
  "    } elsif ( $a =~ /^-qN(\\d+)/ && $in_RTS_args ) {",
  "	$nprocessors = $1;",
  "    } elsif ( $a =~ /^-qp(\\d+)/ && $in_RTS_args ) {",
  "	$nprocessors = $1;",
  "    } else {",
  "	push(@nonPVM_args, $a);",
  "    }",
  "}",
  "",
  "local($return_val) = 0;",
  "# Start the parallel execution by calling SysMan",
  "system(\"$SysMan $debug $pvm_executable $nprocessors @nonPVM_args\");",
  "$return_val = $?;",
  "# ToDo: fix race condition moving files and flushing them!!",
  "system(\"cp $ENV{'HOME'}/$pvm_executable_base.???.gr .\") if -f \"$ENV{'HOME'}/$pvm_executable_base.002.gr\";",
  "exit($return_val);"
 ]

847
848
849
850
-----------------------------------------------------------------------------
-- Complain about non-dynamic flags in OPTIONS pragmas

checkProcessArgsResult flags basename suff
851
  = do when (not (null flags)) (throwDyn (ProgramError (
852
853
854
855
           basename ++ "." ++ suff 
           ++ ": static flags are not allowed in {-# OPTIONS #-} pragmas:\n\t" 
           ++ unwords flags)) (ExitFailure 1))

856
857
858
859
860
-----------------------------------------------------------------------------
-- Linking

doLink :: [String] -> IO ()
doLink o_files = do
861
862
    verb       <- getVerbFlag
    static     <- readIORef v_Static
863
864
    no_hs_main <- readIORef v_NoHsMain

865
    o_file <- readIORef v_Output_file
866
867
868
869
870
    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

871
    lib_paths <- readIORef v_Library_paths
872
873
874
    let lib_path_opts = map ("-L"++) lib_paths

    pkg_libs <- getPackageLibraries
875
876
    let imp	     = if static then "" else "_imp"
        pkg_lib_opts = map (\lib -> "-l" ++ lib ++ imp) pkg_libs
877

878
    libs <- readIORef v_Cmdline_libraries
879
880
881
882
883
884
    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
885
    extra_ld_inputs <- readIORef v_Ld_inputs
886
887

	-- opts from -optl-<blah>
888
    extra_ld_opts <- getStaticOpts v_Opt_l
889

890
891
892
893
    rts_pkg <- getPackageDetails ["rts"]
    std_pkg <- getPackageDetails ["std"]
    let extra_os = if static || no_hs_main
                   then []
rrt's avatar
rrt committed
894
895
                   else [ head (library_dirs (head rts_pkg)) ++ "/Main.dll_o",
                          head (library_dirs (head std_pkg)) ++ "/PrelMain.dll_o" ]
896

897
    (md_c_flags, _) <- machdepCCOpts
sof's avatar
sof committed
898
899
    SysTools.runLink ( [ SysTools.Option verb
    		       , SysTools.Option "-o"
sof's avatar
sof committed
900
		       , SysTools.FileOption "" output_fn
sof's avatar
sof committed
901
902
903
		       ]
		      ++ map SysTools.Option (
		         md_c_flags
904
905
906
907
908
909
910
911
912
	 	      ++ o_files
		      ++ extra_os
		      ++ extra_ld_inputs
	 	      ++ lib_path_opts
	 	      ++ lib_opts
	 	      ++ pkg_lib_path_opts
	 	      ++ pkg_lib_opts
	 	      ++ pkg_extra_ld_opts
	 	      ++ extra_ld_opts
sof's avatar
sof committed
913
	              ++ if static && not no_hs_main then
914
			    [ "-u", prefixUnderscore "Main_zdmain_closure"] 
sof's avatar
sof committed
915
			 else []))
916

917
918
    -- parallel only: move binary to another dir -- HWL
    ways_ <- readIORef v_Ways
919
920
921
922
    when (WayPar `elem` ways_)
	 (do success <- run_phase_MoveBinary output_fn
             if success then return ()
                        else throwDyn (InstallationError ("cannot move binary to PVM dir")))
923

rrt's avatar
rrt committed
924
-----------------------------------------------------------------------------
925
-- Making a DLL (only for Win32)
rrt's avatar
rrt committed
926
927
928

doMkDLL :: [String] -> IO ()
doMkDLL o_files = do
929
930
    verb       <- getVerbFlag
    static     <- readIORef v_Static
rrt's avatar
rrt committed
931
932
933
934
935
936
937
938
939
940
941
942
    no_hs_main <- readIORef v_NoHsMain

    o_file <- readIORef v_Output_file
    let output_fn = case o_file of { Just s -> s; Nothing -> "HSdll.dll"; }

    pkg_lib_paths <- getPackageLibraryPath
    let pkg_lib_path_opts = map ("-L"++) pkg_lib_paths

    lib_paths <- readIORef v_Library_paths
    let lib_path_opts = map ("-L"++) lib_paths

    pkg_libs <- getPackageLibraries
943
944
    let imp = if static then "" else "_imp"
        pkg_lib_opts = map (\lib -> "-l" ++ lib ++ imp) pkg_libs
rrt's avatar
rrt committed
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959

    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 v_Ld_inputs

	-- opts from -optdll-<blah>
    extra_ld_opts <- getStaticOpts v_Opt_dll

    rts_pkg <- getPackageDetails ["rts"]
    std_pkg <- getPackageDetails ["std"]
960

rrt's avatar
rrt committed
961
962
963
964
    let extra_os = if static || no_hs_main
                   then []
                   else [ head (library_dirs (head rts_pkg)) ++ "/Main.dll_o",
                          head (library_dirs (head std_pkg)) ++ "/PrelMain.dll_o" ]
965

rrt's avatar
rrt committed
966
    (md_c_flags, _) <- machdepCCOpts
967
    SysTools.runMkDLL
sof's avatar
sof committed
968
969
	 ([ SysTools.Option verb
	  , SysTools.Option "-o"
sof's avatar
sof committed
970
	  , SysTools.FileOption "" output_fn
sof's avatar
sof committed
971
972
973
	  ]
	 ++ map SysTools.Option (
	    md_c_flags
rrt's avatar
rrt committed
974
975
976
977
978
979
980
981
982
	 ++ o_files
	 ++ extra_os
	 ++ [ "--target=i386-mingw32" ]
	 ++ extra_ld_inputs
	 ++ lib_path_opts
	 ++ lib_opts
	 ++ pkg_lib_path_opts
	 ++ pkg_lib_opts
	 ++ pkg_extra_ld_opts
983
984
985
         ++ (if "--def" `elem` (concatMap words extra_ld_opts)
	       then [ "" ]
               else [ "--export-all" ])
rrt's avatar
rrt committed
986
	 ++ extra_ld_opts
sof's avatar
sof committed
987
	))
rrt's avatar
rrt committed
988

989
990
991
992
993
994
-----------------------------------------------------------------------------
-- Just preprocess a file, put the result in a temp. file (used by the
-- compilation manager during the summary phase).

preprocess :: FilePath -> IO FilePath
preprocess filename =
995
  ASSERT(haskellish_src_file filename) 
996
  do restoreDynFlags	-- Restore to state of last save
sof's avatar
sof committed
997
     let fInfo = (filename, getFileSuffix filename)
998
     pipeline <- genPipeline (StopBefore Hsc) ("preprocess") False 
sof's avatar
sof committed
999
1000
			     defaultHscLang fInfo
     (fn,_)   <- runPipeline pipeline fInfo
sof's avatar
sof committed
1001
1002
     	                     False{-no linking-} False{-no -o flag-}
     return fn
1003
1004

-----------------------------------------------------------------------------
1005
-- Compile a single module, under the control of the compilation manager.
1006
1007
1008
1009
1010
1011
--
-- This is the interface between the compilation manager and the
-- compiler proper (hsc), where we deal with tedious details like
-- reading the OPTIONS pragma from the source file, and passing the
-- output of hsc through the C compiler.

1012
1013
1014
1015
1016
1017
-- The driver sits between 'compile' and 'hscMain', translating calls
-- to the former into calls to the latter, and results from the latter
-- into results from the former.  It does things like preprocessing
-- the .hs file if necessary, and compiling up the .stub_c files to
-- generate Linkables.

1018
1019
1020
1021
-- NB.  No old interface can also mean that the source has changed.

compile :: GhciMode                -- distinguish batch from interactive
        -> ModSummary              -- summary, including source
1022
1023
	-> Bool			   -- True <=> source unchanged
	-> Bool			   -- True <=> have object
1024
        -> Maybe ModIface          -- old interface, if available
1025
1026
        -> HomeSymbolTable         -- for home module ModDetails
	-> HomeIfaceTable	   -- for home module Ifaces
1027
1028
1029
        -> PersistentCompilerState -- persistent compiler state
        -> IO CompResult

1030
data CompResult
1031
1032
1033
1034
1035
1036
   = CompOK   PersistentCompilerState	-- updated PCS
              ModDetails  -- new details (HST additions)
              ModIface    -- new iface   (HIT additions)
              (Maybe Linkable)
                       -- new code; Nothing => compilation was not reqd
                       -- (old code is still valid)
1037
1038
1039
1040

   | CompErrs PersistentCompilerState	-- updated PCS


1041
1042
compile ghci_mode summary source_unchanged have_object 
	old_iface hst hit pcs = do 
1043
1044
   dyn_flags <- restoreDynFlags		-- Restore to the state of the last save

1045

1046
   showPass dyn_flags 
1047
	(showSDoc (text "Compiling" <+> ppr (modSummaryName summary)))
1048

1049
   let verb	  = verbosity dyn_flags
1050
   let location   = ms_location summary
1051
1052
   let input_fn   = unJust "compile:hs" (ml_hs_file location) 
   let input_fnpp = unJust "compile:hspp" (ml_hspp_file location)
1053

1054
   when (verb >= 2) (hPutStrLn stderr ("compile: input file " ++ input_fnpp))
1055

1056
   opts <- getOptionsFromSource input_fnpp
1057
   processArgs dynamic_flags opts []
1058
   dyn_flags <- getDynFlags
1059

1060
   let hsc_lang      = hscLang dyn_flags
1061
1062
       (basename, _) = splitFilename input_fn
       
1063
   keep_hc <- readIORef v_Keep_hc_files
sof's avatar
sof committed
1064
#ifdef ILX
rrt's avatar
rrt committed
1065
   keep_il <- readIORef v_Keep_il_files
sof's avatar
sof committed
1066
#endif
1067
1068
1069
1070
1071
1072
1073
1074
1075
   keep_s  <- readIORef v_Keep_s_files

   output_fn <- 
	case hsc_lang of
	   HscAsm  | keep_s    -> return (basename ++ '.':phaseInputExt As)
		   | otherwise -> newTempName (phaseInputExt As)
	   HscC    | keep_hc   -> return (basename ++ '.':phaseInputExt HCc)
		   | otherwise -> newTempName (phaseInputExt HCc)
           HscJava             -> newTempName "java" -- ToDo
1076
#ifdef ILX
rrt's avatar
rrt committed
1077
1078
	   HscILX  | keep_il   -> return (basename ++ '.':phaseInputExt Ilasm)
                   | otherwise -> newTempName (phaseInputExt Ilx2Il) 	
1079
#endif
1080
	   HscInterpreted      -> return (error "no output file")
apt's avatar
apt committed
1081
           HscNothing	       -> return (error "no output file")
1082

1083
   let dyn_flags' = dyn_flags { hscOutName = output_fn,
1084
				hscStubCOutName = basename ++ "_stub.c",
apt's avatar
apt committed
1085
				hscStubHOutName = basename ++ "_stub.h",
apt's avatar
apt committed
1086
				extCoreName = basename ++ ".hcr" }
1087

1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
   -- figure out which header files to #include in a generated .hc file
   c_includes <- getPackageCIncludes
   cmdline_includes <- dynFlag cmdlineHcIncludes -- -#include options

   let cc_injects = unlines (map mk_include 
                                 (c_includes ++ reverse cmdline_includes))
       mk_include h_file = 
	case h_file of 
           '"':_{-"-} -> "#include "++h_file
           '<':_      -> "#include "++h_file
           _          -> "#include \""++h_file++"\""

   writeIORef v_HCHeader cc_injects

1102
1103
   -- -no-recomp should also work with --make
   do_recomp <- readIORef v_Recomp
1104
   let source_unchanged' = source_unchanged && do_recomp
1105

1106
   -- run the compiler
1107
   hsc_result <- hscMain ghci_mode dyn_flags'
1108
			 (ms_mod summary) location
1109
			 source_unchanged' have_object old_iface hst hit pcs
1110

1111
1112
   case hsc_result of
      HscFail pcs -> return (CompErrs pcs)
1113

1114
      HscNoRecomp pcs details iface -> return (CompOK pcs details iface Nothing)
1115

1116
      HscRecomp pcs details iface
1117
1118
1119
	stub_h_exists stub_c_exists maybe_interpreted_code -> do
	   let 
	   maybe_stub_o <- compileStub dyn_flags' stub_c_exists
1120
1121
1122
	   let stub_unlinked = case maybe_stub_o of
				  Nothing -> []
				  Just stub_o -> [ DotO stub_o ]
1123

1124
	   (hs_unlinked, unlinked_time) <-