f149970 · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

on master help sign in

Rename --target to --codegen and add options to specify target triple and CPU, defaulting to that of host

f149970Benjamin Saunders13 years ago

idris.cabal+1−1

compare with master

unifiedsplit

@@ -272,7 +272,7 @@ Executable idris

272 haskeline>=0.7, split, directory,

273 containers, process, transformers, filepath,

274 directory, binary, bytestring, text, pretty,

275− language-java>=0.2.2, libffi, llvm-general==3.3.2.*

275+ language-java>=0.2.2, libffi, llvm-general==3.3.3.*

276

277 Extensions: MultiParamTypeClasses, FunctionalDependencies,

278 FlexibleInstances, TemplateHaskell

src/IRTS/CodegenLLVM.hs+7−6

@@ -52,17 +52,16 @@ import Debug.Trace

52data Target = Target { triple :: String, dataLayout :: DataLayout }

54codegenLLVM :: [(TT.Name, SDecl)] ->

55+ String -> -- target triple

56+ String -> -- target CPU

55 FilePath -> -- output file name

57 FilePath -> -- output file name

56 OutputType ->

58 OutputType ->

57 IO ()

59 IO ()

58−codegenLLVM defs file outty = withContext $ \context -> do

60+codegenLLVM defs triple cpu file outty = withContext $ \context -> do

59− triple <- getDefaultTargetTriple

60− cpu <- getHostCPUName

61− features <- getHostCPUFeatures

62 initializeAllTargets

61 initializeAllTargets

63 (target, _) <- failInIO $ lookupTarget Nothing triple

62 (target, _) <- failInIO $ lookupTarget Nothing triple

64 withTargetOptions $ \options ->

63 withTargetOptions $ \options ->

65− withTargetMachine target triple cpu features options R.Default CM.Default CGO.Default $ \tm ->

64+ withTargetMachine target triple cpu S.empty options R.Default CM.Default CGO.Default $ \tm ->

66 do layout <- getTargetMachineDataLayout tm

65 do layout <- getTargetMachineDataLayout tm

67 let ast = codegen (Target triple layout) (map snd defs)

66 let ast = codegen (Target triple layout) (map snd defs)

68 result <- runErrorT . M.withModuleFromAST context ast $ \m ->

67 result <- runErrorT . M.withModuleFromAST context ast $ \m ->

@@ -160,10 +159,12 @@ initDefs tgt =

160 (Do $ Ret (Just (LocalReference (UnName 1))) [])

159 (Do $ Ret (Just (LocalReference (UnName 1))) [])

161 ]

160 ]

162 , exfun "llvm.trap" VoidType [] False

161 , exfun "llvm.trap" VoidType [] False

162+ -- , exfun "llvm.llvm.memcpy.p0i8.p0i8.i32" VoidType [ptrI8, ptrI8, IntegerType 32, IntegerType 32, IntegerType 1] False

163+ -- , exfun "llvm.llvm.memcpy.p0i8.p0i8.i64" VoidType [ptrI8, ptrI8, IntegerType 64, IntegerType 32, IntegerType 1] False

164+ , exfun "memcpy" ptrI8 [ptrI8, ptrI8, intPtr] False

163 , exfun "snprintf" (IntegerType 32) [ptrI8, intPtr, ptrI8] True

165 , exfun "snprintf" (IntegerType 32) [ptrI8, intPtr, ptrI8] True

164 , exfun "strcmp" (IntegerType 32) [ptrI8, ptrI8] False

166 , exfun "strcmp" (IntegerType 32) [ptrI8, ptrI8] False

165 , exfun "strlen" intPtr [ptrI8] False

167 , exfun "strlen" intPtr [ptrI8] False

166− , exfun "memcpy" ptrI8 [ptrI8, ptrI8, intPtr] False

167 , exfun "GC_init" VoidType [] False

168 , exfun "GC_init" VoidType [] False

168 , exfun "GC_malloc" ptrI8 [intPtr] False

169 , exfun "GC_malloc" ptrI8 [intPtr] False

169 , exfun "GC_malloc_atomic" ptrI8 [intPtr] False

170 , exfun "GC_malloc_atomic" ptrI8 [intPtr] False

src/IRTS/Compiler.hs+9−7

@@ -30,8 +30,8 @@ import System.FilePath ((</>), addTrailingPathSeparator)

