f675e05 · Idris-dev · git.iko.soy

src/IRTS/CodegenC.hs+26−10

compare with master

unifiedsplit

@@ -20,16 +20,32 @@ import System.Directory

20import System.FilePath ((</>), (<.>))

21import Control.Monad

22

23+codegenC :: CodeGenerator

24+codegenC ci = codegenC' (simpleDecls ci)

25+ (outputFile ci)

26+ (outputType ci)

27+ (includes ci)

28+ (concatMap mkObj (compileObjs ci))

29+ (concatMap mkLib (compileLibs ci) ++

30+ concatMap incdir (importDirs ci))

31+ (concatMap mkFlag (compilerFlags ci))

32+ (debugLevel ci)

33+

34+ where mkObj f = f ++ " "

35+ mkLib l = "-l" ++ l ++ " "

36+ mkFlag l = l ++ " "

37+ incdir i = "-I" ++ i ++ " "

38+

23−codegenC :: [(Name, SDecl)] ->

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

24− String -> -- output file name

40+ String -> -- output file name

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

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

26− [FilePath] -> -- include files

42+ [FilePath] -> -- include files

27− String -> -- extra object files

43+ String -> -- extra object files

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

44+ String -> -- extra compiler flags (libraries)

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

45+ String -> -- extra compiler flags (anything)

30− DbgLevel ->

46+ DbgLevel ->

31− IO ()

47+ IO ()

32−codegenC defs out exec incs objs libs flags dbg

48+codegenC' defs out exec incs objs libs flags dbg

33 = do -- print defs

49 = do -- print defs

34 let bc = map toBC defs

50 let bc = map toBC defs

35 let h = concatMap toDecl (map fst bc)

51 let h = concatMap toDecl (map fst bc)

src/IRTS/CodegenCommon.hs+25

@@ -2,8 +2,11 @@ module IRTS.CodegenCommon where

2

3import Idris.Core.TT

4import IRTS.Simplified

5+import IRTS.Defunctionalise

6+import IRTS.Lang

5

7

6import Control.Exception

8import Control.Exception

9+import Data.Word

7import System.Environment

10import System.Environment

8

11

9data DbgLevel = NONE | DEBUG | TRACE deriving Eq

12data DbgLevel = NONE | DEBUG | TRACE deriving Eq

@@ -13,3 +16,25 @@ environment :: String -> IO (Maybe String)

13environment x = Control.Exception.catch (do e <- getEnv x

16environment x = Control.Exception.catch (do e <- getEnv x

14 return (Just e))

17 return (Just e))

15 (\y-> do return (y::SomeException); return Nothing)

18 (\y-> do return (y::SomeException); return Nothing)

19+

20+-- Everything which might be needed in a code generator - a CG can choose which

21+-- level of Decls to generate code from (simplified, defunctionalised or merely

22+-- lambda lifted) and has access to the list of object files, libraries, etc.

23+

24+data CodegenInfo = CodegenInfo { outputFile :: String,

25+ outputType :: OutputType,

26+ targetTriple :: String,

27+ targetCPU :: String,

28+ optimisation :: Word,

29+ includes :: [FilePath],

30+ importDirs :: [FilePath],

31+ compileObjs :: [String],

32+ compileLibs :: [String],

33+ compilerFlags :: [String],

34+ debugLevel :: DbgLevel,

35+ simpleDecls :: [(Name, SDecl)],

36+ defunDecls :: [(Name, DDecl)],

37+ liftDecls :: [(Name, LDecl)]

38+ }

39+

40+type CodeGenerator = CodegenInfo -> IO ()

src/IRTS/CodegenJava.hs+13−8

@@ -34,14 +34,19 @@ import System.Process

34

35-----------------------------------------------------------------------

36-- Main function

37+codegenJava :: CodeGenerator

38+codegenJava cg = codegenJava' [] (simpleDecls cg) (outputFile cg)

39+ (includes cg) (compileLibs cg)

40+ (outputType cg)

41+

37−codegenJava :: [(Name, SExp)] -> -- initialization of globals

42+codegenJava' :: [(Name, SExp)] -> -- initialization of globals

38− [(Name, SDecl)] -> -- decls

43+ [(Name, SDecl)] -> -- decls

39− FilePath -> -- output file name

44+ FilePath -> -- output file name

40− [String] -> -- headers

45+ [String] -> -- headers

41− [String] -> -- libs

46+ [String] -> -- libs

42− OutputType ->

47+ OutputType ->

43− IO ()

48+ IO ()

44−codegenJava globalInit defs out hdrs libs exec =

49+codegenJava' globalInit defs out hdrs libs exec =

