04650f0 · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

Merge pull request #105 from chetant/windows

Ability to build in Windows MingW32

commit04650f06a07151c6bdb6d259da1502c77d42b4a7 authorEdwin Brady <edwin.brady@gmail.com> dateWed 28 Nov 2012, 14:50 (14 years ago) parent960c468 614c682

8 files changed+65−15

compare with master

unifiedsplit

.gitignore+2 rts/idris_rts.h+1−1 src/IRTS/CodegenC.hs+5−1 src/Main.hs+8−6 src/Pkg/Package.hs+9−2 src/Util/System.hs+27−2 test/runtest.pl+11−1 test/test015/test015.idr+2−2

.gitignore+2

@@ -8,3 +8,5 @@ cabal-dev/

88test/output

99test/test???/output

1010test/reg???/output

11+test/test???/*.exe

12+test/reg???/*.exe

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/Pkg/Package.hs+9−2

@@ -1,3 +1,4 @@

1+{-# LANGUAGE CPP #-}

12module Pkg.Package where

34import System.Process

@@ -104,7 +105,7 @@ installIBC p m = do let f = toIBCFile m

104105 d <- getDataDir

105106 let destdir = d </> p </> getDest m

106107 putStrLn $ "Installing " ++ f ++ " to " ++ destdir

107− system $ "mkdir -p " ++ destdir

108+ system $ mkDirCmd ++ destdir

108109 system $ "install " ++ f ++ " " ++ destdir

109110 return ()

110111 where getDest (UN n) = ""

@@ -114,10 +115,16 @@ installObj :: String -> String -> IO ()

114115installObj p o = do d <- getDataDir

115116 let destdir = addTrailingPathSeparator (d </> p)

116117 putStrLn $ "Installing " ++ o ++ " to " ++ destdir

117− system $ "mkdir -p " ++ destdir

118+ system $ mkDirCmd ++ destdir

118119 system $ "install " ++ o ++ " " ++ destdir

119120 return ()

120121

122+#ifdef mingw32_HOST_OS

123+mkDirCmd = "mkdir "

124+#else

125+mkDirCmd = "mkdir -p "

126+#endif

127+

121128make :: Maybe String -> IO ()

122129make Nothing = return ()

123130make (Just s) = do system $ "make -f " ++ s

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/runtest.pl+11−1

@@ -10,7 +10,7 @@ sub runtest {

1010 print "Running $test...";

1111 $got = `sh ./run @idrOpts`;

1212 $exp = `cat expected`;

13−

13+

1414 open(OUT,">output");

1515 print OUT $got;

1616 close(OUT);

@@ -20,6 +20,16 @@ sub runtest {

2020 $got =~ s/\r\n/\n/g;

2121 $exp =~ s/\r\n/\n/g;

2222

23+# Normalize paths in $got and $exp, so the expected outcomes don't change between platforms

24+ while($got =~ /(^|.*?\n)(.*?)\\(.*?):(\d+):(.*)/ms)

25+ {

26+ $got = "$1$2/$3:$4:$5";

27+ }

28+ while($exp =~ /(^|.*?\n)(.*?)\\(.*?):(\d+):(.*)/ms)

29+ {

30+ $exp = "$1$2/$3:$4:$5";

31+ }

32+

2333 if ($got eq $exp) {

2434 print "success\n";

2535 } else {

test/test015/test015.idr+2−2

@@ -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)

@@ -37,7 +37,7 @@ natToBin (S k) O = do x <- natToBin k O

3737 Just (pad x)

3838natToBin (S w) (S k) with (parity k)

3939 natToBin (S w) (S (plus j j)) | even = do jbin <- natToBin w j

40− let value = jbin # b1

40+ let value = jbin # b1

4141 ?ntbEven

4242 natToBin (S w) (S (S (plus j j))) | odd = do jbin <- natToBin w (S j)

4343 let value = jbin # b0