f675e05 · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

Add CodegenInfo structure, give CGs uniform types

All code generators now have type CodegenInfo -> IO (), with access to all IRs. Later, we'll be able to register new CGs easily if they all have the same type.

commitf675e059aa4d61d6b744196b4bafd4b1f93013ae authorEdwin Brady <eb@cs.st-andrews.ac.uk> dateTue 1 Apr 2014, 21:21 (13 years ago) parent7d09d05

7 files changed+103−60

compare with master

unifiedsplit

src/IRTS/CodegenC.hs+26−10 src/IRTS/CodegenCommon.hs+25 src/IRTS/CodegenJava.hs+13−8 src/IRTS/CodegenJavaScript.hs+11−3 src/IRTS/CodegenLLVM.hs+12−7 src/IRTS/Compiler.hs+14−23 src/Util/LLVMStubs.hs+2−9

src/IRTS/CodegenC.hs+26−10

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

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

2121import Control.Monad

2222

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

24− String -> -- output file name

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

26− [FilePath] -> -- include files

27− String -> -- extra object files

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

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

30− DbgLevel ->

31− IO ()

32−codegenC defs out exec incs objs libs flags dbg

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+

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

40+ String -> -- output file name

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

42+ [FilePath] -> -- include files

43+ String -> -- extra object files

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

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

46+ DbgLevel ->

47+ IO ()

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

3349 = do -- print defs

3450 let bc = map toBC defs

3551 let h = concatMap toDecl (map fst bc)

src/IRTS/CodegenCommon.hs+25

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

33import Idris.Core.TT

44import IRTS.Simplified

5+import IRTS.Defunctionalise

6+import IRTS.Lang

68import Control.Exception

9+import Data.Word

710import System.Environment

811

912data DbgLevel = NONE | DEBUG | TRACE deriving Eq

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

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

1417 return (Just e))

1518 (\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

3434

3535-----------------------------------------------------------------------

3636-- Main function

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

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

39− FilePath -> -- output file name

40− [String] -> -- headers

41− [String] -> -- libs

42− OutputType ->

43− IO ()

44−codegenJava globalInit defs out hdrs libs exec =

37+codegenJava :: CodeGenerator

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

39+ (includes cg) (compileLibs cg)

40+ (outputType cg)

41+

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

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

44+ FilePath -> -- output file name

45+ [String] -> -- headers

46+ [String] -> -- libs

47+ OutputType ->

48+ IO ()

49+codegenJava' globalInit defs out hdrs libs exec =

4550 withTgtDir exec out (codegenJava' exec)

4651 where

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

src/IRTS/CodegenJavaScript.hs+11−3

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

11{-# LANGUAGE PatternGuards #-}

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

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

55import Idris.AbsSyntax hiding (TypeCase)

66import IRTS.Bytecode

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

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

13901390getIncludes = mapM readFile

13911391

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

13931401 :: JSTarget

13941402 -> [(Name, SDecl)]

13951403 -> [FilePath]

13961404 -> FilePath

13971405 -> OutputType

13981406 -> IO ()

1399−codegenJavaScript target definitions includes filename outputType = do

1407+codegenJS_all target definitions includes filename outputType = do

14001408 let (header, rt) = case target of

14011409 Node ->

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

src/IRTS/CodegenLLVM.hs+12−7

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

5858

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

6060

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

62− String -> -- target triple

63− String -> -- target CPU

64− Word -> -- Optimization degree

65− FilePath -> -- output file name

66− OutputType ->

67− IO ()

61+codegenLLVM :: CodeGenerator

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

63+ (targetCPU ci) (optimisation ci)

64+ (outputFile ci) (outputType ci)

65+

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

67+ String -> -- target triple

68+ String -> -- target CPU

69+ Word -> -- Optimization degree

70+ FilePath -> -- output file name

71+ OutputType ->

72+ IO ()

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

6974 initializeAllTargets

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

src/IRTS/Compiler.hs+14−23

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

7171 case dumpDefun of

7272 Nothing -> return ()

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

74− triple <- targetTriple

75− cpu <- targetCPU

76− optimize <- optLevel

74+ triple <- Idris.AbsSyntax.targetTriple

75+ cpu <- Idris.AbsSyntax.targetCPU

76+ optimise <- optLevel

7777 iLOG "Building output"

78+

7879 case checked of

79− OK c -> runIO $ case codegen of

80− ViaC ->

81− codegenC c f outty hdrs

82− (concatMap mkObj objs)

83− (concatMap mkLib libs)

84− (concatMap mkFlag flags ++

85− concatMap incdir impdirs) NONE

86− ViaJava ->

87− codegenJava [] c f hdrs libs outty

88− ViaJavaScript ->

89− codegenJavaScript JavaScript c hdrs f outty

90− ViaNode ->

91− codegenJavaScript Node c hdrs f outty

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

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

84+ runIO $ case codegen of

85+ ViaC -> codegenC cginfo

86+ ViaJava -> codegenJava cginfo

87+ ViaJavaScript -> codegenJavaScript cginfo

88+ ViaNode -> codegenNode cginfo

89+ ViaLLVM -> codegenLLVM cginfo

9390 Bytecode -> dumpBC c f

9491 Error e -> ierror e

9592 where checkMVs = do i <- getIState

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

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

10097 ex <- doesFileExist f

10198 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−

10899

109100irMain :: TT Name -> Idris LDecl

110101irMain tm = do i <- ir tm

src/Util/LLVMStubs.hs+2−9

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

2020getHostCPUName = return ""

2121

2222

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

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."

23+codegenLLVM :: CodeGenerator

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