[Haskell-cafe] From function over expression (+, *) derive function over expression (+)

Reid Barton rwbarton at math.harvard.edu
Fri Dec 4 13:14:14 EST 2009


On Fri, Dec 04, 2009 at 11:52:35AM -0600, Derek Elkins wrote:
> On Fri, Dec 4, 2009 at 11:26 AM, Radek Micek <radek.micek at gmail.com> wrote:
> > Hello.
> >
> > I have two types for expression:
> >
> > data Expr = Add Expr Expr | Mul Expr Expr | Const Int
> >
> > data AExpr = AAdd AExpr AExpr | AConst Int
> >
> > The first one supports addition and multiplication and the second
> > only addition.
> >
> > I can write a function to simplify the first expression:
> >
> > simplify :: Expr -> Expr
> > simplify = {- replaces:
> > "a*1" and "1*a" by "a",
> > "a+0" and "0+a" by a -}
> >
> > And I would like to use the function simplify for the second type
> > AExpr. What can I do is to convert AExpr to Expr, simplify it and
> > convert it back. But I don't like this solution because
> > conversions take some time.
> >
> > I would prefer following: I say to the compiler that AAdd is like Add
> > and AConst is like Const and the compiler derives function
> > asimplify for AExpr.
> >
> > Is it possible to do this? In fact I want to have two distinct types
> > where one is "extension" of the second (Expr is extension of AExpr)
> > and I want to define a function for the extended type (Expr) and
> > use it for the original type (AExpr). I assume that the function won't
> > introduce Mul to the expression which had no Mul.
> 
> What you'd ideally want is called refinement types which Haskell, and
> as far as I know, no practical language has.  There is a paper about a
> way to encode these, but it is fairly heavy-weight.  You could use
> phantom type trickery to combine the data types into one type but
> still statically check that only additive expressions are passed to
> certain functions, but that too is also probably more trouble than
> it's worth.

In this particular case, with only two types Expr and AExpr, the
encoding is not particularly onerous.

{-# LANGUAGE GADTs, EmptyDataDecls, ViewPatterns #-}

data M
data Blah

-- A value of type 'E a' can only involve multiplication when a is M
data E a where
  Const :: Int -> E a
  Add :: E a -> E a -> E a
  Mul :: E M -> E M -> E M

type Expr = E M
type AExpr = E Blah

-- The same simplify function we would write for the original Expr,
-- with a different type
simplify :: E a -> E a
simplify (Const x) = Const x
simplify (Add (simplify -> a) (simplify -> b)) = case (a, b) of
  (Const 0, _) -> b
  (_, Const 0) -> a
  _ -> Add a b
simplify (Mul (simplify -> a) (simplify -> b)) = case (a, b) of
  (Const 1, _) -> b
  (_, Const 1) -> a
  _ -> Mul a b

Regards,
Reid Barton


More information about the Haskell-Cafe mailing list