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

expandableAlt

Browse Source
This commit is contained in:
crumbtoo
2024-02-06 11:04:17 -07:00
parent bd55efc5ed
commit 0c98bca174
1 changed files with 4 additions and 4 deletions
Download Patch File Download Diff File Expand all files Collapse all files

8
src/Rlp2Core.hs
View File

@@ -74,13 +74,13 @@ exprToCore (CaseE e as) = undefined
-- Just (ConP "C" [Located (SrcSpan 0 0 0 0) (VarP "p"),Located (SrcSpan 0 0 0 0) (VarP "name")],ConP "P" [],VarE' () "e") -- Just (ConP "C" [Located (SrcSpan 0 0 0 0) (VarP "p"),Located (SrcSpan 0 0 0 0) (VarP "name")],ConP "P" [],VarE' () "e")
expandableAlt :: IdP RlpcPs -> Alt RlpcPs expandableAlt :: IdP RlpcPs -> Alt RlpcPs
-> Maybe (Pat RlpcPs, Pat RlpcPs, RlpExpr RlpcPs) -> Maybe (Pat RlpcPs, Pat RlpcPs, RlpExpr RlpcPs)
expandableAlt n (AltA c@(ConP'' cn as) e) = do expandableAlt n (AltA c@(ConP'' cn as) e) =
p <- nestedPat nestedPat <&> (c', , extract e)
let c' = ConP cn as'
pure (c', p, extract e)
where where
l :: Lens' [Pat RlpcPs] (Maybe (Pat RlpcPs)) l :: Lens' [Pat RlpcPs] (Maybe (Pat RlpcPs))
l = atFound (has _ConP) l = atFound (has _ConP)
c' = ConP cn as'
nestedPat = (unXRec <$> as) ^. l nestedPat = (unXRec <$> as) ^. l
as' = (unXRec <$> as) & l ?~ VarP n as' = (unXRec <$> as) & l ?~ VarP n
& fmap nolo & fmap nolo