b949b28 · Idris-dev · git.iko.soy

Setup.hs+1−1

compare with master

unifiedsplit

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

254 target = datadir $ L.absoluteInstallDirs pkg local copy

255

256 installStdLib = do

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

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

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

259 makeInstall "libs" target'

260

src/IRTS/CodegenC.hs+2−2

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

66 let h = concatMap toDecl (map fst bc)

67 let cc = concatMap (uncurry toC) bc

68 let hi = concatMap ifaceC (concatMap getExp exports)

69− d <- getDataDir

69+ d <- getIdrisCRTSDir

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

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

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

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

73 case exec of

src/IRTS/CodegenJavaScript.hs+16−16

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

121 -> OutputType

122 -> IO ()

123codegenJS_all target definitions includes libs filename exports outputType = do

124− let bytecode = map toBC definitions

124+ let bytecode = map toBC definitions

125− let info = initCompileInfo bytecode

125+ let info = initCompileInfo bytecode

126− let js = concatMap (translateDecl info) bytecode

126+ let js = concatMap (translateDecl info) bytecode

127− let full = concatMap processFunction js

127+ let full = concatMap processFunction js

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

129− let code = deadCodeElim exportedNames full

129+ let code = deadCodeElim exportedNames full

130− let ext = takeExtension filename

130+ let ext = takeExtension filename

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

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

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

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

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

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

134− let (cons, opt) = optimizeConstructors code

134+ let (cons, opt) = optimizeConstructors code

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

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

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

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

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

138

139 included <- concat <$> getIncludes includes

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

140+ path <- getIdrisJSRTSDir

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

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

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

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

143 jsbn <- if compileInfoNeedsBigInt info

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

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

145 else return ""

146 let runtime = ( header

147 ++ includeLibs libs

src/IRTS/System.hs+30−21

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

7-}

