git.iko.soy/Idris-dev
on master help sign in
Fixing compilation in Mingw32
1d0c6aaChetan T
rts/idris_rts.h+1−1
compare with master
unifiedsplit
@@ -128,7 +128,7 @@ typedef intptr_t i_int;
128#define INITFRAME VAL* myoldbase
128#define INITFRAME VAL* myoldbase
129#define REBASE vm->valstack_base = oldbase
129#define REBASE vm->valstack_base = oldbase
130#define RESERVE(x) if (vm->valstack_top+(x) > vm->stack_max) { stackOverflow(); } \
130#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)); }
132#define ADDTOP(x) vm->valstack_top += (x)
132#define ADDTOP(x) vm->valstack_top += (x)
133#define TOPBASE(x) vm->valstack_top = vm->valstack_base + (x)
133#define TOPBASE(x) vm->valstack_top = vm->valstack_base + (x)
134#define BASETOP(x) vm->valstack_base = vm->valstack_top + (x)
134#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
43 hClose tmph
43 hClose tmph
44 let useclang = False
44 let useclang = False
45 comp <- getCC
45 comp <- getCC
46+ libFlags <- getLibFlags
47+ incFlags <- getIncFlags
46 let gcc = comp ++ " " ++
48 let gcc = comp ++ " " ++
47 gccDbg dbg ++
49 gccDbg dbg ++
48 " -I. " ++ objs ++ " -x c " ++
50 " -I. " ++ objs ++ " -x c " ++
49 (if (exec == Executable) then "" else " -c ") ++
51 (if (exec == Executable) then "" else " -c ") ++
50 " " ++ tmpn ++
52 " " ++ tmpn ++
51− " `idris --link` `idris --include` " ++ libs ++
53+ " " ++ libFlags ++
54+ " " ++ incFlags ++
55+ " " ++ libs ++
52 " -o " ++ out
56 " -o " ++ out
53-- putStrLn gcc
57-- putStrLn gcc
54 exit <- system gcc
58 exit <- system gcc
src/Main.hs+8−6
@@ -28,6 +28,8 @@ import Idris.Primitives
28import Idris.Imports
28import Idris.Imports
29import Idris.Error
29import Idris.Error
30
30
31+import Util.System ( getLibFlags, getIdrisLibDir, getIncFlags )
32+
31import Pkg.Package
33import Pkg.Package
32
34
33import Paths_idris
35import Paths_idris
@@ -60,16 +62,16 @@ usage = do putStrLn usagemsg
60showver = do putStrLn $ "Idris version " ++ ver
62showver = do putStrLn $ "Idris version " ++ ver
61 exitWith ExitSuccess
63 exitWith ExitSuccess
62
64
63−showLibs = do dir <- getDataDir
65+showLibs = do libFlags <- getLibFlags
64− putStrLn $ "-L" ++ (dir </> "rts") ++ " -lidris_rts -lgmp -lpthread"
66+ putStrLn libFlags
65 exitWith ExitSuccess
67 exitWith ExitSuccess
66
68
67−showLibdir = do dir <- getDataDir
69+showLibdir = do dir <- getIdrisLibDir
68− putStrLn $ addTrailingPathSeparator dir
70+ putStrLn dir
69 exitWith ExitSuccess
71 exitWith ExitSuccess
70
72
71−showIncs = do dir <- getDataDir
73+showIncs = do incFlags <- getIncFlags
72− putStrLn $ "-I" ++ dir </> "rts"
74+ putStrLn incFlags
73 exitWith ExitSuccess
75 exitWith ExitSuccess
74
76
75usagemsg = "Idris version " ++ ver ++ "\n" ++
77usagemsg = "Idris version " ++ ver ++ "\n" ++
src/Util/System.hs+27−2
@@ -1,14 +1,20 @@
1{-# LANGUAGE CPP #-}
1{-# LANGUAGE CPP #-}
2−module Util.System(tempfile,environment,getCC) where
2+module Util.System(tempfile,environment,getCC,getLibFlags,getIdrisLibDir,getIncFlags) where
3
3
4-- System helper functions.
4-- System helper functions.
5
5
6+import System.FilePath ((</>), addTrailingPathSeparator, normalise)
6import System.Environment
7import System.Environment
7import System.IO
8import System.IO
8#if MIN_VERSION_base(4,0,0)
9#if MIN_VERSION_base(4,0,0)
9import Control.Exception as CE
10import Control.Exception as CE
10#endif
11#endif
11
12
13+-- import Data.List
14+import Data.List.Split(splitOn)
15+
16+import Paths_idris
17+
12#if MIN_VERSION_base(4,0,0)
18#if MIN_VERSION_base(4,0,0)
13catchIO :: IO a -> (IOError -> IO a) -> IO a
19catchIO :: IO a -> (IOError -> IO a) -> IO a
14catchIO = CE.catch
20catchIO = CE.catch
@@ -23,13 +29,32 @@ getCC = do env <- environment "IDRIS_CC"
23 Just cc -> return cc
29 Just cc -> return cc
24
30
25tempfile :: IO (FilePath, Handle)
31tempfile :: IO (FilePath, Handle)
26−tempfile = do env <- environment "TMPDIR"
32+tempfile = do env <- environment tempDirEnvVar
27 let dir = case env of
33 let dir = case env of
28 Nothing -> "/tmp"
34 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
29 (Just d) -> d
39 (Just d) -> d
40+#endif
30 openTempFile dir "idris"
41 openTempFile dir "idris"
42+#ifdef mingw32_HOST_OS
43+ where tempDirEnvVar = "TMP"
44+#else
45+ where tempDirEnvVar = "TMPDIR"
46+#endif
31
47
32environment :: String -> IO (Maybe String)
48environment :: String -> IO (Maybe String)
33environment x = catchIO (do e <- getEnv x
49environment x = catchIO (do e <- getEnv x
34 return (Just e))
50 return (Just e))
35 (\_ -> return Nothing)
51 (\_ -> 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
27
27
28pad : Binary w n -> Binary (S w) n
28pad : Binary w n -> Binary (S w) n
29pad zero = zero # b0
29pad zero = zero # b0
30−pad (num # x) = pad num # x
30+pad (num # x) = pad num # x
31
31
32natToBin : (width : Nat) -> (n : Nat) ->
32natToBin : (width : Nat) -> (n : Nat) ->
33 Maybe (Binary width n)
33 Maybe (Binary width n)