Grundlagen der Funktionalen Programmierung: Auswertung arithmetischer Ausdrücke
| Grundlagen der Funktionalen Programmierung: Auswertung arithmetischer Ausdrücke |
|
 | ||
 |  | |
|
1module Expr0 where
2import ShowTree
3
4data Expr = Const Int
5 | Bin Op2 Expr Expr
6 | Un Op1 Expr
7 deriving (Show)
8
9data Op2 = Add | Sub | Mul | Div
10 deriving (Show)
11
12data Op1 = Plus | Minus | Abs
13 deriving (Show)
14
15eval :: Expr -> Int
16eval (Const n) = n
17eval (Bin op e1 e2) = apply2 op (eval e1) (eval e2)
18eval (Un op e1) = apply1 op (eval e1)
19
20apply2 :: Op2 -> (Int -> Int -> Int)
21apply2 Add = (+)
22apply2 Sub = (-)
23apply2 Mul = (*)
24apply2 Div = div
25
26apply1 :: Op1 -> (Int -> Int)
27apply1 Plus = id
28apply1 Minus = \ x -> 0 - x
29apply1 Abs = abs
30
31-- ----------------------------------------
32--
33-- example expr
34
35e1 :: Expr
36e1 = Bin Mul (Un Abs (Bin Sub (Const 1)
37 (Const 8)
38 )
39 )
40 (Bin Div (Const 13)
41 (Const 2)
42 )
43
44v1 :: Int
45v1 = eval e1
46
47-- ----------------------------------------
48--
49-- pretty printing expr
50
51prettyExpr :: Expr -> String
52prettyExpr (Const n) = show n
53prettyExpr (Bin op e1 e2) = "("
54 ++ prettyExpr e1
55 ++ " "
56 ++ prettyOp2 op
57 ++ " "
58 ++ prettyExpr e2
59 ++ ")"
60prettyExpr (Un op e1) = "("
61 ++ prettyOp1 op
62 ++ prettyExpr e1
63 ++ ")"
64
65prettyOp2 :: Op2 -> String
66prettyOp2 Add = "+"
67prettyOp2 Sub = "-"
68prettyOp2 Mul = "*"
69prettyOp2 Div = "`div`"
70
71prettyOp1 Plus = "+"
72prettyOp1 Minus = "-"
73prettyOp1 Abs = "abs "
74
75-- ----------------------------------------
76--
77-- pseudo graphical tree output for expr
78
79showExpr :: Expr -> String
80showExpr = formatStringNTree . toNTree
81 where
82 toNTree (Const n) = NTree (show n) []
83 toNTree (Bin op2 e1 e2) = NTree (show op2) [toNTree e1, toNTree e2]
84 toNTree (Un op1 e1) = NTree (show op1) [toNTree e1]
85
86printExpr :: Expr -> IO ()
87printExpr = putStrLn . showExpr
88
89-- ----------------------------------------
|
|
1module Expr1 where
2import ShowTree
3
4data Expr a = Const a
5 | Bin Op2 (Expr a) (Expr a)
6 | Un Op1 (Expr a)
7 deriving (Show)
8
9data Op2 = Add | Sub | Mul | Div
10 deriving (Show)
11
12data Op1 = Plus | Minus | Abs
13 deriving (Show)
14
15-- --------------------
16--
17-- functor instance for Expr
18
19mapExpr :: (a -> b) -> Expr a -> Expr b
20mapExpr f (Const n) = Const (f n)
21mapExpr f (Bin op e1 e2) = Bin op (mapExpr f e1) (mapExpr f e2)
22mapExpr f (Un op e1) = Un op (mapExpr f e1)
23
24instance Functor Expr where
25 fmap = mapExpr
26
27-- --------------------
28--
29-- the general evaluator
30
31eval :: (Op2 -> (a -> a -> a)) ->
32 (Op1 -> (a -> a)) ->
33 Expr a -> a
34eval apply2 apply1 e = eval' e
35 where
36 eval' (Const n) = n
37 eval' (Bin op e1 e2) = apply2 op (eval' e1) (eval' e2)
38 eval' (Un op e1) = apply1 op (eval' e1)
39
40-- --------------------
41--
42-- integer arithmetic
43
44apply2i :: Integral a => Op2 -> (a -> a -> a)
45apply2i Add = (+)
46apply2i Sub = (-)
47apply2i Mul = (*)
48apply2i Div = div
49
50-- --------------------
51--
52-- fractional arithmetic
53
54apply2r :: Fractional a => Op2 -> (a -> a -> a)
55apply2r Add = (+)
56apply2r Sub = (-)
57apply2r Mul = (*)
58apply2r Div = (/)
59
60-- --------------------
61--
62-- common arithmetic
63
64apply1 :: Num a => Op1 -> (a -> a)
65apply1 Plus = id
66apply1 Minus = \ x -> 0 - x
67apply1 Abs = abs
68
69-- --------------------
70--
71-- two different evaluators
72
73evali :: Expr Integer -> Integer
74evali = eval apply2i apply1
75
76evalr :: Expr Double -> Double
77evalr = eval apply2r apply1
78
79-- ----------------------------------------
80--
81-- example expr
82
83e1 :: Num a => Expr a
84e1 = Bin Mul (Un Abs (Bin Sub (Const 1)
85 (Const 8)
86 )
87 )
88 (Bin Div (Const 13)
89 (Const 2)
90 )
91
92v1 :: Integer
93v1 = evali e1
94
95v2 :: Double
96v2 = evalr e1
97
98-- ----------------------------------------
99
100e1' :: Expr String
101e1' = fmap show e1
102
103apply2s :: Op2 -> (String -> String -> String)
104apply2s Add = binToString "+"
105apply2s Sub = binToString "-"
106apply2s Mul = binToString "*"
107apply2s Div = binToString "/"
108
109binToString op s1 s2 =
110 "(" ++ s1 ++ " " ++ op ++ " " ++ s2 ++ ")"
111
112apply1s :: Op1 -> (String -> String)
113apply1s Plus = unToString "+"
114apply1s Minus = unToString "-"
115apply1s Abs = unToString "abs"
116
117unToString op s1 =
118 "(" ++ op ++ " " ++ s1 ++ ")"
119
120evals :: Expr String -> String
121evals = eval apply2s apply1s
122
123exprToString :: Show a => Expr a -> String
124exprToString = evals . fmap show
125
126-- ----------------------------------------
127--
128-- test output
129
130showExpr :: Show a => Expr a -> String
131showExpr = formatStringNTree . toNTree
132 where
133 toNTree (Const n) = NTree (show n) []
134 toNTree (Bin op2 e1 e2) = NTree (show op2) [toNTree e1, toNTree e2]
135 toNTree (Un op1 e1) = NTree (show op1) [toNTree e1]
136
137printExpr :: Show a => Expr a -> IO ()
138printExpr = putStrLn . showExpr
139
140-- ----------------------------------------
|
|
Expr0.hs Expr1.hs ShowTree.hs |
 | | |
| | |
| Letzte Änderung: 17.01.2018 | © Prof. Dr. Uwe Schmidt |