8{-# LANGUAGE CPP #-}

9module IRTS.System( getDataFileName

10− , getDataDir

11− , getTargetDir

12 , getCC

10 , getCC

13 , getLibFlags

11 , getLibFlags

12+ , getIdrisDataDir

14 , getIdrisLibDir

13 , getIdrisLibDir

15 , getIdrisDocDir

14 , getIdrisDocDir

15+ , getIdrisCRTSDir

16+ , getIdrisJSRTSDir

16 , getIncFlags

17 , getIncFlags

17 , getEnvFlags

18 , getEnvFlags

18 , version

19 , version

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

32import Paths_idris

33import Paths_idris

33#endif

34#endif

34

35

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

36+getIdrisDataDir :: IO String

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

37+getIdrisDataDir = do

37− -> IO FilePath

38−overrideIdrisDirWith fp envVar = do

39− envValue <- lookupEnv envVar

38+ envValue <- lookupEnv "TARGET"

40 case envValue of

39 case envValue of

41 Nothing -> do

40 Nothing -> do

42 ddir <- getDataDir

41 ddir <- getDataDir

43− return (ddir </> fp)

42+ return ddir

44 Just ddir -> return ddir

43 Just ddir -> return ddir

45

44

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

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

46−overrideIdrisLibDirWith :: String -> IO FilePath

47+ -> IO FilePath

47−overrideIdrisLibDirWith = overrideIdrisDirWith "libs"

48+overrideIdrisSubDirWith fp envVar = do

48−

49+ envValue <- lookupEnv envVar

49−overrideIdrisDocDirWith :: String -> IO FilePath

50+ case envValue of

50−overrideIdrisDocDirWith = overrideIdrisDirWith "docs"

51+ Nothing -> do

52+ ddir <- getIdrisDataDir

53+ return (ddir </> fp)

54+ Just ddir -> return ddir

51

55

52getCC :: IO String

56getCC :: IO String

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

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

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

55getEnvFlags :: IO [String]

59getEnvFlags :: IO [String]

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

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

57

61

58−getTargetDir :: IO String

59−getTargetDir = overrideIdrisLibDirWith "TARGET"

60

62

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

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

62 || defined(openbsd_HOST_OS) || defined(netbsd_HOST_OS)

64 || defined(openbsd_HOST_OS) || defined(netbsd_HOST_OS)

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

73gmpLib = []

75gmpLib = []

74#endif

76#endif

75

77

76−getLibFlags = do dir <- getDataDir

78+getLibFlags = do dir <- getIdrisCRTSDir

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

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

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

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

79

81

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

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

83+

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

81

85

86+getIdrisJSRTSDir = do

87+ ddir <- getIdrisDataDir

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

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

83

89

90+getIdrisCRTSDir = do

91+ ddir <- getIdrisDataDir

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

84

93

85−getIncFlags = do dir <- getDataDir

94+getIncFlags = do dir <- getIdrisCRTSDir

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

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

src/Idris/Info.hs+13−1

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

6Maintainer : The Idris Community.

7-}

8module Idris.Info

9+ ( getIdrisDataDir

10+ , getIdrisCRTSDir

11+ , getIdrisJSRTSDir

9− ( getIdrisLibDir

12+ , getIdrisLibDir

10 , getIdrisDocDir

13 , getIdrisDocDir

11 , getIdrisFlagsLib

14 , getIdrisFlagsLib

12 , getIdrisFlagsInc

15 , getIdrisFlagsInc

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

34

37

35import Paths_idris

38import Paths_idris

36

39

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+

37getIdrisDocDir :: IO String

49getIdrisDocDir :: IO String

38getIdrisDocDir = S.getIdrisDocDir

50getIdrisDocDir = S.getIdrisDocDir

39

51

src/Idris/Info/Show.hs+36

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

4

5import Idris.Info

6

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+

7showIdrisFlagsLibs :: IO ()

27showIdrisFlagsLibs :: IO ()

8showIdrisFlagsLibs = do

28showIdrisFlagsLibs = do

9 libFlags <- getIdrisFlagsLib

29 libFlags <- getIdrisFlagsLib

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

14 showIdrisFlagsLibs

34 showIdrisFlagsLibs

15 exitSuccess

35 exitSuccess

16

36

37+showIdrisDataDir :: IO ()

38+showIdrisDataDir = do

39+ ldir <- getIdrisDataDir

40+ putStrLn ldir

41+

42+showExitIdrisDataDir :: IO ()

43+showExitIdrisDataDir = do

44+ showIdrisDataDir

45+ exitSuccess

46+

17showIdrisLibDir :: IO ()

47showIdrisLibDir :: IO ()

18showIdrisLibDir = do

48showIdrisLibDir = do

19 ldir <- getIdrisLibDir

49 ldir <- getIdrisLibDir

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

79 ldir <- getIdrisLibDir

109 ldir <- getIdrisLibDir

80 udir <- getIdrisUserDataDir

110 udir <- getIdrisUserDataDir

81 ddir <- getIdrisDocDir

111 ddir <- getIdrisDocDir

112+ idir <- getIdrisDataDir

113+ crdir <- getIdrisCRTSDir

114+ jrdir <- getIdrisJSRTSDir

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

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

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

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

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

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

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

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

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

85

121

src/Idris/Package.hs+3−3

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

285 -> PkgDesc -- ^ iPKG file.

286 -> IO ()

287installPkg altdests pkgdesc = inPkgDir pkgdesc $ do

288− d <- getTargetDir

288+ d <- getIdrisLibDir

289 let destdir = case altdests of

290 [] -> d

291 (d':_) -> d'

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

308

309testLib :: Bool -> String -> String -> IO Bool

310testLib warn p f

311− = do d <- getDataDir

311+ = do d <- getIdrisCRTSDir

312 gcc <- getCC

313 (tmpf, tmph) <- tempfile ""

314 hClose tmph

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

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

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

317 case e of

318 ExitSuccess -> return True