git.iko.soy/Idris-dev
on master help sign in
javascript: factor out translateCase
186cc36raichoo
src/IRTS/CodegenJavaScript.hs+22−18
compare with master
unifiedsplit
@@ -183,10 +183,10 @@ jsCon :: JS
183jsCon = JSRaw $ idrRTNamespace ++ "Con"
183jsCon = JSRaw $ idrRTNamespace ++ "Con"
184
184
185jsTag :: JS -> JS
185jsTag :: JS -> JS
186−jsTag obj = (JSProj obj "tag")
186+jsTag obj = JSProj obj "tag"
187
187
188jsTypeTag :: JS -> JS
188jsTypeTag :: JS -> JS
189−jsTypeTag obj = (JSProj obj "type")
189+jsTypeTag obj = JSProj obj "type"
190
190
191jsBigInt :: JS -> JS
191jsBigInt :: JS -> JS
192jsBigInt val =
192jsBigInt val =
@@ -614,7 +614,7 @@ translateExpression patterncase
614 where
614 where
615 caseHelper var cases param =
615 caseHelper var cases param =
616 JSApp (JSFunction [param] (
616 JSApp (JSFunction [param] (
617− JSCond $ map ((expandCase param) . translateCase param) cases
617+ JSCond $ map (expandCase param . translateCaseCond param) cases
618 )) [JSVar var]
618 )) [JSVar var]
619
619
620 expandCase :: String -> (Cond, JS) -> (JS, JS)
620 expandCase :: String -> (Cond, JS) -> (JS, JS)
@@ -655,11 +655,11 @@ data CaseType = ConCase Int
655data Cond = CaseCond CaseType
655data Cond = CaseCond CaseType
656 | RawCond JS
656 | RawCond JS
657
657
658−translateCase :: String -> SAlt -> (Cond, JS)
658+translateCaseCond :: String -> SAlt -> (Cond, JS)
659−translateCase _ (SDefaultCase e) =
659+translateCaseCond _ cse@(SDefaultCase _) =
660− (CaseCond DefaultCase, translateExpression e)
660+ (CaseCond DefaultCase, translateCase Nothing cse)
661
661
662−translateCase var (SConstCase ty e)
662+translateCaseCond var cse@(SConstCase ty _)
663 | StrType <- ty = matchHelper JSStringTy
663 | StrType <- ty = matchHelper JSStringTy
664 | PtrType <- ty = matchHelper JSPtrTy
664 | PtrType <- ty = matchHelper JSPtrTy
665 | Forgot <- ty = matchHelper JSForgotTy
665 | Forgot <- ty = matchHelper JSForgotTy
@@ -669,20 +669,24 @@ translateCase var (SConstCase ty e)
669 | (AType (ATInt ITChar)) <- ty = matchHelper JSCharTy
669 | (AType (ATInt ITChar)) <- ty = matchHelper JSCharTy
670 where
670 where
671 matchHelper :: JSType -> (Cond, JS)
671 matchHelper :: JSType -> (Cond, JS)
672− matchHelper ty = (CaseCond $ TypeCase ty, translateExpression e)
672+ matchHelper ty = (CaseCond $ TypeCase ty, translateCase Nothing cse)
673
673
674−translateCase var (SConstCase cst@(BI _) e) =
674+translateCaseCond var cse@(SConstCase cst@(BI _) _) =
675 let cond = jsMeth (JSRaw var) "equals" [translateConstant cst] in
675 let cond = jsMeth (JSRaw var) "equals" [translateConstant cst] in
676− (RawCond cond, translateExpression e)
676+ (RawCond cond, translateCase Nothing cse)
677
677
678−translateCase var (SConstCase cst e) =
678+translateCaseCond var cse@(SConstCase cst _) =
679 let cond = JSRaw var `jsEq` translateConstant cst in
679 let cond = JSRaw var `jsEq` translateConstant cst in
680− (RawCond cond, translateExpression e)
680+ (RawCond cond, translateCase Nothing cse)
681
681
682+translateCaseCond var cse@(SConCase _ tag _ _ _) =
682−translateCase var (SConCase a tag name vars e) =
683+ (CaseCond $ ConCase tag, translateCase (Just var) cse)
684+
685+translateCase :: Maybe String -> SAlt -> JS
686+translateCase _ (SDefaultCase e) = translateExpression e
687+translateCase _ (SConstCase _ e) = translateExpression e
688+translateCase (Just var) (SConCase a _ _ vars e) =
683 let params = map jsVar [a .. (a + length vars)] in
689 let params = map jsVar [a .. (a + length vars)] in
684− (CaseCond $ ConCase tag,
685− jsMeth (JSFunction params (JSReturn $ translateExpression e)) "apply" [
690+ jsMeth (JSFunction params (JSReturn $ translateExpression e)) "apply" [
686− JSThis, JSProj (JSRaw var) "vars"
691+ JSThis, JSProj (JSRaw var) "vars"
687− ]
692+ ]
688− )