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
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156

------------------------------------------------------------------------------
--- Library with functional logic parser combinators.
---
--- Adapted from: Rafael Caballero and Francisco J. Lopez-Fraguas:
---               A Functional Logic Perspective of Parsing.
---               In Proc. FLOPS'99, Springer LNCS 1722, pp. 85-99, 1999
---
--- @author Michael Hanus
--- @version November 2020
------------------------------------------------------------------------------
{-# OPTIONS_FRONTEND -Wno-incomplete-patterns #-}

module Parser where

-- Operator declarations for the parser combinators:

infixr 4 <*>
infixr 3 >>>
infixr 2 <|>, <||>

-- We distinguish two kind of parsers:

-- A parser without a representation has type "[token] -> [token]":
-- it parses a list of tokens and returns the remaining unparsed tokens

type Parser token = [token] -> [token]

-- A parser with representation has type "rep -> [token] -> [token]":
-- in addition to the input tokens, it has the representation as an argument
-- (which is usually a free variable bound to the representation after parsing)

type ParserRep rep token = rep -> Parser token


-- Now we can define the basic combinators for parsers:

--- Combines two parsers without representation in an alternative manner.
(<|>)  :: Parser t -> Parser t -> Parser t
p <|> q = \sentence -> p sentence ? q sentence


--- Combines two parsers with representation in an alternative manner.
(<||>)  :: ParserRep r t -> ParserRep r t -> ParserRep r t
p <||> q = \rep -> p rep <|> q rep


--- Combines two parsers (with or without representation) in a
--- sequential manner.
(<*>)    :: Data t => Parser t -> Parser t -> Parser t
p1 <*> p2 = seq
 where seq sentence | p1 sentence =:= sent1 = p2 sent1  where sent1 free


--- Attaches a representation to a parser without representation.
(>>>) :: (Data token, Data rep) => Parser token -> rep -> ParserRep rep token
parser >>> repexp = attach
  where attach rep sentence | parser sentence =:= rest &> repexp =:= rep
                            = rest              where rest free


-- Finally, we define some useful basic parsers and derived combinators:

--- The empty parser which recognizes the empty word.
empty :: Parser _
empty sentence = sentence

--- A parser recognizing a particular terminal symbol.
terminal :: Data token => token -> Parser token
terminal sym (token:tokens) | sym=:=token = tokens

--- A parser (with representation) recognizing a terminal satisfying
--- a given predicate.
satisfy :: Data token => (token -> Bool) -> ParserRep token token
satisfy pred sym (token:tokens) | pred token =:= True & sym=:=token = tokens

--- A star combinator for parsers. The returned parser
--- repeats zero or more times a parser p with representation and
--- returns the representation of all parsers in a list.
star :: (Data token, Data rep) => ParserRep rep token -> ParserRep [rep] token
star p =    p x <*> (star p) xs >>> (x:xs)
       <||> empty               >>> []         where x,xs free

--- A some combinator for parsers. The returned parser
--- repeats the argument parser (with representation) at least once.
some :: (Data token, Data rep) => ParserRep rep token -> ParserRep [rep] token
some p = p x <*> (star p) xs >>> (x:xs)        where x,xs free


{-----------------------------------------------------------------------

As a simple example we define a parser for arithmetic expressions
over natural numbers. The presentation of this parser is the value
of the expression.

expression   =  term t <*> plus_minus op <*> expression e  >>> (op t e)
           <||> term
 where op,t,e free

term         =  factor f <*> prod_div op <*> term t        >>> (op f t)
           <||> factor
 where op,f,t free

factor       =  terminal '(' <*> expression e <*> terminal ')'  >>> e
           <||> num
 where e free

plus_minus   =  terminal '+'  >>> (+)
           <||> terminal '-'  >>> (-)

prod_div     =  terminal '*'  >>> (*)
           <||> terminal '/'  >>> div

num = some digit l >>> numeric_value l
  where l free
        numeric_value ds = foldl1 ((+).(10*)) (map (\c->ord c - ord '0') ds)

digit = satisfy isDigit


-- example application: expression val "(10+5*2)/4" =:= []

-----------------------------------------------------------------------}