From 114470474d2e037d16b736354070fa03181e8348 Mon Sep 17 00:00:00 2001
From: sof <unknown>
Date: Fri, 26 Oct 2001 00:53:27 +0000
Subject: [PATCH] [project @ 2001-10-26 00:53:27 by sof] Added support for a
 custom pre-processor pass:

  ghc -F -pgmF/path/to/a/pre/processor ...

will now run /path/to/a/pre/processor over Haskell
input sources. It is positioned in the compilation
pipeline just before the compiler proper, but after
unlit'ing and CPP'ing. The pre-processor is passed
the following command-line when invoked:

   /path/to/a/pre/processor orig_input_source_file_path
   			    input_source_file
			    output_source_file
			    <other options>

Additionally options can be fed directly to the
pre-processor via -optF<option> options.

The -F option causes the pre-processor to run _iff_ one
has been specified via -pgmF (there's some redundancy
here, but I went for this cmd-line interface as it's
consistent with the general -pgm<Foo> story).

Motivation:

 * hooking in a pre-processor is occasionally useful;
   e.g., cheap&cheerful way to integrate language
   extensions with GHC, compile-time syntax/style
   checking etc.

 * Artfully re-using the CPP phase (by specifying your
   own via -pgmP) doesn't really work as the driver
   really assumes that GNU cpp is what's being invoked
   (and path mangling is also performed on Win32 platforms).

   Additionally, there are cases when you want to be
   able to run CPP _and_ a pre-processor.

 * The alternative of running the pre-processor as a
   separate program in a Makefile (say) doesn't work
   in interpreted mode, and this approach also forces
   you to give up on recompilation checking when in
   batch mode.
---
 ghc/compiler/main/CmdLineOpts.lhs   |    4 ++
 ghc/compiler/main/DriverFlags.hs    |    5 +-
 ghc/compiler/main/DriverPhases.hs   |    9 ++-
 ghc/compiler/main/DriverPipeline.hs |  135 ++++++++++++++++++++---------------
 ghc/compiler/main/DriverState.hs    |    6 +-
 ghc/compiler/main/Main.hs           |   11 +--
 ghc/compiler/main/SysTools.lhs      |   14 +++-
 7 files changed, 114 insertions(+), 70 deletions(-)

