Using ViewPatterns and PatternSynonyms to simply pattern matches
Lets say I have a GADT for a language like so (my actual language is much more complex, about 50 constructors, but this is a simplified example):
data Expr t where
Add :: Expr t -> Expr t -> Expr t
Sub :: Expr t -> Expr t -> Expr t
Mult :: Expr t -> Expr t -> Expr t
Negate :: Expr t -> Expr t
Abs :: Expr t -> Expr t
Scalar :: t -> Expr t
Now lets define another datatype like so:
data BinOpT = AddOp | SubOp | MultOp
Also, lets say I've got the following function:
stringBinOp :: BinOpT -> String
stringBinOp AddOp = "+"
stringBinOp SubOp = "-"
stringBinOp MultOp = "*"
Also, lets define the following type:
data BinOp t = BinOp BinOpT (Expr t) (Expr t)
Now I want to define a pretty printing function like so:
prettyPrint :: Show t => Expr t -> String
prettyPrint (BinOp op x y) = prettyPrint x ++ showOp op ++ prettyPrint y
prettyPrint (Negate x) = "-" ++ prettyPrint x
prettyPrint (Abs x) = "abs(" ++ prettyPrint x ++ ")"
prettyPrint (Scalar x) = show x
Note that this is not valid, as BinOp is not a constructor of Expr t .
Of course I could redefine Expr t like so:
data Expr t where
BinOp :: BinOp -> Expr t -> Expr t -> Expr t
Negate :: Expr t -> Expr t
Abs :: Expr t -> Expr t
Scalar :: t -> Expr t
And that would work fine, but I'd rather not do this. It makes other code that uses this a little uglier, and also I think it will be slightly more inefficient in terms of space and time, and you've got to match against two constructors instead of one, which means two case statements (hence jump tables) instead of one.
I suspect I can use a combination of the following two GHC extensions to achieve what I'm trying to do cleanly, namely:
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE PatternSynonyms #-}
But I'm not quite exactly sure how to best do this. A simple example for this code would be helpful (I can then apply it to the more complex language I'm dealing with).
Many imaginary bonus points will be awarded if the solution will compile without warnings for missing pattern matches. I understand GHC 8.2 may be helpful in this regard, so a GHC 8.2 example with it's extensions to exhaustiveness checking will be fine, although a pre GHC 8.2 solution with passes the exhaustiveness checker will be even better.
Clarification:
What I'm actually asking is how can I do something like this:
prettyPrint :: Show t => Expr t -> String
prettyPrint (BinOp op x y) = prettyPrint x ++ showOp op ++ prettyPrint y
prettyPrint (Negate x) = "-" ++ prettyPrint x
prettyPrint (Abs x) = "abs(" ++ prettyPrint x ++ ")"
prettyPrint (Scalar x) = show x
Whilst keeping the definition of Expr t like so:
data Expr t where
Add :: Expr t -> Expr t -> Expr t
Sub :: Expr t -> Expr t -> Expr t
Mult :: Expr t -> Expr t -> Expr t
Negate :: Expr t -> Expr t
Abs :: Expr t -> Expr t
Scalar :: t -> Expr t
The important line is:
prettyPrint (BinOp op x y) = prettyPrint x ++ showOp op ++ prettyPrint y
Which won't compile as BinOp is not a constructor of Expr t . I want like this line that does compile, as I don't want to do this everywhere:
prettyPrint (Add x y) = ...
prettyPrint (Sub x y) = ...
prettyPrint (Mult x y) = ...
Because that means a lot of code duplication as lots of functions will use Expr t .
View pattern
asBinOp (Add a b) = Just (AddOp, a, b)
asBinOp (Sub a b) = Just (SubOp, a, b)
asBinOp (Mul a b) = Just (MulOp, a, b)
asBinOp _ = Nothing
prettyPrint (asBinOp -> Just (op, x, y)) = prettyPrint x ++ showOp op ++ prettyPrint y
... + Pattern synonym
pattern BinOp :: BinOpT -> Expr t -> Expr t -> Expr t
pattern BinOp op a b <- (asBinOp -> Just (op, a, b)) where
BinOp AddOp a b = Add a b
BinOp SubOp a b = Sub a b
BinOp MulOp a b = Mul a b
prettyPrint (BinOp op x y) = prettyPrint x ++ showOp op ++ prettyPrint y
In GHC 8.2, you can satisfy the exhaustiveness checker with this pragma:
{-# COMPLETE BinOp, Negate, Abs, Scalar #-}
上一篇: 输入非违约