b71febe · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

on master help sign in

Merge branch 'master' of github.com:idris-lang/Idris-dev into issue_3697

b71febeRui Barreiro9 years ago

CHANGELOG.md+7−4

compare with master

unifiedsplit

@@ -1,13 +1,16 @@

2## Tool Updates

4−+ New javascript code generator that uses an higher level intermediate

4++ New JavaScript code generator that uses an higher level intermediate

5 representation.

6−

7++ Various optimizations of the novel JavaScript code generator to make

8+ its results fast.

7+ Names are now annotated with their representations over the IDE

10+ Names are now annotated with their representations over the IDE

8 protocol, which allows IDEs to provide commands that work on special

11 protocol, which allows IDEs to provide commands that work on special

9− names that don't have syntax, such as case block names

12+ names that don't have syntax, such as case block names.

10−

13+

12# New in 1.0

15# New in 1.0

src/IRTS/JavaScript/Codegen.hs+37−37

@@ -89,12 +89,7 @@ isYes _ = False

89codegenJs :: CGConf -> CodeGenerator

90codegenJs conf ci =

91 do

92− optim <- isYes <$> lookupEnv "IDRISJS_OPTIM"

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

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

94− if debug then

95− if optim then putStrLn "compiling width idris-js optimizations"

96− else putStrLn "compiling widthout idris-js optimizations"

97− else pure ()

98 let defs = Map.fromList $ liftDecls ci

93 let defs = Map.fromList $ liftDecls ci

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

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

100 if debug then

95 if debug then

@@ -118,13 +113,16 @@ codegenJs conf ci =

