http://www.seas.upenn.edu/~cis194/spring13/hw/05-type-classes.pdf

gistfile1.hs

{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}

-- Homework 6 - http://www.seas.upenn.edu/~cis194/spring13/hw/05-type-classes.pdf

import ExprT
import Parser
import StackVM as VM
import qualified Data.Map as M
import Control.Monad

eval :: ExprT -> Integer
eval (ExprT.Lit n)         = n
eval (ExprT.Add exp1 exp2) = eval exp1 + eval exp2
eval (ExprT.Mul exp1 exp2) = eval exp1 * eval exp2

evalStr :: String -> Maybe Integer
evalStr = fmap eval . parseExp ExprT.Lit ExprT.Add ExprT.Mul

class Expr a where
    lit :: Integer -> a
    add :: a -> a -> a
    mul :: a -> a -> a

instance Expr ExprT where
    lit = ExprT.Lit
    add = ExprT.Add
    mul = ExprT.Mul

reify :: ExprT -> ExprT
reify = id

instance Expr Integer where
    lit = id
    add = (+)
    mul = (*)

instance Expr Bool where
    lit n | n <= 0 = False
          | n > 0  = True
    add = (||)
    mul = (&&)

newtype MinMax = MinMax Integer
                 deriving (Eq, Show)

instance Expr MinMax where
    lit x                     = MinMax x
    add (MinMax x) (MinMax y) = MinMax $ max x y
    mul (MinMax x) (MinMax y) = MinMax $ min x y

newtype Mod7 = Mod7 Integer
               deriving (Eq, Show)

instance Expr Mod7 where
    lit x                 = Mod7 $ x `mod` 7
    add (Mod7 x) (Mod7 y) = Mod7 $ (x+y) `mod` 7
    mul (Mod7 x) (Mod7 y) = Mod7 $ (x*y) `mod` 7

testExp :: Expr a => Maybe a
testExp = parseExp lit add mul "(3 * -4) + 5"

testInteger = testExp :: Maybe Integer
testBool    = testExp :: Maybe Bool
testMM      = testExp :: Maybe MinMax
testSat     = testExp :: Maybe Mod7

-- Exercise 5

instance Expr Program where
    lit x   = [VM.PushI x]
    add x y = x ++ y ++ [VM.Add]
    mul x y = x ++ y ++ [VM.Mul]

compile :: String -> Maybe Program
compile = parseExp lit add mul

-- Exercise 6

class HasVars a where
    var :: String -> a

data VarExprT = Lit Integer
              | Add VarExprT VarExprT
              | Mul VarExprT VarExprT
              | Var String
  deriving (Show, Eq)

instance Expr VarExprT where
    lit = Main.Lit
    add = Main.Add
    mul = Main.Mul

instance HasVars VarExprT where
    var = Main.Var

instance HasVars (M.Map String Integer -> Maybe Integer) where
    var = M.lookup

instance Expr (M.Map String Integer -> Maybe Integer) where
    add a b m = liftM2 (+) (a m) (b m)
    mul a b m = liftM2 (*) (a m) (b m)
    lit i = const $ Just i

withVars :: [(String,Integer)]
           -> (M.Map String Integer -> Maybe Integer)
           -> Maybe Integer

withVars vs exp = exp $ M.fromList vs