From d3b10fea875a34da69463839ba8071d82eb568c6 Mon Sep 17 00:00:00 2001
From: sof <unknown>
Date: Thu, 13 Feb 2003 01:50:05 +0000
Subject: [PATCH] [project @ 2003-02-13 01:50:04 by sof] Be sensitive to
 filenames containing spaces when processing :load & :add
 commands. Ditto when interpreting filenames given on GHCi's
 cmd-line.

Merge to STABLE.
---
 ghc/compiler/ghci/InteractiveUI.hs |   24 +++++++++++++-----------
 ghc/compiler/utils/Util.lhs        |   29 ++++++++++++++++++++++++++++-
 2 files changed, 41 insertions(+), 12 deletions(-)

diff --git a/ghc/compiler/ghci/InteractiveUI.hs b/ghc/compiler/ghci/InteractiveUI.hs
index 7f17397..e68c14b 100644
--- a/ghc/compiler/ghci/InteractiveUI.hs
+++ b/ghc/compiler/ghci/InteractiveUI.hs
@@ -1,6 +1,6 @@
 {-# OPTIONS -#include "Linker.h" #-}
 -----------------------------------------------------------------------------
--- $Id: InteractiveUI.hs,v 1.143 2003/02/12 15:01:35 simonpj Exp $
+-- $Id: InteractiveUI.hs,v 1.144 2003/02/13 01:50:04 sof Exp $
 --
 -- GHC Interactive User Interface
 --
@@ -88,14 +88,14 @@ GLOBAL_VAR(commands, builtin_commands, [(String, String -> GHCi Bool)])
 
 builtin_commands :: [(String, String -> GHCi Bool)]
 builtin_commands = [
-  ("add",	keepGoing addModule),
+  ("add",	keepGoingPaths addModule),
   ("browse",    keepGoing browseCmd),
   ("cd",    	keepGoing changeDirectory),
   ("def",	keepGoing defineMacro),
   ("help",	keepGoing help),
   ("?",		keepGoing help),
   ("info",      keepGoing info),
-  ("load",	keepGoing loadModule),
+  ("load",	keepGoingPaths loadModule),
   ("module",	keepGoing setContext),
   ("reload",	keepGoing reloadModule),
   ("set",	keepGoing setCmd),
@@ -109,6 +109,9 @@ builtin_commands = [
 keepGoing :: (String -> GHCi ()) -> (String -> GHCi Bool)
 keepGoing a str = a str >> return False
 
+keepGoingPaths :: ([FilePath] -> GHCi ()) -> (String -> GHCi Bool)
+keepGoingPaths a str = a (toArgs str) >> return False
+
 shortHelpText = "use :? for help.\n"
 
 -- NOTE: spaces at the end of each line to workaround CPP/string gap bug.
@@ -227,7 +230,7 @@ runGHCi paths dflags = do
   -- perform a :load for files given on the GHCi command line
   when (not (null paths)) $
      ghciHandle showException $
-	loadModule (unwords paths)
+	loadModule paths
 
   -- enter the interactive loop
 #if defined(mingw32_TARGET_OS)
@@ -527,9 +530,8 @@ info s = do
   setCmState cms
   return ()
 
-addModule :: String -> GHCi ()
-addModule str = do
-  let files = words str
+addModule :: [FilePath] -> GHCi ()
+addModule files = do
   state <- getGHCiState
   dflags <- io (getDynFlags)
   io (revertCAFs)			-- always revert CAFs on load/add.
@@ -591,11 +593,11 @@ undefineMacro macro_name = do
   io (writeIORef commands (filter ((/= macro_name) . fst) cmds))
 
 
-loadModule :: String -> GHCi ()
-loadModule str = timeIt (loadModule' str)
+loadModule :: [FilePath] -> GHCi ()
+loadModule fs = timeIt (loadModule' fs)
 
-loadModule' str = do
-  let files = words str
+loadModule' :: [FilePath] -> GHCi ()
+loadModule' files = do
   state <- getGHCiState
   dflags <- io getDynFlags
 
diff --git a/ghc/compiler/utils/Util.lhs b/ghc/compiler/utils/Util.lhs
index 23c6f4e..058431c 100644
--- a/ghc/compiler/utils/Util.lhs
+++ b/ghc/compiler/utils/Util.lhs
@@ -46,6 +46,8 @@ module Util (
 
 	-- module names
 	looksLikeModuleName,
+	
+	toArgs
     ) where
 
 #include "../includes/config.h"
@@ -66,7 +68,7 @@ import qualified List	( elem, notElem )
 import List		( zipWith4 )
 #endif
 
-import Char		( isUpper, isAlphaNum )
+import Char		( isUpper, isAlphaNum, isSpace )
 
 infixr 9 `thenCmp`
 \end{code}
@@ -797,3 +799,28 @@ looksLikeModuleName (c:cs) = isUpper c && go cs
 	go ('.':cs) = looksLikeModuleName cs
 	go (c:cs)   = (isAlphaNum c || c == '_') && go cs
 \end{code}
+
+Akin to @Prelude.words@, but sensitive to dquoted entities treating
+them as single words.
+
+\begin{code}
+toArgs :: String -> [String]
+toArgs "" = []
+toArgs s  =
+  case break (\ ch -> isSpace ch || ch == '"') (dropWhile isSpace s) of -- "
+    (w,aft) ->
+       (\ ws -> if null w then ws else w : ws) $
+       case aft of
+	 []           -> []
+	 (x:xs)
+	   | x /= '"'  -> toArgs xs
+	   | otherwise ->
+             case lex aft of
+	       ((str,rs):_) -> stripQuotes str : toArgs rs
+	       _            -> [aft]
+ where
+    -- strip away dquotes; assume first and last chars contain quotes.
+   stripQuotes :: String -> String
+   stripQuotes ('"':xs)  = init xs
+   stripQuotes xs        = xs
+\end{code}
-- 
1.7.10.4