118 TIO.writeFile (outputFile ci) $ T.concat [ header conf

113 TIO.writeFile (outputFile ci) $ T.concat [ header conf

119 , "\"use strict\";\n\n"

114 , "\"use strict\";\n\n"

120 , "(function(){\n\n"

115 , "(function(){\n\n"

116+ -- rts

121 , runtimeCommon, "\n"

117 , runtimeCommon, "\n"

122 , extraRT, "\n"

118 , extraRT, "\n"

123 , jsbn, "\n"

119 , jsbn, "\n"

124− , doPartials (partialApplications stats), "\n"

120+ -- external libraries

125− , doHiddenClasses (hiddenClasses stats), "\n"

126 , includes, "\n"

121 , includes, "\n"

127 , libs, "\n"

122 , libs, "\n"

123+ -- user code

124+ , doPartials (partialApplications stats), "\n"

125+ , doHiddenClasses (hiddenClasses stats), "\n"

128 , out, "\n"

126 , out, "\n"

129 , jsName (sMN 0 "runMain"), "();\n"

127 , jsName (sMN 0 "runMain"), "();\n"

130 , "}.call(this))"

128 , "}.call(this))"

@@ -146,6 +144,7 @@ doHiddenClasses :: Set HiddenClass -> Text

146doHiddenClasses x =

144doHiddenClasses x =

147 T.intercalate "\n" (map f $ Set.toList x)

145 T.intercalate "\n" (map f $ Set.toList x)

148 where

146 where

147+ f p@(HiddenClass n id 0) = jsStmt2Text $ JsDecConst (jsNameHiddenClass p) $ JsObj [("type", JsInt id)]

149 f p@(HiddenClass n id arity) =

148 f p@(HiddenClass n id arity) =

150 let vars = map dataPartName $ take arity [1..]

149 let vars = map dataPartName $ take arity [1..]

151 in jsStmt2Text $

150 in jsStmt2Text $

@@ -360,27 +359,9 @@ cgBody' rt (LApp tailcall (LV (Glob fn)) args) =

360 let ((y1,y2), y3) = tailCallOptimRefreshArgs (zip argN argVals) Set.empty

359 let ((y1,y2), y3) = tailCallOptimRefreshArgs (zip argN argVals) Set.empty

361 addUsedArgsTailCallOptim y3

360 addUsedArgsTailCallOptim y3

362 pure (preDecs, y1 `JsSeq` y2)

361 pure (preDecs, y1 `JsSeq` y2)

363− _ ->

362+ _ -> do

364− do

363+ app <- formApp fn argVals

365− argsFn <- getArgList fn

366− case argsFn of

367− Nothing -> do

368− fn' <- cgName fn

369− pure (preDecs, addRT rt $ jsCurryApp fn' argVals )

370− Just agFn ->

371− do

372− let lenAgFn = length agFn

373− let lenArgs = length args

374− case compare lenAgFn lenArgs of

375− EQ ->

376− pure (preDecs, addRT rt $ jsAppN fname argVals)

364+ pure (preDecs, addRT rt app)

377− LT ->

378− pure (preDecs, addRT rt $ jsCurryApp (jsAppN fname (take lenAgFn argVals)) (drop lenAgFn argVals) )

379− GT ->

380− do

381− let part = Partial fn lenArgs lenAgFn

382− addPartial part

383− pure (preDecs, addRT rt $ jsAppN (jsNamePartial part) argVals )

384

365

385cgBody' rt (LForce (LLazyApp n args)) = cgBody rt (LApp False (LV (Glob n)) args)

366cgBody' rt (LForce (LLazyApp n args)) = cgBody rt (LApp False (LV (Glob n)) args)

386cgBody' rt (LLazyApp n args) =

367cgBody' rt (LLazyApp n args) =

@@ -458,18 +439,36 @@ altHasNoProj :: LAlt -> Bool

458altHasNoProj (LConCase _ _ args _) = args == []

439altHasNoProj (LConCase _ _ args _) = args == []

459altHasNoProj _ = True

440altHasNoProj _ = True

460

441

442+formApp :: Name -> [JsExpr] -> State CGBodyState JsExpr

443+formApp fn argVals = case specialCall fn of

444+ Just (arity, g) | arity == length argVals -> pure $ g argVals

445+ _ -> do

446+ argsFn <- getArgList fn

447+ fname <- cgName fn

448+ case argsFn of

449+ Nothing -> pure $ jsCurryApp fname argVals

450+ Just agFn -> do

451+ let lenAgFn = length agFn

452+ let lenArgs = length argVals

453+ case compare lenAgFn lenArgs of

454+ EQ -> pure $ JsApp fname argVals

455+ LT -> pure $ jsCurryApp (JsApp fname (take lenAgFn argVals)) (drop lenAgFn argVals)

456+ GT -> do

457+ let part = Partial fn lenArgs lenAgFn

458+ addPartial part

459+ pure $ jsAppN (jsNamePartial part) argVals

460+

461formCon :: Name -> [JsExpr] -> State CGBodyState JsExpr

462formCon n args = do

463 case specialCased n of

464 Just (ctor, test, match) -> pure $ ctor args

465 Nothing -> do

466 (conId, arity) <- getConsId n

467− if (arity > 0)

468− then do

469− let hc = HiddenClass n conId arity

467+ let hc = HiddenClass n conId arity

470− addHiddenClass hc

468+ addHiddenClass hc

469+ pure $ if (arity > 0)

471− pure $ JsNew (JsVar $ jsNameHiddenClass hc) args

470+ then JsNew (JsVar $ jsNameHiddenClass hc) args

472− else pure $ JsInt conId

471+ else JsVar $ jsNameHiddenClass hc

473

472

474formConTest :: Name -> JsExpr -> State CGBodyState JsExpr

473formConTest :: Name -> JsExpr -> State CGBodyState JsExpr

475formConTest n x = do

474formConTest n x = do

@@ -477,9 +476,10 @@ formConTest n x = do

477 Just (ctor, test, match) -> pure $ test x

476 Just (ctor, test, match) -> pure $ test x

478 Nothing -> do

477 Nothing -> do

479 (conId, arity) <- getConsId n

478 (conId, arity) <- getConsId n

479+ pure $ JsBinOp "===" (JsProp x (T.pack "type")) (JsInt conId)

480− if (arity > 0)

480+ -- if (arity > 0)

481− then pure $ JsBinOp "===" (JsProp x (T.pack "type")) (JsInt conId)

481+ -- then pure $ JsBinOp "===" (JsProp x (T.pack "type")) (JsInt conId)

482− else pure $ JsBinOp "===" x (JsInt conId)

482+ -- else pure $ JsBinOp "===" x (JsInt conId)

483

484formProj :: Name -> JsExpr -> Int -> JsExpr

485formProj n v i =

src/IRTS/JavaScript/PrimOp.hs+5−5

@@ -37,7 +37,7 @@ primDB =

37 Map.fromList [

38 item (LPlus ATFloat) False PTAny $ binop "+"

39 , item (LPlus (ATInt ITChar)) False PTAny $ JsForeign "String.fromCharCode(%0.charCodeAt(0) + %1.charCodeAt(0))"

40− , item (LPlus (ATInt ITNative)) False PTAny $ JsForeign "%0+%1|0"

40+ , item (LPlus (ATInt ITNative)) False PTAny $ binop "+"

41 , item (LPlus (ATInt (ITFixed IT8))) False PTAny $ JsForeign "%0 + %1 & 0xFF"

42 , item (LPlus (ATInt (ITFixed IT16))) False PTAny $ JsForeign "%0 + %1 & 0xFFFF"

43 , item (LPlus (ATInt (ITFixed IT32))) False PTAny $ JsForeign "%0+%1|0"

@@ -46,7 +46,7 @@ primDB =

46 \[l, r] -> JsForeign "%0.add(%1).and(new $JSRTS.jsbn.BigInteger(%2))" [l,r, JsStr $ show 0xFFFFFFFFFFFFFFFF]

47 , item (LMinus ATFloat) False PTAny $ binop "-"

48 , item (LMinus (ATInt ITChar)) False PTAny $ JsForeign "String.fromCharCode(%0.charCodeAt(0) - %1.charCodeAt(0))"

49− , item (LMinus (ATInt ITNative)) False PTAny $ JsForeign "%0-%1|0"

49+ , item (LMinus (ATInt ITNative)) False PTAny $ binop "-"

50 , item (LMinus (ATInt (ITFixed IT8))) False PTAny $ JsForeign "%0 - %1 & 0xFF"

51 , item (LMinus (ATInt (ITFixed IT16))) False PTAny $ JsForeign "%0 - %1 & 0xFFFF"

52 , item (LMinus (ATInt (ITFixed IT32))) False PTAny $ JsForeign "%0-%1|0"

@@ -55,7 +55,7 @@ primDB =

55 \[l, r] -> JsForeign "%0.subtract(%1).and(new $JSRTS.jsbn.BigInteger(%2))" [l,r, JsStr $ show 0xFFFFFFFFFFFFFFFF]

56 , item (LTimes ATFloat) False PTAny $ binop "*"

57 , item (LTimes (ATInt ITChar)) False PTAny $ JsForeign "String.fromCharCode(%0.charCodeAt(0) * %1.charCodeAt(0))"

58− , item (LTimes (ATInt ITNative)) False PTAny $ JsForeign "%0*%1|0"

58+ , item (LTimes (ATInt ITNative)) False PTAny $ binop "*"

59 , item (LTimes (ATInt (ITFixed IT8))) False PTAny $ JsForeign "%0 * %1 & 0xFF"

60 , item (LTimes (ATInt (ITFixed IT16))) False PTAny $ JsForeign "%0 * %1 & 0xFFFF"

61 , item (LTimes (ATInt (ITFixed IT32))) False PTAny $ JsForeign "%0*%1|0"

@@ -71,14 +71,14 @@ primDB =

71 , item (LSDiv (ATInt (ITFixed IT16))) False PTAny $ JsForeign "%0 / %1"

72 , item (LSDiv (ATInt (ITFixed IT32))) False PTAny $ JsForeign "%0 / %1 |0"

73 , item (LSDiv (ATInt (ITFixed IT64))) True PTAny $ JsForeign "%0.divide(%1)"

74− , item (LSDiv (ATInt ITNative)) False PTAny $ JsForeign "%0/%1|0"

74+ , item (LSDiv (ATInt ITNative)) False PTAny $ JsForeign "%0/%1|0" -- we need "|0" in this

75 , item (LSDiv (ATInt ITBig)) True PTAny $ method "divide"

76 , item (LURem (ITFixed IT8)) False PTAny $ JsForeign "%0 % %1"

77 , item (LURem (ITFixed IT16)) False PTAny $ JsForeign "%0 % %1"

78 , item (LURem (ITFixed IT32)) False PTAny $ JsForeign "(%0>>>0) % (%1>>>0) |0"

79 , item (LURem (ITFixed IT64)) True PTAny $ method "remainder"

80 , item (LSRem ATFloat) False PTAny $ binop "%"

81− , item (LSRem (ATInt ITNative)) False PTAny $ JsForeign "%0 % %1 |0"

81+ , item (LSRem (ATInt ITNative)) False PTAny $ binop "%"

82 , item (LSRem (ATInt (ITFixed IT8))) False PTAny $ JsForeign "%0 % %1"

83 , item (LSRem (ATInt (ITFixed IT16))) False PTAny $ JsForeign "%0 % %1"

84 , item (LSRem (ATInt (ITFixed IT32))) False PTAny $ JsForeign "%0 % %1 |0"

test/README.md+1−1

@@ -132,7 +132,7 @@ for the compatible backends are:

132

133- `ANY`: choose this if your test will work with any code generator

134- `C_CG`: choose this to only test against the C code generator

135−- `JS_CG`: choose this to only test against the Node code generator

135+- `NODE_CG`: choose this to only test against the Node code generator

136- `NONE`: choose this if you don't want your test to be run with multiple code

137generators (mainly for tests that only perform type checking)

138

test/TestData.hs+1

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

127 , ( 7, C_CG )

128 , ( 8, C_CG )

129 , ( 9, C_CG )

130+ , ( 10, NODE_CG )

130 ]),

131 ]),

