fraport/fradrive-old
fraport/fradrive-old
Archived
3
1
Fork 0
Code Issues 65 Pull Requests 5 Actions Packages Projects Releases 197 Wiki Activity

Versionbump: Extended pattern matching for Template Haskell expressions.

Browse Source
This commit is contained in:
Stephan Barth 2024-02-21 04:04:52 +01:00
parent b70a13e1c3
commit 3731cd6bec
1 changed files with 7 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
src/Utils/TH/AlphaConversion.hs
View File

@ -1,4 +1,4 @@
-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de> -- SPDX-FileCopyrightText: 2022-2024 Stephan Barth <stephan.barth@uniworx.de>, Gregor Kleen <gregor.kleen@ifi.lmu.de>
-- --
-- SPDX-License-Identifier: AGPL-3.0-or-later -- SPDX-License-Identifier: AGPL-3.0-or-later
@ -31,6 +31,7 @@ alphaConvE ns = alphaConvE' Set.empty
ParensE e -> ParensE $ alphaConvE' bound e ParensE e -> ParensE $ alphaConvE' bound e
LamE ps e -> LamE ps $ alphaConvE' (bound `Set.union` foldMap pVars ps) e LamE ps e -> LamE ps $ alphaConvE' (bound `Set.union` foldMap pVars ps) e
LamCaseE _ -> error "alphaConvE: LamCaseE not implemented" LamCaseE _ -> error "alphaConvE: LamCaseE not implemented"
LamCasesE _ -> error "alphaConvE: LamCasesE not implemented"
TupE es -> TupE $ over (traverse . _Just) (alphaConvE' bound) es TupE es -> TupE $ over (traverse . _Just) (alphaConvE' bound) es
UnboxedTupE es -> UnboxedTupE $ over (traverse . _Just) (alphaConvE' bound) es UnboxedTupE es -> UnboxedTupE $ over (traverse . _Just) (alphaConvE' bound) es
UnboxedSumE e sAlt sAry -> UnboxedSumE (alphaConvE' bound e) sAlt sAry UnboxedSumE e sAlt sAry -> UnboxedSumE (alphaConvE' bound e) sAlt sAry
@ -38,9 +39,11 @@ alphaConvE ns = alphaConvE' Set.empty
MultiIfE _ -> error "alphaConvE: MultiIfE not implemented" MultiIfE _ -> error "alphaConvE: MultiIfE not implemented"
LetE _ _ -> error "alphaConvE: LetE not implemented" LetE _ _ -> error "alphaConvE: LetE not implemented"
CaseE _ _ -> error "alphaConvE: CaseE not implemented" CaseE _ _ -> error "alphaConvE: CaseE not implemented"
DoE _ -> error "alphaConvE: DoE not implemented" DoE _ _ -> error "alphaConvE: DoE not implemented"
MDoE _ -> error "alphaConvE: MDoE not implemented" MDoE _ _ -> error "alphaConvE: MDoE not implemented"
CompE _ -> error "alphaConvE: CompE not implemented" CompE _ -> error "alphaConvE: CompE not implemented"
GetFieldE _ _ -> error "alphaConvE: GetFieldE not implemented"
ProjectionE _ -> error "alphaConvE: ProjectionE not implemented"
ArithSeqE (FromR e) -> ArithSeqE . FromR $ alphaConvE' bound e ArithSeqE (FromR e) -> ArithSeqE . FromR $ alphaConvE' bound e
ArithSeqE (FromThenR e1 e2) -> ArithSeqE $ FromThenR (alphaConvE' bound e1) (alphaConvE' bound e2) ArithSeqE (FromThenR e1 e2) -> ArithSeqE $ FromThenR (alphaConvE' bound e1) (alphaConvE' bound e2)
ArithSeqE (FromToR e1 e2) -> ArithSeqE $ FromToR (alphaConvE' bound e1) (alphaConvE' bound e2) ArithSeqE (FromToR e1 e2) -> ArithSeqE $ FromToR (alphaConvE' bound e1) (alphaConvE' bound e2)
@ -61,7 +64,7 @@ pVars = \case
TupP ps -> foldMap pVars ps TupP ps -> foldMap pVars ps
UnboxedTupP ps -> foldMap pVars ps UnboxedTupP ps -> foldMap pVars ps
UnboxedSumP p _ _ -> pVars p UnboxedSumP p _ _ -> pVars p
ConP _ ps -> foldMap pVars ps ConP _ _ ps -> foldMap pVars ps
InfixP p1 _ p2 -> pVars p1 `Set.union` pVars p2 InfixP p1 _ p2 -> pVars p1 `Set.union` pVars p2
UInfixP p1 _ p2 -> pVars p1 `Set.union` pVars p2 UInfixP p1 _ p2 -> pVars p1 `Set.union` pVars p2
ParensP p -> pVars p ParensP p -> pVars p