b1cb65c · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

Merge pull request #374 from raichoo/javascript

Javascript

commitb1cb65c8b906e6afc3ad22c608b680788b785828 authorEdwin Brady <edwin.brady@gmail.com> dateTue 16 Jul 2013, 05:08 (13 years ago) parent0c1deaf e449182

5 files changed+83−92

compare with master

unifiedsplit

js/Runtime-browser.js+1−1 js/Runtime-common.js+16−20 js/Runtime-node.js+1−1 src/IRTS/CodegenJavaScript.hs+65−69 test/Makefile−1

js/Runtime-browser.js+1−1

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

1−__IDRRT__.print = function(s) {

1+var __IDRRT__print = function(s) {

22 console.log(s);

33};

js/Runtime-common.js+16−20

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

1−var __IDRRT__ = {};

2−

31/** @constructor */

4−__IDRRT__.Type = function(type) {

2+var __IDRRT__Type = function(type) {

53 this.type = type;

64};

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

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

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

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

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

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

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

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

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

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

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

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

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

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

1513

1614

1715/** @constructor */

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

19−__IDRRT__.ffiWrap = function(fid) {

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

17+var __IDRRT__ffiWrap = function(fid) {

2018 return function(arg) {

21− return __IDRRT__.tailcall(function(){

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

19+ return __IDRRT__tailcall(function(){

20+ return __IDR__APPLY0(fid, arg);

2321 });

2422 };

2523};

2624

2725/** @constructor */

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

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

2927 this.i = i;

3028 this.vars = vars;

3129};

3230

33−__IDRRT__.tailcall = function(f) {

31+var __IDRRT__tailcall = function(f) {

3432 var __f = f;

3533 var ret;

3634 while (__f) {

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

3836 __f = null;

3937 ret = f();

4038

41− if (ret instanceof __IDRRT__.Tailcall) {

39+ if (ret instanceof __IDRRT__Tailcall) {

4240 __f = ret.f;

4341 } else {

4442 return ret;

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

5048 BigInteger Javascript code taken from:

5149 https://github.com/peterolson

5250*/

53−__IDRRT__.bigInt = (function () {

51+var __IDRRT__bigInt = (function () {

5452 var base = 10000000, logBase = 7;

5553 var sign = {

5654 positive: false,

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

391389 fnReturn.minusOne = MINUS_ONE;

392390 return fnReturn;

393391})();

394−

395−var __IDR__ = {};

js/Runtime-node.js+1−1

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

1−__IDRRT__.print = (function() {

1+var __IDRRT__print = (function() {

22 var util = require('util');

33 return function(s) {

44 util.print(s);

src/IRTS/CodegenJavaScript.hs+65−69

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

2020

2121idrNamespace :: String

2222idrNamespace = "__IDR__"

23+idrRTNamespace = "__IDRRT__"

2324

2425data JSTarget = Node | JavaScript deriving Eq

2526

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

4142 writeFile filename ( header

4243 ++ idrRuntime

4344 ++ tgtRuntime

44− ++ modules

4545 ++ functions

4646 ++ mainLoop)

4747

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

5656

5757 mainLoop :: String

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

59− , createTailcall "__IDR__.runMain0()"

59+ , createTailcall "__IDR__runMain0()"

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

6161 ]

6262

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−

7263translateIdentifier :: String -> String

7364translateIdentifier =

7465 replaceReserved . concatMap replaceBadChars

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

127118 , "yield"

128119 ]

129120

130−translateNamespace :: Name -> [String]

131−translateNamespace (UN _) = [idrNamespace]

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

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

121+translateNamespace :: Name -> String

122+translateNamespace (UN _) = idrNamespace

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

124+translateNamespace (MN _ _) = idrNamespace

134125

135126translateName :: Name -> String

136127translateName (UN name) = translateIdentifier name

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

139130

140131translateConstant :: Const -> String

141132translateConstant (I i) = show i

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

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

143134translateConstant (Fl f) = show f

144135translateConstant (Ch c) = show c

145136translateConstant (Str s) = show s

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

147−translateConstant StrType = "__IDRRT__.String"

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

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

150−translateConstant PtrType = "__IDRRT__.Ptr"

151−translateConstant Forgot = "__IDRRT__.Forgot"

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

138+translateConstant StrType = idrRTNamespace ++ "String"

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

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

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

142+translateConstant PtrType = idrRTNamespace ++ "Ptr"

143+translateConstant Forgot = idrRTNamespace ++ "Forgot"

152144translateConstant c =

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

154146

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

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

158150 translateParameter (UN name) = translateIdentifier name

159151

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

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

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

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

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

163155 ++ " = function("

164156 ++ intercalate "," p

165157 ++ "){\n"

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

205197 createTailcall $ translateFunctionCall name vars

206198

207199translateExpression (SApp True name vars) =

208− "new __IDRRT__.Tailcall("

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

209201 ++ "function(){\n"

210202 ++ "return " ++ translateFunctionCall name vars

211203 ++ ";\n})"

212204

213205translateExpression (SOp op vars)

214− | (LPlus _) <- op

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

216− | (LMinus _) <- op

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

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

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

207+

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

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

246210

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

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

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

284248 | (LGe ATFloat) <- op

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

286250

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+

287284 | LStrConcat <- op

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

289286 | LStrEq <- op

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

298295 | (LIntStr ITNative) <- op

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

300297 | (LSExt ITNative ITBig) <- op

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

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

302299 | (LTrunc ITBig ITNative) <- op

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

304301 | (LIntStr ITBig) <- op

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

306303 | (LStrInt ITBig) <- op

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

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

308305 | LFloatStr <- op

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

310307 | LStrFloat <- op

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

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

368365

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

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

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

371368

372369translateExpression (SForeign _ _ fun args)

373370 | "[]=" `isSuffixOf` fun

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

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

424421

425422 generateWrapper (ffunc, name)

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

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

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

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

428425

429426 generateWrapper (_, name) =

430427 translateVariableName name

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

444441 ++ ")"

445442

446443translateExpression (SCon i name vars) =

447− concat [ "new __IDRRT__.Con("

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

448445 , show i

449446 , ",["

450447 , intercalate "," $ map translateVariableName vars

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

480477 matchHelper tyName = translateTypeMatch var tyName e

481478

482479translateCase 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

484481 createIfBlock cond (translateExpression e)

485482

486483translateCase var (SConstCase cst e) =

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

488485 createIfBlock cond (translateExpression e)

489486

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

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

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

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

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

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

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

503500translateTypeMatch var ty exp =

504501 let e = translateExpression exp in

505502 createIfBlock (var

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

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

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

508505

509506

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

513510 ++ ";\n}"

514511

515512createTailcall call =

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

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

517514

518515translateFunctionCall name vars =

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

520− ++ "."

516+ translateNamespace name

521517 ++ translateName name

522518 ++ "("

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

test/Makefile−1

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

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

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

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

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

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

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

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