6d954d8 · Idris-dev · git.iko.soy

CHANGELOG.md+1

compare with master

unifiedsplit

@@ -15,6 +15,7 @@

15## Tool Updates

16+ Private functions are no longer visible in the REPL except for modules

17 that are explicitly loaded.

18++ The --interface option now creates CommonJS modules on the node backend.

18

19

19# New in 1.1.1

20# New in 1.1.1

20

21

CONTRIBUTORS+1

@@ -177,6 +177,7 @@ Ricky Elrod

177Robert Clipsham

178Robert Edström

179Ross Meikleham

180+Rui Barreiro

180Ryan Scott

181Ryan Scott

181Sam Elliott

182Sam Elliott

182Sam T

183Sam T

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

@@ -7,10 +7,15 @@ import Idris.Options

7import IRTS.CodegenJavaScript

8import IRTS.Compiler

9

10+import Paths_idris

11+

12+import Control.Monad

13+

10import System.Environment

14import System.Environment

11import System.Exit

15import System.Exit

12

16

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

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

18+ , interface :: Bool

14 , output :: FilePath

19 , output :: FilePath

15 }

20 }

16

21

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

20

25

21getOpts :: IO Opts

26getOpts :: IO Opts

22getOpts = do xs <- getArgs

27getOpts = do xs <- getArgs

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

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

24 where

29 where

25 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

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

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

27 process opts [] = opts

33 process opts [] = opts

28

34

29jsMain :: Opts -> Idris ()

35jsMain :: Opts -> Idris ()

30jsMain opts = do elabPrims

36jsMain opts = do elabPrims

31 loadInputs (inputs opts) Nothing

37 loadInputs (inputs opts) Nothing

38+ mainProg <- if interface opts

39+ then return Nothing

32− mainProg <- elabMain

40+ else liftM Just elabMain

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

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

34 runIO $ codegenNode ir

42 runIO $ codegenNode ir

35

43

36main :: IO ()

44main :: IO ()

src/IRTS/CodegenJavaScript.hs+15−6

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

55

56codegenNode :: CodeGenerator

57codegenNode ci =

58− do

58+ if interfaces ci then

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

59+ codegenJs (CGConf { header = ""

60 , footer = ""

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

62 , extraRunTime = "Runtime-node.js"

63 }

64 )

65 ci

66+ else

67+ do

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

69+ , footer = ""

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

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

72+ }

73+ )

74+ ci

66− setPermissions (outputFile ci) (emptyPermissions { readable = True

75+ setPermissions (outputFile ci) (emptyPermissions { readable = True

67− , executable = True

76+ , executable = True

68− , writable = True

77+ , writable = True

69− })

78+ })

src/IRTS/Compiler.hs+1−1

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

142 return fn

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

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

145− exit <- rawSystem cmd args

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

146 when (exit /= ExitSuccess) $

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

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

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

@@ -14,6 +14,7 @@ module IRTS.JavaScript.Codegen( codegenJs

14

15import Idris.Core.TT

16import IRTS.CodegenCommon

17+import IRTS.Exports

17import IRTS.JavaScript.AST

18import IRTS.JavaScript.AST

18import IRTS.JavaScript.LangTransforms

19import IRTS.JavaScript.LangTransforms

19import IRTS.JavaScript.Name

20import IRTS.JavaScript.Name

@@ -39,7 +40,6 @@ import System.Directory (doesFileExist)

39import System.Environment

40import System.Environment

40import System.FilePath

41import System.FilePath

41

42

42−

43-- | Code generation stats hold information about the generated user

44-- code. Based on that information we add additional code to make

45-- things work.

@@ -98,6 +98,31 @@ isYes (Just "Y") = True

98isYes (Just "y") = True

99isYes _ = False

100

101+makeExportDecls :: Map Name LDecl -> ExportIFace -> [Text]

102+makeExportDecls defs (Export _ _ e) =

103+ concatMap makeExport e

104+ where

105+ uncurryF name argTy (Just args) =

106+ if length argTy == length args then name

107+ else T.concat [ "function(){ return "

108+ , name

109+ , ".apply(this, Array.prototype.slice.call(arguments, 0,", T.pack $ show $ length args,"))"

110+ , T.concat $ map (\x -> T.concat ["(arguments[", T.pack $ show x , "])"]) [length args .. (length argTy - 1)]

111+ , "}"

112+ ]

113+ uncurryF name argTy Nothing = name

114+

115+ addApplyForIO (FIO _) f = T.concat ["function(){ return (",f, ").apply(this,arguments)()}"]

116+ addApplyForIO _ f = f

117+

118+ makeExport (ExportData _) =

119+ []

120+ makeExport (ExportFun name (FStr exportname) retTy argTy) =

121+ [T.concat [ T.pack $ exportname

122+ , ": "

123+ , addApplyForIO retTy $ uncurryF (jsName name) argTy (getArgList' name defs)

124+ ]

125+ ]

101

126

102codegenJs :: CGConf -> CodeGenerator

127codegenJs :: CGConf -> CodeGenerator

103codegenJs conf ci =

128codegenJs conf ci =

@@ -105,7 +130,10 @@ codegenJs conf ci =

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

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

106 let defs' = Map.fromList $ liftDecls ci

131 let defs' = Map.fromList $ liftDecls ci

107 let defs = globlToCon defs'

132 let defs = globlToCon defs'

133+ let iface = interfaces ci

134+ let used = if iface then

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

108− let used = Map.elems $ removeDeadCode defs [sMN 0 "runMain"]

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

109 when debug $ do

137 when debug $ do

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

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

111 putStrLn $ "Finished calculating used"

139 putStrLn $ "Finished calculating used"

@@ -136,7 +164,8 @@ codegenJs conf ci =

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

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

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

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

138 , out, "\n"

166 , out, "\n"

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

139− , jsName (sMN 0 "runMain"), "();\n"

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

140 , "}.call(this))"

169 , "}.call(this))"

141 , footer conf

170 , footer conf

142 ]

171 ]

