@@ -482,14 +482,14 @@ translateDeclaration (path, SFun name params stackSize body)
483 hasProp :: String -> String -> JS
483 hasProp :: String -> String -> JS
484 hasProp table var =
484 hasProp table var =
485− jsMeth (JSRaw table) "hasOwnProperty" [JSRaw $ var ++ ".tag"]
485+ JSIndex (JSRaw table) (JSProj (JSRaw var) "tag")
487 caseFun :: [(LVar, String)] -> LVar -> SAlt -> JS
487 caseFun :: [(LVar, String)] -> LVar -> SAlt -> JS
488 caseFun aux var cse =
488 caseFun aux var cse =
489 jsFunAux aux (translateCase (Just (translateVariableName var)) cse)
489 jsFunAux aux (translateCase (Just (translateVariableName var)) cse)
491− getTag :: SAlt -> Maybe String
491+ getTag :: SAlt -> Maybe Int
492− getTag (SConCase _ tag _ _ _) = Just $ show tag
492+ getTag (SConCase _ tag _ _ _) = Just tag
493 getTag _ = Nothing
493 getTag _ = Nothing
495 lookupTableName :: String
495 lookupTableName :: String
@@ -498,10 +498,22 @@ translateDeclaration (path, SFun name params stackSize body)
498 lookupTable :: [(LVar, String)] -> LVar -> [SAlt] -> JS
498 lookupTable :: [(LVar, String)] -> LVar -> [SAlt] -> JS
499 lookupTable aux var cases =
499 lookupTable aux var cases =
500 JSAlloc lookupTableName $ Just (
500 JSAlloc lookupTableName $ Just (
501+ JSApp (JSFunction [] (
503+ JSAlloc "t" $ Just (JSArray [])
501− JSObject $ catMaybes $ map (lookupEntry aux var) cases
504+ ] ++ assignEntries (catMaybes $ map (lookupEntry aux var) cases) ++ [
505+ JSReturn (JSRaw "t")
510+ assignEntries :: [(Int, JS)] -> [JS]
511+ assignEntries entries =
513+ JSAssign (JSIndex (JSRaw "t") (JSNum $ JSInt tag)) fun
504− lookupEntry :: [(LVar, String)] -> LVar -> SAlt -> Maybe (String, JS)
516+ lookupEntry :: [(LVar, String)] -> LVar -> SAlt -> Maybe (Int, JS)
505 lookupEntry aux var alt = do
517 lookupEntry aux var alt = do
506 tag <- getTag alt
518 tag <- getTag alt
507 return (tag, caseFun aux var alt)
519 return (tag, caseFun aux var alt)