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

git.iko.soy/Idris-dev

Merge pull request #4073 from rbarreiro/exportiface_js

--interface for node backend

commit6d954d8fe7e97ffaa95e81589bcf733f7c4efd99 authorNiklas Larsson <metaniklas@gmail.com> dateWed 20 Sep 2017, 20:49 (9 years ago) parentbd8ea0a bea08ac

12 files changed+113−18

compare with master

unifiedsplit

CHANGELOG.md+1 CONTRIBUTORS+1 codegen/idris-codegen-node/Main.hs+11−3 src/IRTS/CodegenJavaScript.hs+15−6 src/IRTS/Compiler.hs+1−1 src/IRTS/JavaScript/Codegen.hs+39−6 src/Idris/REPL.hs+3−1 test/TestData.hs+2−1 test/ffi011/expected+2 test/ffi011/ffi011+7 test/ffi011/ffi011.idr+27 test/ffi011/run+4

CHANGELOG.md+1

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

1515## Tool Updates

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

1717 that are explicitly loaded.

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

1819

1920# New in 1.1.1

2021

CONTRIBUTORS+1

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

177177Robert Clipsham

178178Robert Edström

179179Ross Meikleham

180+Rui Barreiro

180181Ryan Scott

181182Sam Elliott

182183Sam T

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

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

77import IRTS.CodegenJavaScript

88import IRTS.Compiler

10+import Paths_idris

11+

12+import Control.Monad

13+

1014import System.Environment

1115import System.Exit

1216

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

18+ , interface :: Bool

1419 , output :: FilePath

1520 }

1621

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

2025

2126getOpts :: IO Opts

2227getOpts = do xs <- getArgs

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

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

2429 where

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

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

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

2733 process opts [] = opts

2834

2935jsMain :: Opts -> Idris ()

3036jsMain opts = do elabPrims

3137 loadInputs (inputs opts) Nothing

32− mainProg <- elabMain

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

38+ mainProg <- if interface opts

39+ then return Nothing

40+ else liftM Just elabMain

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

3442 runIO $ codegenNode ir

3543

3644main :: IO ()

src/IRTS/CodegenJavaScript.hs+15−6

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

5555

5656codegenNode :: CodeGenerator

5757codegenNode ci =

58− do

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

58+ if interfaces ci then

59+ codegenJs (CGConf { header = ""

6060 , footer = ""

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

6262 , extraRunTime = "Runtime-node.js"

6363 }

6464 )

6565 ci

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

67− , executable = True

68− , writable = True

69− })

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

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

76+ , executable = True

77+ , writable = True

78+ })

src/IRTS/Compiler.hs+1−1

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

142142 return fn

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

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

145− exit <- rawSystem cmd args

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

146146 when (exit /= ExitSuccess) $

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

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

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

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

1414

1515import Idris.Core.TT

1616import IRTS.CodegenCommon

17+import IRTS.Exports

1718import IRTS.JavaScript.AST

1819import IRTS.JavaScript.LangTransforms

1920import IRTS.JavaScript.Name

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

3940import System.Environment

4041import System.FilePath

4142

42−

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

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

4545-- things work.

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

9898isYes (Just "y") = True

9999isYes _ = False

100100

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+ ]

101126

102127codegenJs :: CGConf -> CodeGenerator

103128codegenJs conf ci =

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

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

106131 let defs' = Map.fromList $ liftDecls ci

107132 let defs = globlToCon defs'

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

133+ let iface = interfaces ci

134+ let used = if iface then

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

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

109137 when debug $ do

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

111139 putStrLn $ "Finished calculating used"

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

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

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

138166 , out, "\n"

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

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

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

140169 , "}.call(this))"

141170 , footer conf

142171 ]

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

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

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

225254

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+

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

227262getArgList n =

228263 do

229264 st <- get

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

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

232− _ -> pure Nothing

265+ pure $ getArgList' n (defs st)

233266

234267data BodyResTarget = ReturnBT

235268 | DecBT Text

src/Idris/REPL.hs+3−1

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

7979import Idris.Termination

8080import Idris.TypeSearch (searchByType)

8181import Idris.WhoCalls

82+import IRTS.CodegenCommon

8283import IRTS.Compiler

8384import Network

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

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

12801281 return (Just m')

12811282 ir <- compile codegen f m

12821283 i <- getIState

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

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

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

12841286 where fc = fileFC "main"

12851287process fn (LogLvl i) = setLogLevel i

12861288process fn (LogCategory cs) = setLogCats cs

test/TestData.hs+2−1

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

7272 ( 18, ANY ),

7373 ( 19, ANY ),

7474 ( 20, ANY ),

75− ( 21, ANY )]),

75+ ( 21, C_CG )]),

7676 ("bignum", "Bignum",

7777 [ ( 1, ANY ),

7878 ( 2, ANY )]),

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

129129 , ( 8, C_CG )

130130 , ( 9, C_CG )

131131 , ( 10, NODE_CG )

132+ , ( 11, NODE_CG )

132133 ]),

133134 ("folding", "Folding",

134135 [ ( 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");

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);

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

test/ffi011/ffi011.idrnew file+27

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

1+module Lib

3+import Data.List

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

6+addLists xs ys = xs ++ ys

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