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

.gitignore+2

compare with master

unifiedsplit

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

8test/output

9test/test???/output

10test/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;

128#define INITFRAME VAL* myoldbase

129#define REBASE vm->valstack_base = oldbase

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)

133#define TOPBASE(x) vm->valstack_top = vm->valstack_base + (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

44 let useclang = False

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

29import Idris.Error

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

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

1+{-# LANGUAGE CPP #-}

1module Pkg.Package where

2module Pkg.Package where

2

3

3import System.Process

4import System.Process

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

104 d <- getDataDir

105 d <- getDataDir

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

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

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

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

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

108+ system $ mkDirCmd ++ destdir

108 system $ "install " ++ f ++ " " ++ destdir

109 system $ "install " ++ f ++ " " ++ destdir

109 return ()

110 return ()

110 where getDest (UN n) = ""

111 where getDest (UN n) = ""

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

114installObj p o = do d <- getDataDir

115installObj p o = do d <- getDataDir

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

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

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

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

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

118+ system $ mkDirCmd ++ destdir

118 system $ "install " ++ o ++ " " ++ destdir

119 system $ "install " ++ o ++ " " ++ destdir

119 return ()

120 return ()

120

121

122+#ifdef mingw32_HOST_OS

123+mkDirCmd = "mkdir "

124+#else

125+mkDirCmd = "mkdir -p "

126+#endif

127+

121make :: Maybe String -> IO ()

128make :: Maybe String -> IO ()

122make Nothing = return ()

129make Nothing = return ()

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

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

src/Util/System.hs+27−2

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

1{-# LANGUAGE CPP #-}

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

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

3

4-- System helper functions.

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

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

10 print "Running $test...";

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

12 $exp = `cat expected`;

13−

13+

14 open(OUT,">output");

15 print OUT $got;

16 close(OUT);

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

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

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

22

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+

23 if ($got eq $exp) {

33 if ($got eq $exp) {

24 print "success\n";

34 print "success\n";

25 } else {

35 } else {

test/test015/test015.idr+2−2

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

27

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

29pad zero = zero # b0

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

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

31

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

33 Maybe (Binary width n)

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

37 Just (pad x)

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

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

40− let value = jbin # b1

40+ let value = jbin # b1

41 ?ntbEven

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

43 let value = jbin # b0