e71676e · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

Merge pull request #1701 from Melvar/weed-system

Weed out uses of `system`

commite71676e02576b58d7af67d71d78edf66548ac7d8 authorEdwin Brady <edwin.brady@gmail.com> dateMon 24 Nov 2014, 11:13 (12 years ago) parentddc2981 78155be

7 files changed+51−52

compare with master

unifiedsplit

main/Main.hs+2−2 src/IRTS/CodegenC.hs+24−27 src/IRTS/Compiler.hs+4−4 src/IRTS/System.hs+9−9 src/Idris/REPL.hs+5−5 src/Pkg/Package.hs+4−4 test/basic001/reg005.idr+3−1

main/Main.hs+2−2

@@ -81,7 +81,7 @@ showver = do putStrLn $ "Idris version " ++ ver

8181

8282showLibs :: IO b

8383showLibs = do libFlags <- getLibFlags

84− putStrLn libFlags

84+ putStrLn $ unwords libFlags

8585 exitWith ExitSuccess

8686

8787showLibdir :: IO b

@@ -91,5 +91,5 @@ showLibdir = do dir <- getIdrisLibDir

9191

9292showIncs :: IO b

9393showIncs = do incFlags <- getIncFlags

94− putStrLn incFlags

94+ putStrLn $ unwords incFlags

9595 exitWith ExitSuccess

src/IRTS/CodegenC.hs+24−27

@@ -24,24 +24,22 @@ codegenC ci = codegenC' (simpleDecls ci)

2424 (outputFile ci)

2525 (outputType ci)

2626 (includes ci)

27− (concatMap mkObj (compileObjs ci))

28− (concatMap mkLib (compileLibs ci) ++

29− concatMap incdir (importDirs ci))

30− (concatMap mkFlag (compilerFlags ci))

27+ (compileObjs ci)

28+ (map mkLib (compileLibs ci) ++

29+ map incdir (importDirs ci))

30+ (compilerFlags ci)

3131 (debugLevel ci)

3232

33− where mkObj f = f ++ " "

34− mkLib l = "-l" ++ l ++ " "

35− mkFlag l = l ++ " "

36− incdir i = "-I" ++ i ++ " "

33+ where mkLib l = "-l" ++ l

34+ incdir i = "-I" ++ i

3735

3836codegenC' :: [(Name, SDecl)] ->

3937 String -> -- output file name

4038 OutputType -> -- generate executable if True, only .o if False

4139 [FilePath] -> -- include files

42− String -> -- extra object files

43− String -> -- extra compiler flags (libraries)

44− String -> -- extra compiler flags (anything)

40+ [String] -> -- extra object files

41+ [String] -> -- extra compiler flags (libraries)

42+ [String] -> -- extra compiler flags (anything)

4543 DbgLevel ->

4644 IO ()

4745codegenC' defs out exec incs objs libs flags dbg

@@ -64,23 +62,22 @@ codegenC' defs out exec incs objs libs flags dbg

6462 comp <- getCC

6563 libFlags <- getLibFlags

6664 incFlags <- getIncFlags

67− let gcc = comp ++ " " ++

68− gccDbg dbg ++ " " ++

69− gccFlags ++

70− -- # Any flags defined here which alter the RTS API must also be added to config.mk

71− " -DHAS_PTHREAD -DIDRIS_ENABLE_STATS" ++

72− " -I. " ++ objs ++ " -x c " ++

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

74− " " ++ tmpn ++

75− " " ++ libFlags ++

76− " " ++ incFlags ++

77− " " ++ libs ++

78− " " ++ flags ++

79− " -o " ++ out

65+ let args = [gccDbg dbg] ++

66+ gccFlags ++

67+ -- # Any flags defined here which alter the RTS API must also be added to config.mk

68+ ["-DHAS_PTHREAD", "-DIDRIS_ENABLE_STATS",

69+ "-I."] ++ objs ++ ["-x", "c"] ++

70+ (if (exec == Executable) then [] else ["-c"]) ++

71+ [tmpn] ++

72+ libFlags ++

73+ incFlags ++

74+ libs ++

75+ flags ++

76+ ["-o", out]

8077-- putStrLn gcc

81− exit <- system gcc

78+ exit <- rawSystem comp args

8279 when (exit /= ExitSuccess) $

83− putStrLn ("FAILURE: " ++ gcc)

80+ putStrLn ("FAILURE: " ++ show comp ++ " " ++ show args)

8481

8582headers xs =

8683 concatMap

@@ -92,7 +89,7 @@ debug _ = ""

9289

9390-- We're using signed integers now. Make sure we get consistent semantics

9491-- out of them from gcc. See e.g. http://thiemonagel.de/2010/01/signed-integer-overflow/

95−gccFlags = " -fwrapv -fno-strict-overflow"

92+gccFlags = ["-fwrapv", "-fno-strict-overflow"]

9693

9794gccDbg DEBUG = "-g"

9895gccDbg TRACE = "-O2"

src/IRTS/Compiler.hs+4−4

@@ -121,11 +121,11 @@ generate codegen mainmod ir

121121 -- Built-in code generators (FIXME: lift these out!)

122122 Via "c" -> codegenC ir

123123 -- Any external code generator

