Pattern match is Redundant in while updating State Monad - haskell

Question

I have a state where it contains different values and I want to use the same function to update different values in the state. But I am unable to do so because of the following error.
Error Received:
warning: [-Woverlapping-patterns]
Pattern match is redundant
In a case alternative: currentRegister -> ...
|
559 | currentRegister -> modify $ \st->st{ currentRegister = nextAddr}
| ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
data St = St
{ cotxt :: [Cxt]
, currentLabel :: Int
, currentLogicLabel :: Int
, currentIfLabel :: Int
, currentWhileLabel :: Int
, currentRegister :: Int
}
getcurrStateValue :: (St -> Int) -> Compile Int
getcurrStateValue x = do
current <- gets x
let nextAddr = current + 1
case x of
currentLabel -> modify $ \st->st{ currentLabel = nextAddr}
currentRegister -> modify $ \st->st{ currentRegister = nextAddr}
currentLogicLabel -> modify $ \st->st{ currentLogicLabel = nextAddr}
currentIfLabel -> modify $ \st->st{ currentIfLabel = nextAddr}
currentWhileLabel -> modify $ \st->st{ currentWhileLabel = nextAddr}
return current
func1::
..
current <- getcurrStateValue currentRegister
..
func2::
anothercurrent <- getcurrStateValue currentLogicLabel ```

Answer 1

As commenters have pointed out, in this case expression, you’re trying to compare the parameter x with the getter functions from the St type.
case x of
currentLabel -> modify $ \ st -> st { currentLabel = nextAddr }
currentRegister -> modify $ \ st -> st { currentRegister = nextAddr }
-- …
Unfortunately, functions cannot be compared; only data constructors and numeric literals (Num + Eq) can appear in basic patterns. What your code actually does is match x against anything, and bind it to a new local variable currentLabel, and then all the subsequent case branches (currentRegister and so on) are redundant, as the warning tells you.
It’s just as if you had written this, with distinct variable names:
case x of
a -> modify $ \ st -> st { currentLabel = nextAddr }
b -> modify $ \ st -> st { currentRegister = nextAddr }
-- …
A simple solution here is to add a new enumeration type indicating which field you want to modify, and pattern-match on that:
data Field
= CurrentLabel
| CurrentLogicLabel
| CurrentIfLabel
| CurrentWhileLabel
| CurrentRegister
getCurrStateValue :: Field -> Compile Int
getCurrStateValue field = case field of
CurrentLabel -> do
current <- gets currentLabel
modify $ \ st -> st { currentLabel = current + 1 }
pure current
CurrentRegister -> do
current <- gets currentRegister
modify $ \ st -> st { currentRegister = current + 1 }
pure current
CurrentLogicLabel -> do
current <- gets currentLogicLabel
modify $ \ st -> st { currentLogicLabel = current + 1 }
pure current
CurrentIfLabel -> do
current <- gets currentIfLabel
modify $ \ st -> st { currentIfLabel = current + 1 }
pure current
CurrentWhileLabel -> do
current <- gets currentWhileLabel
modify $ \ st -> st { currentWhileLabel = current + 1 }
pure current
As you can see, though, this is quite repetitive! A better solution is to pass both a getter and a setter function (whereas currently you’re only passing the getter):
getCurrStateValue
:: (St -> Int)
-> (St -> Int -> St)
-> Compile Int
getCurrStateValue getField setField = do
current <- gets getField
modify $ \ st -> setField st $ current + 1
pure current
Of course, now this has moved the repetitiveness to the call site, since you must pass both functions, and they must refer to the same field:
current <- getCurrStateValue
currentRegister
(\ st x -> st { currentRegister = x })
So an improvement would be to package up these invocations into helper functions for each field:
getCurrRegister = getCurrStateValue
currentRegister
(\ st x -> st { currentRegister = x })
getCurrLogicLabel = getCurrStateValue
currentLogicLabel
(\ st x -> st { currentLogicLabel = x })
I think this is a good place to stop: the repetition is abstracted away without too much heavy machinery.
However, this can be abstracted further. The combination of a getter and setter for the same field is very useful, and it would be nice to reuse it with other functions besides getCurrStateValue.
A getter+setter pair can be packaged up into a lens (or more generally an “optic”), which is a first-class accessor that can be composed with other lenses. While there are many lens libraries like lens (big and complete) and microlens (small and simple) containing functions for working with lenses, you don’t actually need any dependencies to define a lens; it’s just a function with a type like this:
(Functor f) => (a -> f b) -> s -> f t
Or, slightly simplified:
(Functor f) => (a -> f a) -> s -> f s
How this works is beyond the scope of this answer, but what it means is an accessor for a field of type a within a structure of type s. In your case, a is always Int and s is St. Here’s a helper function for defining a lens from a getter and setter:
lens
:: Functor f
=> (s -> a) -- get ‘a’ out of ‘s’
-> (s -> a -> s) -- put ‘a’ into ‘s’
-> (a -> f a) -> s -> f s -- lens
lens getter setter
= \ f s -> fmap (setter s) (f (getter s))
Using this, you can define lenses for your fields:
currentRegisterL, currentLogicLabelL -- …
:: (Functor f) => (Int -> f Int) -> St -> f St
currentRegisterL = lens
currentRegister
(\ st x -> st { currentRegister = x })
currentLogicLabelL = lens
currentLogicLabel
(\ st x -> st { currentLogicLabel = x })
-- …
And then use them with functions and types from lens, such as view to use the getter part and set to use the setter. To take a lens as a function parameter, you need the RankNTypes extension, which allows passing polymorphic functions like lenses as arguments to other functions.
{-# LANGUAGE RankNTypes #-}
import Control.Lens (Lens', set, view)
getCurrStateValue :: Lens' St Int -> Compile Int
getCurrStateValue field = do
current <- gets $ view field
modify $ set field $ current + 1
pure current
Most of the time, when using lenses, people don’t write their own by hand, unless they specifically want to avoid a dependency on a lens package. Instead, it’s common to automate this by deriving lenses for a data type with Template Haskell:
{-# LANGUAGE TemplateHaskell #-}
import Control.Lens.TH (makeLenses)
data St = St
{ _cotxt :: [Cxt]
, _currentLabel :: Int
, _currentLogicLabel :: Int
, _currentIfLabel :: Int
, _currentWhileLabel :: Int
, _currentRegister :: Int
}
makeLenses ''St
The convention is that the getters and record accessors are prefixed with an underscore, like _currentLabel, and the lenses derived from them have no prefix, like currentLabel. You can still use the accessor functions directly, but when you need to abstract over field access, you can use view, set, over, and other such functions.

Answer 2

Pattern matching only works with data constructors; it can't check for equality of values. (Patterns like x:xs, [x,y], and (x,y) are treated constructor matches.) In particular, there is no other general way to handle coproduct types like data Foo = Bar | Baz. (Aside from using Eq, Ord, etc.)
What you probably need here is a lens.