c79e46c · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

on master help sign in

javascript: match on types

c79e46craichoo14 years ago

src/IRTS/CodegenJavaScript.hs+21−2

compare with master

unifiedsplit

@@ -46,7 +46,10 @@ codegenJavaScript definitions filename outputType =

46idrRuntime :: String

47idrRuntime =

48 createModule Nothing idrNamespace $ concat

49− [ "__IDR__.IntType = { type: 'IntType' };"

49+ [ "__IDR__.Type = function(type) { this.type = type; };"

50+ , "__IDR__.Int = new __IDR__.Type('Int');"

51+ , "__IDR__.Char = new __IDR__.Type('Char');"

52+ , "__IDR__.String = new __IDR__.Type('String');"

51 , "__IDR__.Tailcall = function(f) { this.f = f };"

54 , "__IDR__.Tailcall = function(f) { this.f = f };"

@@ -152,7 +155,9 @@ translateConstant (BI i) = show i

152translateConstant (Fl f) = show f

155translateConstant (Fl f) = show f

153translateConstant (Ch c) = show c

156translateConstant (Ch c) = show c

154translateConstant (Str s) = show s

157translateConstant (Str s) = show s

155−translateConstant IType = "__IDR__.IntType"

158+translateConstant IType = "__IDR__.Int"

159+translateConstant ChType = "__IDR__.Char"

160+translateConstant StrType = "__IDR__.String"

156translateConstant c =

161translateConstant c =

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

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

158

163

@@ -354,6 +359,12 @@ translateCase :: String -> String -> SAlt -> String

354translateCase modname _ (SDefaultCase e) =

359translateCase modname _ (SDefaultCase e) =

355 createIfBlock "true" (translateExpression modname e)

360 createIfBlock "true" (translateExpression modname e)

356

361

362+translateCase modname var (SConstCase ChType e) =

363+ translateTypeMatch modname var "Char" e

364+

365+translateCase modname var (SConstCase StrType e) =

366+ translateTypeMatch modname var "String" e

367+

357translateCase modname var (SConstCase cst e) =

368translateCase modname var (SConstCase cst e) =

358 let cond = var ++ " == " ++ translateConstant cst in

369 let cond = var ++ " == " ++ translateConstant cst in

359 createIfBlock cond (translateExpression modname e)

370 createIfBlock cond (translateExpression modname e)

@@ -370,6 +381,14 @@ translateCase modname var (SConCase a i name vars e) =

370 cond = intercalate " && " [isCon, isI] in

381 cond = intercalate " && " [isCon, isI] in

371 createIfBlock cond $ f (translateExpression modname e)

382 createIfBlock cond $ f (translateExpression modname e)

372

383

384+translateTypeMatch :: String -> String -> String -> SExp -> String

385+translateTypeMatch modname var ty exp =

386+ let e = translateExpression modname exp in

387+ createIfBlock (var

388+ ++ " instanceof __IDR__.Type && "

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

390+

391+

373createIfBlock cond e =

392createIfBlock cond e =

374 "if (" ++ cond ++") {\n"

393 "if (" ++ cond ++") {\n"

375 ++ "return " ++ e

394 ++ "return " ++ e