06fffa3 · Idris-dev · git.iko.soy

src/IRTS/CodegenJavaScript.hsnew file+59

compare with master

unifiedsplit

@@ -0,0 +1,59 @@

1+module IRTS.CodegenJavaScript (codegenJavaScript ) where

2+

3+import Idris.AbsSyntax

4+import IRTS.Bytecode

5+import IRTS.Lang

6+import IRTS.Simplified

7+import IRTS.CodegenCommon

8+import Core.TT

9+import Paths_idris

10+import Util.System

11+

12+import Data.Char

13+import Data.List

14+import System.IO

15+

16+codegenJavaScript

17+ :: [(Name, SDecl)]

18+ -> FilePath

19+ -> OutputType

20+ -> IO ()

21+codegenJavaScript definitions filename outputType = do

22+ let body = concat $ map (translateDeclaration . snd) definitions

23+ output = concat [header, body, footer]

24+ writeFile filename output

25+

26+

27+header :: String

28+header =

29+ concat $ map (\line -> line ++ "\n")

30+ ["define(function(require) {",

31+ "var m = {};"]

32+

33+

34+footer :: String

35+footer =

36+ concat $ map (\line -> line ++ "\n")

37+ ["return m;",

38+ "});"]

39+

40+

41+translateName :: Name -> String

42+translateName = show

43+

44+

45+translateDeclaration :: SDecl -> String

46+translateDeclaration (SFun name parameterNames stackSize body) =

47+ concat ["m[\"", translateName name, "\"] = function(s) { ",

48+ translateExpression body, " ",

49+ intercalate " " $ take (length parameterNames) $ repeat "s.pop();",

50+ " };\n"]

51+

52+

53+translateExpression :: SExp -> String

54+translateExpression (SLet name value body) =

55+ intercalate " "

56+ $ [translateExpression value,

57+ translateExpression body,

58+ "s.pop();", "s.pop();"]

59+translateExpression _ = "..."

src/IRTS/Compiler.hs+2

@@ -8,6 +8,7 @@ import IRTS.Simplified

8import IRTS.CodegenCommon

9import IRTS.CodegenC

10import IRTS.CodegenJava

11+import IRTS.CodegenJavaScript

11import IRTS.Inliner

12import IRTS.Inliner

12

13

13import Idris.AbsSyntax

14import Idris.AbsSyntax

@@ -67,6 +68,7 @@ compile target f tm

67 (concatMap mkObj objs)

68 (concatMap mkObj objs)

68 (concatMap mkLib libs) NONE

69 (concatMap mkLib libs) NONE

69 ViaJava -> liftIO $ codegenJava c f outty

70 ViaJava -> liftIO $ codegenJava c f outty

71+ ToJavaScript -> liftIO $ codegenJavaScript c f outty

70 Error e -> fail $ show e

72 Error e -> fail $ show e

71 where checkMVs = do i <- get

73 where checkMVs = do i <- get

72 case idris_metavars i \\ primDefs of

74 case idris_metavars i \\ primDefs of

src/IRTS/LParser.hs+1

@@ -9,6 +9,7 @@ import IRTS.Bytecode

9import IRTS.CodegenCommon

10import IRTS.CodegenC

11import IRTS.CodegenJava

12+import IRTS.CodegenJavaScript

12import IRTS.Defunctionalise

13import IRTS.Defunctionalise

13import Paths_idris

14import Paths_idris

14

15

src/Idris/AbsSyntaxTree.hs+1−1

@@ -140,7 +140,7 @@ type Idris = StateT IState (InputT IO)

140

141-- Commands in the REPL

142

143−data Target = ViaC | ViaJava

143+data Target = ViaC | ViaJava | ToJavaScript

144 deriving (Show, Eq)

145

146data Command = Quit

src/Idris/REPL.hs+2

@@ -423,6 +423,7 @@ parseArgs ("--noprelude":ns) = NoPrelude : (parseArgs ns)

423parseArgs ("--check":ns) = NoREPL : (parseArgs ns)

424parseArgs ("-o":n:ns) = NoREPL : Output n : (parseArgs ns)

425parseArgs ("-no":n:ns) = NoREPL : NewOutput n : (parseArgs ns)

426+parseArgs ("--javascript":ns) = UseTarget ToJavaScript : (parseArgs ns)

426parseArgs ("--typecase":ns) = TypeCase : (parseArgs ns)

427parseArgs ("--typecase":ns) = TypeCase : (parseArgs ns)

427parseArgs ("--typeintype":ns) = TypeInType : (parseArgs ns)

428parseArgs ("--typeintype":ns) = TypeInType : (parseArgs ns)

428parseArgs ("--total":ns) = DefaultTotal : (parseArgs ns)

429parseArgs ("--total":ns) = DefaultTotal : (parseArgs ns)

@@ -471,6 +472,7 @@ help =

471 ([":showproof"], "<name>", "Show proof"),

472 ([":showproof"], "<name>", "Show proof"),

472 ([":proofs"], "", "Show available proofs"),

473 ([":proofs"], "", "Show available proofs"),

473 ([":c",":compile"], "<filename>", "Compile to an executable <filename>"),

474 ([":c",":compile"], "<filename>", "Compile to an executable <filename>"),

475+ ([":js", ":javascript"], "<filename>", "Compile to JavaScript <filename>"),

474 ([":exec",":execute"], "", "Compile to an executable and run"),

476 ([":exec",":execute"], "", "Compile to an executable and run"),

475 ([":?",":h",":help"], "", "Display this help text"),

477 ([":?",":h",":help"], "", "Display this help text"),

476 ([":set"], "<option>", "Set an option (errorcontext, showimplicits)"),

478 ([":set"], "<option>", "Set an option (errorcontext, showimplicits)"),

src/Idris/REPLParser.hs+1

@@ -30,6 +30,7 @@ pCmd = try (do cmd ["q", "quit"]; eof; return Quit)

30 <|> try (do cmd ["ttshell"]; eof; return TTShell)

31 <|> try (do cmd ["c", "compile"]; f <- identifier; eof; return (Compile ViaC f))

32 <|> try (do cmd ["jc", "newcompile"]; f <- identifier; eof; return (Compile ViaJava f))

33+ <|> try (do cmd ["js", "javascript"]; f <- identifier; eof; return (Compile ToJavaScript f))

33 <|> try (do cmd ["nc", "newcompile"]; f <- identifier; eof; return (NewCompile f))

34 <|> try (do cmd ["nc", "newcompile"]; f <- identifier; eof; return (NewCompile f))

34 <|> try (do cmd ["m", "metavars"]; eof; return Metavars)

35 <|> try (do cmd ["m", "metavars"]; eof; return Metavars)

35 <|> try (do cmd ["proofs"]; eof; return Proofs)

36 <|> try (do cmd ["proofs"]; eof; return Proofs)

src/Main.hs+1

@@ -86,6 +86,7 @@ usagemsg = "Idris version " ++ ver ++ "\n" ++

86 "\t--log [level] Set debugging log level\n" ++

87 "\t-S Do no further compilation of code generator output\n" ++

88 "\t-c Compile to object files rather than an executable\n" ++

89+ "\t--javascript Compile to JavaScript rather than to native code\n" ++

89 "\t--libdir Show library install directory and exit\n" ++

90 "\t--libdir Show library install directory and exit\n" ++

90 "\t--link Show C library directories and exit (for C linking)\n" ++

91 "\t--link Show C library directories and exit (for C linking)\n" ++

91 "\t--include Show C include directories and exit (for C linking)\n"

92 "\t--include Show C include directories and exit (for C linking)\n"