b949b28 · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

Fix build system dir inconsistencies.

There were several glaring inconsistencies in Idris' paths for system installation. For example, one could override Idris' default data directory, but the system would ignore this for some paths. This commit makes data directory and sub directory access consistent.

commitb949b2846691ef82e679f346a08b78b6af609772 authorJan de Muijnck-Hughes <jfdm@st-andrews.ac.uk> dateWed 28 Sep 2016, 18:21 (10 years ago) parentde5a79c

7 files changed+101−44

compare with master

unifiedsplit

Setup.hs+1−1 src/IRTS/CodegenC.hs+2−2 src/IRTS/CodegenJavaScript.hs+16−16 src/IRTS/System.hs+30−21 src/Idris/Info.hs+13−1 src/Idris/Info/Show.hs+36 src/Idris/Package.hs+3−3

Setup.hs+1−1

@@ -254,7 +254,7 @@ idrisInstall verbosity copy pkg local = unless (execOnly (configFlags local)) $

254254 target = datadir $ L.absoluteInstallDirs pkg local copy

255255

256256 installStdLib = do

257− let target' = target </> "libs"

257+ let target' = target -- </> "libs"

258258 putStrLn $ "Installing libraries in " ++ target'

259259 makeInstall "libs" target'

260260

src/IRTS/CodegenC.hs+2−2

@@ -66,8 +66,8 @@ codegenC' defs out exec incs objs libs flags exports iface dbg

6666 let h = concatMap toDecl (map fst bc)

6767 let cc = concatMap (uncurry toC) bc

6868 let hi = concatMap ifaceC (concatMap getExp exports)

69− d <- getDataDir

70− mprog <- readFile (d </> "rts" </> "idris_main" <.> "c")

69+ d <- getIdrisCRTSDir

70+ mprog <- readFile (d </> "idris_main" <.> "c")

7171 let cout = headers incs ++ debug dbg ++ h ++ wrappers ++ cc ++

7272 (if (exec == Executable) then mprog else hi)

7373 case exec of

src/IRTS/CodegenJavaScript.hs+16−16

@@ -121,27 +121,27 @@ codegenJS_all

121121 -> OutputType

122122 -> IO ()

123123codegenJS_all target definitions includes libs filename exports outputType = do

124− let bytecode = map toBC definitions

125− let info = initCompileInfo bytecode

126− let js = concatMap (translateDecl info) bytecode

127− let full = concatMap processFunction js

124+ let bytecode = map toBC definitions

125+ let info = initCompileInfo bytecode

126+ let js = concatMap (translateDecl info) bytecode

127+ let full = concatMap processFunction js

128128 let exportedNames = map translateName ((getExpNames exports) ++ [sUN "call__IO"])

129− let code = deadCodeElim exportedNames full

130− let ext = takeExtension filename

131− let isHtml = target == JavaScript && ext == ".html"

132− let htmlPrologue = T.pack "<!doctype html><html><head><script>\n"

133− let htmlEpilogue = T.pack "\n</script></head><body></body></html>"

134− let (cons, opt) = optimizeConstructors code

135− let (header, rt) = case target of

136− Node -> ("#!/usr/bin/env node\n", "-node")

129+ let code = deadCodeElim exportedNames full

130+ let ext = takeExtension filename

131+ let isHtml = target == JavaScript && ext == ".html"

132+ let htmlPrologue = T.pack "<!doctype html><html><head><script>\n"

133+ let htmlEpilogue = T.pack "\n</script></head><body></body></html>"

134+ let (cons, opt) = optimizeConstructors code

135+ let (header, rt) = case target of

136+ Node -> ("#!/usr/bin/env node\n", "-node")

137137 JavaScript -> ("", "-browser")

138138

139139 included <- concat <$> getIncludes includes

140− path <- (++) <$> getDataDir <*> (pure "/jsrts/")

141− idrRuntime <- readFile $ path ++ "Runtime-common.js"

142− tgtRuntime <- readFile $ concat [path, "Runtime", rt, ".js"]

140+ path <- getIdrisJSRTSDir

141+ idrRuntime <- readFile $ path </> "Runtime-common.js"

142+ tgtRuntime <- readFile $ path </> concat ["Runtime", rt, ".js"]

143143 jsbn <- if compileInfoNeedsBigInt info

144− then readFile $ path ++ "jsbn/jsbn.js"

144+ then readFile $ path </> "jsbn/jsbn.js"

145145 else return ""

