Lecture 24

Programming Propositional Logic

Propositional logic is an important tool for reasoning about many things, including programs. But our immediate goal is to write programs that will help us in working with propositional formulae. Haskell is very well suited for this sort of work. We'll start by declaring the type of propositional formulae:

module Proposition where data Proposition = Var String | Boolean Bool | Not Proposition | And Proposition Proposition | Or Proposition Proposition | Implies Proposition Proposition deriving (Eq,Show)

Well, actually... . This is the way my code started for years, but these days, I recognize the tremendous utility of monads, even in contexts where they need to be teased out a bit. So I tried something a bit different:

data Prop a = Var a | Boolean Bool | Not (Prop a) | And (Prop a) (Prop a) | Or (Prop a) (Prop a) | Implies (Prop a) (Prop a) deriving (Eq, Show)

abstracting out the String coordinate in the Var constructor. With this, the monad instance is easy to write

instance Monad Prop where return = Var m >>= f = case m of Var a -> f a Boolean b -> Boolean b Not p -> unop Not p And p q -> binop And p q Or p q -> binop Or p q Implies p q -> binop Implies p q where unop op p = op (p >>= f) binop op p q = op (p >>= f) (q >>= f)

This is one of those odd cases where the case statement feels cleaner than a pattern-matching definition. Defining a Monad instance first gives us “free” instances of Functor and Applicative, which we'll need to define soon enough anyway. If they prove to be important, we might come back and re-implement them directly.

instance Functor Prop where fmap = liftM instance Applicative Prop where pure = return (<*>) = ap

A final typeclass is Foldable, and to write this, we'll just view a Prop as a container of a's, and not worry about the distinction between the various connectives. This turns out to be surprisingly useful, as well as very easy to write:

instance Foldable Prop where foldMap f = fm where fm m = case m of Var a -> f a Boolean b -> mempty Not p -> fm p And p q -> merge p q Or p q -> merge p q Implies p q -> merge p q where merge p q = fm p `mappend` fm q

Of course, if you look at the instance declarations for Monad and Foldable, there is that Yogi Berra sense of “deja vu all over again.” Both definitions are special cases of definition by primitive recursion, a pattern in which a function defined on an algebraic type calls itself recursively to process factors that have the same type, as with foldr. So let's write a function for defining functions with domain Prop a by primitive recursion:

primrec :: (a -> b) -- ^ Var -> (Bool -> b) -- ^ Boolean -> (b -> b) -- ^ Not -> (b -> b -> b) -- ^ And -> (b -> b -> b) -- ^ Or -> (b -> b -> b) -- ^ Implies -> Prop a -> b primrec varf boolf notf andf orf impliesf = result where result p = case p of Var a -> varf a Boolean b -> boolf b Not p -> notf (result p) And p q -> andf (result p) (result q) Or p q -> orf (result p) (result q) Implies p q -> impliesf (result p) (result q)

With this in hand, we can now express the special cases of (>>=) and foldMap concisely:

instance Monad Prop where prop >>= f = primrec f Boolean Not And Or Implies prop

and

instance Foldable Prop where foldMap f = primrec f (const mempty) id mappend mappend mappend

That's better. It will take a while for all this “infrastructure” work to pay off, but it will, in big bits and small.

Our major task for today is write a parser for propositional formulae. To that end, we'll have to deal with the unfortunate fact that the notion system that we've been using isn't especially friendly for keyboard input, so we're going to replace the standard logical symbols for propositional connectives with keyboard friendly versions: conjunction/and (&), disjunction/or (|), implication/implies (->), and negation (!). We'll also use T for $\ltrue$, and F for $\lfalse$.

We are going to write a precedence based parser. In doing so, it is easiest to start at the lowest level of precedence, corresponding to the connectives that have the least binding strength, and move up. Text.ParserCombinators.ReadP has combinators that make describing a single parsing level simple. So we'll start with:

parseProp :: ReadP a -> ReadP (Prop a) parseProp parseA = prec 0 where

The trickiness here is that we're trying to write a parser for a Prop a, when we know essentially nothing about a. To do that, we'll delegate the task of parsing a values to an argument. We'll start by defining a few utility parsers:

wchar :: Char -> ReadP Char wchar c = skipSpaces >> char c wstring :: String -> ReadP String wstring s = skipSpaces >> string s

which are variants of char and string respectively, but which skip any whitespace first. Of course, these days, we want to migrate parser code from Monad to Applicative, so we look through Control.Applicative for a operation that sequences two actions, and returns the second, finding (*>).

wchar c = skipSpaces *> char c wstring s = skipSpaces *> string s

Another convenience parser is

parseConst :: a -> ReadP b -> ReadP a parseConst value parser = fmap (const value) parser

Of course, this gets η-reduced:

parseConst value = fmap (const value)

The effect of parseConst is to parse an expression using the parser argument, but to throw out its result, returning value instead.

The main parser routine is prec, which takes a precedence-level argument.

prec 0 = chainr1 (prec 1) $ parseConst Implies $ wstring "->" prec 1 = chainl1 (prec 2) $ parseConst Or $ wchar '|' prec 2 = chainl1 (prec 3) $ parseConst And $ wchar '&' prec 3 = prefix (prec 4) $ parseConst Not $ wchar '!' prec 4 = parseBool +++ parseVar +++ parseParens (prec 0)

This makes heavy use of the chain parser combinators from Text.ParserCombinators.ReadP, which used to parse expressions of the form $p_1 \; op_1 \; p_2 \; ... \; p_{k-1} \; op_{k-1} \; p_k$, where each of the $p_i$'s is a subexpression, and each $op_i$ is a binary associative operator. There are four such combinators, chainr, chainl, chainr1, and chainl1. The difference between the r and l versions is whether the operators are specified as right or left associative respectively; the 1 versions require that there is at least one $p_i$, whereas the plain versions do not, but require a default value for the case where there are no $p_i$'s. We use chainr1, and chainl1, which have the type:

chainr1, chainl1 :: ReadP p -> ReadP (p -> p -> p) -> ReadP p

The first argument is the parser for the $p_i$'s, the second is a parser for the $op_i$'s, which returns an appropriate combining function.

We then provide specialized parsers

parseVar = skipSpaces *> fmap Var parseA parseBool = parseConst (Boolean True) (wchar 'T') +++ parseConst (Boolean False) (wchar 'F') parseParens = between (wchar '(') (wchar ')')

This leaves the prefix parser, which can be thought of as a unary analog to the chain parsers, but isn't a standard part of Text.ParserCombinators,ReadP:

prefix :: ReadP a -> ReadP (a -> a) -> ReadP a prefix p op = pp where pp = p +++ do f <- op a <- pp return $ f a

This goes through a couple of transformations, ending in Applicative style:

prefix p op = pp where pp = p +++ (op <*> pp)

Note that the parentheses are necessary here because (<*>) binds less tightly (at precedence level 4) than (+++) (at precedence level 5).

And that's about it, although most of these definitions ultimately get encapsulated within the definition of parseProp. Ordinarily, we'd just use parseProp in the definition of our type's Read instance, but we've made our life a little harder by generalizing out the String type in the Var constructor. It would be nice to define

instance Read (Prop String) where ...

but Haskell complains. We can only create a typeclass instance for a type constant, not for a type expression. Fortunately, we've seen a workaround:

newtype Proposition = Proposition { getProp :: Prop String } instance Read (Proposition) where readsPrec _ = readP_to_S $ fmap Proposition $ parseProp parseVar where parseVar = liftA2 (:) (satisfy isLower) (munch (liftA2 (||) isAlpha isDigit))

Here, Proposition is a simple type constant, proving a virtual box into which we put a Prop String instance. We provide a sub-parser for variables, requiring that they're a non-empty sequence of letters and digits, starting with a lower-case letter. This decision avoids ambiguity with our choice of T and F to encode they boolean constants. There's a bit of trickiness here. The first is to remember that the type (->) e is a monad and therefore an applicative in the same way, so we can use functions like liftA2 to build new functions based on the results of other functions. Neat, huh? Perhaps it is easier to note that we started with the following, and then transformed it to the definition of parseVar above:

