[Hat] problem specifying location of imported module

[Malcolm Wallace]

Olaf Chitil <O.Chitil at kent.ac.uk> writes:

> >Above it looks like the wrong directory was created. Hat created the
> >directory Hat/../Code when I think it should have created the
> >directory ../Code/Hat.
>
> I agree. The directory Hat should be put at the end of the import path, 
> not at the begining.

The placement of the Hat directory (at the beginning or end of
a path) is dependent on how the directory name is to be interpreted.
A path corresponding to the hierarchical module namespace, like
    Code/Pictures/Jpg.hs
should become
    Hat/Code/Pictures/Jpg.hs
whereas a mere relative pathname with a flat namespace should be the
opposite, e.g.
    ../Code/Pictures/Jpg.hs
becomes
    ../Code/Pictures/Hat/Jpg.hs


> This is a problem with hmake, not with the Hat tools themselves. 
> Malcolm, could you modify hmake accordingly?

Actually, in this instance hmake guessed the directory correctly.
The fault was with hat-trans, which simply assumed all paths were
strictly hierarchical.  The attached patch should fix it.

Regards,
    Malcolm
-------------- next part --------------
Index: src/compiler98/OsOnly.hs
===================================================================
RCS file: /home/cvs/root/nhc98/src/compiler98/OsOnly.hs,v
retrieving revision 1.8
diff -u -r1.8 OsOnly.hs
--- src/compiler98/OsOnly.hs	12 Jun 2003 10:13:56 -0000	1.8
+++ src/compiler98/OsOnly.hs	4 Jul 2005 15:02:49 -0000
@@ -2,9 +2,12 @@
 module OsOnly
   (isPrelude
   , fixImportNames, fixRootDir, fixDependFile, fixTypeFile, fixObjectFile
-  , fixHatAuxFile,fixHatTransFile,fixHatFileBase
+  , fixHatAuxFile,fixHatTransDir,fixHatTransFile,fixHatFileBase
+  , hierarchical
   ) where
 
+import Char (isUpper)
+
 isPrelude str = {-take (7::Int)-} str == "Prelude"
 
 -- from complete filename determine path and pure filename without extension
@@ -46,9 +49,16 @@
 fixObjectFile isUnix rootdir s = rootdir ++ fixFile isUnix s "hc"
 fixDependFile isUnix rootdir s = rootdir ++ fixFile isUnix s "dep"
 fixHatAuxFile isUnix rootdir s = rootdir ++ fixFile isUnix s "hx"
-fixHatTransFile isUnix rootdir s = "Hat/"++ rootdir ++ fixFile isUnix s "hs"
 fixHatFileBase isUnix rootdir s = rootdir ++ s 
 
+fixHatTransDir isUnix rootdir =
+  if null rootdir then "Hat"
+  else if hierarchical rootdir then "Hat/"++init rootdir
+       else rootdir++"Hat"
+
+fixHatTransFile isUnix rootdir s =
+  fixHatTransDir isUnix rootdir ++"/"++ fixFile isUnix s "hs"
+
 -- add extension to file
 fixFile :: Bool -> String -> String -> String
 fixFile isUnix file suf =
@@ -65,8 +75,19 @@
 toUnixPath :: String -> String
 toUnixPath = map (\c-> if (c=='.') then '/' else c)
 
+{- Does a directory name look like a hierarchical module namespace? -}
+hierarchical :: String -> Bool
+hierarchical dir =
+    let (a,b) = break (=='/') dir in
+    case b of
+      "" -> True
+      _  -> case a of
+              ""    -> hierarchical (tail b)
+              "."   -> False
+              ".."  -> False
+              (x:_) -> isUpper x && hierarchical (tail b)
 
--- obscure file compression needed only for RiscOs:
+-- obscure filename compression needed only for RiscOs:
 
 maxTen file = let tolong =  length file - 10
               in if tolong <= 0 then file
Index: src/hattrans/Flags.hs
===================================================================
RCS file: /home/cvs/root/hat/src/hattrans/Flags.hs,v
retrieving revision 1.25
diff -u -r1.25 Flags.hs
--- src/hattrans/Flags.hs	1 Jul 2005 10:18:06 -0000	1.25
+++ src/hattrans/Flags.hs	4 Jul 2005 15:02:50 -0000
@@ -30,7 +30,7 @@
 
 import IO
 import OsOnly(fixRootDir,fixTypeFile,fixObjectFile
-             ,fixHatAuxFile,fixHatTransFile,fixHatFileBase)
+             ,fixHatAuxFile,fixHatTransFile,fixHatTransDir,fixHatFileBase)
 import List(isPrefixOf,isSuffixOf)
 import Char(isDigit)
 
@@ -111,7 +111,7 @@
   , sHatFileBase  = fixHatFileBase isUnix rootdir filename
   , sIncludes = getIncludes xs++[rootdir]
   , sPreludes = getPreludes xs
-  , sSrcDir   = rootdir
+  , sSrcDir   = fixHatTransDir isUnix rootdir
 
   , sUnix = fElem True  "unix" xs          	
   -- ^ Use unix file names
@@ -147,6 +147,7 @@
 getIncludes :: [String] -> [String]
 getIncludes = map (drop (2::Int)) . 
               filter (\xs -> case xs of ('-':'I':_) -> True  
+                                        ('-':'i':_) -> True  
                                         _           -> False)
 
 {- obtain list of prelude paths from argument list -}
@@ -187,3 +188,4 @@
   where
   settings = map (drop (length f + 1)) . 
              filter (isPrefixOf ('-':f)) $ flags
+
Index: src/hattrans/HatTrans.hs
===================================================================
RCS file: /home/cvs/root/hat/src/hattrans/HatTrans.hs,v
retrieving revision 1.14
diff -u -r1.14 HatTrans.hs
--- src/hattrans/HatTrans.hs	23 Apr 2003 18:21:30 -0000	1.14
+++ src/hattrans/HatTrans.hs	4 Jul 2005 15:02:50 -0000
@@ -92,8 +92,7 @@
   pF (sParse flags) "Parse" (prettyPrintTokenId flags ppModule parsedPrg) 
 
   {- Ensure we can write our output files. -}
-  let hatDir = let s = sSrcDir flags in
-               if null s then "Hat" else "Hat/"++init s
+  let hatDir = sSrcDir flags
   dir <- doesDirectoryExist hatDir
   when (not dir) (createDirectoriesRecursively hatDir)