45 withTgtDir exec out (codegenJava' exec)

50 withTgtDir exec out (codegenJava' exec)

46 where

51 where

47 codegenJava' :: OutputType -> FilePath -> IO ()

52 codegenJava' :: OutputType -> FilePath -> IO ()

src/IRTS/CodegenJavaScript.hs+11−3

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

1{-# LANGUAGE PatternGuards #-}

2

3−module IRTS.CodegenJavaScript (codegenJavaScript, JSTarget(..)) where

3+module IRTS.CodegenJavaScript (codegenJavaScript, codegenNode, JSTarget(..)) where

4

5import Idris.AbsSyntax hiding (TypeCase)

6import IRTS.Bytecode

@@ -1389,14 +1389,22 @@ getGlobalCons js = foldJS match (++) [] js

1389getIncludes :: [FilePath] -> IO [String]

1390getIncludes = mapM readFile

1391

1392−codegenJavaScript

1392+codegenJavaScript :: CodeGenerator

1393+codegenJavaScript ci = codegenJS_all JavaScript (simpleDecls ci)

1394+ (includes ci) (outputFile ci) (outputType ci)

1395+

1396+codegenNode :: CodeGenerator

1397+codegenNode ci = codegenJS_all Node (simpleDecls ci)

1398+ (includes ci) (outputFile ci) (outputType ci)

1399+

1400+codegenJS_all

1393 :: JSTarget

1401 :: JSTarget

1394 -> [(Name, SDecl)]

1402 -> [(Name, SDecl)]

1395 -> [FilePath]

1403 -> [FilePath]

1396 -> FilePath

1404 -> FilePath

1397 -> OutputType

1405 -> OutputType

1398 -> IO ()

1406 -> IO ()

1399−codegenJavaScript target definitions includes filename outputType = do

1407+codegenJS_all target definitions includes filename outputType = do

1400 let (header, rt) = case target of

1408 let (header, rt) = case target of

1401 Node ->

1409 Node ->

1402 ("#!/usr/bin/env node\n", "-node")

1410 ("#!/usr/bin/env node\n", "-node")

src/IRTS/CodegenLLVM.hs+12−7

@@ -58,13 +58,18 @@ import Debug.Trace

58

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

60

61+codegenLLVM :: CodeGenerator

62+codegenLLVM ci = codegenLLVM' (simpleDecls ci) (targetTriple ci)

63+ (targetCPU ci) (optimisation ci)

64+ (outputFile ci) (outputType ci)

65+

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

66+codegenLLVM' :: [(TT.Name, SDecl)] ->

62− String -> -- target triple

67+ String -> -- target triple

63− String -> -- target CPU

68+ String -> -- target CPU

64− Word -> -- Optimization degree

69+ Word -> -- Optimization degree

65− FilePath -> -- output file name

70+ FilePath -> -- output file name

66− OutputType ->

71+ OutputType ->

67− IO ()

72+ IO ()

68codegenLLVM defs triple cpu optimize file outty = withContext $ \context -> do

73codegenLLVM defs triple cpu optimize file outty = withContext $ \context -> do

69 initializeAllTargets

74 initializeAllTargets

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

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

src/IRTS/Compiler.hs+14−23

@@ -71,25 +71,22 @@ compile codegen f tm

71 case dumpDefun of

72 Nothing -> return ()

73 Just f -> runIO $ writeFile f (dumpDefuns defuns)

74− triple <- targetTriple

74+ triple <- Idris.AbsSyntax.targetTriple

75− cpu <- targetCPU

75+ cpu <- Idris.AbsSyntax.targetCPU

76− optimize <- optLevel

76+ optimise <- optLevel

77 iLOG "Building output"

78+

78 case checked of

79 case checked of

80+ OK c -> do let cginfo = CodegenInfo f outty triple cpu optimise

81+ hdrs impdirs objs libs flags

82+ NONE c (toAlist defuns)

83+ tagged

79− OK c -> runIO $ case codegen of

84+ runIO $ case codegen of

80− ViaC ->

81− codegenC c f outty hdrs

85+ ViaC -> codegenC cginfo

82− (concatMap mkObj objs)

83− (concatMap mkLib libs)

84− (concatMap mkFlag flags ++

85− concatMap incdir impdirs) NONE

86− ViaJava ->

86+ ViaJava -> codegenJava cginfo

87− codegenJava [] c f hdrs libs outty

88− ViaJavaScript ->

87+ ViaJavaScript -> codegenJavaScript cginfo

89− codegenJavaScript JavaScript c hdrs f outty

90− ViaNode ->

88+ ViaNode -> codegenNode cginfo

91− codegenJavaScript Node c hdrs f outty

92− ViaLLVM -> codegenLLVM c triple cpu optimize f outty

89+ ViaLLVM -> codegenLLVM cginfo

93 Bytecode -> dumpBC c f

90 Bytecode -> dumpBC c f

94 Error e -> ierror e

91 Error e -> ierror e

95 where checkMVs = do i <- getIState

92 where checkMVs = do i <- getIState

@@ -99,12 +96,6 @@ compile codegen f tm

99 inDir d h = do let f = d </> h

96 inDir d h = do let f = d </> h

100 ex <- doesFileExist f

97 ex <- doesFileExist f

101 if ex then return f else return h

98 if ex then return f else return h

102− mkObj f = f ++ " "

103− mkLib l = "-l" ++ l ++ " "

104− mkFlag l = l ++ " "

105−

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

107−

108

99

109irMain :: TT Name -> Idris LDecl

100irMain :: TT Name -> Idris LDecl

110irMain tm = do i <- ir tm

101irMain tm = do i <- ir tm

src/Util/LLVMStubs.hs+2−9

@@ -20,12 +20,5 @@ getHostCPUName :: IO String

20getHostCPUName = return ""

21

22

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

23+codegenLLVM :: CodeGenerator

24− String -> -- target triple

25− String -> -- target CPU

26− Word -> -- Optimization degree

27− FilePath -> -- output file name

28− OutputType ->

29− IO ()

30−

31−codegenLLVM _ _ _ _ _ _ = fail "This Idris was compiled without the LLVM backend."

24+codegenLLVM _ = fail "This Idris was compiled without the LLVM backend."