146146 let runtime = ( header

147147 ++ includeLibs libs

src/IRTS/System.hs+30−21

@@ -7,12 +7,13 @@ Maintainer : The Idris Community.

77-}

88{-# LANGUAGE CPP #-}

99module IRTS.System( getDataFileName

10− , getDataDir

11− , getTargetDir

1210 , getCC

1311 , getLibFlags

12+ , getIdrisDataDir

1413 , getIdrisLibDir

1514 , getIdrisDocDir

15+ , getIdrisCRTSDir

16+ , getIdrisJSRTSDir

1617 , getIncFlags

1718 , getEnvFlags

1819 , version

@@ -32,22 +33,25 @@ import Paths_idris (version)

3233import Paths_idris

3334#endif

3435

35−overrideIdrisDirWith :: String -- ^ Sub directory in `getDataDir` location.

36− -> String -- ^ Environment variable to get new location from.

37− -> IO FilePath

38−overrideIdrisDirWith fp envVar = do

39− envValue <- lookupEnv envVar

36+getIdrisDataDir :: IO String

37+getIdrisDataDir = do

38+ envValue <- lookupEnv "TARGET"

4039 case envValue of

4140 Nothing -> do

4241 ddir <- getDataDir

43− return (ddir </> fp)

42+ return ddir

4443 Just ddir -> return ddir

4544

46−overrideIdrisLibDirWith :: String -> IO FilePath

47−overrideIdrisLibDirWith = overrideIdrisDirWith "libs"

48−

49−overrideIdrisDocDirWith :: String -> IO FilePath

50−overrideIdrisDocDirWith = overrideIdrisDirWith "docs"

45+overrideIdrisSubDirWith :: String -- ^ Sub directory in `getDataDir` location.

46+ -> String -- ^ Environment variable to get new location from.

47+ -> IO FilePath

48+overrideIdrisSubDirWith fp envVar = do

49+ envValue <- lookupEnv envVar

50+ case envValue of

51+ Nothing -> do

52+ ddir <- getIdrisDataDir

53+ return (ddir </> fp)

54+ Just ddir -> return ddir

5155

5256getCC :: IO String

5357getCC = fromMaybe "gcc" <$> lookupEnv "IDRIS_CC"

@@ -55,8 +59,6 @@ getCC = fromMaybe "gcc" <$> lookupEnv "IDRIS_CC"

5559getEnvFlags :: IO [String]

5660getEnvFlags = maybe [] (splitOn " ") <$> lookupEnv "IDRIS_CFLAGS"

5761

58−getTargetDir :: IO String

59−getTargetDir = overrideIdrisLibDirWith "TARGET"

6062

6163#if defined(freebsd_HOST_OS) || defined(dragonfly_HOST_OS)\

6264 || defined(openbsd_HOST_OS) || defined(netbsd_HOST_OS)

@@ -73,14 +75,21 @@ gmpLib = ["-lgmp"]

7375gmpLib = []

7476#endif

7577

76−getLibFlags = do dir <- getDataDir

77− return $ ["-L" ++ (dir </> "rts"),

78+getLibFlags = do dir <- getIdrisCRTSDir

79+ return $ ["-L" ++ dir,

7880 "-lidris_rts"] ++ extraLib ++ gmpLib ++ ["-lpthread"]

7981

80−getIdrisLibDir = addTrailingPathSeparator <$> overrideIdrisLibDirWith "IDRIS_LIBRARY_PATH"

82+getIdrisLibDir = addTrailingPathSeparator <$> overrideIdrisSubDirWith "libs" "IDRIS_LIBRARY_PATH"

83+

84+getIdrisDocDir = addTrailingPathSeparator <$> overrideIdrisSubDirWith "docs" "IDRIS_DOC_PATH"

8185

82−getIdrisDocDir = addTrailingPathSeparator <$> overrideIdrisDocDirWith "IDRIS_DOC_PATH"

86+getIdrisJSRTSDir = do

87+ ddir <- getIdrisDataDir

88+ return $ addTrailingPathSeparator (ddir </> "jsrts")

8389

90+getIdrisCRTSDir = do

91+ ddir <- getIdrisDataDir

92+ return $ addTrailingPathSeparator (ddir </> "rts")

8493

85−getIncFlags = do dir <- getDataDir

86− return $ ("-I" ++ dir </> "rts") : extraInclude

94+getIncFlags = do dir <- getIdrisCRTSDir

95+ return $ ("-I" ++ dir) : extraInclude

src/Idris/Info.hs+13−1

@@ -6,7 +6,10 @@ License : BSD3

66Maintainer : The Idris Community.

77-}

88module Idris.Info

9− ( getIdrisLibDir

9+ ( getIdrisDataDir

10+ , getIdrisCRTSDir

11+ , getIdrisJSRTSDir

12+ , getIdrisLibDir

1013 , getIdrisDocDir

1114 , getIdrisFlagsLib

1215 , getIdrisFlagsInc

@@ -34,6 +37,15 @@ import Version_idris (gitHash)

3437

3538import Paths_idris

3639

40+getIdrisDataDir :: IO String

41+getIdrisDataDir = S.getIdrisDataDir

42+

43+getIdrisCRTSDir :: IO String

44+getIdrisCRTSDir = S.getIdrisCRTSDir

45+

46+getIdrisJSRTSDir :: IO String

47+getIdrisJSRTSDir = S.getIdrisJSRTSDir

48+

3749getIdrisDocDir :: IO String

3850getIdrisDocDir = S.getIdrisDocDir

3951

src/Idris/Info/Show.hs+36

@@ -4,6 +4,26 @@ import System.Exit

55import Idris.Info

7+showIdrisCRTSDir :: IO ()

8+showIdrisCRTSDir = do

9+ ldir <- getIdrisCRTSDir

10+ putStrLn ldir

11+

12+showExitIdrisCRTSDir :: IO ()

13+showExitIdrisCRTSDir = do

14+ showIdrisCRTSDir

15+ exitSuccess

16+

17+showIdrisJSRTSDir :: IO ()

18+showIdrisJSRTSDir = do

19+ ldir <- getIdrisJSRTSDir

20+ putStrLn ldir

21+

22+showExitIdrisJSRTSDir :: IO ()

23+showExitIdrisJSRTSDir = do

24+ showIdrisJSRTSDir

25+ exitSuccess

26+

727showIdrisFlagsLibs :: IO ()

828showIdrisFlagsLibs = do

929 libFlags <- getIdrisFlagsLib

@@ -14,6 +34,16 @@ showExitIdrisFlagsLibs = do

1434 showIdrisFlagsLibs

1535 exitSuccess

1636

37+showIdrisDataDir :: IO ()

38+showIdrisDataDir = do

39+ ldir <- getIdrisDataDir

40+ putStrLn ldir

41+

42+showExitIdrisDataDir :: IO ()

43+showExitIdrisDataDir = do

44+ showIdrisDataDir

45+ exitSuccess

46+

1747showIdrisLibDir :: IO ()

1848showIdrisLibDir = do

1949 ldir <- getIdrisLibDir

@@ -79,7 +109,13 @@ showIdrisInfo = do

79109 ldir <- getIdrisLibDir

80110 udir <- getIdrisUserDataDir

81111 ddir <- getIdrisDocDir

112+ idir <- getIdrisDataDir

113+ crdir <- getIdrisCRTSDir

114+ jrdir <- getIdrisJSRTSDir

115+ putStrLn $ unwords ["-", "Data Dir:", idir]

82116 putStrLn $ unwords ["-", "Library Dir:", ldir]

117+ putStrLn $ unwords ["-", "C RTS Dir:", crdir]

118+ putStrLn $ unwords ["-", "JS RTS Dir:", jrdir]

83119 putStrLn $ unwords ["-", "User Dir:", udir]

84120 putStrLn $ unwords ["-", "Documentation Dir:", ddir]

85121

src/Idris/Package.hs+3−3

@@ -285,7 +285,7 @@ installPkg :: [String] -- ^ Alternate install location

285285 -> PkgDesc -- ^ iPKG file.

286286 -> IO ()

287287installPkg altdests pkgdesc = inPkgDir pkgdesc $ do

288− d <- getTargetDir

288+ d <- getIdrisLibDir

289289 let destdir = case altdests of

290290 [] -> d

291291 (d':_) -> d'

@@ -308,11 +308,11 @@ buildMods opts ns = do let f = map (toPath . showCG) ns

308308

309309testLib :: Bool -> String -> String -> IO Bool

310310testLib warn p f

311− = do d <- getDataDir

311+ = do d <- getIdrisCRTSDir

312312 gcc <- getCC

313313 (tmpf, tmph) <- tempfile ""

314314 hClose tmph

315− let libtest = d </> "rts" </> "libtest.c"

315+ let libtest = d </> "libtest.c"

316316 e <- rawSystem gcc [libtest, "-l" ++ f, "-o", tmpf]

317317 case e of

318318 ExitSuccess -> return True