Thinking Functionally with Haskell (49 page)

A simple expression is a sequence of one or more terms separated by composition:
simple :: Parser Expr

simple = do {es <- somewith (symbol ".") term;

return (Compose (concatMap deCompose es))}

The function
concatMap f
as an alternative to
concat . map f
is provided in the standard prelude, and
deCompose
is defined by
deCompose :: Expr -> [Atom]

deCompose (Compose as) = as

Next, a term is an identifier, either a variable or a constant, possibly with arguments, or a parenthesised expression:
term :: Parser Expr

term = ident args <|> paren expr

args = many (ident none <|> paren expr)

The parser
ident
takes a parser for a list of expressions and returns a parser for expressions:
ident :: Parser [Expr] -> Parser Exp

ident args

= do {x <- token (some (sat isAlphaNum));

Parsing.guard (isAlpha (head x));

if isVar x

then return (Compose [Var x])

else if (x == "id")

then return (Compose [])

else

do {as <- args;

return (Compose [Con x as])}}

The test for being a variable is implemented by

isVar [x]
= True

isVar [x,d] = isDigit d

isVar _
= False

Note that any identifier consisting entirely of alphanumeric characters and beginning with a letter and which is not a variable is a constant.

Next, we make
Expr
and
Atom
instances of
Show
. As in the previous chapter we
will do this by defining
showsPrec p
for each type. A little thought reveals that we need three values for
p
:

• At top level, there is no need for parentheses. For example, we write all of
  map f . map g
  ,
  foo * baz
  , and
  bar bie doll
  without parentheses. We assign
  p=0
  to this case.
  
• When an expression is a composition of terms, or an operator expression, occurring as an argument to a constant, we need to parenthesise it. For example, parentheses are necessary in the expression
  

map (f . g) . foo f g . (bar * bar)

But we don’t have to parenthesise the middle term. We assign
p=1
to this case.

• Finally,
  p=2
  means we should parenthesise compositions of terms, operator expressions and curried functions of at least one argument, as in
  

map (f . g) . foo (foldr f e) g . (bar * bar)

Here goes. We start with

instance Show Expr where

showsPrec p (Compose []) = showString "id"

showsPrec p (Compose [a]) = showsPrec p a

showsPrec p (Compose as)

= showParen (p>0) (showSep " . " (showsPrec 1) as)

The last line makes use of the function
showSep
, defined by
showSep :: String -> (a -> ShowS) -> [a] -> ShowS

showSep sep f

= compose . intersperse (showString sep) . map f

The utility function
compose
is defined by
compose = foldr (.) id
. The function
intersperse :: a -> [a] -> [a]
can be found in
Data.List
and intersperses its first argument between elements of its second. For example,
intersperse ',' "abcde" == "a,b,c,d,e"

The two occurrences of
showsPrec
on the right-hand sides of the second two clauses of
showsPrec
refer to the corresponding function for atoms:
instance Show Atom where

showsPrec p (Var v) = showString v

showsPrec p (Con f []) = showString f

showsPrec p (Con f [e1,e2])

| isOp f = showParen (p>0) (showsPrec 1 e1 . showSpace .

showString f . showSpace . showsPrec 1 e2)

showsPrec p (Con f es)

= showParen (p>1) (showString f . showSpace .

showSep " " (showsPrec 2) es)

isOp f = all symbolic f

The value
p=2
is needed in the final clause because we want parentheses in, for example,
foo (bar bie) doll
. Variables and nullary constants never need parentheses.

A module structure

The final step is to install these definitions, and possibly others, in a module for expressions. Such a module will include all the functions specifically related to expressions.

Creating such a module is not immediate because we do not yet know what other functions on expressions we may need in other modules, modules that deal with laws, calculations and so on. But for the moment we declare
module Expressions

(Expr (Compose), Atom (Var,Con),

VarName, ConName, deCompose, expr)

where

import Parsing

import Data.List (intersperse)

import Utilities (compose)

import Data.Char (isAlphaNum,isAlpha,isDigit)

The module
Expressions
has to be stored in a file
Expressions.lhs
to enable Haskell to find out where it resides. It exports the types
Expr
and
Atom
along with their constructors. It also exports the type synonyms
VarName
and
ConName
, as well as the functions
deCompose
and
expr
, all of which are likely to be needed in the module that deals with laws. Later on we might add more functions on expressions to this export list.

Next comes the imports. We import the module
Parsing
that contains the parsing functions, and also some functions from
Data.List
and
Data.Char
. We will also set up a module
Utilities
containing general utility functions. A good example
of a utility function is
compose
, defined above. It is not specific to expressions and may be needed in other places, so we put it into the utilities module.

We define laws in the following way:

data Law
= Law LawName Equation

type LawName
= String

type Equation
= (Expr,Expr)

A law consists of a descriptive name and an equation. To parse a law we define:

law :: Parser Law

law = do {name <- upto ':';

eqn <- equation;

return (Law name eqn)}

The parsing function
upto c
returns the string up to but not including the character
c
, and then discards
c
if found. It wasn’t included among the parsing functions of the previous chapter, but we will put it into the module
Parsing
to avoid breaking the parser abstraction. One definition is:
upto :: Char -> Parser String

upto c

= Parser (\s ->

let (xs,ys) = break (==c) s in

if null ys then []

else [(xs,tail ys)])

The parser
equation
is defined by

equation :: Parser Equation

equation = do {e1 <- expr;

symbol "=";

e2 <- expr;

return (e1,e2)}

We probably don’t need to show laws, but here is the definition anyway:

instance Show Law where

showsPrec _ (Law name (e1,e2))

= showString name .

showString ": " .

shows e1 .

showString " = " .

shows e2

The precedence number is not needed to define
showPrec
so it is made a don’t care pattern. Recall that
shows
takes a printable value, here an expression, and returns a function of type
ShowS
, a synonym for
String -> String
.

Finally we sort the laws:

sortLaws :: [Law] -> [Law]

sortLaws laws = simple ++ others ++ defns

where

(simple,nonsimple) = partition isSimple laws

(defns,others) = partition isDefn nonsimple

This definition makes use of a
Data.List
function
partition
that partitions a list:
partition p xs = (filter p xs, filter (not . p) xs)

The various tests are defined by

isSimple (Law _ (Compose as1,Compose as2))

= length as1 > length as2

isDefn (Law _ (Compose [Con f es], _))

= all isVar es

isDefn _ = False

isVar (Compose [Var _]) = True

isVar _ = False

The test
isVar
also appears in the module
Expressions
though with a different definition. There is no problem though since that function is not exported from the expressions module.

Here is the module declaration for laws:

module Laws

(Law (Law), LawName, law, sortLaws,

Equation, equation)

where

import Expressions

import Parsing

import Data.List (partition)

Having shown how to parse and print expressions and laws, we can now define two functions, one a version of
calculate
that consumes strings rather than laws and expressions:
simplify :: [String] -> String -> Calculation

simplify strings string

= let laws = map (parse law) strings

e = parse expr string

in calculate laws e

In a similar vein we can define

prove :: [String] -> String -> Calculation

prove strings string

= let laws = map (parse law) strings

(e1,e2) = parse equation string

in paste (calculate laws e1) (calculate laws e2)

These two functions can be put in a module
Main
. We put
paste
and
calculate
into a module concerned solely with calculations, and we turn to this module next.

Calculations are defined by

data Calculation = Calc Expr [Step]

type Step
= (LawName,Expr)

Let’s begin with the key definition of the calculator, that of
calculate
:
calculate :: [Law] -> Expr -> Calculation

calculate laws e = Calc e (manyStep rws e)

where rws e = [(name,e')

| Law name eqn <- sortedlaws,

e' <- rewrites eqn e,

e' /= e]

sortedlaws = sortLaws laws

The function
rewrites :: Equation -> Expr -> [Expr]
returns a list of all the possible ways of rewriting an expression using a given equation, a function that will be defined in a separate module. It may be the case that an expression can be rewritten to itself (see Exercise H), but such rewrites are disallowed because they would lead to infinite calculations. The function
rws :: Expr -> [Step]
returns a list of all the single steps, leading to new expressions, that can arise by using the laws in all possible ways. This list is defined by taking each law in turn and generating all the rewrites associated with the law. That means we give preference to laws over subexpressions in calculations, resolving one of the issues we worried about in the first section. Only experimentation will show if we have made the right decision.

The function
manyStep
uses
rws
to construct as many steps as possible:
manyStep :: (Expr -> [Step]) -> Expr -> [Step]

manyStep rws e

= if null steps then []

else step : manyStep rws (snd step)

where steps = rws e

step = head steps

The calculation ends if
rws e
is the empty list; otherwise the head of the list is used to continue the calculation.

The remaining functions of the calculations module deal with showing and pasting calculations. We show a calculation as follows:
instance Show Calculation where

showsPrec _ (Calc e steps)

= showString "\n " .

shows e .

showChar '\n' .

compose (map showStep steps)

Each individual step is shown as follows:

showStep :: Step -> ShowS

showStep (why,e)

= showString "= {" .

showString why .

showString "}\n " .

shows e .

showChar '\n'

In order to paste two calculations together we have to reverse the steps of a calculation. For example, the calculation
Calc e0 [(why1,e1),(why2,e2),(why3,e3)]

has to be turned into

Calc e3 [(why3,e2),(why2,e1),(why1,e0)]

In particular, the conclusion of a calculation is the first expression in the reversed calculation. Here is how to reverse a calculation:
reverseCalc :: Calculation -> Calculation