d3f9138 · Idris-dev · git.iko.soy

codegen/idris-codegen-node/Main.hs+8−3

compare with master

unifiedsplit

@@ -10,10 +10,12 @@ import IRTS.Compiler

10

11import Paths_idris

12

13+import Control.Monad

13import System.Environment

14import System.Environment

14import System.Exit

15import System.Exit

15

16

16data Opts = Opts { inputs :: [FilePath]

17data Opts = Opts { inputs :: [FilePath]

18+ , interface :: Bool

17 , output :: FilePath

19 , output :: FilePath

18 }

20 }

19

21

@@ -23,17 +25,20 @@ showUsage = do putStrLn "A code generator which is intended to be called by the

23

25

24getOpts :: IO Opts

26getOpts :: IO Opts

25getOpts = do xs <- getArgs

27getOpts = do xs <- getArgs

26− return $ process (Opts [] "main.js") xs

28+ return $ process (Opts [] False "main.js") xs

27 where

29 where

28 process opts ("-o":o:xs) = process (opts { output = o }) xs

30 process opts ("-o":o:xs) = process (opts { output = o }) xs

31+ process opts ("--interface":xs) = process (opts { interface = True }) xs

29 process opts (x:xs) = process (opts { inputs = x:inputs opts }) xs

32 process opts (x:xs) = process (opts { inputs = x:inputs opts }) xs

30 process opts [] = opts

33 process opts [] = opts

31

34

32jsMain :: Opts -> Idris ()

35jsMain :: Opts -> Idris ()

33jsMain opts = do elabPrims

36jsMain opts = do elabPrims

34 loadInputs (inputs opts) Nothing

37 loadInputs (inputs opts) Nothing

38+ mainProg <- if interface opts

39+ then return Nothing

35− mainProg <- elabMain

40+ else liftM Just elabMain

36− ir <- compile (Via IBCFormat "node") (output opts) (Just mainProg)

41+ ir <- compile (Via IBCFormat "node") (output opts) mainProg

37 runIO $ codegenNode ir

42 runIO $ codegenNode ir

38

43

39main :: IO ()

44main :: IO ()

src/IRTS/CodegenJavaScript.hs+9−10

@@ -55,8 +55,15 @@ codegenJavaScript ci =

55

56codegenNode :: CodeGenerator

57codegenNode ci =

58− do

58+ if interfaces ci then

59− if outputType ci == Executable then

59+ codegenJs (CGConf { header = ""

60+ , footer = ""

61+ , jsbnPath = "jsbn/jsbn-browser.js"

62+ , extraRunTime = "Runtime-node.js"

63+ }

64+ )

65+ ci

66+ else

60 do

67 do

61 codegenJs (CGConf { header = "#!/usr/bin/env node\n"

68 codegenJs (CGConf { header = "#!/usr/bin/env node\n"

62 , footer = ""

69 , footer = ""

@@ -69,11 +76,3 @@ codegenNode ci =

69 , executable = True

76 , executable = True

70 , writable = True

77 , writable = True

71 })

78 })

72− else

73− codegenJs (CGConf { header = ""

74− , footer = ""

75− , jsbnPath = "jsbn/jsbn-browser.js"

76− , extraRunTime = "Runtime-node.js"

77− }

78− )

79− ci

src/IRTS/Compiler.hs+1−1

@@ -152,7 +152,7 @@ generate codegen mainmod ir

152 return fn

153 let cmd = "idris-codegen-" ++ cg

154 args = [input, "-o", outputFile ir] ++ compilerFlags ir

155− exit <- rawSystem cmd args

155+ exit <- rawSystem cmd (if interfaces ir then "--interface" : args else args)

156 when (exit /= ExitSuccess) $

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

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

src/IRTS/JavaScript/Codegen.hs+6−7

@@ -114,11 +114,10 @@ codegenJs conf ci =

114 debug <- isYes <$> lookupEnv "IDRISJS_DEBUG"

115 let defs' = Map.fromList $ liftDecls ci

116 let defs = globlToCon defs'

117− let isExec = outputType ci == Executable

117+ let iface = interfaces ci

118− putStrLn $ show $ isExec

119− let used = if isExec then

118+ let used = if iface then

120− Map.elems $ removeDeadCode defs [sMN 0 "runMain"]

119+ Map.elems $ removeDeadCode defs (getExpNames $ exportDecls ci)

121− else Map.elems $ removeDeadCode defs (getExpNames $ exportDecls ci)

120+ else Map.elems $ removeDeadCode defs [sMN 0 "runMain"]

122 when debug $ do

121 when debug $ do

123 writeFile (outputFile ci ++ ".LDeclsDebug") $ (unlines $ intersperse "" $ map show used) ++ "\n\n\n"

122 writeFile (outputFile ci ++ ".LDeclsDebug") $ (unlines $ intersperse "" $ map show used) ++ "\n\n\n"

124 putStrLn $ "Finished calculating used"

123 putStrLn $ "Finished calculating used"

@@ -149,8 +148,8 @@ codegenJs conf ci =

149 , doPartials (partialApplications stats), "\n"

148 , doPartials (partialApplications stats), "\n"

150 , doHiddenClasses (hiddenClasses stats), "\n"

149 , doHiddenClasses (hiddenClasses stats), "\n"

151 , out, "\n"

150 , out, "\n"

152− , if isExec then jsName (sMN 0 "runMain") `T.append` "();\n"

153− else T.concat ["module.exports = {\n", T.intercalate ";\n" $ concatMap makeExportDecls (exportDecls ci), "\n};\n"]

151+ , if iface then T.concat ["module.exports = {\n", T.intercalate ";\n" $ concatMap makeExportDecls (exportDecls ci), "\n};\n"]

152+ else jsName (sMN 0 "runMain") `T.append` "();\n"

154 , "}.call(this))"

153 , "}.call(this))"

155 , footer conf

154 , footer conf

156 ]

155 ]

src/Idris/REPL.hs+3−1

@@ -79,6 +79,7 @@ import Idris.Termination

79import Idris.TypeSearch (searchByType)

80import Idris.WhoCalls

81import IRTS.Compiler

82+import IRTS.CodegenCommon

82import Network

83import Network

83import Prelude hiding (id, (.), (<$>))

84import Prelude hiding (id, (.), (<$>))

84import System.Console.Haskeline as H

85import System.Console.Haskeline as H

@@ -1284,7 +1285,8 @@ process fn (Compile codegen f)

1284 return (Just m')

1285 return (Just m')

1285 ir <- compile codegen f m

1286 ir <- compile codegen f m

1286 i <- getIState

1287 i <- getIState

1288+ let ir' = ir {interfaces = iface}

1287− runIO $ generate codegen (fst (head (idris_imported i))) ir

1289+ runIO $ generate codegen (fst (head (idris_imported i))) ir'

1288 where fc = fileFC "main"

1290 where fc = fileFC "main"

1289process fn (LogLvl i) = setLogLevel i

1291process fn (LogLvl i) = setLogLevel i

1290process fn (LogCategory cs) = setLogCats cs

1292process fn (LogCategory cs) = setLogCats cs