124− Via cg -> do let cmd = "idris-" ++ cg ++ " " ++ mainmod ++

125− " -o " ++ outputFile ir

126− exit <- system cmd

124+ Via cg -> do let cmd = "idris-" ++ cg

125+ args = [mainmod, "-o", outputFile ir]

126+ exit <- rawSystem cmd args

127127 when (exit /= ExitSuccess) $

128− putStrLn ("FAILURE: " ++ show cmd)

128+ putStrLn ("FAILURE: " ++ show cmd ++ " " ++ show args)

129129 Bytecode -> dumpBC (simpleDecls ir) (outputFile ir)

130130

131131irMain :: TT Name -> Idris LDecl

src/IRTS/System.hs+9−9

@@ -38,31 +38,31 @@ getTargetDir :: IO String

3838getTargetDir = environment "TARGET" >>= maybe getDataDir return

3939

4040#if defined(FREEBSD) || defined(DRAGONFLY)

41−extraLib = " -L/usr/local/lib"

41+extraLib = ["-L/usr/local/lib"]

4242#else

43−extraLib = ""

43+extraLib = []

4444#endif

4545

4646#ifdef IDRIS_GMP

47−gmpLib = " -lgmp"

47+gmpLib = ["-lgmp"]

4848#else

49−gmpLib = ""

49+gmpLib = []

5050#endif

5151

5252getLibFlags = do dir <- getDataDir

53− return $ "-L" ++ (dir </> "rts") ++

54− " -lidris_rts" ++ extraLib ++ gmpLib ++ " -lpthread"

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

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

5555

5656getIdrisLibDir = do dir <- getDataDir

5757 return $ addTrailingPathSeparator dir

5858

5959#if defined(FREEBSD) || defined(DRAGONFLY)

60−extraInclude = " -I/usr/local/include"

60+extraInclude = ["-I/usr/local/include"]

6161#else

62−extraInclude = ""

62+extraInclude = []

6363#endif

6464getIncFlags = do dir <- getDataDir

65− return $ "-I" ++ dir </> "rts" ++ extraInclude

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

6666

6767getExecutablePom = do dir <- getDataDir

6868 return $ dir </> "java" </> "executable_pom.xml"

src/Idris/REPL.hs+5−5

@@ -669,10 +669,10 @@ edit f orig

669669 env <- runIO $ getEnvironment

670670 let editor = getEditor env

671671 let line = case errSpan i of

672− Just l -> " +" ++ show (fst (fc_start l)) ++ " "

673− Nothing -> " "

674− let cmd = editor ++ line ++ fixName f

675− runIO $ system cmd

672+ Just l -> ['+' : show (fst (fc_start l))]

673+ Nothing -> []

674+ let args = line ++ [fixName f]

675+ runIO $ rawSystem editor args

676676 clearErr

677677 putIState $ orig { idris_options = idris_options i

678678 , idris_colourTheme = idris_colourTheme i

@@ -1069,7 +1069,7 @@ process fn Execute

10691069 ir <- compile t tmpn m

10701070 runIO $ generate t (head (idris_imported ist)) ir

10711071 case idris_outputmode ist of

1072− RawOutput h -> do runIO $ system tmpn

1072+ RawOutput h -> do runIO $ rawSystem tmpn []

10731073 return ()

10741074 IdeSlave n h -> runIO . hPutStrLn h $

10751075 IdeSlave.convSExp "run-program" tmpn n)

src/Pkg/Package.hs+4−4

@@ -184,7 +184,7 @@ testPkg fp

184184 (tmpn', tmph') <- tempfile

185185 hClose tmph'

186186 m_ist <- idris (Filename tmpn : NoREPL : Verbose : Output tmpn' : idris_opts pkgdesc)

187− system tmpn'

187+ rawSystem tmpn' []

188188 setCurrentDirectory dir

189189 case m_ist of

190190 Nothing -> exitWith (ExitFailure 1)

@@ -224,7 +224,7 @@ testLib warn p f

224224 (tmpf, tmph) <- tempfile

225225 hClose tmph

226226 let libtest = d </> "rts" </> "libtest.c"

227− e <- system $ gcc ++ " " ++ libtest ++ " -l" ++ f ++ " -o " ++ tmpf

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

228228 case e of

229229 ExitSuccess -> return True

230230 _ -> do if warn

@@ -269,13 +269,13 @@ mkDirCmd = "mkdir -p "

269269-- | Invoke a Makefile's default target.

270270make :: Maybe String -> IO ()

271271make Nothing = return ()

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

272+make (Just s) = do rawSystem "make" ["-f", s]

273273 return ()

274274

275275-- | Invoke a Makefile's clean target.

276276clean :: Maybe String -> IO ()

277277clean Nothing = return ()

278−clean (Just s) = do system $ "make -f " ++ s ++ " clean"

278+clean (Just s) = do rawSystem "make" ["-f", s, "clean"]

279279 return ()

280280

281281-- --------------------------------------------------------------------- [ EOF ]

test/basic001/reg005.idr+3−1

@@ -1,6 +1,8 @@

11module Main

3−%flag C "-g3 -ggdb -O0"

3+%flag C "-g3"

4+%flag C "-ggdb"

5+%flag C "-O0"

57rep : (n : Nat) -> Char -> Vect n Char

68rep Z x = []