You are doing both too much work and not enough.
You are doing too much work because you don't need to repeatedly squash units in case the first pass has returned a modified expression.
You are not doing enough work because you are not squashing the units coming from MulId
rather than Lit mulId
Here is a solution which one could argue is more idiomatic as well as dealing with the two shortcomings I pointed out earlier:
We start by implementing the recursion pattern first; it is a quite common thing to do in Haskell as it helps make it easier to understand from first sight how a function works (what does this function do? Oh! It goes by recursion on the structure! Let's see what the different cases are...).
To do that, you define a function fold
taking one argument per constructor of the datatype and having a given return type (here b
). The arguments are functions taking the same arguments as the constructors they correspond to except that the recursive occurences of RingExpr a
have been replaced by the return type b
(i.e. we assume we already know the result for the recursive subcomputations!)
fold :: (a -> b) -> -- Lit :: a -> RingExpr a
b -> -- AddId :: RingExpr a
(b -> b) -> -- AddInv :: RingExpr a -> RingExpr a
b -> -- MulId :: RingExpr a
(b -> b -> b) -> -- Add :: RingExpr a -> RingExpr a -> RingExpr a
(b -> b -> b) -> -- Mul :: RingExpr a -> RingExpr a -> RingExpr a
RingExpr a -> b
fold litb addIdb addInvb mulIdb addb mulb = go
where go (Lit a) = litb a
go AddId = addIdb
go (AddInv e) = addInvb $ go e
go MulId = mulIdb
go (Add e f) = go e `addb` go f
go (Mul e f) = go e `mulb` go f
The function you are looking to define is now a simple instance of the recursion pattern we just described: for the cases which are not Mul
, we simply use the corresponding constructor but in the case of Mul
we do the squashing
:
squashMulId :: (Ring a, Eq a) => RingExpr a -> RingExpr a
squashMulId = fold Lit AddId AddInv MulId Add squashing
where
squashing a b
| a == Lit mulId || a == MulId = a
| b == Lit mulId || b == MulId = b
| otherwise = Mul a b