131 ("folding", "Folding",

132 ("folding", "Folding",

132 [ ( 1, ANY )]),

133 [ ( 1, ANY )]),

test/ffi010/expectednew file+3

@@ -0,0 +1,3 @@

1+start

2+olare

3+end

test/ffi010/ffi010.idrnew file+43

@@ -0,0 +1,43 @@

2+%inline

3+public export

4+jscall : (fname : String) -> (ty : Type) ->

5+ {auto fty : FTy FFI_JS [] ty} -> ty

6+jscall fname ty = foreign FFI_JS fname ty

8+export

9+data ServiceM : Type -> Type where

10+ PureServ : a -> ServiceM a

11+

12+

13+get_jsio : ServiceM a -> JS_IO (Either String a)

14+get_jsio (PureServ x) = do

15+ pure $ Right x

16+

17+export

18+mytst : String -> ServiceM String

19+mytst x = PureServ $ "end"

20+

21+call_fn : (String -> JS_IO String) -> String -> JS_IO String

22+call_fn f x = jscall

23+ "%0(%1)"

24+ ((JsFn (String -> JS_IO String)) -> String -> JS_IO String)

25+ (MkJsFn f)

26+ x

27+

28+mytstJs : String -> JS_IO String

29+mytstJs x = do

30+ r <- get_jsio $ mytst "arst"

31+ case r of

32+ Right k => pure k

33+

34+tst2 : JS_IO String

35+tst2 = call_fn mytstJs "inputmytst"

36+

37+export

38+main : JS_IO ()

39+main = do

40+ putStrLn' "start"

41+ r <- tst2

42+ putStrLn' "olare"

43+ putStrLn' r

test/ffi010/runnew file+4

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

1+#!/usr/bin/env bash

2+${IDRIS:-idris} $@ ffi010.idr -o ffi010

3+./ffi010

4+rm -f ffi010 *.ibc