7e329c9 · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

on master help sign in

Merge pull request #1340 from raichoo/javascript

7e329c9raichoo12 years ago

jsrts/Runtime-common.js−1

compare with master

unifiedsplit

@@ -5,7 +5,6 @@ var i$VM = function() {

5 this.valstack_base = 0;

7 this.ret = null;

8− this.reg1 = null;

10 this.callstack = [];

9 this.callstack = [];

11}

10}

jsrts/jsbn/jsbn.js+3−3

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

1−var __IDRRT__bigInt = (function() {

1+var i$bigInt = (function() {

4// See "LICENSE" for details.

@@ -1234,5 +1234,5 @@ return function(val) {

1234}

1235})();

1236

1237−var __IDRRT__ZERO = __IDRRT__bigInt("0");

1237+var i$ZERO = i$bigInt("0");

1238−var __IDRRT__ONE = __IDRRT__bigInt("1");

1238+var i$ONE = i$bigInt("1");

src/IRTS/CodegenJavaScript.hs+36−41

@@ -24,12 +24,6 @@ import System.IO

24import System.Directory

27−idrNamespace :: String

28−idrNamespace = "__IDR__"

29−idrRTNamespace = "__IDRRT__"

30−idrLTNamespace = "__IDRLT__"

31−idrCTRNamespace = "__IDRCTR__"

32−

33data CompileInfo = CompileInfo { compileInfoApplyCases :: [Int]

27data CompileInfo = CompileInfo { compileInfoApplyCases :: [Int]

34 , compileInfoEvalCases :: [Int]

28 , compileInfoEvalCases :: [Int]

35 , compileInfoNeedsBigInt :: Bool

29 , compileInfoNeedsBigInt :: Bool

@@ -44,16 +38,16 @@ initCompileInfo bc =

44 lookupBigInt = any (needsBigInt . snd)

38 lookupBigInt = any (needsBigInt . snd)

45 where

39 where

46 needsBigInt :: [BC] -> Bool

40 needsBigInt :: [BC] -> Bool

47− needsBigInt bc = any id $ map testBCForBigInt bc

41+ needsBigInt bc = or $ map testBCForBigInt bc

48 where

42 where

49 testBCForBigInt :: BC -> Bool

43 testBCForBigInt :: BC -> Bool

50 testBCForBigInt (ASSIGNCONST _ c) =

44 testBCForBigInt (ASSIGNCONST _ c) =

51 testConstForBigInt c

45 testConstForBigInt c

53 testBCForBigInt (CONSTCASE _ c d) =

47 testBCForBigInt (CONSTCASE _ c d) =

54− (maybe False needsBigInt d)

48+ maybe False needsBigInt d

55− || (any id $ map (needsBigInt . snd) c)

49+ || (or $ map (needsBigInt . snd) c)

56− || (any id $ map (testConstForBigInt . fst) c)

50+ || (or $ map (testConstForBigInt . fst) c)

58 testBCForBigInt _ = False

52 testBCForBigInt _ = False

@@ -171,7 +165,7 @@ ffi code args = let parsed = ffiParse code in

171 | isDigit s =

165 | isDigit s =

172 FFIArg (read $ s : takeWhile isDigit ss) : ffiParse (dropWhile isDigit ss)

166 FFIArg (read $ s : takeWhile isDigit ss) : ffiParse (dropWhile isDigit ss)

173 | otherwise =

167 | otherwise =

174− [FFIError $ "FFI - Invalid positional argument"]

168+ [FFIError "FFI - Invalid positional argument"]

175 ffiParse (s:ss) = FFICode s : ffiParse ss

169 ffiParse (s:ss) = FFICode s : ffiParse ss

176

170

177

171

@@ -183,8 +177,8 @@ ffi code args = let parsed = ffiParse code in

183

177

184 renderFFI :: [FFI] -> [String] -> String

178 renderFFI :: [FFI] -> [String] -> String

185 renderFFI [] _ = ""

179 renderFFI [] _ = ""

186− renderFFI ((FFICode c) : fs) args = c : renderFFI fs args

180+ renderFFI (FFICode c : fs) args = c : renderFFI fs args

187− renderFFI ((FFIArg i) : fs) args

181+ renderFFI (FFIArg i : fs) args

188 | i < length args && i >= 0 = args !! i ++ renderFFI fs args

182 | i < length args && i >= 0 = args !! i ++ renderFFI fs args

189 | otherwise = error "FFI - Argument index out of bounds"

183 | otherwise = error "FFI - Argument index out of bounds"

190

184

@@ -214,18 +208,18 @@ compileJS' indent (JSFunction args body) =

214 ++ "\n}\n"

208 ++ "\n}\n"

215

209

216compileJS' indent (JSType ty)

210compileJS' indent (JSType ty)

217− | JSIntTy <- ty = idrRTNamespace ++ "Int"

211+ | JSIntTy <- ty = "i$Int"

218− | JSStringTy <- ty = idrRTNamespace ++ "String"

212+ | JSStringTy <- ty = "i$String"

219− | JSIntegerTy <- ty = idrRTNamespace ++ "Integer"

213+ | JSIntegerTy <- ty = "i$Integer"

220− | JSFloatTy <- ty = idrRTNamespace ++ "Float"

214+ | JSFloatTy <- ty = "i$Float"

221− | JSCharTy <- ty = idrRTNamespace ++ "Char"

215+ | JSCharTy <- ty = "i$Char"

222− | JSPtrTy <- ty = idrRTNamespace ++ "Ptr"

216+ | JSPtrTy <- ty = "i$Ptr"

223− | JSForgotTy <- ty = idrRTNamespace ++ "Forgot"

217+ | JSForgotTy <- ty = "i$Forgot"

224

218

225compileJS' indent (JSSeq seq) =

219compileJS' indent (JSSeq seq) =

226 intercalate ";\n" (

220 intercalate ";\n" (

227 map (

221 map (

228− ((replicate indent ' ') ++) . (compileJS' indent)

222+ (replicate indent ' ' ++) . (compileJS' indent)

229 ) $ filter (/= JSNoop) seq

223 ) $ filter (/= JSNoop) seq

230 ) ++ ";"

224 ) ++ ";"

231

225

@@ -284,10 +278,10 @@ compileJS' indent (JSString str) =

284compileJS' indent (JSNum num)

278compileJS' indent (JSNum num)

285 | JSInt i <- num = show i

279 | JSInt i <- num = show i

286 | JSFloat f <- num = show f

280 | JSFloat f <- num = show f

287− | JSInteger JSBigZero <- num = "__IDRRT__ZERO"

281+ | JSInteger JSBigZero <- num = "i$ZERO"

288− | JSInteger JSBigOne <- num = "__IDRRT__ONE"

282+ | JSInteger JSBigOne <- num = "i$ONE"

289 | JSInteger (JSBigInt i) <- num = show i

283 | JSInteger (JSBigInt i) <- num = show i

290− | JSInteger (JSBigIntExpr e) <- num = "__IDRRT__bigInt(" ++ compileJS' indent e ++ ")"

284+ | JSInteger (JSBigIntExpr e) <- num = "i$bigInt(" ++ compileJS' indent e ++ ")"

291

285

292compileJS' indent (JSAssign lhs rhs) =

286compileJS' indent (JSAssign lhs rhs) =

293 compileJS' indent lhs ++ " = " ++ compileJS' indent rhs

287 compileJS' indent lhs ++ " = " ++ compileJS' indent rhs

@@ -318,14 +312,16 @@ compileJS' indent (JSCond branches) =

318 ++ replicate (indent + 2) ' ' ++ compileJS' (indent + 2) e

312 ++ replicate (indent + 2) ' ' ++ compileJS' (indent + 2) e

319 ++ ";\n" ++ replicate indent ' ' ++ "}"

313 ++ ";\n" ++ replicate indent ' ' ++ "}"

320

314

321−compileJS' indent (JSSwitch val [(_,seq)] Nothing) =

315+compileJS' indent (JSSwitch val [(_,JSSeq seq)] Nothing) =

316+ let (h,t) = splitAt 1 seq in

322− compileJS' indent seq

317+ (concatMap (compileJS' indent) h ++ ";\n")

318+ ++ (intercalate ";\n" $ map ((replicate indent ' ' ++) . compileJS' indent) t)

323

319

324compileJS' indent (JSSwitch val branches def) =

320compileJS' indent (JSSwitch val branches def) =

325 "switch(" ++ compileJS' indent val ++ "){\n"

321 "switch(" ++ compileJS' indent val ++ "){\n"

326 ++ concatMap mkBranch branches

322 ++ concatMap mkBranch branches

327 ++ mkDefault def

323 ++ mkDefault def

328− ++ (replicate indent ' ') ++ "}"

324+ ++ replicate indent ' ' ++ "}"

329 where

325 where

330 mkBranch :: (JS, JS) -> String

326 mkBranch :: (JS, JS) -> String

331 mkBranch (tag, code) =

327 mkBranch (tag, code) =

@@ -359,7 +355,7 @@ compileJS' indent (JSWord word)

359 | JSWord8 b <- word = "new Uint8Array([" ++ show b ++ "])"

355 | JSWord8 b <- word = "new Uint8Array([" ++ show b ++ "])"

360 | JSWord16 b <- word = "new Uint16Array([" ++ show b ++ "])"

356 | JSWord16 b <- word = "new Uint16Array([" ++ show b ++ "])"

361 | JSWord32 b <- word = "new Uint32Array([" ++ show b ++ "])"

357 | JSWord32 b <- word = "new Uint32Array([" ++ show b ++ "])"

362− | JSWord64 b <- word = idrRTNamespace ++ "bigInt(\"" ++ show b ++ "\")"

358+ | JSWord64 b <- word = "i$bigInt(\"" ++ show b ++ "\")"

363

359

364codegenJavaScript :: CodeGenerator

360codegenJavaScript :: CodeGenerator

365codegenJavaScript ci =

361codegenJavaScript ci =

@@ -404,9 +400,9 @@ codegenJS_all target definitions includes libs filename outputType = do

404 )

400 )

405 writeFile filename $ runtime ++ concat code ++ main ++ invokeMain

401 writeFile filename $ runtime ++ concat code ++ main ++ invokeMain

406 setPermissions filename (emptyPermissions { readable = True

402 setPermissions filename (emptyPermissions { readable = True

407− , executable = target == Node

403+ , executable = target == Node

408− , writable = True

404+ , writable = True

409− })

405+ })

410 where

406 where

411 includeLibs :: [String] -> String

407 includeLibs :: [String] -> String

412 includeLibs =

408 includeLibs =

@@ -494,15 +490,15 @@ splitFunction (JSAlloc name (Just (JSFunction args body@(JSSeq _)))) = do

494 where

490 where

495 processBranches :: [(JS,JS)] -> RWS () [(Int,JS)] Int [(JS,JS)]

491 processBranches :: [(JS,JS)] -> RWS () [(Int,JS)] Int [(JS,JS)]

496 processBranches =

492 processBranches =

497− traverse (runKleisli (arr id *** (Kleisli splitSequence)))

493+ traverse (runKleisli (arr id *** Kleisli splitSequence))

498

494

499 splitSequence :: JS -> RWS () [(Int, JS)] Int JS

495 splitSequence :: JS -> RWS () [(Int, JS)] Int JS

500− splitSequence js@(JSSeq seq) = do

496+ splitSequence js@(JSSeq seq) =

501 let (pre,post) = break isCall seq in

497 let (pre,post) = break isCall seq in

502 case post of

498 case post of

503 [] -> JSSeq <$> traverse splitCondition seq

499 [] -> JSSeq <$> traverse splitCondition seq

504 [js@(JSCond _)] -> splitCondition js

500 [js@(JSCond _)] -> splitCondition js

505− [js@(JSSwitch _ _ _)] -> splitCondition js

501+ [js@(JSSwitch {})] -> splitCondition js

506 [_] -> return js

502 [_] -> return js

507 (call:rest) -> do

503 (call:rest) -> do

508 depth <- get

504 depth <- get

@@ -572,7 +568,7 @@ translateDecl info (name@(MN 0 fun), bc)

572

568

573 isCase :: BC -> Bool

569 isCase :: BC -> Bool

574 isCase bc

570 isCase bc

575− | CASE _ _ _ _ <- bc = True

571+ | CASE {} <- bc = True

576 | otherwise = False

572 | otherwise = False

577

573

578 defaultCase :: [BC] -> [BC]

574 defaultCase :: [BC] -> [BC]

@@ -610,7 +606,7 @@ translateDecl info (name, bc) =

610translateReg :: Reg -> JS

606translateReg :: Reg -> JS

611translateReg reg

607translateReg reg

612 | RVal <- reg = jsRET

608 | RVal <- reg = jsRET

613− | Tmp <- reg = JSProj (JSIdent "vm") "reg1"

609+ | Tmp <- reg = JSRaw "//TMPREG"

614 | L n <- reg = jsLOC n

610 | L n <- reg = jsLOC n

615 | T n <- reg = jsTOP n

611 | T n <- reg = jsTOP n

616

612

@@ -651,7 +647,7 @@ translateChar ch

651 | '\\' <- ch = "\\\\"

647 | '\\' <- ch = "\\\\"

652 | '\"' <- ch = "\\\""

648 | '\"' <- ch = "\\\""

653 | '\'' <- ch = "\\\'"

649 | '\'' <- ch = "\\\'"

654− | ch `elem` asciiTab = "\\u00" ++ fill (showIntAtBase 16 intToDigit (ord ch) "")

650+ | ch `elem` asciiTab = "\\u00" ++ fill (showHex (ord ch) "")

655 | otherwise = [ch]

651 | otherwise = [ch]

656 where

652 where

657 fill :: String -> String

653 fill :: String -> String

@@ -667,8 +663,8 @@ translateChar ch

667

663

668translateName :: Name -> String

664translateName :: Name -> String

669translateName n = "_idris_" ++ concatMap cchar (showCG n)

665translateName n = "_idris_" ++ concatMap cchar (showCG n)

670− where cchar x | isAlpha x || isDigit x = [x]

666+ where cchar x | isAlphaNum x = [x]

671− | otherwise = "_" ++ show (fromEnum x) ++ "_"

667+ | otherwise = "_" ++ show (fromEnum x) ++ "_"

672

668

673jsASSIGN :: CompileInfo -> Reg -> Reg -> JS

669jsASSIGN :: CompileInfo -> Reg -> Reg -> JS

674jsASSIGN _ r1 r2 = JSAssign (translateReg r1) (translateReg r2)

670jsASSIGN _ r1 r2 = JSAssign (translateReg r1) (translateReg r2)

@@ -1538,6 +1534,5 @@ translateBC info bc

1538 | PROJECT r l a <- bc = jsPROJECT info r l a

1534 | PROJECT r l a <- bc = jsPROJECT info r l a

1539 | OP r o a <- bc = jsOP info r o a

1535 | OP r o a <- bc = jsOP info r o a

1540 | ERROR e <- bc = jsERROR info e

1536 | ERROR e <- bc = jsERROR info e

1541− | otherwise = JSRaw $ show bc

1537+ | otherwise = JSRaw $ "//" ++ show bc

1542− {- PROJECTINTO _ _ _ <- bc = undefined -}

1543

1538