31import Paths_idris

33−compile :: Target -> FilePath -> Term -> Idris ()

33+compile :: Codegen -> FilePath -> Term -> Idris ()

34−compile target f tm

34+compile codegen f tm

35 = do checkMVs

36 let tmnames = namesUsed (STerm tm)

37 usedIn <- mapM (allNames []) tmnames

@@ -39,9 +39,9 @@ compile target f tm

39 defsIn <- mkDecls tm (concat used)

40 findUnusedArgs (concat used)

41 maindef <- irMain tm

42− objs <- getObjectFiles target

42+ objs <- getObjectFiles codegen

43− libs <- getLibs target

43+ libs <- getLibs codegen

44− hdrs <- getHdrs target

44+ hdrs <- getHdrs codegen

45 let defs = defsIn ++ [(MN 0 "runMain", maindef)]

46 -- iputStrLn $ showSep "\n" (map show defs)

47 let (nexttag, tagged) = addTags 65536 (liftAll defs)

@@ -64,9 +64,11 @@ compile target f tm

64 case dumpDefun of

65 Nothing -> return ()

66 Just f -> liftIO $ writeFile f (dumpDefuns defuns)

67+ triple <- targetTriple

68+ cpu <- targetCPU

67 iLOG "Building output"

69 iLOG "Building output"

68 case checked of

70 case checked of

69− OK c -> liftIO $ case target of

71+ OK c -> liftIO $ case codegen of

70 ViaC ->

72 ViaC ->

71 codegenC c f outty hdrs

73 codegenC c f outty hdrs

72 (concatMap mkObj objs)

74 (concatMap mkObj objs)

@@ -77,7 +79,7 @@ compile target f tm

77 codegenJavaScript JavaScript c f outty

79 codegenJavaScript JavaScript c f outty

78 ViaNode ->

80 ViaNode ->

79 codegenJavaScript Node c f outty

81 codegenJavaScript Node c f outty

80− ViaLLVM -> codegenLLVM c f outty

82+ ViaLLVM -> codegenLLVM c triple cpu f outty

82 Bytecode -> dumpBC c f

84 Bytecode -> dumpBC c f

83 Error e -> fail $ show e

85 Error e -> fail $ show e

src/IRTS/LParser.hs+3−3

@@ -49,8 +49,8 @@ strlit = PTok.stringLiteral lexer

49chlit = PTok.charLiteral lexer

50lchar = lexeme.char

52−fovm :: Target -> OutputType -> FilePath -> IO ()

52+fovm :: Codegen -> OutputType -> FilePath -> IO ()

53−fovm tgt outty f

53+fovm cgn outty f

54 = do defs <- parseFOVM f

55 let (nexttag, tagged) = addTags 0 (liftAll defs)

56 ctxtIn = addAlist tagged emptyContext

@@ -59,7 +59,7 @@ fovm tgt outty f

59 let checked = checkDefs defuns (toAlist defuns)

60-- print checked

61 case checked of

62− OK c -> case tgt of

62+ OK c -> case cgn of

63 ViaC -> codegenC c "a.out" outty ["math.h"] "" "" TRACE

64 ViaJava -> codegenJava [] c "a.out" [] [] outty

65 Error e -> fail $ show e

src/Idris/AbsSyntax.hs+39−19

@@ -30,19 +30,19 @@ import Util.System

30getContext :: Idris Context

31getContext = do i <- getIState; return (tt_ctxt i)

33−forTarget :: Target -> [(Target, a)] -> [a]

33+forCodegen :: Codegen -> [(Codegen, a)] -> [a]

