b1cb65c · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

on master help sign in

Merge pull request #374 from raichoo/javascript

b1cb65cEdwin Brady13 years ago

js/Runtime-browser.js+1−1

compare with master

unifiedsplit

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

1−__IDRRT__.print = function(s) {

1+var __IDRRT__print = function(s) {

2 console.log(s);

3};

js/Runtime-common.js+16−20

@@ -1,36 +1,34 @@

1−var __IDRRT__ = {};

2−

3/** @constructor */

1/** @constructor */

4−__IDRRT__.Type = function(type) {

2+var __IDRRT__Type = function(type) {

5 this.type = type;

3 this.type = type;

6};

4};

8−__IDRRT__.Int = new __IDRRT__.Type('Int');

6+var __IDRRT__Int = new __IDRRT__Type('Int');

9−__IDRRT__.Char = new __IDRRT__.Type('Char');

7+var __IDRRT__Char = new __IDRRT__Type('Char');

10−__IDRRT__.String = new __IDRRT__.Type('String');

8+var __IDRRT__String = new __IDRRT__Type('String');

11−__IDRRT__.Integer = new __IDRRT__.Type('Integer');

9+var __IDRRT__Integer = new __IDRRT__Type('Integer');

12−__IDRRT__.Float = new __IDRRT__.Type('Float');

10+var __IDRRT__Float = new __IDRRT__Type('Float');

13−__IDRRT__.Ptr = new __IDRRT__.Type('Pointer');

11+var __IDRRT__Ptr = new __IDRRT__Type('Pointer');

14−__IDRRT__.Forgot = new __IDRRT__.Type('Forgot');

12+var __IDRRT__Forgot = new __IDRRT__Type('Forgot');

17/** @constructor */

15/** @constructor */

18−__IDRRT__.Tailcall = function(f) { this.f = f };

16+var __IDRRT__Tailcall = function(f) { this.f = f };

19−__IDRRT__.ffiWrap = function(fid) {

17+var __IDRRT__ffiWrap = function(fid) {

20 return function(arg) {

18 return function(arg) {

21− return __IDRRT__.tailcall(function(){

19+ return __IDRRT__tailcall(function(){

22− return __IDR__.APPLY0(fid, arg);

20+ return __IDR__APPLY0(fid, arg);

23 });

21 });

24 };

22 };

25};

23};

27/** @constructor */

25/** @constructor */

28−__IDRRT__.Con = function(i,vars) {

26+var __IDRRT__Con = function(i,vars) {

29 this.i = i;

27 this.i = i;

30 this.vars = vars;

28 this.vars = vars;

31};

29};

33−__IDRRT__.tailcall = function(f) {

31+var __IDRRT__tailcall = function(f) {

34 var __f = f;

32 var __f = f;

35 var ret;

33 var ret;

36 while (__f) {

34 while (__f) {

@@ -38,7 +36,7 @@ __IDRRT__.tailcall = function(f) {

38 __f = null;

36 __f = null;

39 ret = f();

37 ret = f();

41− if (ret instanceof __IDRRT__.Tailcall) {

39+ if (ret instanceof __IDRRT__Tailcall) {

42 __f = ret.f;

40 __f = ret.f;

43 } else {

41 } else {

44 return ret;

42 return ret;

@@ -50,7 +48,7 @@ __IDRRT__.tailcall = function(f) {

50 BigInteger Javascript code taken from:

48 BigInteger Javascript code taken from:

51 https://github.com/peterolson

49 https://github.com/peterolson

52*/

50*/

53−__IDRRT__.bigInt = (function () {

51+var __IDRRT__bigInt = (function () {

54 var base = 10000000, logBase = 7;

52 var base = 10000000, logBase = 7;

55 var sign = {

53 var sign = {

56 positive: false,

54 positive: false,

@@ -391,5 +389,3 @@ __IDRRT__.bigInt = (function () {

391 fnReturn.minusOne = MINUS_ONE;

389 fnReturn.minusOne = MINUS_ONE;

392 return fnReturn;

390 return fnReturn;

393})();

391})();

394−

395−var __IDR__ = {};

js/Runtime-node.js+1−1

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

1−__IDRRT__.print = (function() {

1+var __IDRRT__print = (function() {

2 var util = require('util');

3 return function(s) {

4 util.print(s);

src/IRTS/CodegenJavaScript.hs+65−69

@@ -20,6 +20,7 @@ import System.Directory

21idrNamespace :: String

22idrNamespace = "__IDR__"

23+idrRTNamespace = "__IDRRT__"

24data JSTarget = Node | JavaScript deriving Eq

25data JSTarget = Node | JavaScript deriving Eq

@@ -41,7 +42,6 @@ codegenJavaScript target definitions filename outputType = do

41 writeFile filename ( header

42 writeFile filename ( header

42 ++ idrRuntime

43 ++ idrRuntime

43 ++ tgtRuntime

44 ++ tgtRuntime

44− ++ modules

45 ++ functions

46 ++ mainLoop)

@@ -56,19 +56,10 @@ codegenJavaScript target definitions filename outputType = do

57 mainLoop :: String

58 mainLoop = intercalate "\n" [ "\nfunction main() {"

59− , createTailcall "__IDR__.runMain0()"

59+ , createTailcall "__IDR__runMain0()"

60 , "}\n\nmain();\n"

61 ]

63− modules =

64− concatMap allocMod mods

65− where

66− allocMod m = intercalate "." m ++ " = {};\n"

67− sortMods a b = compare (length a) (length b)

68−

69− mods =

70− drop 1 $ sortBy sortMods $ nub $ concatMap (inits . fst) def

71−

72translateIdentifier :: String -> String

63translateIdentifier :: String -> String

73translateIdentifier =

64translateIdentifier =

74 replaceReserved . concatMap replaceBadChars

65 replaceReserved . concatMap replaceBadChars

@@ -127,10 +118,10 @@ translateIdentifier =

127 , "yield"

118 , "yield"

128 ]

119 ]

129

120

130−translateNamespace :: Name -> [String]

121+translateNamespace :: Name -> String

131−translateNamespace (UN _) = [idrNamespace]

122+translateNamespace (UN _) = idrNamespace

132−translateNamespace (NS _ ns) = idrNamespace : map translateIdentifier ns

123+translateNamespace (NS _ ns) = idrNamespace ++ concatMap translateIdentifier ns

133−translateNamespace (MN _ _) = [idrNamespace]

124+translateNamespace (MN _ _) = idrNamespace

134

125

135translateName :: Name -> String

126translateName :: Name -> String

136translateName (UN name) = translateIdentifier name

127translateName (UN name) = translateIdentifier name

@@ -139,16 +130,17 @@ translateName (MN i name) = translateIdentifier name ++ show i

139

130

140translateConstant :: Const -> String

131translateConstant :: Const -> String

141translateConstant (I i) = show i

132translateConstant (I i) = show i

142−translateConstant (BI i) = "__IDRRT__.bigInt('" ++ show i ++ "')"

133+translateConstant (BI i) = idrRTNamespace ++ "bigInt('" ++ show i ++ "')"

143translateConstant (Fl f) = show f

134translateConstant (Fl f) = show f

144translateConstant (Ch c) = show c

135translateConstant (Ch c) = show c

145translateConstant (Str s) = show s

136translateConstant (Str s) = show s

146−translateConstant (AType (ATInt ITNative)) = "__IDRRT__.Int"

137+translateConstant (AType (ATInt ITNative)) = idrRTNamespace ++ "Int"

147−translateConstant StrType = "__IDRRT__.String"

138+translateConstant StrType = idrRTNamespace ++ "String"

148−translateConstant (AType (ATInt ITBig)) = "__IDRRT__.Integer"

139+translateConstant (AType (ATInt ITBig)) = idrRTNamespace ++ "Integer"

149−translateConstant (AType ATFloat) = "__IDRRT__.Float"

140+translateConstant (AType ATFloat) = idrRTNamespace ++ "Float"

150−translateConstant PtrType = "__IDRRT__.Ptr"

141+translateConstant (AType (ATInt ITChar)) = idrRTNamespace ++ "Char"

142+translateConstant PtrType = idrRTNamespace ++ "Ptr"

151−translateConstant Forgot = "__IDRRT__.Forgot"

143+translateConstant Forgot = idrRTNamespace ++ "Forgot"

152translateConstant c =

144translateConstant c =

153 "(function(){throw 'Unimplemented Const: " ++ show c ++ "';})()"

145 "(function(){throw 'Unimplemented Const: " ++ show c ++ "';})()"

154

146

@@ -157,9 +149,9 @@ translateParameterlist =

157 where translateParameter (MN i name) = translateIdentifier name ++ show i

149 where translateParameter (MN i name) = translateIdentifier name ++ show i

158 translateParameter (UN name) = translateIdentifier name

150 translateParameter (UN name) = translateIdentifier name

159

151

160−translateDeclaration :: ([String], SDecl) -> String

152+translateDeclaration :: (String, SDecl) -> String

161translateDeclaration (path, SFun name params stackSize body) =

153translateDeclaration (path, SFun name params stackSize body) =

162− intercalate "." (path ++ [translateName name])

154+ "var " ++ path ++ translateName name

163 ++ " = function("

155 ++ " = function("

164 ++ intercalate "," p

156 ++ intercalate "," p

165 ++ "){\n"

157 ++ "){\n"

@@ -205,44 +197,16 @@ translateExpression (SApp False name vars) =

205 createTailcall $ translateFunctionCall name vars

197 createTailcall $ translateFunctionCall name vars

206

198

207translateExpression (SApp True name vars) =

199translateExpression (SApp True name vars) =

208− "new __IDRRT__.Tailcall("

200+ "new " ++ idrRTNamespace ++ "Tailcall("

209 ++ "function(){\n"

201 ++ "function(){\n"

210 ++ "return " ++ translateFunctionCall name vars

202 ++ "return " ++ translateFunctionCall name vars

211 ++ ";\n})"

203 ++ ";\n})"

212

204

213translateExpression (SOp op vars)

205translateExpression (SOp op vars)

214− | (LPlus _) <- op

206+ | LNoOp <- op = translateVariableName (last vars)

215− , (lhs:rhs:_) <- vars = translateBinaryOp "+" lhs rhs

207+

216− | (LMinus _) <- op

208+ | (LZExt _ ITBig) <- op =

217− , (lhs:rhs:_) <- vars = translateBinaryOp "-" lhs rhs

209+ idrRTNamespace ++ "bigInt(" ++ translateVariableName (last vars) ++ ")"

218− | (LTimes _) <- op

219− , (lhs:rhs:_) <- vars = translateBinaryOp "*" lhs rhs

220− | (LSDiv _) <- op

221− , (lhs:rhs:_) <- vars = translateBinaryOp "/" lhs rhs

222− | (LSRem _) <- op

223− , (lhs:rhs:_) <- vars = translateBinaryOp "%" lhs rhs

224− | (LEq _) <- op

225− , (lhs:rhs:_) <- vars = translateBinaryOp "==" lhs rhs

226− | (LLt _) <- op

227− , (lhs:rhs:_) <- vars = translateBinaryOp "<" lhs rhs

228− | (LLe _) <- op

229− , (lhs:rhs:_) <- vars = translateBinaryOp "<=" lhs rhs

230− | (LGt _) <- op

231− , (lhs:rhs:_) <- vars = translateBinaryOp ">" lhs rhs

232− | (LGe _) <- op

233− , (lhs:rhs:_) <- vars = translateBinaryOp ">=" lhs rhs

234− | (LAnd _) <- op

235− , (lhs:rhs:_) <- vars = translateBinaryOp "&" lhs rhs

236− | (LOr _) <- op

237− , (lhs:rhs:_) <- vars = translateBinaryOp "|" lhs rhs

238− | (LXOr _) <- op

239− , (lhs:rhs:_) <- vars = translateBinaryOp "^" lhs rhs

240− | (LSHL _) <- op

241− , (lhs:rhs:_) <- vars = translateBinaryOp "<<" rhs lhs

242− | (LASHR _) <- op

243− , (lhs:rhs:_) <- vars = translateBinaryOp ">>" rhs lhs

244− | (LCompl _) <- op

245− , (arg:_) <- vars = '~' : translateVariableName arg

246

210

247 | (LPlus (ATInt ITBig)) <- op

211 | (LPlus (ATInt ITBig)) <- op

248 , (lhs:rhs:_) <- vars = translateBinaryOp ".add(" lhs rhs ++ ")"

212 , (lhs:rhs:_) <- vars = translateBinaryOp ".add(" lhs rhs ++ ")"

@@ -284,6 +248,39 @@ translateExpression (SOp op vars)

284 | (LGe ATFloat) <- op

248 | (LGe ATFloat) <- op

285 , (lhs:rhs:_) <- vars = translateBinaryOp ">=" lhs rhs

249 , (lhs:rhs:_) <- vars = translateBinaryOp ">=" lhs rhs

286

250

251+ | (LPlus _) <- op

252+ , (lhs:rhs:_) <- vars = translateBinaryOp "+" lhs rhs

253+ | (LMinus _) <- op

254+ , (lhs:rhs:_) <- vars = translateBinaryOp "-" lhs rhs

255+ | (LTimes _) <- op

256+ , (lhs:rhs:_) <- vars = translateBinaryOp "*" lhs rhs

257+ | (LSDiv _) <- op

258+ , (lhs:rhs:_) <- vars = translateBinaryOp "/" lhs rhs

259+ | (LSRem _) <- op

260+ , (lhs:rhs:_) <- vars = translateBinaryOp "%" lhs rhs

261+ | (LEq _) <- op

262+ , (lhs:rhs:_) <- vars = translateBinaryOp "==" lhs rhs

263+ | (LLt _) <- op

264+ , (lhs:rhs:_) <- vars = translateBinaryOp "<" lhs rhs

265+ | (LLe _) <- op

266+ , (lhs:rhs:_) <- vars = translateBinaryOp "<=" lhs rhs

267+ | (LGt _) <- op

268+ , (lhs:rhs:_) <- vars = translateBinaryOp ">" lhs rhs

269+ | (LGe _) <- op

270+ , (lhs:rhs:_) <- vars = translateBinaryOp ">=" lhs rhs

271+ | (LAnd _) <- op

272+ , (lhs:rhs:_) <- vars = translateBinaryOp "&" lhs rhs

273+ | (LOr _) <- op

274+ , (lhs:rhs:_) <- vars = translateBinaryOp "|" lhs rhs

275+ | (LXOr _) <- op

276+ , (lhs:rhs:_) <- vars = translateBinaryOp "^" lhs rhs

277+ | (LSHL _) <- op

278+ , (lhs:rhs:_) <- vars = translateBinaryOp "<<" rhs lhs

279+ | (LASHR _) <- op

280+ , (lhs:rhs:_) <- vars = translateBinaryOp ">>" rhs lhs

281+ | (LCompl _) <- op

282+ , (arg:_) <- vars = '~' : translateVariableName arg

283+

287 | LStrConcat <- op

284 | LStrConcat <- op

288 , (lhs:rhs:_) <- vars = translateBinaryOp "+" lhs rhs

285 , (lhs:rhs:_) <- vars = translateBinaryOp "+" lhs rhs

289 | LStrEq <- op

286 | LStrEq <- op

@@ -298,13 +295,13 @@ translateExpression (SOp op vars)

298 | (LIntStr ITNative) <- op

295 | (LIntStr ITNative) <- op

299 , (arg:_) <- vars = "String(" ++ translateVariableName arg ++ ")"

296 , (arg:_) <- vars = "String(" ++ translateVariableName arg ++ ")"

300 | (LSExt ITNative ITBig) <- op

297 | (LSExt ITNative ITBig) <- op

301− , (arg:_) <- vars = "__IDRRT__.bigInt(" ++ translateVariableName arg ++ ")"

298+ , (arg:_) <- vars = idrRTNamespace ++ "bigInt(" ++ translateVariableName arg ++ ")"

302 | (LTrunc ITBig ITNative) <- op

299 | (LTrunc ITBig ITNative) <- op

303 , (arg:_) <- vars = translateVariableName arg ++ ".valueOf()"

300 , (arg:_) <- vars = translateVariableName arg ++ ".valueOf()"

304 | (LIntStr ITBig) <- op

301 | (LIntStr ITBig) <- op

305 , (arg:_) <- vars = translateVariableName arg ++ ".toString()"

302 , (arg:_) <- vars = translateVariableName arg ++ ".toString()"

306 | (LStrInt ITBig) <- op

303 | (LStrInt ITBig) <- op

307− , (arg:_) <- vars = "__IDRRT__.bigInt(" ++ translateVariableName arg ++ ")"

304+ , (arg:_) <- vars = idrRTNamespace ++ "bigInt(" ++ translateVariableName arg ++ ")"

308 | LFloatStr <- op

305 | LFloatStr <- op

309 , (arg:_) <- vars = "String(" ++ translateVariableName arg ++ ")"

306 , (arg:_) <- vars = "String(" ++ translateVariableName arg ++ ")"

310 | LStrFloat <- op

307 | LStrFloat <- op

@@ -367,7 +364,7 @@ translateExpression (SError msg) =

367 "(function(){throw \'" ++ msg ++ "\';})()"

364 "(function(){throw \'" ++ msg ++ "\';})()"

368

365

369translateExpression (SForeign _ _ "putStr" [(FString, var)]) =

366translateExpression (SForeign _ _ "putStr" [(FString, var)]) =

370− "__IDRRT__.print(" ++ translateVariableName var ++ ")"

367+ idrRTNamespace ++ "print(" ++ translateVariableName var ++ ")"

371

368

372translateExpression (SForeign _ _ fun args)

369translateExpression (SForeign _ _ fun args)

373 | "[]=" `isSuffixOf` fun

370 | "[]=" `isSuffixOf` fun

@@ -423,8 +420,8 @@ translateExpression (SForeign _ _ fun args)

423 '(' : intercalate "," (map generateWrapper as) ++ ")"

420 '(' : intercalate "," (map generateWrapper as) ++ ")"

424

421

425 generateWrapper (ffunc, name)

422 generateWrapper (ffunc, name)

426− | FFunction <- ffunc = "__IDRRT__.ffiWrap(" ++ translateVariableName name ++ ")"

423+ | FFunction <- ffunc = idrRTNamespace ++ "ffiWrap(" ++ translateVariableName name ++ ")"

427− | FFunctionIO <- ffunc = "__IDRRT__.ffiWrap(" ++ translateVariableName name ++ ")"

424+ | FFunctionIO <- ffunc = idrRTNamespace ++ "ffiWrap(" ++ translateVariableName name ++ ")"

428

425

429 generateWrapper (_, name) =

426 generateWrapper (_, name) =

430 translateVariableName name

427 translateVariableName name

@@ -444,7 +441,7 @@ translateExpression (SCase var cases) =

444 ++ ")"

441 ++ ")"

445

442

446translateExpression (SCon i name vars) =

443translateExpression (SCon i name vars) =

447− concat [ "new __IDRRT__.Con("

444+ concat [ "new " ++ idrRTNamespace ++ "Con("

448 , show i

445 , show i

449 , ",["

446 , ",["

450 , intercalate "," $ map translateVariableName vars

447 , intercalate "," $ map translateVariableName vars

@@ -480,7 +477,7 @@ translateCase var (SConstCase ty e)

480 matchHelper tyName = translateTypeMatch var tyName e

477 matchHelper tyName = translateTypeMatch var tyName e

481

478

482translateCase var (SConstCase cst@(BI _) e) =

479translateCase var (SConstCase cst@(BI _) e) =

483− let cond = "__IDRRT__.bigInt(" ++ var ++ ").equals(" ++ translateConstant cst ++ ")" in

480+ let cond = idrRTNamespace ++ "bigInt(" ++ var ++ ").equals(" ++ translateConstant cst ++ ")" in

484 createIfBlock cond (translateExpression e)

481 createIfBlock cond (translateExpression e)

485

482

486translateCase var (SConstCase cst e) =

483translateCase var (SConstCase cst e) =

@@ -488,7 +485,7 @@ translateCase var (SConstCase cst e) =

488 createIfBlock cond (translateExpression e)

485 createIfBlock cond (translateExpression e)

489

486

490translateCase var (SConCase a i name vars e) =

487translateCase var (SConCase a i name vars e) =

491− let isCon = var ++ " instanceof __IDRRT__.Con"

488+ let isCon = var ++ " instanceof " ++ idrRTNamespace ++ "Con"

492 isI = show i ++ " == " ++ var ++ ".i"

489 isI = show i ++ " == " ++ var ++ ".i"

493 params = intercalate "," $ map (("__var_" ++) . show) [a..(a+length vars)]

490 params = intercalate "," $ map (("__var_" ++) . show) [a..(a+length vars)]

494 args = ".apply(this," ++ var ++ ".vars)"

491 args = ".apply(this," ++ var ++ ".vars)"

@@ -503,7 +500,7 @@ translateTypeMatch :: String -> String -> SExp -> String

503translateTypeMatch var ty exp =

500translateTypeMatch var ty exp =

504 let e = translateExpression exp in

501 let e = translateExpression exp in

505 createIfBlock (var

502 createIfBlock (var

506− ++ " instanceof __IDRRT__.Type && "

503+ ++ " instanceof " ++ idrRTNamespace ++ "Type && "

507 ++ var ++ ".type == '"++ ty ++"'") e

504 ++ var ++ ".type == '"++ ty ++"'") e

508

505

509

506

@@ -513,11 +510,10 @@ createIfBlock cond e =

513 ++ ";\n}"

510 ++ ";\n}"

514

511

515createTailcall call =

512createTailcall call =

516− "__IDRRT__.tailcall(function(){return " ++ call ++ "})"

513+ idrRTNamespace ++ "tailcall(function(){return " ++ call ++ "})"

517

514

518translateFunctionCall name vars =

515translateFunctionCall name vars =

519− concat (intersperse "." $ translateNamespace name)

516+ translateNamespace name

520− ++ "."

521 ++ translateName name

517 ++ translateName name

522 ++ "("

518 ++ "("

523 ++ intercalate "," (map translateVariableName vars)

519 ++ intercalate "," (map translateVariableName vars)

test/Makefile−1

@@ -9,7 +9,6 @@ test_js:

9 @perl ./runtest.pl reg002 --codegen node

10 @perl ./runtest.pl reg003 --codegen node

11 @perl ./runtest.pl reg004 --codegen node

12− @perl ./runtest.pl reg004 --codegen node

13 @perl ./runtest.pl reg005 --codegen node

12 @perl ./runtest.pl reg005 --codegen node

14 @perl ./runtest.pl reg006 --codegen node

13 @perl ./runtest.pl reg006 --codegen node

15 @perl ./runtest.pl reg007 --codegen node

14 @perl ./runtest.pl reg007 --codegen node