From e3189514e16d5894bd9303a655434d244ea343d3 Mon Sep 17 00:00:00 2001 From: Montmorency Date: Mon, 26 Sep 2022 13:56:07 +0100 Subject: [PATCH] Now working with simple constructor pattern matching (no type annotation) no infix constructors yet. --- ihp-hsx/IHP/HSX/HsExpToTH.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/ihp-hsx/IHP/HSX/HsExpToTH.hs b/ihp-hsx/IHP/HSX/HsExpToTH.hs index b30f672b9..8bd076453 100644 --- a/ihp-hsx/IHP/HSX/HsExpToTH.hs +++ b/ihp-hsx/IHP/HSX/HsExpToTH.hs @@ -79,7 +79,8 @@ toPat :: Pat.Pat GhcPs -> TH.Pat toPat (Pat.VarPat _ (unLoc -> name)) = TH.VarP (toName name) toPat (TuplePat _ p _) = TH.TupP (map (toPat . unLoc) p) toPat (ParPat xP lP) = (toPat . unLoc) lP --error "TH.ParPat not implemented" -toPat (ConPat pat_con_ext pat_con pat_args) = TH.ConP (toName pat_con_ext) (map toType (map hsLPatType (Pat.hsConPatArgs pat_args))) (map (toPat . unLoc) (Pat.hsConPatArgs pat_args)) --error "TH.ConstructorPattern not implemented" +toPat (ConPat pat_con_ext ((unLoc -> name)) pat_args) = TH.ConP (toName name) (map toType []) (map (toPat . unLoc) (Pat.hsConPatArgs pat_args)) --error "TH.ConstructorPattern not implemented" +--toPat (ConPat pat_con_ext pat_con pat_args) = TH.ConP (toName pat_con_ext) (map (toType . unLoc) (hsPatSigType pat_args)) (map (toPat . unLoc) (Pat.hsConPatArgs pat_args)) --error "TH.ConstructorPattern not implemented" toPat (ViewPat pat_con pat_args pat_con_ext) = error "TH.ViewPattern not implemented" toPat (SumPat _ _ _ _) = error "TH.SumPat not implemented" toPat (WildPat _ ) = error "TH.WildPat not implemented"