34−forTarget tgt xs = [x | (tgt', x) <- xs, tgt == tgt']

34+forCodegen tgt xs = [x | (tgt', x) <- xs, tgt == tgt']

36−getObjectFiles :: Target -> Idris [FilePath]

36+getObjectFiles :: Codegen -> Idris [FilePath]

37−getObjectFiles tgt = do i <- getIState; return (forTarget tgt $ idris_objs i)

37+getObjectFiles tgt = do i <- getIState; return (forCodegen tgt $ idris_objs i)

39−addObjectFile :: Target -> FilePath -> Idris ()

39+addObjectFile :: Codegen -> FilePath -> Idris ()

40addObjectFile tgt f = do i <- getIState; putIState $ i { idris_objs = (tgt, f) : idris_objs i }

42−getLibs :: Target -> Idris [String]

42+getLibs :: Codegen -> Idris [String]

43−getLibs tgt = do i <- getIState; return (forTarget tgt $ idris_libs i)

43+getLibs tgt = do i <- getIState; return (forCodegen tgt $ idris_libs i)

45−addLib :: Target -> String -> Idris ()

45+addLib :: Codegen -> String -> Idris ()

46addLib tgt f = do i <- getIState; putIState $ i { idris_libs = (tgt, f) : idris_libs i }

48addDyLib :: [String] -> Idris (Either DynamicLib String)

@@ -55,7 +55,7 @@ addDyLib libs = do i <- getIState

55 putIState $ i { idris_dynamic_libs = x:ls }

56 return (Left x)

58−addHdr :: Target -> String -> Idris ()

58+addHdr :: Codegen -> String -> Idris ()

59addHdr tgt f = do i <- getIState; putIState $ i { idris_hdrs = (tgt, f) : idris_hdrs i }

61addLangExt :: LanguageExt -> Idris ()

@@ -163,8 +163,8 @@ addIBC ibc = do i <- getIState; putIState $ i { ibc_write = ibc : ibc_write i }

163clearIBC :: Idris ()

164clearIBC = do i <- getIState; putIState $ i { ibc_write = [] }

165

166−getHdrs :: Target -> Idris [String]

166+getHdrs :: Codegen -> Idris [String]

167−getHdrs tgt = do i <- getIState; return (forTarget tgt $ idris_hdrs i)

167+getHdrs tgt = do i <- getIState; return (forCodegen tgt $ idris_hdrs i)

168

169setErrLine :: Int -> Idris ()

170setErrLine x = do i <- getIState;

@@ -345,15 +345,15 @@ getQuiet = do i <- getIState

345 let opts = idris_options i

346 return (opt_quiet opts)

347

348−setTarget :: Target -> Idris ()

348+setCodegen :: Codegen -> Idris ()

349−setTarget t = do i <- getIState

349+setCodegen t = do i <- getIState

350− let opts = idris_options i

350+ let opts = idris_options i

351− let opt' = opts { opt_target = t }

351+ let opt' = opts { opt_codegen = t }

352− putIState $ i { idris_options = opt' }

352+ putIState $ i { idris_options = opt' }

353

354−target :: Idris Target

354+codegen :: Idris Codegen

355−target = do i <- getIState

355+codegen = do i <- getIState

356− return (opt_target (idris_options i))

356+ return (opt_codegen (idris_options i))

357

358setOutputTy :: OutputType -> Idris ()

359setOutputTy t = do i <- getIState

@@ -370,6 +370,26 @@ setIdeSlave True = do i <- getIState

370 putIState $ i { idris_outputmode = (IdeSlave 0) }

371setIdeSlave False = return ()

372

373+setTargetTriple :: String -> Idris ()

374+setTargetTriple t = do i <- getIState

375+ let opts = idris_options i

376+ opt' = opts { opt_triple = t }

377+ putIState $ i { idris_options = opt' }

378+

379+targetTriple :: Idris String

380+targetTriple = do i <- getIState

381+ return (opt_triple (idris_options i))

382+

383+setTargetCPU :: String -> Idris ()

384+setTargetCPU t = do i <- getIState

385+ let opts = idris_options i

386+ opt' = opts { opt_cpu = t }

387+ putIState $ i { idris_options = opt' }

388+

389+targetCPU :: Idris String

390+targetCPU = do i <- getIState

391+ return (opt_cpu (idris_options i))

392+

373verbose :: Idris Bool

393verbose :: Idris Bool

374verbose = do i <- getIState

394verbose = do i <- getIState

375 return (opt_verbose (idris_options i))

395 return (opt_verbose (idris_options i))

src/Idris/AbsSyntaxTree.hs+23−16

@@ -33,10 +33,12 @@ data IOption = IOption { opt_logLevel :: Int,

33 opt_repl :: Bool,

34 opt_verbose :: Bool,

35 opt_quiet :: Bool,

36− opt_target :: Target,

36+ opt_codegen :: Codegen,

37 opt_outputTy :: OutputType,

38 opt_ibcsubdir :: FilePath,

39 opt_importdirs :: [FilePath],

40+ opt_triple :: String,

41+ opt_cpu :: String,

40 opt_cmdline :: [Opt] -- remember whole command line

42 opt_cmdline :: [Opt] -- remember whole command line

41 }

43 }

42 deriving (Show, Eq)

44 deriving (Show, Eq)

@@ -50,10 +52,12 @@ defaultOpts = IOption { opt_logLevel = 0

50 , opt_repl = True

52 , opt_repl = True

51 , opt_verbose = True

53 , opt_verbose = True

52 , opt_quiet = False

54 , opt_quiet = False

53− , opt_target = ViaC

55+ , opt_codegen = ViaC

54 , opt_outputTy = Executable

56 , opt_outputTy = Executable

55 , opt_ibcsubdir = ""

57 , opt_ibcsubdir = ""

56 , opt_importdirs = []

58 , opt_importdirs = []

59+ , opt_triple = ""

60+ , opt_cpu = ""

57 , opt_cmdline = []

61 , opt_cmdline = []

58 }

62 }

@@ -95,9 +99,9 @@ data IState = IState {

95 syntax_keywords :: [String],

99 syntax_keywords :: [String],

96 imported :: [FilePath], -- ^ The imported modules

100 imported :: [FilePath], -- ^ The imported modules

97 idris_scprims :: [(Name, (Int, PrimFn))],

101 idris_scprims :: [(Name, (Int, PrimFn))],

98− idris_objs :: [(Target, FilePath)],

102+ idris_objs :: [(Codegen, FilePath)],

99− idris_libs :: [(Target, String)],

103+ idris_libs :: [(Codegen, String)],

100− idris_hdrs :: [(Target, String)],

104+ idris_hdrs :: [(Codegen, String)],

101 proof_list :: [(Name, [String])],

105 proof_list :: [(Name, [String])],

102 errLine :: Maybe Int,

106 errLine :: Maybe Int,

103 lastParse :: Maybe Name,

107 lastParse :: Maybe Name,

@@ -145,10 +149,10 @@ data IBCWrite = IBCFix FixDecl

145 | IBCSyntax Syntax

149 | IBCSyntax Syntax

146 | IBCKeyword String

150 | IBCKeyword String

147 | IBCImport FilePath

151 | IBCImport FilePath

148− | IBCObj Target FilePath

152+ | IBCObj Codegen FilePath

149− | IBCLib Target String

153+ | IBCLib Codegen String

150 | IBCDyLib String

154 | IBCDyLib String

151− | IBCHeader Target String

155+ | IBCHeader Codegen String

152 | IBCAccess Name Accessibility

156 | IBCAccess Name Accessibility

153 | IBCTotal Name Totality

157 | IBCTotal Name Totality

154 | IBCFlags Name [FnOpt]

158 | IBCFlags Name [FnOpt]

@@ -171,12 +175,12 @@ type Idris = StateT IState IO

171

175

172-- Commands in the REPL

176-- Commands in the REPL

173

177

174−data Target = ViaC

178+data Codegen = ViaC

175− | ViaJava

179+ | ViaJava

176− | ViaNode

180+ | ViaNode

177− | ViaJavaScript

181+ | ViaJavaScript

178− | ViaLLVM

182+ | ViaLLVM

179− | Bytecode

183+ | Bytecode

180 deriving (Show, Eq)

184 deriving (Show, Eq)

181

185

182-- | REPL commands

186-- | REPL commands

@@ -191,7 +195,7 @@ data Command = Quit

191 | ChangeDirectory FilePath

195 | ChangeDirectory FilePath

192 | ModImport String

196 | ModImport String

193 | Edit

197 | Edit

194− | Compile Target String

198+ | Compile Codegen String

195 | Execute

199 | Execute

196 | ExecVal PTerm

200 | ExecVal PTerm

197 | NewCompile String

201 | NewCompile String

@@ -251,10 +255,13 @@ data Opt = Filename String

251 | DumpDefun String

255 | DumpDefun String

252 | DumpCases String

256 | DumpCases String

253 | FOVM String

257 | FOVM String

254− | UseTarget Target

258+ | UseCodegen Codegen

255 | OutputTy OutputType

259 | OutputTy OutputType

256 | Extension LanguageExt

260 | Extension LanguageExt

257 | InterpretScript String

261 | InterpretScript String

262+ | TargetTriple String

263+ | TargetCPU String

264+ | OptLevel Int

258 deriving (Show, Eq)

265 deriving (Show, Eq)

259

266

260-- Parsed declarations

267-- Parsed declarations

src/Idris/IBC.hs+8−8

@@ -38,10 +38,10 @@ data IBCFile = IBCFile { ver :: Word8,

38 ibc_optimise :: [(Name, OptInfo)],

39 ibc_syntax :: [Syntax],

40 ibc_keywords :: [String],

41− ibc_objs :: [(Target, FilePath)],

41+ ibc_objs :: [(Codegen, FilePath)],

42− ibc_libs :: [(Target, String)],

42+ ibc_libs :: [(Codegen, String)],

43 ibc_dynamic_libs :: [String],

44− ibc_hdrs :: [(Target, String)],

44+ ibc_hdrs :: [(Codegen, String)],

45 ibc_access :: [(Name, Accessibility)],

46 ibc_total :: [(Name, Totality)],

47 ibc_flags :: [(Name, [FnOpt])],

@@ -243,10 +243,10 @@ pKeywords :: [String] -> Idris ()

243pKeywords k = do i <- getIState

244 putIState (i { syntax_keywords = k ++ syntax_keywords i })

245

246−pObjs :: [(Target, FilePath)] -> Idris ()

246+pObjs :: [(Codegen, FilePath)] -> Idris ()

247pObjs os = mapM_ (uncurry addObjectFile) os

248

249−pLibs :: [(Target, String)] -> Idris ()

249+pLibs :: [(Codegen, String)] -> Idris ()

250pLibs ls = mapM_ (uncurry addLib) ls

251

252pDyLibs :: [String] -> Idris ()

@@ -256,7 +256,7 @@ pDyLibs ls = do res <- mapM (addDyLib . return) ls

256 where checkLoad (Left _) = return ()

257 checkLoad (Right err) = fail err

258

259−pHdrs :: [(Target, String)] -> Idris ()

259+pHdrs :: [(Codegen, String)] -> Idris ()

260pHdrs hs = mapM_ (uncurry addHdr) hs

261

262pDefs :: [(Name, Def)] -> Idris ()

@@ -1678,7 +1678,7 @@ instance Binary SSymbol where

1678 return (Binding x1)

1679 _ -> error "Corrupted binary data for SSymbol"

1680

1681−instance Binary Target where

1681+instance Binary Codegen where

1682 put x

1683 = case x of

1684 ViaC -> putWord8 0

@@ -1694,5 +1694,5 @@ instance Binary Target where

1694 2 -> return ViaNode

1695 3 -> return ViaJavaScript

1696 4 -> return Bytecode

1697− _ -> error "Corrupted binary data for Target"

1697+ _ -> error "Corrupted binary data for Codegen"

1698

src/Idris/Parser.hs+16−15

@@ -1535,25 +1535,26 @@ pWhereblock n syn

1535 closeBlock

1536 return (concat ds, map (\x -> (x, decoration syn x)) dns)

1537

1538−pTarget :: IParser Target

1538+pCodegen :: IParser Codegen

1539−pTarget = try (do reserved "C"; return ViaC)

1539+pCodegen = try (do reserved "C"; return ViaC)

1540− <|> try (do reserved "Java"; return ViaJava)

1540+ <|> try (do reserved "Java"; return ViaJava)

1541− <|> try (do reserved "JavaScript"; return ViaJavaScript)

1541+ <|> try (do reserved "JavaScript"; return ViaJavaScript)

1542− <|> try (do reserved "Node"; return ViaNode)

1542+ <|> try (do reserved "Node"; return ViaNode)

1543+ <|> try (do reserved "LLVM"; return ViaLLVM)

1543− <|> try (do reserved "Bytecode"; return Bytecode)

1544+ <|> try (do reserved "Bytecode"; return Bytecode)

1544

1545

1545pDirective :: SyntaxInfo -> IParser [PDecl]

1546pDirective :: SyntaxInfo -> IParser [PDecl]

1546−pDirective syn = try (do lchar '%'; reserved "lib"; tgt <- pTarget; lib <- strlit;

1547+pDirective syn = try (do lchar '%'; reserved "lib"; cgn <- pCodegen; lib <- strlit;

1547− return [PDirective (do addLib tgt lib

1548+ return [PDirective (do addLib cgn lib

1548− addIBC (IBCLib tgt lib))])

1549+ addIBC (IBCLib cgn lib))])

1549− <|> try (do lchar '%'; reserved "link"; tgt <- pTarget; obj <- strlit;

1550+ <|> try (do lchar '%'; reserved "link"; cgn <- pCodegen; obj <- strlit;

1550 return [PDirective (do datadir <- liftIO getDataDir

1551 return [PDirective (do datadir <- liftIO getDataDir

1551 o <- liftIO $ findInPath [".", datadir] obj

1552 o <- liftIO $ findInPath [".", datadir] obj

1552− addIBC (IBCObj tgt o)

1553+ addIBC (IBCObj cgn o)

1553− addObjectFile tgt o)])

1554+ addObjectFile cgn o)])

1554− <|> try (do lchar '%'; reserved "include"; tgt <- pTarget; hdr <- strlit;

1555+ <|> try (do lchar '%'; reserved "include"; cgn <- pCodegen; hdr <- strlit;

1555− return [PDirective (do addHdr tgt hdr

1556+ return [PDirective (do addHdr cgn hdr

1556− addIBC (IBCHeader tgt hdr))])

1557+ addIBC (IBCHeader cgn hdr))])

1557 <|> try (do lchar '%'; reserved "hide"; n <- iName []

1558 <|> try (do lchar '%'; reserved "hide"; n <- iName []

1558 return [PDirective (do setAccessibility n Hidden

1559 return [PDirective (do setAccessibility n Hidden

1559 addIBC (IBCAccess n Hidden))])

1560 addIBC (IBCAccess n Hidden))])

src/Idris/REPL.hs+46−21

@@ -39,6 +39,8 @@ import IRTS.CodegenCommon

39-- import RTS.PreC

40-- import RTS.CodegenC

42+import LLVM.General.Target

43+

42import System.Console.Haskeline as H

44import System.Console.Haskeline as H

43import System.FilePath

45import System.FilePath

44import System.Exit

46import System.Exit

@@ -155,8 +157,8 @@ ideslaveProcess fn Execute = do process fn Execute

155 iResult ""

157 iResult ""

156ideslaveProcess fn (NewCompile f) = do process fn (NewCompile f)

158ideslaveProcess fn (NewCompile f) = do process fn (NewCompile f)

157 iResult ""

159 iResult ""

158−ideslaveProcess fn (Compile target f) = do process fn (Compile target f)

160+ideslaveProcess fn (Compile codegen f) = do process fn (Compile codegen f)

159− iResult ""

161+ iResult ""

160ideslaveProcess fn (LogLvl i) = do process fn (LogLvl i)

162ideslaveProcess fn (LogLvl i) = do process fn (LogLvl i)

161 iResult ""

163 iResult ""

162ideslaveProcess fn (Pattelab t) = process fn (Pattelab t)

164ideslaveProcess fn (Pattelab t) = process fn (Pattelab t)

@@ -465,7 +467,7 @@ process fn Execute = do (m, _) <- elabVal toplevel False

465-- (PRef (FC "main" 0) (NS (UN "main") ["main"]))

467-- (PRef (FC "main" 0) (NS (UN "main") ["main"]))

466 (tmpn, tmph) <- liftIO tempfile

468 (tmpn, tmph) <- liftIO tempfile

467 liftIO $ hClose tmph

469 liftIO $ hClose tmph

468− t <- target

470+ t <- codegen

469 compile t tmpn m

471 compile t tmpn m

470 liftIO $ system tmpn

472 liftIO $ system tmpn

471 return ()

473 return ()

@@ -476,11 +478,11 @@ process fn (NewCompile f)

476 [pexp $ PRef fc (NS (UN "main") ["Main"])])

478 [pexp $ PRef fc (NS (UN "main") ["Main"])])

477 compileEpic f m

479 compileEpic f m

478 where fc = FC "main" 0

480 where fc = FC "main" 0

479−process fn (Compile target f)

481+process fn (Compile codegen f)

480 = do (m, _) <- elabVal toplevel False

482 = do (m, _) <- elabVal toplevel False

481 (PApp fc (PRef fc (UN "run__IO"))

483 (PApp fc (PRef fc (UN "run__IO"))

482 [pexp $ PRef fc (NS (UN "main") ["Main"])])

484 [pexp $ PRef fc (NS (UN "main") ["Main"])])

483− compile target f m

485+ compile codegen f m

484 where fc = FC "main" 0

486 where fc = FC "main" 0

485process fn (LogLvl i) = setLogLevel i

487process fn (LogLvl i) = setLogLevel i

486-- Elaborate as if LHS of a pattern (debug command)

488-- Elaborate as if LHS of a pattern (debug command)

@@ -560,14 +562,14 @@ displayHelp = let vstr = showVersion version in

560 l ++ take (c1 - length l) (repeat ' ') ++

562 l ++ take (c1 - length l) (repeat ' ') ++

561 m ++ take (c2 - length m) (repeat ' ') ++ r ++ "\n"

563 m ++ take (c2 - length m) (repeat ' ') ++ r ++ "\n"

562

564

563−parseTarget :: String -> Target

565+parseCodegen :: String -> Codegen

564−parseTarget "C" = ViaC

566+parseCodegen "C" = ViaC

565−parseTarget "Java" = ViaJava

567+parseCodegen "Java" = ViaJava

566−parseTarget "bytecode" = Bytecode

568+parseCodegen "bytecode" = Bytecode

567−parseTarget "javascript" = ViaJavaScript

569+parseCodegen "javascript" = ViaJavaScript

568−parseTarget "node" = ViaNode

570+parseCodegen "node" = ViaNode

569−parseTarget "llvm" = ViaLLVM

571+parseCodegen "llvm" = ViaLLVM

570−parseTarget _ = error "unknown target" -- FIXME: partial function

572+parseCodegen _ = error "unknown codegen" -- FIXME: partial function

571

573

572parseArgs :: [String] -> [Opt]

574parseArgs :: [String] -> [Opt]

573parseArgs [] = []

575parseArgs [] = []

@@ -605,10 +607,17 @@ parseArgs ("-S":ns) = OutputTy Raw : (parseArgs ns)

605parseArgs ("-c":ns) = OutputTy Object : (parseArgs ns)

607parseArgs ("-c":ns) = OutputTy Object : (parseArgs ns)

606parseArgs ("--dumpdefuns":n:ns) = DumpDefun n : (parseArgs ns)

608parseArgs ("--dumpdefuns":n:ns) = DumpDefun n : (parseArgs ns)

607parseArgs ("--dumpcases":n:ns) = DumpCases n : (parseArgs ns)

609parseArgs ("--dumpcases":n:ns) = DumpCases n : (parseArgs ns)

608−parseArgs ("--target":n:ns) = UseTarget (parseTarget n) : (parseArgs ns)

610+parseArgs ("--codegen":n:ns) = UseCodegen (parseCodegen n) : (parseArgs ns)

609parseArgs ["--exec"] = InterpretScript "Main.main" : []

611parseArgs ["--exec"] = InterpretScript "Main.main" : []

610parseArgs ("--exec":expr:ns) = InterpretScript expr : parseArgs ns

612parseArgs ("--exec":expr:ns) = InterpretScript expr : parseArgs ns

611parseArgs ("-XTypeProviders":ns) = Extension TypeProviders : (parseArgs ns)

613parseArgs ("-XTypeProviders":ns) = Extension TypeProviders : (parseArgs ns)

614+parseArgs ("-O3":ns) = OptLevel 3 : parseArgs ns

615+parseArgs ("-O2":ns) = OptLevel 2 : parseArgs ns

616+parseArgs ("-O1":ns) = OptLevel 1 : parseArgs ns

617+parseArgs ("-O0":ns) = OptLevel 0 : parseArgs ns

618+parseArgs ("-O":n:ns) = OptLevel (read n) : parseArgs ns

619+parseArgs ("--target":n:ns) = TargetTriple n : parseArgs ns

620+parseArgs ("--cpu":n:ns) = TargetCPU n : parseArgs ns

612parseArgs (n:ns) = Filename n : (parseArgs ns)

621parseArgs (n:ns) = Filename n : (parseArgs ns)

613

622

614helphead =

623helphead =

@@ -637,10 +646,16 @@ idrisMain opts =

637 let bcs = opt getBC opts

646 let bcs = opt getBC opts

638 let vm = opt getFOVM opts

647 let vm = opt getFOVM opts

639 let pkgdirs = opt getPkgDir opts

648 let pkgdirs = opt getPkgDir opts

649+ trpl <- case opt getTriple opts of

650+ [] -> liftIO $ getDefaultTargetTriple

651+ xs -> return (last xs)

652+ tcpu <- case opt getCPU opts of

653+ [] -> liftIO $ getHostCPUName

654+ xs -> return (last xs)

640 let outty = case opt getOutputTy opts of

655 let outty = case opt getOutputTy opts of

641 [] -> Executable

656 [] -> Executable

642 xs -> last xs

657 xs -> last xs

643− let tgt = case opt getTarget opts of

658+ let cgn = case opt getCodegen opts of

644 [] -> ViaC

659 [] -> ViaC

645 xs -> last xs

660 xs -> last xs

646 script <- case opt getExecScript opts of

661 script <- case opt getExecScript opts of

@@ -657,13 +672,15 @@ idrisMain opts =

657 setVerbose runrepl

672 setVerbose runrepl

658 setCmdLine opts

673 setCmdLine opts

659 setOutputTy outty

674 setOutputTy outty

660− setTarget tgt

675+ setCodegen cgn

676+ setTargetTriple trpl

677+ setTargetCPU tcpu

661 when (Verbose `elem` opts) $ setVerbose True

678 when (Verbose `elem` opts) $ setVerbose True

662 mapM_ makeOption opts

679 mapM_ makeOption opts

663 -- if we have the --fovm flag, drop into the first order VM testing

680 -- if we have the --fovm flag, drop into the first order VM testing

664 case vm of

681 case vm of

665 [] -> return ()

682 [] -> return ()

666− xs -> liftIO $ mapM_ (fovm tgt outty) xs

683+ xs -> liftIO $ mapM_ (fovm cgn outty) xs

667 -- if we have the --bytecode flag, drop into the bytecode assembler

684 -- if we have the --bytecode flag, drop into the bytecode assembler

668 case bcs of

685 case bcs of

669 [] -> return ()

686 [] -> return ()

@@ -684,7 +701,7 @@ idrisMain opts =

684 ok <- noErrors

701 ok <- noErrors

685 when ok $ case output of

702 when ok $ case output of

686 [] -> return ()

703 [] -> return ()

687− (o:_) -> process "" (Compile tgt o)

704+ (o:_) -> process "" (Compile cgn o)

688 when ok $ case newoutput of

705 when ok $ case newoutput of

689 [] -> return ()

706 [] -> return ()

690 (o:_) -> process "" (NewCompile o)

707 (o:_) -> process "" (NewCompile o)

@@ -758,9 +775,9 @@ getPkgClean :: Opt -> Maybe String

758getPkgClean (PkgClean str) = Just str

775getPkgClean (PkgClean str) = Just str

759getPkgClean _ = Nothing

776getPkgClean _ = Nothing

760

777

761−getTarget :: Opt -> Maybe Target

778+getCodegen :: Opt -> Maybe Codegen

762−getTarget (UseTarget x) = Just x

779+getCodegen (UseCodegen x) = Just x

763−getTarget _ = Nothing

780+getCodegen _ = Nothing

764

781

765getExecScript :: Opt -> Maybe String

782getExecScript :: Opt -> Maybe String

766getExecScript (InterpretScript expr) = Just expr

783getExecScript (InterpretScript expr) = Just expr

@@ -774,6 +791,14 @@ getLanguageExt :: Opt -> Maybe LanguageExt

774getLanguageExt (Extension e) = Just e

791getLanguageExt (Extension e) = Just e

775getLanguageExt _ = Nothing

792getLanguageExt _ = Nothing

776

793

794+getTriple :: Opt -> Maybe String

795+getTriple (TargetTriple x) = Just x

796+getTriple _ = Nothing

797+

798+getCPU :: Opt -> Maybe String

799+getCPU (TargetCPU x) = Just x

800+getCPU _ = Nothing

801+

777opt :: (Opt -> Maybe a) -> [Opt] -> [a]

802opt :: (Opt -> Maybe a) -> [Opt] -> [a]

778opt = mapMaybe

803opt = mapMaybe

779

804