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)