@@ -223,13 +252,17 @@ getConsId n =

223 Just (LConstructor _ conId arity) -> pure (conId, arity)

252 Just (LConstructor _ conId arity) -> pure (conId, arity)

224 _ -> error $ "Internal JS Backend error " ++ showCG n ++ " is not a constructor."

253 _ -> error $ "Internal JS Backend error " ++ showCG n ++ " is not a constructor."

225

254

255+getArgList' :: Name -> Map Name LDecl -> Maybe [Name]

256+getArgList' n defs =

257+ case Map.lookup n defs of

258+ Just (LFun _ _ a _) -> Just a

259+ _ -> Nothing

260+

226getArgList :: Name -> State CGBodyState (Maybe [Name])

261getArgList :: Name -> State CGBodyState (Maybe [Name])

227getArgList n =

262getArgList n =

228 do

263 do

229 st <- get

264 st <- get

230− case Map.lookup n (defs st) of

265+ pure $ getArgList' n (defs st)

231− Just (LFun _ _ a _) -> pure $ Just a

232− _ -> pure Nothing

233

266

234data BodyResTarget = ReturnBT

267data BodyResTarget = ReturnBT

235 | DecBT Text

268 | DecBT Text

src/Idris/REPL.hs+3−1

@@ -79,6 +79,7 @@ import Idris.REPL.Parser

79import Idris.Termination

80import Idris.TypeSearch (searchByType)

81import Idris.WhoCalls

82+import IRTS.CodegenCommon

82import IRTS.Compiler

83import IRTS.Compiler

83import Network

84import Network

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

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

@@ -1280,7 +1281,8 @@ process fn (Compile codegen f)

1280 return (Just m')

1281 return (Just m')

1281 ir <- compile codegen f m

1282 ir <- compile codegen f m

1282 i <- getIState

1283 i <- getIState

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

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

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

1284 where fc = fileFC "main"

1286 where fc = fileFC "main"

1285process fn (LogLvl i) = setLogLevel i

1287process fn (LogLvl i) = setLogLevel i

1286process fn (LogCategory cs) = setLogCats cs

1288process fn (LogCategory cs) = setLogCats cs

test/TestData.hs+2−1

@@ -72,7 +72,7 @@ testFamiliesData = [

72 ( 18, ANY ),

73 ( 19, ANY ),

74 ( 20, ANY ),

75− ( 21, ANY )]),

75+ ( 21, C_CG )]),

76 ("bignum", "Bignum",

77 [ ( 1, ANY ),

78 ( 2, ANY )]),

@@ -129,6 +129,7 @@ testFamiliesData = [

129 , ( 8, C_CG )

130 , ( 9, C_CG )

131 , ( 10, NODE_CG )

132+ , ( 11, NODE_CG )

132 ]),

133 ]),

133 ("folding", "Folding",

134 ("folding", "Folding",

134 [ ( 1, ANY )]),

135 [ ( 1, ANY )]),

test/ffi011/expectednew file+2

@@ -0,0 +1,2 @@

1+Ready to show...

2+[10, 20, 30, 40]

test/ffi011/ffi011new file+7

@@ -0,0 +1,7 @@

1+l = require("./lib.js");

2+

3+x = l.cons(10, l.cons(20, l.nil()));

4+y = l.cons(30, l.cons(40, l.nil()));

5+z = l.addLists(x, y);

6+

7+console.log(l.showList(z));

test/ffi011/ffi011.idrnew file+27

@@ -0,0 +1,27 @@

1+module Lib

2+

3+import Data.List

4+

5+addLists : List Int -> List Int -> List Int

6+addLists xs ys = xs ++ ys

7+

8+nil : List Int

9+nil = []

10+

11+cons : Int -> List Int -> List Int

12+cons x xs = x :: xs

13+

14+show' : List Int -> JS_IO String

15+show' xs = do putStrLn' "Ready to show..."

16+ pure (show xs)

17+

18+testList : FFI_Export FFI_JS "" []

19+testList = Data (List Int) "ListInt" $

20+ Data (List Nat) "ListNat" $

21+ Fun addLists "addLists" $

22+ Fun nil "nil" $

23+ Fun cons "cons" $

24+ Data Nat "Nat" $

25+ Fun Strings.length "lengthS" $

26+ Fun show' "showList" $

27+ End

test/ffi011/runnew file+4

@@ -0,0 +1,4 @@

1+#!/usr/bin/env bash

2+${IDRIS:-idris} $@ ffi011.idr --interface -o lib.js

3+node ./ffi011

4+rm -f *.ibc lib.js