e5d412e · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

on master help sign in

javascript: added lookuptable namespace

e5d412eraichoo13 years ago

src/IRTS/CodegenJavaScript.hs+14−6

compare with master

unifiedsplit

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

21idrNamespace :: String

22idrNamespace = "__IDR__"

23idrRTNamespace = "__IDRRT__"

24+idrLTNamespace = "__IDRLT__"

25data JSTarget = Node | JavaScript deriving Eq

26data JSTarget = Node | JavaScript deriving Eq

@@ -330,8 +331,8 @@ translateDeclaration (path, SFun name params stackSize body)

330 JSSeq [ lookupTable var cases

331 JSSeq [ lookupTable var cases

331 , jsDecl $ JSRaw $ concat [ "function(arg0){"

332 , jsDecl $ JSRaw $ concat [ "function(arg0){"

332 , "if (arg0 instanceof __IDRRT__Con "

333 , "if (arg0 instanceof __IDRRT__Con "

333− , " && LOOKUPTABLE.hasOwnProperty(arg0.tag))"

334+ , " && " ++ lookupTableName ++ ".hasOwnProperty(arg0.tag))"

334− , "return LOOKUPTABLE[arg0.tag](arg0);"

335+ , "return " ++ lookupTableName ++ "[arg0.tag](arg0);"

335 , "else "

336 , "else "

336 , "return arg0; }"

337 , "return arg0; }"

337 ]

338 ]

@@ -349,12 +350,19 @@ translateDeclaration (path, SFun name params stackSize body)

349 getTag (SConCase _ tag _ _ _) = Just $ show tag

350 getTag (SConCase _ tag _ _ _) = Just $ show tag

350 getTag _ = Nothing

351 getTag _ = Nothing

351

352

353+ lookupTableName :: String

354+ lookupTableName = idrLTNamespace ++ translateName name

355+

352 lookupTable :: LVar -> [SAlt] -> JS

356 lookupTable :: LVar -> [SAlt] -> JS

353 lookupTable var cases =

357 lookupTable var cases =

358+ JSAlloc lookupTableName $ Just (

354− JSAlloc "LOOKUPTABLE" $ Just $ JSObject $ catMaybes $ map (lookupEntry var) cases

359+ JSObject $ catMaybes $ map (lookupEntry var) cases

355−

360+ )

361+ where

356− lookupEntry :: LVar -> SAlt -> Maybe (String, JS)

362+ lookupEntry :: LVar -> SAlt -> Maybe (String, JS)

357− lookupEntry var alt = getTag alt >>= \tag -> Just (tag, caseFun var alt)

363+ lookupEntry var alt = do

364+ tag <- getTag alt

365+ return (tag, caseFun var alt)

358

366

359 jsDecl :: JS -> JS

367 jsDecl :: JS -> JS

360 jsDecl = JSAlloc (path ++ translateName name) . Just

368 jsDecl = JSAlloc (path ++ translateName name) . Just