do c <- satisfy isLower cs <- munch (\c -> isLower c || isDigit c) return $ c:cs

*Exercise 24.1

Write a small desktop calculator, based the following data type:

data Expression = DoubleValue Double | Sum Expression Expression | Difference Expression Expression | Product Expression Expression | Quotient Expression Expression

You should process input line-by-line, doing a proper precedence-based parse of each line, an evaluation of the resulting expression, and print the final result.

Don't worry about syntax errors, but try to make your calculator program as smooth as possible otherwise. Note also that you can define the parser directly, so there's no need for a Proposition-like extra type layer.

Note that generalizing the parsing strategy above requires dealing with multiple operators at the same precedence level, fortunately with the same associativity. This requires a more complicated "composing" parser than in the examples above, e.g.,

prec 0 = chainl1 (prec 1) (sum +++ difference) where sum = parseConst Sum $ wchar '+' difference = parseConst Difference $ wchar '-'

This exercise is very similar in specification to Lab 4, albeit with a very much larger programming toolkit, and you might find it interesting to review the code you wrote for Lab 4 after you've completed this exercise. You should, for your own benefit, compare and contrast the solutions.

At this point, we can test our parser. But making Proposition an instance of Show as well (this involves eliminating the "deriving Show" above).

We can approach this naively:

instance Show Proposition where show = showProp . getProp where showProp (Var v) = v showProp (Const True) = "T" showProp (Const False) = "F" showProp (Not p) = "!" ++ show p showProp (And p q) = "(" ++ show p ++ " & " ++ show q ++ ")" showProp (Or p q) = "(" ++ show p ++ " | " ++ show q ++ ")" showProp (Implies p q) = "(" ++ show p ++ " -> " ++ show q ++ ")"

But the results are unsatisfactory. E.g., the result of reading, then showing

(a|b) -> (a -> c) -> (b -> c) -> c

is

((a | b) -> ((a -> c) -> ((b -> c) -> c)))

As you can see, too many parentheses detract from readability. To avoid this, we have to go to precedence based output. The idea here is that we have a precedence context. If we're in too deep (whatever that means), we need parentheses, but we get to reset our precedence context.

One nuance here is that we'll want to have direct access to the precedence level in deciding when to parenthesize, and so we'll make the precedence level an argument to a more general prec function written at the level of Prop, in the style of parseProp:

showProp :: (a -> String) -> Prop a -> String showProp vshow = prec 0 where prec _ (Boolean True) = "T" prec _ (Boolean False) = "F" prec _ (Var v) = vshow v prec _ (Not p) = '!' : prec 3 p prec i (And s t) = paren 2 i $ prec 2 s ++ " & " ++ prec 2 t prec i (Or s t) = paren 1 i $ prec 1 s ++ " | " ++ prec 1 t prec i (Implies s t) = paren 0 i $ prec 1 s ++ " -> " ++ prec 0 t paren cutoff prec str | prec > cutoff = "(" ++ str ++ ")" | otherwise = str

and

instance Show Proposition where show = showProp id . getProp

There are a couple of things to notice here.

We can use the parser/formatter pair to do something that is already a bit interesting. Consider norm.hs:

module Main where import Control.Exception import System.Environment import System.IO import Proposition showArg :: String -> IO () showArg arg = do p <- try (readIO arg) :: IO (Either IOError Proposition) case p of Left _ -> putStrLn $ "Could not parse \'" ++ arg ++ "\'." Right r -> putStrLn $ show r main :: IO () main = do args <- getArgs mapM_ showArg args

This simply reads and writes a proposition. There is a bit of trickiness in the try (readIO arg) line, but for now, treat this as an idiom that allows us to catch any exception thrown by read via an ordinary Either type without having to write our own exception handlers (not that that's so hard, but we've not covered it).

Why is this interesting? Because beginning students are often confused about precedence, and will use way more parentheses than are actually necessary, e.g.

$ norm "(a&b) -> (a|b)" a & b -> a | b $

Exercise 24.2 Note that the it is not necessarily the case that

(read (show p)) == p

for all propositions p. Why? Does this really matter, and if it doesn't how might we explain ourselves?

Hint: Consider "a | (b | c)".

Code