-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathParser.hs
70 lines (55 loc) · 2.01 KB
/
Parser.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
module Parser (
parse
) where
import Types
-- "p q not or" -> Or p (not q)
fromRpn :: String -> Formula
fromRpn form = head . foldl folder [Variable $ head form] $ tail $ words form
where folder (x:y:ys) "and" = And y x: ys
folder (x:y:ys) "or" = Or y x : ys
folder (x:xs) "not" = Not x : xs
folder (x:y:ys) "implies" = Implies y x : ys
folder arr [x] = Variable x : arr
folder _ _ = error "incorrect input ;c"
-- up to first "("
dump :: ([String], [String]) -> ([String], [String])
dump (a, "(" : xs) = (a, xs)
dump (a, x : xs) = dump (x : a, xs)
toRpn :: [String] -> String
toRpn str = (unwords . reverse . fst) (foldl func ([], []) (("(" : str) ++ [")"]))
where func (a, b) "(" = (a, "(" : b)
func (a, b) ")" = dump (a, b)
func (a, b) [v] = ([v] : a, b)
func (a, b) op = (a, op : b)
-- "(p) or (q)" -> ["(","p",")","or","(","q",")"]
clean :: String -> [String]
clean = words . foldr func []
where func ')' arr = " ) " ++ arr
func '(' arr = " ( " ++ arr
func x xs = x : xs
parse :: String -> Formula
parse = fromRpn . toRpn . clean
{- CNF part
-- "(a,b),(x,y)..." -> ["a,b", "x,y",...]
parseOut :: String -> [String]
parseOut str = head x : map tail (tail x)
where x = map tail $ endBy ")" str
-- "a" -> Literal 'a', "~a" -> Negated 'a'
getLiteral :: String -> Literal
getLiteral [a] = Literal a
getLiteral ('~':[a]) = Negated a
getLiteral x = error $ "wrong literal! " ++ x
-- "(a,b),(x,y)" -> [Literal 'a',...]
parseCnf :: String -> Cnf
parseCnf str = map (Clause . map getLiteral . splitOn ",") (parseOut str)
-}
{-
-- ["(", "p", "or", "q", ")"] -> "p q or"
toRpn :: [String] -> String
toRpn strs = unwords $ reverse (if null a then fs else (let [x] = a in x) : fs)
where func a "(" = a
func (acc, x : xs) ")" = (x : acc, xs)
func (acc, ops) [v] = ([v] : acc, ops)
func (acc, ops) sth = (acc, sth : ops)
(fs, a) = foldl func ([], []) strs
-}