b669628 · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

on master help sign in

javascript: switch to Data.Text for code generation

b669628raichoo12 years ago

src/IRTS/CodegenJavaScript.hs+87−84

compare with master

unifiedsplit

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

1{-# LANGUAGE PatternGuards #-}

2+{-# LANGUAGE OverloadedStrings #-}

2module IRTS.CodegenJavaScript (codegenJavaScript, codegenNode, JSTarget(..)) where

3module IRTS.CodegenJavaScript (codegenJavaScript, codegenNode, JSTarget(..)) where

4import Idris.AbsSyntax hiding (TypeCase)

5import Idris.AbsSyntax hiding (TypeCase)

@@ -25,6 +26,8 @@ import System.IO

25import System.Directory

26import System.Directory

27import qualified Data.Map.Strict as M

28import qualified Data.Map.Strict as M

29+import qualified Data.Text as T

30+import qualified Data.Text.IO as TIO

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

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

@@ -154,7 +157,7 @@ data JS = JSRaw String

154

157

155data FFI = FFICode Char | FFIArg Int | FFIError String

158data FFI = FFICode Char | FFIArg Int | FFIError String

156

159

157−ffi :: String -> [String] -> String

160+ffi :: String -> [String] -> T.Text

158ffi code args = let parsed = ffiParse code in

161ffi code args = let parsed = ffiParse code in

159 case ffiError parsed of

162 case ffiError parsed of

160 Just err -> error err

163 Just err -> error err

@@ -178,37 +181,37 @@ ffi code args = let parsed = ffiParse code in

178 ffiError (x:xs) = ffiError xs

181 ffiError (x:xs) = ffiError xs

179

182

180

183

181− renderFFI :: [FFI] -> [String] -> String

184+ renderFFI :: [FFI] -> [String] -> T.Text

182 renderFFI [] _ = ""

185 renderFFI [] _ = ""

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

186+ renderFFI (FFICode c : fs) args = c `T.cons` renderFFI fs args

184 renderFFI (FFIArg i : fs) args

187 renderFFI (FFIArg i : fs) args

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

188+ | i < length args && i >= 0 = T.pack (args !! i) `T.append` renderFFI fs args

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

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

187

190

188−compileJS :: JS -> String

191+compileJS :: JS -> T.Text

189compileJS = compileJS' 0

192compileJS = compileJS' 0

190

193

191−compileJS' :: Int -> JS -> String

194+compileJS' :: Int -> JS -> T.Text

192compileJS' indent JSNoop = ""

195compileJS' indent JSNoop = ""

193

196

194compileJS' indent (JSAnnotation annotation js) =

197compileJS' indent (JSAnnotation annotation js) =

195− "/** @" ++ show annotation ++ " */\n" ++ compileJS' indent js

198+ "/** @" `T.append` T.pack (show annotation) `T.append` " */\n" `T.append` compileJS' indent js

196

199

197compileJS' indent (JSFFI raw args) =

200compileJS' indent (JSFFI raw args) =

198− ffi raw (map (compileJS' indent) args)

201+ ffi raw (map (T.unpack . compileJS' indent) args)

199

202

200compileJS' indent (JSRaw code) =

203compileJS' indent (JSRaw code) =

201− code

204+ T.pack code

202

205

203compileJS' indent (JSIdent ident) =

206compileJS' indent (JSIdent ident) =

204− ident

207+ T.pack ident

205

208

206compileJS' indent (JSFunction args body) =

209compileJS' indent (JSFunction args body) =

207− replicate indent ' ' ++ "function("

210+ T.replicate indent " " `T.append` "function("

208− ++ intercalate "," args

211+ `T.append` T.intercalate "," (map T.pack args)

209− ++ "){\n"

212+ `T.append` "){\n"

210− ++ compileJS' (indent + 2) body

213+ `T.append` compileJS' (indent + 2) body

211− ++ "\n}\n"

214+ `T.append` "\n}\n"

212

215

213compileJS' indent (JSType ty)

216compileJS' indent (JSType ty)

214 | JSIntTy <- ty = "i$Int"

217 | JSIntTy <- ty = "i$Int"

@@ -220,42 +223,42 @@ compileJS' indent (JSType ty)

220 | JSForgotTy <- ty = "i$Forgot"

223 | JSForgotTy <- ty = "i$Forgot"

221

224

222compileJS' indent (JSSeq seq) =

225compileJS' indent (JSSeq seq) =

223− intercalate ";\n" (

226+ T.intercalate ";\n" (

224 map (

227 map (

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

228+ (T.replicate indent " " `T.append`) . (compileJS' indent)

226 ) $ filter (/= JSNoop) seq

229 ) $ filter (/= JSNoop) seq

227− ) ++ ";"

230+ ) `T.append` ";"

228

231

229compileJS' indent (JSReturn val) =

232compileJS' indent (JSReturn val) =

230− "return " ++ compileJS' indent val

233+ "return " `T.append` compileJS' indent val

231

234

232compileJS' indent (JSApp lhs rhs)

235compileJS' indent (JSApp lhs rhs)

233 | JSFunction {} <- lhs =

236 | JSFunction {} <- lhs =

234− concat ["(", compileJS' indent lhs, ")(", args, ")"]

237+ T.concat ["(", compileJS' indent lhs, ")(", args, ")"]

235 | otherwise =

238 | otherwise =

236− concat [compileJS' indent lhs, "(", args, ")"]

239+ T.concat [compileJS' indent lhs, "(", args, ")"]

237− where args :: String

240+ where args :: T.Text

238− args = intercalate "," $ map (compileJS' 0) rhs

241+ args = T.intercalate "," $ map (compileJS' 0) rhs

239

242

240compileJS' indent (JSNew name args) =

243compileJS' indent (JSNew name args) =

241− "new " ++ name ++ "(" ++ intercalate "," (map (compileJS' 0) args) ++ ")"

244+ "new " `T.append` T.pack name `T.append` "(" `T.append` T.intercalate "," (map (compileJS' 0) args) `T.append` ")"

242

245

243compileJS' indent (JSError exc) =

246compileJS' indent (JSError exc) =

244− "throw new Error(\"" ++ exc ++ "\")"

247+ "throw new Error(\"" `T.append` T.pack exc `T.append` "\")"

245

248

246compileJS' indent (JSBinOp op lhs rhs) =

249compileJS' indent (JSBinOp op lhs rhs) =

247− compileJS' indent lhs ++ " " ++ op ++ " " ++ compileJS' indent rhs

250+ compileJS' indent lhs `T.append` " " `T.append` T.pack op `T.append` " " `T.append` compileJS' indent rhs

248

251

249compileJS' indent (JSPreOp op val) =

252compileJS' indent (JSPreOp op val) =

250− op ++ compileJS' indent val

253+ T.pack op `T.append` compileJS' indent val

251

254

252compileJS' indent (JSProj obj field)

255compileJS' indent (JSProj obj field)

253 | JSFunction {} <- obj =

256 | JSFunction {} <- obj =

254− concat ["(", compileJS' indent obj, ").", field]

257+ T.concat ["(", compileJS' indent obj, ").", T.pack field]

255 | JSAssign {} <- obj =

258 | JSAssign {} <- obj =

256− concat ["(", compileJS' indent obj, ").", field]

259+ T.concat ["(", compileJS' indent obj, ").", T.pack field]

257 | otherwise =

260 | otherwise =

258− compileJS' indent obj ++ '.' : field

261+ compileJS' indent obj `T.append` ('.' `T.cons` T.pack field)

259

262

260compileJS' indent JSNull =

263compileJS' indent JSNull =

261 "null"

264 "null"

@@ -273,95 +276,95 @@ compileJS' indent JSFalse =

273 "false"

276 "false"

274

277

275compileJS' indent (JSArray elems) =

278compileJS' indent (JSArray elems) =

276− "[" ++ intercalate "," (map (compileJS' 0) elems) ++ "]"

279+ "[" `T.append` T.intercalate "," (map (compileJS' 0) elems) `T.append` "]"

277

280

278compileJS' indent (JSString str) =

281compileJS' indent (JSString str) =

279− "\"" ++ str ++ "\""

282+ "\"" `T.append` T.pack str `T.append` "\""

280

283

281compileJS' indent (JSNum num)

284compileJS' indent (JSNum num)

282− | JSInt i <- num = show i

285+ | JSInt i <- num = T.pack (show i)

283− | JSFloat f <- num = show f

286+ | JSFloat f <- num = T.pack (show f)

284− | JSInteger JSBigZero <- num = "i$ZERO"

287+ | JSInteger JSBigZero <- num = T.pack "i$ZERO"

285− | JSInteger JSBigOne <- num = "i$ONE"

288+ | JSInteger JSBigOne <- num = T.pack "i$ONE"

286− | JSInteger (JSBigInt i) <- num = show i

289+ | JSInteger (JSBigInt i) <- num = T.pack (show i)

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

290+ | JSInteger (JSBigIntExpr e) <- num = "i$bigInt(" `T.append` compileJS' indent e `T.append` ")"

288

291

289compileJS' indent (JSAssign lhs rhs) =

292compileJS' indent (JSAssign lhs rhs) =

290− compileJS' indent lhs ++ " = " ++ compileJS' indent rhs

293+ compileJS' indent lhs `T.append` " = " `T.append` compileJS' indent rhs

291

294

292compileJS' 0 (JSAlloc name (Just val@(JSNew _ _))) =

295compileJS' 0 (JSAlloc name (Just val@(JSNew _ _))) =

293− "var " ++ name ++ " = " ++ compileJS' 0 val ++ ";\n"

296+ "var " `T.append` T.pack name `T.append` " = " `T.append` compileJS' 0 val `T.append` ";\n"

294

297

295compileJS' indent (JSAlloc name val) =

298compileJS' indent (JSAlloc name val) =

296− "var " ++ name ++ maybe "" ((" = " ++) . compileJS' indent) val

299+ "var " `T.append` T.pack name `T.append` maybe "" ((" = " `T.append`) . compileJS' indent) val

297

300

298compileJS' indent (JSIndex lhs rhs) =

301compileJS' indent (JSIndex lhs rhs) =

299− compileJS' indent lhs ++ "[" ++ compileJS' indent rhs ++ "]"

302+ compileJS' indent lhs `T.append` "[" `T.append` compileJS' indent rhs `T.append` "]"

300

303

301compileJS' indent (JSCond branches) =

304compileJS' indent (JSCond branches) =

302− intercalate " else " $ map createIfBlock branches

305+ T.intercalate " else " $ map createIfBlock branches

303 where

306 where

304 createIfBlock (JSNoop, e@(JSSeq _)) =

307 createIfBlock (JSNoop, e@(JSSeq _)) =

305 "{\n"

308 "{\n"

306− ++ compileJS' (indent + 2) e

309+ `T.append` compileJS' (indent + 2) e

307− ++ "\n" ++ replicate indent ' ' ++ "}"

310+ `T.append` "\n" `T.append` T.replicate indent " " `T.append` "}"

308 createIfBlock (JSNoop, e) =

311 createIfBlock (JSNoop, e) =

309 "{\n"

312 "{\n"

310− ++ compileJS' (indent + 2) e

313+ `T.append` compileJS' (indent + 2) e

311− ++ ";\n" ++ replicate indent ' ' ++ "}"

314+ `T.append` ";\n" `T.append` T.replicate indent " " `T.append` "}"

312 createIfBlock (cond, e@(JSSeq _)) =

315 createIfBlock (cond, e@(JSSeq _)) =

313− "if (" ++ compileJS' indent cond ++") {\n"

316+ "if (" `T.append` compileJS' indent cond `T.append`") {\n"

314− ++ compileJS' (indent + 2) e

317+ `T.append` compileJS' (indent + 2) e

315− ++ "\n" ++ replicate indent ' ' ++ "}"

318+ `T.append` "\n" `T.append` T.replicate indent " " `T.append` "}"

316 createIfBlock (cond, e) =

319 createIfBlock (cond, e) =

317− "if (" ++ compileJS' indent cond ++") {\n"

320+ "if (" `T.append` compileJS' indent cond `T.append`") {\n"

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

321+ `T.append` T.replicate (indent + 2) " " `T.append` compileJS' (indent + 2) e

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

322+ `T.append` ";\n" `T.append` T.replicate indent " " `T.append` "}"

320

323

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

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

322 let (h,t) = splitAt 1 seq in

325 let (h,t) = splitAt 1 seq in

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

326+ (T.concat (map (compileJS' indent) h) `T.append` ";\n")

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

327+ `T.append` (T.intercalate ";\n" $ map ((T.replicate indent " " `T.append`) . compileJS' indent) t)

325

328

326compileJS' indent (JSSwitch val branches def) =

329compileJS' indent (JSSwitch val branches def) =

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

330+ "switch(" `T.append` compileJS' indent val `T.append` "){\n"

328− ++ concatMap mkBranch branches

331+ `T.append` T.concat (map mkBranch branches)

329− ++ mkDefault def

332+ `T.append` mkDefault def

330− ++ replicate indent ' ' ++ "}"

333+ `T.append` T.replicate indent " " `T.append` "}"

331 where

334 where

332− mkBranch :: (JS, JS) -> String

335+ mkBranch :: (JS, JS) -> T.Text

333 mkBranch (tag, code) =

336 mkBranch (tag, code) =

334− replicate (indent + 2) ' ' ++ "case " ++ compileJS' indent tag ++ ":\n"

337+ T.replicate (indent + 2) " " `T.append` "case " `T.append` compileJS' indent tag `T.append` ":\n"

335− ++ compileJS' (indent + 4) code

338+ `T.append` compileJS' (indent + 4) code

336− ++ "\n" ++ (replicate (indent + 4) ' ' ++ "break;\n")

339+ `T.append` "\n" `T.append` (T.replicate (indent + 4) " " `T.append` "break;\n")

337

340

338− mkDefault :: Maybe JS -> String

341+ mkDefault :: Maybe JS -> T.Text

339 mkDefault Nothing = ""

342 mkDefault Nothing = ""

340 mkDefault (Just def) =

343 mkDefault (Just def) =

341− replicate (indent + 2) ' ' ++ "default:\n"

344+ T.replicate (indent + 2) " " `T.append` "default:\n"

342− ++ compileJS' (indent + 4)def

345+ `T.append` compileJS' (indent + 4)def

343− ++ "\n"

346+ `T.append` "\n"

344

347

345

348

346compileJS' indent (JSTernary cond true false) =

349compileJS' indent (JSTernary cond true false) =

347 let c = compileJS' indent cond

350 let c = compileJS' indent cond

348 t = compileJS' indent true

351 t = compileJS' indent true

349 f = compileJS' indent false in

352 f = compileJS' indent false in

350− "(" ++ c ++ ")?(" ++ t ++ "):(" ++ f ++ ")"

353+ "(" `T.append` c `T.append` ")?(" `T.append` t `T.append` "):(" `T.append` f `T.append` ")"

351

354

352compileJS' indent (JSParens js) =

355compileJS' indent (JSParens js) =

353− "(" ++ compileJS' indent js ++ ")"

356+ "(" `T.append` compileJS' indent js `T.append` ")"

354

357

355compileJS' indent (JSWhile cond body) =

358compileJS' indent (JSWhile cond body) =

356− "while (" ++ compileJS' indent cond ++ ") {\n"

359+ "while (" `T.append` compileJS' indent cond `T.append` ") {\n"

357− ++ compileJS' (indent + 2) body

360+ `T.append` compileJS' (indent + 2) body

358− ++ "\n" ++ replicate indent ' ' ++ "}"

361+ `T.append` "\n" `T.append` T.replicate indent " " `T.append` "}"

359

362

360compileJS' indent (JSWord word)

363compileJS' indent (JSWord word)

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

364+ | JSWord8 b <- word = "new Uint8Array([" `T.append` T.pack (show b) `T.append` "])"

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

365+ | JSWord16 b <- word = "new Uint16Array([" `T.append` T.pack (show b) `T.append` "])"

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

366+ | JSWord32 b <- word = "new Uint32Array([" `T.append` T.pack (show b) `T.append` "])"

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

367+ | JSWord64 b <- word = "i$bigInt(\"" `T.append` T.pack (show b) `T.append` "\")"

365

368

366codegenJavaScript :: CodeGenerator

369codegenJavaScript :: CodeGenerator

367codegenJavaScript ci =

370codegenJavaScript ci =

@@ -406,12 +409,12 @@ codegenJS_all target definitions includes libs filename outputType = do

406 ++ idrRuntime

409 ++ idrRuntime

407 ++ tgtRuntime

410 ++ tgtRuntime

408 )

411 )

409− writeFile filename ( runtime

412+ TIO.writeFile filename ( T.pack runtime

410− ++ concatMap compileJS opt

413+ `T.append` T.concat (map compileJS opt)

411− ++ concatMap compileJS cons

414+ `T.append` T.concat (map compileJS cons)

412− ++ main

415+ `T.append` main

413− ++ invokeMain

416+ `T.append` invokeMain

414− )

417+ )

415 setPermissions filename (emptyPermissions { readable = True

418 setPermissions filename (emptyPermissions { readable = True

416 , executable = target == Node

419 , executable = target == Node

417 , writable = True

420 , writable = True

@@ -478,7 +481,7 @@ codegenJS_all target definitions includes libs filename outputType = do

478 getIncludes :: [FilePath] -> IO [String]

481 getIncludes :: [FilePath] -> IO [String]

479 getIncludes = mapM readFile

482 getIncludes = mapM readFile

480

483

481− main :: String

484+ main :: T.Text

482 main =

485 main =

483 compileJS $ JSAlloc "main" (Just $

486 compileJS $ JSAlloc "main" (Just $

484 JSFunction [] (

487 JSFunction [] (

@@ -532,7 +535,7 @@ codegenJS_all target definitions includes libs filename outputType = do

532 )

535 )

533 ]

536 ]

534

537

535− invokeMain :: String

538+ invokeMain :: T.Text

536 invokeMain = compileJS $ JSApp (JSIdent "main") []

539 invokeMain = compileJS $ JSApp (JSIdent "main") []

537

540

538optimizeConstructors :: [JS] -> ([JS], [JS])

541optimizeConstructors :: [JS] -> ([JS], [JS])