diff options
author | Gregor Kleen <gkleen@yggdrasil.li> | 2015-11-24 14:29:20 +0100 |
---|---|---|
committer | Gregor Kleen <gkleen@yggdrasil.li> | 2015-11-24 14:29:20 +0100 |
commit | 76b9e428426e2afeb67f48c094bbc0225563dd3d (patch) | |
tree | 0c10c68b5963a8e11724cba86879d4c395a7ab4b /ws2015/ffp/blaetter/06/FFP_U06b_ApplParse.hs | |
parent | 154ed6744254b0d7553e40071656b53382816123 (diff) | |
download | uni-76b9e428426e2afeb67f48c094bbc0225563dd3d.tar uni-76b9e428426e2afeb67f48c094bbc0225563dd3d.tar.gz uni-76b9e428426e2afeb67f48c094bbc0225563dd3d.tar.bz2 uni-76b9e428426e2afeb67f48c094bbc0225563dd3d.tar.xz uni-76b9e428426e2afeb67f48c094bbc0225563dd3d.zip |
FFP - 06 (partially) & 06b
Diffstat (limited to 'ws2015/ffp/blaetter/06/FFP_U06b_ApplParse.hs')
-rw-r--r-- | ws2015/ffp/blaetter/06/FFP_U06b_ApplParse.hs | 256 |
1 files changed, 256 insertions, 0 deletions
diff --git a/ws2015/ffp/blaetter/06/FFP_U06b_ApplParse.hs b/ws2015/ffp/blaetter/06/FFP_U06b_ApplParse.hs new file mode 100644 index 0000000..b63e800 --- /dev/null +++ b/ws2015/ffp/blaetter/06/FFP_U06b_ApplParse.hs | |||
@@ -0,0 +1,256 @@ | |||
1 | -- Fortgeschrittene Funktionale Programmierung, | ||
2 | -- LMU, TCS, Wintersemester 2015/16 | ||
3 | -- Steffen Jost, Alexander Isenko | ||
4 | -- | ||
5 | -- Übungsblatt 06b. 25.11.2015 | ||
6 | -- | ||
7 | -- Thema: Applikativer Parser | ||
8 | -- | ||
9 | -- Als Beispiel betrachten wir hier einen primitiven applikativen Parser. | ||
10 | -- Alles wesentliche liegt in dieser Datei vor. | ||
11 | -- Dies hat den Nachteil, dass es die Datei aufbläht; | ||
12 | -- aber auch den Vorteil, dass man genau sehen kann wie alles funktioniert. | ||
13 | -- Also nicht abschrecken lassen, Ihr müsst hier nicht alle Details verstehen! | ||
14 | -- | ||
15 | -- Die Funktionen orientieren sich an den Modulen Text.Parsec | ||
16 | -- und Text.ParserCombinators.ReadP welche zwei verschiedene | ||
17 | -- monadische Parser zur Verfügung stellen, d.h. dieses Beispiel | ||
18 | -- könnte man auch tatsächlich nutzen, um einen richtigen Parser zu schreiben. | ||
19 | -- Beide Module setzen jedoch entgegen der vereinfachten Version hier | ||
20 | -- eine volle Monade ein, anstatt lediglich einen applikativen | ||
21 | -- Funktor zu verwenden, welcher auch ausreicht! | ||
22 | -- | ||
23 | -- Aufgabenstellung folgt in Zeile 169 | ||
24 | -- | ||
25 | |||
26 | import Data.Maybe | ||
27 | import Data.Char as Char | ||
28 | import Data.Functor | ||
29 | import Control.Applicative | ||
30 | import Data.Traversable | ||
31 | |||
32 | -- newtype eines Parser wird für Instanzdeklarationen benötigt | ||
33 | newtype Parser a = Parser (String -> [(a,String)]) | ||
34 | |||
35 | runParser :: Parser a -> String -> [(a,String)] | ||
36 | runParser (Parser p) s = p s | ||
37 | |||
38 | runParserComplete :: Parser a -> String -> [a] | ||
39 | runParserComplete (Parser p) s = [ r |(r,"") <- p s] | ||
40 | |||
41 | parse :: Parser a -> String -> Maybe a -- returns first complete parse | ||
42 | parse p s = listToMaybe $ runParserComplete p s | ||
43 | |||
44 | -- Die Instanzdeklarationen | ||
45 | instance Functor Parser where | ||
46 | fmap f (Parser p) = Parser $ \s -> map (\(a,b) -> (f a, b)) $ p s | ||
47 | |||
48 | instance Applicative Parser where | ||
49 | -- pure :: a -> Parser a -- konsumiert keine Eingabe und liefer immer ein Ergebnis | ||
50 | pure x = Parser $ \s -> [(x,s)] | ||
51 | |||
52 | -- <*> :: Parser (a -> b) -> Parser a -> Parser b -- parsed eine Funktion und aus dem Rest der Eingabe ein Argument für diese Funktion und liefert das Ergebnis | ||
53 | (Parser p1) <*> (Parser p2) = Parser $ \inp -> | ||
54 | [(r1 r2, rem2) | (r1,rem1) <- p1 inp, (r2,rem2) <- p2 rem1] | ||
55 | |||
56 | -- Ebenfalls in Modul Control.Applicative definiert: | ||
57 | -- Typklasse Alternative ist eine Unterklasse für Applikative Funktoren | ||
58 | -- mit Monoid-Strultur, d.h.: es gibt eine binäre Verküpfung mit neutralem Element! | ||
59 | instance Alternative Parser where | ||
60 | -- empty :: Parser a -- neutrales Element, ein Parser der immer fehlschlägt | ||
61 | empty = Parser $ \s -> [] | ||
62 | |||
63 | -- <|> :: Parser a -> Parser a -> Parser a -- verknüpft zwei Parser zu einem Parser, welcher beides alternativ parsen kann | ||
64 | (Parser p1) <|> (Parser p2) = Parser pbranches | ||
65 | where | ||
66 | pbranches s | ||
67 | | null r1 = r2 | ||
68 | | null r2 = r1 | ||
69 | | otherwise = r1 ++ r2 | ||
70 | where | ||
71 | r1 = p1 s | ||
72 | r2 = p2 s | ||
73 | |||
74 | -- Basic Parsers | ||
75 | satisfy :: (Char -> Bool) -> Parser Char -- parse a desired character | ||
76 | satisfy p = Parser check | ||
77 | where | ||
78 | check (c:s) | p c = [(c,s)] -- successful | ||
79 | check _ = [ ] -- no parse | ||
80 | |||
81 | char :: Char -> Parser Char -- parse a certain character | ||
82 | char c = satisfy (c ==) | ||
83 | |||
84 | space :: Parser Char -- exactly one space character | ||
85 | space = satisfy isSpace | ||
86 | |||
87 | alpha :: Parser Char -- any alpha chars (no numbers or special symbols) | ||
88 | alpha = satisfy isAlpha | ||
89 | |||
90 | upper :: Parser Char | ||
91 | upper = satisfy isUpper | ||
92 | |||
93 | lower :: Parser Char | ||
94 | lower = satisfy isLower | ||
95 | |||
96 | digit :: Parser Int | ||
97 | digit = n2n <$> satisfy isDigit | ||
98 | where | ||
99 | n2n '0' = 0 | ||
100 | n2n '1' = 1 | ||
101 | n2n '2' = 2 | ||
102 | n2n '3' = 3 | ||
103 | n2n '4' = 4 | ||
104 | n2n '5' = 5 | ||
105 | n2n '6' = 6 | ||
106 | n2n '7' = 7 | ||
107 | n2n '8' = 8 | ||
108 | n2n '9' = 9 | ||
109 | |||
110 | -- Zusammengesetze Parser | ||
111 | string :: Parser String -- acccepts any string | ||
112 | string = some (satisfy $ (\_ -> True)) | ||
113 | |||
114 | keyword :: String -> Parser String -- accepts only a certain string | ||
115 | keyword = traverse char | ||
116 | |||
117 | name :: Parser String -- akzeptiert alle Strings aus Buchstaben | ||
118 | name = some $ satisfy isAlpha | ||
119 | |||
120 | name1 :: Parser String -- akzeptiert alle Strings aus Buchstaben mit großen Anfangsbuchstaben | ||
121 | name1 = (:) <$> (satisfy isUpper) <*> (many $ satisfy isAlpha) | ||
122 | |||
123 | skipSpaces :: Parser () -- zero or more spaces skipped | ||
124 | skipSpaces = (\_ -> ()) <$> many space | ||
125 | |||
126 | skipSpaces1 :: Parser () -- one or more spaces skipped | ||
127 | skipSpaces1 = (\_ -> ()) <$> some space | ||
128 | |||
129 | natural :: Parser Int -- parse natural number | ||
130 | natural = accum <$> some digit | ||
131 | where | ||
132 | accum = foldl (\a n -> n + a*10) 0 | ||
133 | |||
134 | ptwo :: Parser a -> Parser b -> Parser (a,b) -- parse 2-tupel | ||
135 | ptwo p1 p2 = (,) <$> p1 <*> p2 | ||
136 | |||
137 | pPair :: Parser a -> Parser b -> Parser (a,b) -- parse (,)-encased pair | ||
138 | pPair p1 p2 = (,) <$> (char '(' *> p1 <* char ',') <*> p2 <* char ')' | ||
139 | |||
140 | |||
141 | {- instance Functor ((,) a) is defined in `GHC.Base' | ||
142 | mapSnd :: (b -> c) -> (a,b) -> (a,c) | ||
143 | mapSnd f (x,y) = (x,(f y)) | ||
144 | -} | ||
145 | |||
146 | |||
147 | -- Beispiele: | ||
148 | -- | ||
149 | -- > parse upper "A" | ||
150 | -- Just 'A' | ||
151 | -- | ||
152 | -- > parse upper "AB" | ||
153 | -- Nothing | ||
154 | -- | ||
155 | -- > runParser upper "AB" | ||
156 | -- [('A',"B")] | ||
157 | -- | ||
158 | -- > runParser natural "12a" | ||
159 | -- [(12,"a"),(1,"2a")] | ||
160 | -- | ||
161 | -- > runParser (ptwo natural string) "12a" | ||
162 | -- [((12,"a"),""),((1,"2a"),""),((1,"2"),"a")] | ||
163 | |||
164 | |||
165 | |||
166 | -- AUFGABE 6-4 | ||
167 | -- | ||
168 | -- Die geforderten Lösungen sind alles Einzeiler, | ||
169 | -- welche im wesentlichen <$> und <*> einsetzen. | ||
170 | -- Als Muster sollten Sie sich die Funktionen ptwo, name1 und später evtl. pPair anschauen! | ||
171 | -- | ||
172 | -- a) | ||
173 | -- Schreiben Sie einen Parser für den Typ Person: | ||
174 | data Person = Person String deriving (Eq, Show) | ||
175 | |||
176 | -- Namen dürfen nur aus Buchstaben bestehen und müssen mit Großbuchstaben beginnen. | ||
177 | -- | ||
178 | -- Hinweis: schauen Sie sich die Funktionen name und name1 an. | ||
179 | -- Diese können Sie nicht nur verwenden, sondern dienen auch als Beispiel. | ||
180 | -- | ||
181 | -- Zusatz: Ihr Parser verlangt zuerst das Schlüsselwort "Person" vor dem eigentlichen Namen | ||
182 | -- Schlagen Sie dazu die Funktion *> im Modul Control.Applicative nach! | ||
183 | |||
184 | -- Beispiele: | ||
185 | -- > parse pPerson "Fred" | ||
186 | -- Just (Person "Fred") | ||
187 | -- | ||
188 | -- > runParser pPerson "Fred" | ||
189 | -- [(Person "Fred",""),(Person "Fre","d"),(Person "Fr","ed"),(Person "F","red")] | ||
190 | -- | ||
191 | -- > parse pPerson2 "Person Fred" | ||
192 | -- Just (Person "Fred") | ||
193 | -- | ||
194 | -- > parse pPerson2 "Fred" | ||
195 | -- Nothing | ||
196 | |||
197 | pPerson1 :: Parser Person | ||
198 | pPerson1 = Person <$> name1 | ||
199 | |||
200 | pPerson2 :: Parser Person | ||
201 | pPerson2 = keyword "Person" *> skipSpaces *> pPerson1 | ||
202 | |||
203 | |||
204 | -- b) Parsen Sie einen Student mit Matrikelnummer: | ||
205 | data Student = Student String Int deriving (Eq, Show) | ||
206 | |||
207 | -- Zusatz: Ihr Parser verlangt zuerst das Schlüsselwort "Student" vor dem eigentlichen Namen | ||
208 | -- und erlaubt (oder fordert) Leerzeichen zwischen Student, Namen und Nummer! | ||
209 | -- skipSpaces und skipSpaces1 helfen hier weiter! | ||
210 | |||
211 | pStudent1 :: Parser Student | ||
212 | pStudent1 = Student <$> name1 <* skipSpaces <*> natural | ||
213 | |||
214 | pStudent2 :: Parser Student | ||
215 | pStudent2 = keyword "Student" *> skipSpaces *> pStudent1 | ||
216 | |||
217 | -- Beispiele: | ||
218 | -- > parse pStudent1 "Fred0123" | ||
219 | -- Just (Student "Fred012" 3) | ||
220 | -- | ||
221 | -- > parse pStudent2 "Student Fred 0123" | ||
222 | -- Just (Student "Fred" 123) | ||
223 | -- | ||
224 | -- > parse pStudent2 "StudentFred0123" | ||
225 | -- Nothing | ||
226 | |||
227 | |||
228 | -- c) Parsen Sie einen (Hochschul-)Lehrer: | ||
229 | data Lehrer = Prof String | Dozent Titel String deriving (Eq, Show) | ||
230 | data Titel = Dr | Herr deriving (Eq, Show) | ||
231 | -- Verwenden Sie dazu die Funktion <|>, welche Sie ebenfalls in Modul Control.Applicative nachschlagen können! | ||
232 | -- Es ist dazu hilfreich, mehrere einzelne Funktionen zu schreiben, | ||
233 | -- wie hier im Gerüst vorgegeben. (Das ist aber kein Zwang!) | ||
234 | |||
235 | prof :: Parser Lehrer | ||
236 | prof = Prof <$ keyword "Prof" <* skipSpaces <*> name1 | ||
237 | |||
238 | dozent :: Parser Lehrer | ||
239 | dozent = Dozent <$> titel <* skipSpaces <*> name1 | ||
240 | |||
241 | titel :: Parser Titel | ||
242 | titel = (Dr <$ keyword "Dr") <|> (Herr <$ keyword "Herr") | ||
243 | |||
244 | lehrer :: Parser Lehrer | ||
245 | lehrer = prof <|> dozent | ||
246 | |||
247 | -- Beispiele: | ||
248 | -- | ||
249 | -- > parse lehrer "Prof Martin" | ||
250 | -- Just (Prof "Martin") | ||
251 | -- | ||
252 | -- > parse lehrer "Dr Jost" | ||
253 | -- Just (Dozent Dr "Jost") | ||
254 | -- | ||
255 | -- > parse prof "Dr Jost" | ||
256 | -- Nothing | ||