hw5/Calc.hs

   1 {-# LANGUAGE TypeSynonymInstances #-}
   2 {-# LANGUAGE FlexibleInstances #-}
   3 {-# OPTIONS_GHC -Wall #-}
   4
   5
   6 module Calc where
   7
   8 import qualified ExprT as E
   9 import Parser
  10 import StackVM
  11 import qualified Data.Map as M
  12
  13
  14 -- exercise 1
  15 eval :: E.ExprT -> Integer
  16 eval (E.Lit n) = n
  17 eval (E.Add e1 e2) = eval e1 + eval e2
  18 eval (E.Mul e1 e2) = eval e1 * eval e2
  19
  20 -- exercise 2
  21 evalStr :: String -> Maybe Integer
  22 -- evalStr s = case (parseExp Lit Add Mul s) of
  23 --               Just e -> Just (eval e)
  24 --              Nothing -> Nothing
  25 evalStr s = fmap eval (parseExp E.Lit E.Add E.Mul s)
  26
  27 class Expr a where
  28   lit :: Integer -> a
  29   add :: a -> a -> a
  30   mul :: a -> a -> a
  31
  32 instance Expr E.ExprT where
  33   lit = E.Lit
  34   add = E.Add
  35   mul = E.Mul
  36
  37 reify :: E.ExprT -> E.ExprT
  38 reify = id
  39
  40 instance Expr Integer where
  41   lit = id
  42   add = (+)
  43   mul = (-)
  44
  45 instance Expr Bool where
  46   lit x | x <= 0 = False
  47         | otherwise = True
  48   add = (||)
  49   mul = (&&)
  50
  51 newtype MinMax = MinMax Integer deriving (Show, Eq)
  52
  53 instance Expr MinMax where
  54   lit = MinMax
  55   add (MinMax x) (MinMax y) = MinMax (max x y)
  56   mul (MinMax x) (MinMax y) = MinMax (min x y)
  57
  58 newtype Mod7 = Mod7 Integer deriving (Show, Eq)
  59
  60 instance Expr Mod7 where
  61   lit x = Mod7 (x `mod` 7)
  62   add (Mod7 x) (Mod7 y) = Mod7 ((x+y) `mod` 7)
  63   mul (Mod7 x) (Mod7 y) = Mod7 ((x*y) `mod` 7)
  64
  65 -- exercise 5
  66 instance Expr Program where
  67   lit x = [PushI x]
  68   add x y = x ++ y ++ [Add]
  69   mul x y = x ++ y ++ [Mul]
  70
  71 compile :: String -> Maybe Program
  72 compile = parseExp lit add mul
  73
  74 -- exercise 6
  75 data VarExprT = VarLit Integer
  76               | VarAdd VarExprT VarExprT
  77               | VarMul VarExprT VarExprT
  78               | Var String
  79   deriving (Show, Eq)
  80
  81 class HasVars a where
  82   var :: String -> a
  83
  84 instance Expr VarExprT where
  85   lit = VarLit
  86   add = VarAdd
  87   mul = VarMul
  88
  89 instance HasVars VarExprT where
  90   var = Var
  91
  92 instance HasVars  (M.Map String Integer -> Maybe Integer) where
  93   var x = M.lookup x
  94
  95 instance Expr (M.Map String Integer -> Maybe Integer) where
  96   lit x = \_ -> Just x
  97   add x y = \m -> case (x m) of
  98                     Just xv -> case (y m) of
  99                                  Just yv -> Just (xv + yv)
 100                                  Nothing -> Nothing
 101                     Nothing -> Nothing
 102   mul x y = \m -> case (x m) of
 103                     Just xv -> case (y m) of
 104                                  Just yv -> Just (xv * yv)
 105                                  Nothing -> Nothing
 106                     Nothing -> Nothing
 107
 108 withVars :: [(String, Integer)]
 109          -> (M.Map String Integer -> Maybe Integer)
 110          -> Maybe Integer
 111 withVars vs exp = exp $ M.fromList vs