1d0c6aa · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

Fixing compilation in Mingw32

commit1d0c6aa736b1063982d73dcba2d168b28e994c93 authorChetan T <chetant@gmail.com> dateTue 27 Nov 2012, 07:47 (14 years ago) parent7c71bfa

5 files changed+42−11

compare with master

unifiedsplit

rts/idris_rts.h+1−1 src/IRTS/CodegenC.hs+5−1 src/Main.hs+8−6 src/Util/System.hs+27−2 test/test015/test015.idr+1−1

rts/idris_rts.h+1−1

@@ -128,7 +128,7 @@ typedef intptr_t i_int;

128128#define INITFRAME VAL* myoldbase

129129#define REBASE vm->valstack_base = oldbase

130130#define RESERVE(x) if (vm->valstack_top+(x) > vm->stack_max) { stackOverflow(); } \

131− else { bzero(vm->valstack_top, (x)*sizeof(VAL)); }

131+ else { memset(vm->valstack_top, 0, (x)*sizeof(VAL)); }

132132#define ADDTOP(x) vm->valstack_top += (x)

133133#define TOPBASE(x) vm->valstack_top = vm->valstack_base + (x)

134134#define BASETOP(x) vm->valstack_base = vm->valstack_top + (x)

src/IRTS/CodegenC.hs+5−1

@@ -43,12 +43,16 @@ codegenC defs out exec incs objs libs dbg

4343 hClose tmph

4444 let useclang = False

4545 comp <- getCC

46+ libFlags <- getLibFlags

47+ incFlags <- getIncFlags

4648 let gcc = comp ++ " " ++

4749 gccDbg dbg ++

4850 " -I. " ++ objs ++ " -x c " ++

4951 (if (exec == Executable) then "" else " -c ") ++

5052 " " ++ tmpn ++

51− " `idris --link` `idris --include` " ++ libs ++

53+ " " ++ libFlags ++

54+ " " ++ incFlags ++

55+ " " ++ libs ++

5256 " -o " ++ out

5357-- putStrLn gcc

5458 exit <- system gcc

src/Main.hs+8−6

@@ -28,6 +28,8 @@ import Idris.Primitives

2828import Idris.Imports

2929import Idris.Error

3030

31+import Util.System ( getLibFlags, getIdrisLibDir, getIncFlags )

32+

3133import Pkg.Package

3234

3335import Paths_idris

@@ -60,16 +62,16 @@ usage = do putStrLn usagemsg

6062showver = do putStrLn $ "Idris version " ++ ver

6163 exitWith ExitSuccess

6264

63−showLibs = do dir <- getDataDir

64− putStrLn $ "-L" ++ (dir </> "rts") ++ " -lidris_rts -lgmp -lpthread"

65+showLibs = do libFlags <- getLibFlags

66+ putStrLn libFlags

6567 exitWith ExitSuccess

6668

67−showLibdir = do dir <- getDataDir

68− putStrLn $ addTrailingPathSeparator dir

69+showLibdir = do dir <- getIdrisLibDir

70+ putStrLn dir

6971 exitWith ExitSuccess

7072

71−showIncs = do dir <- getDataDir

72− putStrLn $ "-I" ++ dir </> "rts"

73+showIncs = do incFlags <- getIncFlags

74+ putStrLn incFlags

7375 exitWith ExitSuccess

7476

7577usagemsg = "Idris version " ++ ver ++ "\n" ++

src/Util/System.hs+27−2

@@ -1,14 +1,20 @@

11{-# LANGUAGE CPP #-}

2−module Util.System(tempfile,environment,getCC) where

2+module Util.System(tempfile,environment,getCC,getLibFlags,getIdrisLibDir,getIncFlags) where

44-- System helper functions.

6+import System.FilePath ((</>), addTrailingPathSeparator, normalise)

67import System.Environment

78import System.IO

89#if MIN_VERSION_base(4,0,0)

910import Control.Exception as CE

1011#endif

1112

13+-- import Data.List

14+import Data.List.Split(splitOn)

15+

16+import Paths_idris

17+

1218#if MIN_VERSION_base(4,0,0)

1319catchIO :: IO a -> (IOError -> IO a) -> IO a

1420catchIO = CE.catch

@@ -23,13 +29,32 @@ getCC = do env <- environment "IDRIS_CC"

2329 Just cc -> return cc

2430

2531tempfile :: IO (FilePath, Handle)

26−tempfile = do env <- environment "TMPDIR"

32+tempfile = do env <- environment tempDirEnvVar

2733 let dir = case env of

2834 Nothing -> "/tmp"

35+#ifdef mingw32_HOST_OS

36+ -- ghc changes the path separators if we start program in a *nix shell

37+ (Just d) -> normalise d

38+#else

2939 (Just d) -> d

40+#endif

3041 openTempFile dir "idris"

42+#ifdef mingw32_HOST_OS

43+ where tempDirEnvVar = "TMP"

44+#else

45+ where tempDirEnvVar = "TMPDIR"

46+#endif

3147

3248environment :: String -> IO (Maybe String)

3349environment x = catchIO (do e <- getEnv x

3450 return (Just e))

3551 (\_ -> return Nothing)

52+

53+getLibFlags = do dir <- getDataDir

54+ return $ "-L" ++ (dir </> "rts") ++ " -lidris_rts -lgmp -lpthread"

55+

56+getIdrisLibDir = do dir <- getDataDir

57+ return $ addTrailingPathSeparator dir

58+

59+getIncFlags = do dir <- getDataDir

60+ return $ "-I" ++ dir </> "rts"

test/test015/test015.idr+1−1

@@ -27,7 +27,7 @@ instance Show (Binary w k) where

2727

2828pad : Binary w n -> Binary (S w) n

2929pad zero = zero # b0

30−pad (num # x) = pad num # x

30+pad (num # x) = pad num # x

3131

3232natToBin : (width : Nat) -> (n : Nat) ->

3333 Maybe (Binary width n)