msyds/rlp
1
0
Fork 0
Code Issues 4 Pull Requests Actions Packages Projects Releases 2 Wiki Activity

fix incomplete byTag

Browse Source
This commit is contained in:
crumbtoo
2024-02-07 14:26:47 -07:00
parent 77d27dccde
commit 719d5a4089
2 changed files with 7 additions and 4 deletions
Download Patch File Download Diff File Expand all files Collapse all files

10
src/Rlp2Core.hs
View File

@@ -95,14 +95,16 @@ exprToCore :: (NameSupply :> es) => RlpExpr RlpcPs -> Eff es Expr'
exprToCore (VarE n) = pure $ Var (dsNameToName n)
exprToCore (CaseE (unXRec -> e) as) = undefined
exprToCore (CaseE (unXRec -> e) as) = do
e' <- exprToCore e
Case e' <$> caseAltToCore `traverse` as
-- TODO: where-binds
caseAltToCore :: (NameSupply :> es)
=> (Alt RlpcPs, Where RlpcPs) -> Eff es Alter'
caseAltToCore (AltA (extract -> p) e, wh) = undefined
where
caseAltToCore (AltA (unXRec -> p) e, wh) = do
e' <- exprToCore . unXRec $ e
conToRose p <&> foldFix (branchToCore e')
conToRose :: forall es. (NameSupply :> es) => Pat RlpcPs -> Eff es Rose
conToRose (ConP cn as) = Fix . Branch cn <$> patToForrest `traverse` as