diff --git a/ghc/compiler/main/CmdLineOpts.lhs b/ghc/compiler/main/CmdLineOpts.lhs
index 3b99939..e71eff6 100644
--- a/ghc/compiler/main/CmdLineOpts.lhs
+++ b/ghc/compiler/main/CmdLineOpts.lhs
@@ -293,12 +293,14 @@ data DynFlags = DynFlags {
   extCoreName		:: String,	-- name of the .core output file
   verbosity  		:: Int,	 	-- verbosity level
   cppFlag    		:: Bool,	-- preprocess with cpp?
+  ppFlag                :: Bool,        -- preprocess with a Haskell Pp?
   stolen_x86_regs	:: Int,		
   cmdlineHcIncludes	:: [String],	-- -#includes
 
   -- options for particular phases
   opt_L			:: [String],
   opt_P			:: [String],
+  opt_F			:: [String],
   opt_c			:: [String],
   opt_a			:: [String],
   opt_m			:: [String],
@@ -328,10 +330,12 @@ defaultDynFlags = DynFlags {
   extCoreName = "",
   verbosity = 0, 
   cppFlag		= False,
+  ppFlag                = False,
   stolen_x86_regs	= 4,
   cmdlineHcIncludes	= [],
   opt_L			= [],
   opt_P			= [],
+  opt_F                 = [],
   opt_c			= [],
   opt_a			= [],
   opt_m			= [],
diff --git a/ghc/compiler/main/DriverFlags.hs b/ghc/compiler/main/DriverFlags.hs
index 3332a22..65080f2 100644
--- a/ghc/compiler/main/DriverFlags.hs
+++ b/ghc/compiler/main/DriverFlags.hs
@@ -1,7 +1,7 @@
 {-# OPTIONS -#include "hschooks.h" #-}
 
 -----------------------------------------------------------------------------
--- $Id: DriverFlags.hs,v 1.76 2001/10/17 15:44:40 simonpj Exp $
+-- $Id: DriverFlags.hs,v 1.77 2001/10/26 00:53:27 sof Exp $
 --
 -- Driver flags
 --
@@ -300,12 +300,14 @@ static_flags =
 dynamic_flags = [
 
      ( "cpp",		NoArg  (updDynFlags (\s -> s{ cppFlag = True })) )
+  ,  ( "F",             NoArg  (updDynFlags (\s -> s{ ppFlag = True })) )
   ,  ( "#include",	HasArg (addCmdlineHCInclude) )
 
   ,  ( "v",		OptPrefix (setVerbosity) )
 
   ,  ( "optL",		HasArg (addOpt_L) )
   ,  ( "optP",		HasArg (addOpt_P) )
+  ,  ( "optF",          HasArg (addOpt_F) )
   ,  ( "optc",		HasArg (addOpt_c) )
   ,  ( "optm",		HasArg (addOpt_m) )
   ,  ( "opta",		HasArg (addOpt_a) )
@@ -541,6 +543,7 @@ machdepCCOpts
 
 addOpt_L a = updDynFlags (\s -> s{opt_L = a : opt_L s})
 addOpt_P a = updDynFlags (\s -> s{opt_P = a : opt_P s})
+addOpt_F a = updDynFlags (\s -> s{opt_F = a : opt_F s})
 addOpt_c a = updDynFlags (\s -> s{opt_c = a : opt_c s})
 addOpt_a a = updDynFlags (\s -> s{opt_a = a : opt_a s})
 addOpt_m a = updDynFlags (\s -> s{opt_m = a : opt_m s})
diff --git a/ghc/compiler/main/DriverPhases.hs b/ghc/compiler/main/DriverPhases.hs
index 916c6bb..cfe1b3e 100644
--- a/ghc/compiler/main/DriverPhases.hs
+++ b/ghc/compiler/main/DriverPhases.hs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: DriverPhases.hs,v 1.12 2001/08/15 09:32:40 rrt Exp $
+-- $Id: DriverPhases.hs,v 1.13 2001/10/26 00:53:27 sof Exp $
 --
 -- GHC Driver
 --
@@ -41,6 +41,7 @@ data Phase
 	= MkDependHS	-- haskell dependency generation
 	| Unlit
 	| Cpp
+	| HsPp
 	| Hsc -- ToDo: HscTargetLang
 	| Cc
 	| HCc		-- Haskellised C (as opposed to vanilla C) compilation
@@ -59,6 +60,7 @@ data Phase
 -- by its suffix.
 startPhase "lhs"   = Unlit
 startPhase "hs"    = Cpp
+startPhase "hscpp" = HsPp
 startPhase "hspp"  = Hsc
 startPhase "hc"    = HCc
 startPhase "c"     = Cc
@@ -72,6 +74,7 @@ startPhase _       = Ln	   -- all unknown file types
 -- the input requirements of the next phase.
 phaseInputExt Unlit       = "lhs"
 phaseInputExt Cpp         = "lpp"	-- intermediate only
+phaseInputExt HsPp        = "hscpp"
 phaseInputExt Hsc         = "hspp"
 phaseInputExt HCc         = "hc"
 phaseInputExt Cc          = "c"
@@ -86,8 +89,8 @@ phaseInputExt Ilx2Il      = "ilx"
 phaseInputExt Ilasm       = "il"
 #endif
 
-haskellish_suffix     = (`elem` [ "hs", "hspp", "lhs", "hc", "raw_s" ])
-haskellish_src_suffix = (`elem` [ "hs", "hspp", "lhs" ])
+haskellish_suffix     = (`elem` [ "hs", "hspp", "hscpp", "lhs", "hc", "raw_s" ])
+haskellish_src_suffix = (`elem` [ "hs", "hspp", "hscpp", "lhs" ])
 cish_suffix           = (`elem` [ "c", "s", "S" ])  -- maybe .cc et al.??
 
 #if mingw32_TARGET_OS || cygwin32_TARGET_OS
diff --git a/ghc/compiler/main/DriverPipeline.hs b/ghc/compiler/main/DriverPipeline.hs
index 92f22d0..0e8c898 100644
--- a/ghc/compiler/main/DriverPipeline.hs
+++ b/ghc/compiler/main/DriverPipeline.hs
@@ -159,26 +159,26 @@ genPipeline todo stop_flag persistent_output lang (filename,suffix)
    let
    ----------- -----  ----   ---   --   --  -  -  -
     pipeline
-      | todo == DoMkDependHS = [ Unlit, Cpp, MkDependHS ]
+      | todo == DoMkDependHS = [ Unlit, Cpp, HsPp, MkDependHS ]
 
       | haskellish = 
        case real_lang of
-	HscC    | split && mangle -> [ Unlit, Cpp, Hsc, HCc, Mangle, 
+	HscC    | split && mangle -> [ Unlit, Cpp, HsPp, Hsc, HCc, Mangle, 
 					SplitMangle, SplitAs ]
-	        | mangle          -> [ Unlit, Cpp, Hsc, HCc, Mangle, As ]
+	        | mangle          -> [ Unlit, Cpp, HsPp, Hsc, HCc, Mangle, As ]
 	        | split	       	  -> not_valid
-	        | otherwise       -> [ Unlit, Cpp, Hsc, HCc, As ]
+	        | otherwise       -> [ Unlit, Cpp, HsPp, Hsc, HCc, As ]
 
-	HscAsm  | split           -> [ Unlit, Cpp, Hsc, SplitMangle, SplitAs ]
-	        | otherwise       -> [ Unlit, Cpp, Hsc, As ]
+	HscAsm  | split           -> [ Unlit, Cpp, HsPp, Hsc, SplitMangle, SplitAs ]
+	        | otherwise       -> [ Unlit, Cpp, HsPp, Hsc, As ]
 
 	HscJava	| split	          -> not_valid
 		| otherwise       -> error "not implemented: compiling via Java"
 #ifdef ILX
 	HscILX  | split           -> not_valid
-		| otherwise       -> [ Unlit, Cpp, Hsc, Ilx2Il, Ilasm ]
+		| otherwise       -> [ Unlit, Cpp, HsPp, Hsc, Ilx2Il, Ilasm ]
 #endif
-	HscNothing 		  -> [ Unlit, Cpp, Hsc ]
+	HscNothing 		  -> [ Unlit, Cpp, HsPp, Hsc ]
 
       | cish      = [ Cc, As ]
 
@@ -198,22 +198,18 @@ genPipeline todo stop_flag persistent_output lang (filename,suffix)
    ----------- -----  ----   ---   --   --  -  -  -
 
 	-- this shouldn't happen.
-   if start_phase /= Ln && start_phase `notElem` pipeline
-	then throwDyn (CmdLineError ("can't find starting phase for "
-				     ++ filename))
-	else do
-
+   when (start_phase /= Ln && start_phase `notElem` pipeline)
+	(throwDyn (CmdLineError ("can't find starting phase for "
+			         ++ filename)))
 	-- 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).
-   if start_phase `elem` pipeline && 
- 	(stop_phase /= Ln && stop_phase `notElem` pipeline)
-      then throwDyn (UsageError 
-		("flag " ++ stop_flag
-		 ++ " is incompatible with source file `" ++ filename ++ "'"))
-      else do
-
+   when (start_phase `elem` pipeline && 
+   	 (stop_phase /= Ln && stop_phase `notElem` pipeline))
+        (throwDyn (UsageError 
+		    ("flag " ++ stop_flag
+		     ++ " is incompatible with source file `" ++ filename ++ "'")))
    let
 	-- .o and .hc suffixes can be overriden by command-line options:
       myPhaseInputExt Ln  | Just s <- osuf  = s
@@ -279,7 +275,8 @@ pipeLoop (all_phases@((phase, keep, o_suffix):phases))
 
      output_fn <- outputFileName (null phases) keep o_suffix
 
-     mbCarryOn <- run_phase phase orig_basename orig_suffix input_fn output_fn 
+     mbCarryOn <- run_phase phase orig_basename orig_suffix
+     			    input_fn output_fn 
 	-- sometimes we bail out early, eg. when the compiler's recompilation
 	-- checker has determined that recompilation isn't necessary.
      case mbCarryOn of
@@ -388,48 +385,71 @@ run_phase Cpp basename suff input_fn output_fn
 			       ])
 	    return (Just output_fn)
 
+-------------------------------------------------------------------------------
+-- 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)
+
 -----------------------------------------------------------------------------
 -- MkDependHS phase
 
-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
-   
+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
+
 	-- Handle for file that accumulates dependencies 
-   hdl <- readIORef v_Dep_tmp_hdl
+      hdl <- readIORef v_Dep_tmp_hdl
 
 	-- std dependency of the object(s) on the source file
-   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
+      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
 		  -- length objs should be == length deps
-	  sequence_ (zipWith (\o d -> hPutStrLn hdl (o ++ " : " ++ d)) objs deps)
-
-   mapM genDep [ d | Just d <- deps ]
+	     sequence_ (zipWith (\o d -> hPutStrLn hdl (o ++ " : " ++ d)) objs deps)
 
-   return (Just output_fn)
+      sequence_ (map genDep [ d | Just d <- deps ])
+      return (Just output_fn)
 
 -- add the lines to dep_makefile:
 	   -- always:
@@ -965,9 +985,10 @@ preprocess :: FilePath -> IO FilePath
 preprocess filename =
   ASSERT(haskellish_src_file filename) 
   do restoreDynFlags	-- Restore to state of last save
+     let fInfo = (filename, getFileSuffix filename)
      pipeline <- genPipeline (StopBefore Hsc) ("preprocess") False 
-			     defaultHscLang (filename, getFileSuffix filename)
-     (fn,_)   <- runPipeline pipeline (filename,getFileSuffix filename)
+			     defaultHscLang fInfo
+     (fn,_)   <- runPipeline pipeline fInfo
      	                     False{-no linking-} False{-no -o flag-}
      return fn
 
diff --git a/ghc/compiler/main/DriverState.hs b/ghc/compiler/main/DriverState.hs
index fdda888..2a8c09e 100644
--- a/ghc/compiler/main/DriverState.hs
+++ b/ghc/compiler/main/DriverState.hs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: DriverState.hs,v 1.60 2001/10/22 10:33:50 simonmar Exp $
+-- $Id: DriverState.hs,v 1.61 2001/10/26 00:53:27 sof Exp $
 --
 -- Settings for the driver
 --
@@ -64,6 +64,7 @@ v_Hs_source_cpp_opts = global
 	]
 {-# NOINLINE v_Hs_source_cpp_opts #-}
 
+
 -- Keep output from intermediate phases
 GLOBAL_VAR(v_Keep_hi_diffs, 		False, 		Bool)
 GLOBAL_VAR(v_Keep_hc_files,		False,		Bool)
@@ -82,6 +83,9 @@ GLOBAL_VAR(v_Do_asm_mangling,		True,		Bool)
 GLOBAL_VAR(v_Excess_precision,		False,		Bool)
 GLOBAL_VAR(v_Read_DotGHCi,		True,		Bool)
 
+-- Preprocessor flags
+GLOBAL_VAR(v_Hs_source_pp_opts, [], [String])
+
 -----------------------------------------------------------------------------
 -- Splitting object files (for libraries)
 
diff --git a/ghc/compiler/main/Main.hs b/ghc/compiler/main/Main.hs
index 9c8827b..dfe059b 100644
--- a/ghc/compiler/main/Main.hs
+++ b/ghc/compiler/main/Main.hs
@@ -1,7 +1,7 @@
 {-# OPTIONS -fno-warn-incomplete-patterns -optc-DNON_POSIX_SOURCE #-}
 
 -----------------------------------------------------------------------------
--- $Id: Main.hs,v 1.89 2001/10/25 02:13:13 sof Exp $
+-- $Id: Main.hs,v 1.90 2001/10/26 00:53:27 sof Exp $
 --
 -- GHC Driver program
 --
@@ -43,7 +43,7 @@ import DriverFlags	( dynFlag, buildStaticHscOpts, dynamic_flags,
 			  processArgs, static_flags)
 
 import DriverMkDepend	( beginMkDependHS, endMkDependHS )
-import DriverPhases	( Phase(Hsc, HCc), haskellish_src_file, objish_file )
+import DriverPhases	( Phase(HsPp, Hsc, HCc), haskellish_src_file, objish_file )
 
 import DriverUtil	( add, handle, handleDyn, later, splitFilename,
 			  unknownFlagErr, getFileSuffix )
@@ -286,11 +286,12 @@ main =
 
 	  -- just preprocess (Haskell source only)
    	  let src_and_suff = (src, getFileSuffix src)
-	  pp <- if not (haskellish_src_file src) || mode == StopBefore Hsc
+	  let not_hs_file  = not (haskellish_src_file src)
+	  pp <- if not_hs_file || mode == StopBefore Hsc || mode == StopBefore HsPp
 			then return src_and_suff else do
 		phases <- genPipeline (StopBefore Hsc) stop_flag
-			    False{-not persistent-} defaultHscLang
-			    src_and_suff
+				      False{-not persistent-} defaultHscLang
+				      src_and_suff
 	  	pipeLoop phases src_and_suff False{-no linking-} False{-no -o flag-}
 			basename suffix
 
diff --git a/ghc/compiler/main/SysTools.lhs b/ghc/compiler/main/SysTools.lhs
index b8682aa..aa13060 100644
--- a/ghc/compiler/main/SysTools.lhs
+++ b/ghc/compiler/main/SysTools.lhs
@@ -19,6 +19,7 @@ module SysTools (
 
 	-- Interface to system tools
 	runUnlit, runCpp, runCc, -- [Option] -> IO ()
+	runPp,                   -- [Option] -> IO ()
 	runMangle, runSplit,	 -- [Option] -> IO ()
 	runAs, runLink,		 -- [Option] -> IO ()
 	runMkDLL,
@@ -182,6 +183,7 @@ All these pathnames are maintained IN THE NATIVE FORMAT OF THE HOST MACHINE.
 \begin{code}
 GLOBAL_VAR(v_Pgm_L,   	error "pgm_L",   String)	-- unlit
 GLOBAL_VAR(v_Pgm_P,   	error "pgm_P",   String)	-- cpp
+GLOBAL_VAR(v_Pgm_F,   	error "pgm_F",   String)	-- pp
 GLOBAL_VAR(v_Pgm_c,   	error "pgm_c",   String)	-- gcc
 GLOBAL_VAR(v_Pgm_m,   	error "pgm_m",   String)	-- asm code mangler
 GLOBAL_VAR(v_Pgm_s,   	error "pgm_s",   String)	-- asm code splitter
@@ -385,6 +387,7 @@ initSysTools minusB_args
 
 	; writeIORef v_Pgm_L   	 	   unlit_path
 	; writeIORef v_Pgm_P   	 	   cpp_path
+	; writeIORef v_Pgm_F               ""
 	; writeIORef v_Pgm_c   	 	   gcc_path
 	; writeIORef v_Pgm_m   	 	   mangle_path
 	; writeIORef v_Pgm_s   	 	   split_path
@@ -416,6 +419,7 @@ setPgm :: String -> IO ()
 -- So the first character says which program to override
 
 setPgm ('P' : pgm) = writeIORef v_Pgm_P pgm
+setPgm ('F' : pgm) = writeIORef v_Pgm_F pgm
 setPgm ('c' : pgm) = writeIORef v_Pgm_c pgm
 setPgm ('m' : pgm) = writeIORef v_Pgm_m pgm
 setPgm ('s' : pgm) = writeIORef v_Pgm_s pgm
@@ -514,7 +518,7 @@ showOptions ls = unwords (map (quote.showOpt) ls)
 %************************************************************************
 %*									*
 \subsection{Running an external program}
-n%*									*
+%*									*
 %************************************************************************
 
 
@@ -527,6 +531,10 @@ runCpp :: [Option] -> IO ()
 runCpp args =   do p <- readIORef v_Pgm_P
 		   runSomething "C pre-processor" p args
 
+runPp :: [Option] -> IO ()
+runPp args =   do p <- readIORef v_Pgm_F
+		  runSomething "Haskell pre-processor" p args
+
 runCc :: [Option] -> IO ()
 runCc args =   do p <- readIORef v_Pgm_c
 	          runSomething "C Compiler" p args
@@ -781,7 +789,7 @@ dosifyPath stuff
   cygdrive_prefix = "/cygdrive/"
 
   real_stuff
-    | cygdrive_prefix `isPrefixOf` stuff = drop (length cygdrive_prefix) stuff
+    | cygdrive_prefix `isPrefixOf` stuff = dropList cygdrive_prefix stuff
     | otherwise = stuff
    
 #else
@@ -832,7 +840,7 @@ getExecDir = do let len = (2048::Int) -- plenty, PATH_MAX is 512 under Win32.
 		if ret == 0 then destructArray len buf >> return Nothing
 		            else do s <- peekCString buf
 				    destructArray len buf
-				    return (Just (reverse (drop (length "/bin/ghc.exe") (reverse (unDosifyPath s)))))
+				    return (Just (reverse (dropList "/bin/ghc.exe" (reverse (unDosifyPath s)))))
 
 
 foreign import stdcall "GetModuleFileNameA" getModuleFileName :: Addr -> CString -> Int -> IO Int32
-- 
1.7.10.4