How to remove some duplication from this code?

Previous Topic Next Topic
 
classic Classic list List threaded Threaded
2 messages Options
Reply | Threaded
Open this post in threaded view
|

How to remove some duplication from this code?

Peter Hall
I'm following this article about GADTs
[http://en.wikibooks.org/wiki/Haskell/GADT] and it suggests, as an
exercise, to handle invalid trees at runtime, without GADTs, when
evaluating a simple arithmetic syntax tree. My attempt is below.

It seems to work, but I could do with some feedback, as it isn't quite
satisfactory. It feels like I should be able to remove some of the
duplicated code in the eval function, and also in evalIntExpr and
evalBoolExpr, which are identical except for having Left and Right
reversed.

Thanks,

Peter


-------- Arithmetic.hs

module Arithmetic where
import Data.Maybe

data Expr = I Int
    | B Bool
    | Add Expr Expr
    | Mult Expr Expr
    | Eq Expr Expr

eval :: Expr -> Maybe (Either Bool Int)
eval (B b) = return $ Left b
eval (I i) = return $ Right i
eval (Mult e1 e2) = do
    a1 <- evalIntExpr e1
    a2 <- evalIntExpr e2
    return $ Right $ a1 * a2
eval (Add e1 e2) = do
    a1 <- evalIntExpr e1
    a2 <- evalIntExpr e2
    return $ Right $ a1 + a2
eval (Eq e1 e2) = do
    a1 <- evalIntExpr e1
    a2 <- evalIntExpr e2
    return $ Left $ a1 == a2


evalIntExpr :: Expr -> Maybe Int
evalIntExpr e = eval e >>= unwrap
        where
            unwrap (Right x) = Just x
            unwrap (Left x) = Nothing


evalBoolExpr :: Expr -> Maybe Bool
evalBoolExpr e = eval e >>= unwrap
        where
            unwrap (Left x) = Just x
            unwrap (Right x) = Nothing



------- Main.hs

module Main (
    main
) where

import Arithmetic
import Data.Maybe
import Data.Either

test :: Expr
test = Eq
        (Mult
            (Add
                (I 1)
                (I 2)
            )
            (I 5)
        )
        (I 15)

main :: IO ()
main = do
    putStrLn $ case eval test of
        Nothing -> "Invalid expression"
        Just (Left x) -> show x
        Just (Right x) -> show x


Reply | Threaded
Open this post in threaded view
|

How to remove some duplication from this code?

Mike Meyer
On Tue, 13 Dec 2011 21:40:13 +0000
Peter Hall <peter.hall at memorphic.com> wrote:

> It seems to work, but I could do with some feedback, as it isn't quite
> satisfactory. It feels like I should be able to remove some of the
> duplicated code in the eval function, and also in evalIntExpr and
> evalBoolExpr, which are identical except for having Left and Right
> reversed.

I'm also relatively new at this. My first thought was "eval should be
pure". After going back and reading the description, and thinking
about why you were running in the Maybe monad, I figured out what was
going on.

Anyway, here's my take on it. I've left your code quoted, added the
new code in unquoted, and deleted what it replaced.

    <mike


> -------- Arithmetic.hs
>
> module Arithmetic where
> import Data.Maybe
>
> data Expr = I Int
>     | B Bool
>     | Add Expr Expr
>     | Mult Expr Expr
>     | Eq Expr Expr
>
> eval :: Expr -> Maybe (Either Bool Int)
> eval (B b) = return $ Left b
> eval (I i) = return $ Right i

eval (Mult e1 e2) = applyIntOp Right (*) e1 e2
eval (Add e1 e2) = applyIntOp Right (+) e1 e2
eval (Eq e1 e2) = applyIntOp Left (==) e1 e2

applyIntOp :: (t -> b) -> (Int -> Int -> t) -> Expr -> Expr -> Maybe b
applyIntOp const func e1 e2 = do
    a1 <- evalIntExpr e1
    a2 <- evalIntExpr e2
    return $ const $ func a1 a2


> evalIntExpr :: Expr -> Maybe Int
evalIntExpr e = eval e >>= (either (\_ -> Nothing) Just)

> evalBoolExpr :: Expr -> Maybe Bool
evalBoolExpr e = eval e >>= (either Just (\_ -> Nothing))

>
> ------- Main.hs
>
> module Main (
>     main
> ) where
>
> import Arithmetic
> import Data.Maybe
> import Data.Either
>
> test :: Expr
> test = Eq
>         (Mult
>             (Add
>                 (I 1)
>                 (I 2)
>             )
>             (I 5)
>         )
>         (I 15)
>
> main :: IO ()
> main = do
>     putStrLn $ case eval test of
>         Nothing -> "Invalid expression"
>         Just (Left x) -> show x
>         Just (Right x) -> show x