[project @ 1996-07-25 21:02:03 by partain]
[nofib.git] / real / ebnf2ps / HappyParser.ly
1                         -*- Mode: Haskell -*-
2
3 $Locker:  $
4 $Log: HappyParser.ly,v $
5 Revision 1.2  1996/07/25 21:23:57  partain
6 Bulk of final changes for 2.01
7
8 Revision 1.1  1996/01/08 20:02:36  partain
9 Initial revision
10
11
12 A happy specification for the happy input language.
13
14 > {
15 > module HappyParser (theHappyParser) where
16 > import AbstractSyntax
17 > import Lexer
18 > }
19
20 > %name localHappyParser
21 > %tokentype { Token' }
22 > %token
23 >       id_tok          { Ident' _ }
24 >       ":"             { Colon }
25 >       ";"             { Semicolon }
26 >       "::"            { DoubleColon }
27 >       "%%"            { DoublePercent }
28 >       "%"             { Percent }
29 >       "|"             { Bar }
30 >       "{"             { OpenBrace }
31 >       "}"             { ClosingBrace }
32 >       any_symbol      { Symbol' _ }
33 >       any_string      { String' _ }
34
35 %newline                { Symbol "\n" {- no new line token -} }
36
37 > %%
38
39 > parser :: { [Production] }
40 > parser
41 >       : optCode tokInfos "%%" rules optCode
42 >                               { reverse $4 }
43
44 > rules :: { [Production] }
45 > rules : rules rule    { $2 : $1 }
46 >       | rule          { [$1] }
47
48
49 > rule :: { Production }
50 > rule  : id_tok "::" code id_tok ":" prods     { ProdProduction (getIdent' $4) [] (ProdTerm $6) }
51 >       | id_tok ":" prods                      { ProdProduction (getIdent' $1) [] (ProdTerm $3) }
52
53
54 > prods :: { [Production] }
55 > prods : prod "|" prods                        { $1 : $3 }
56 >       | prod                                  { [$1] }
57
58 > prod :: { Production }
59 > prod  : prodItems code ";"                    { ProdFactor $1 }
60 >       | prodItems code                        { ProdFactor $1 }
61
62 > prodItems :: { [Production] }
63 > prodItems
64 >       : prodItem prodItems                    { $1 : $2 }
65 >       |                                       { [] }
66
67 > prodItem :: { Production }
68 > prodItem
69 >       : any_string                            { ProdTerminal (getString' $1) }
70 >       | id_tok                                { ProdNonterminal (getIdent' $1) }
71
72 > tokInfos :: { () } 
73 > tokInfos 
74 >       : tokInfo tokInfos              { () }
75 >       | tokInfo                       { () }
76
77 > tokInfo :: { () }
78 > tokInfo
79 >       : "%" id_tok tokInfoRest        { () }
80
81 > tokInfoRest :: { () }
82 > tokInfoRest
83 >       : code                          { () }
84 >       | id_tok                        { () }
85 >       | tokenList                     { () }
86
87 > tokenList :: { () }
88 > tokenList
89 >       : id_tok code tokenList         { () }
90 >       | any_string code tokenList             { () }
91 >       |                       { () }
92
93 here goes optCode:
94
95 > optCode :: { () }
96 > optCode 
97 >       : code                  { () }
98 >       |                                       { () }
99
100 > code :: { () }
101 > code  : "{" codeBody "}"      { () }
102
103 > codeBody :: { () }
104 > codeBody
105 >       : codeItem codeBody     { () }
106 >       | codeItem              { () }
107
108 > codeItem :: { () }
109 > codeItem
110 >       : any_string            { () }
111 >       | id_tok                { () }
112 >       | code                  { () }
113 >       | any_symbol            { () }
114 >       | ":"    { () }
115 >       | ";"    { () }
116 >       | "::"   { () }
117 >       | "|"    { () }
118 >       | "%%"   { () }
119 >       | "%"    { () }
120
121 > {
122
123 > happyError :: Int -> Int -> [Token'] -> a
124 > happyError s i ts = error ("Parse error in line " ++ show i ++
125 >                          " [state " ++ show s ++ "]" ++
126 >                          case ts of
127 >                          [] -> " (at EOF)\n"
128 >                          _  ->  "\n" ++ show (take 20 ts) ++ "\n")
129
130 A preprocessor for literal scripts (slow)
131
132 > unlit :: String -> String
133 > unlit = unlines . map (tail.tail) . filter p . lines
134 >     where p ('>':' ':_)  = True
135 >           p ('>':'\t':_) = True
136 >           p _            = False
137
138 A postprocessor to make happy happy.
139
140 > data Token' = Ident' String | Symbol' String | String' String
141 >             | Percent | DoublePercent | OpenBrace | ClosingBrace
142 >             | Colon | Semicolon | DoubleColon | Bar
143
144 > instance Show Token' where
145 >   showsPrec n (Ident' s) = showChar '[' . showString s . showString "] "
146 >   showsPrec n (Symbol' s) = showChar '<' . showString s . showString "> "
147 >   showsPrec n (String' s) = showChar '"' . showString s . showString "\" "
148 >   showsPrec n Percent = showString "% "
149 >   showsPrec n DoublePercent = showString "%% "
150 >   showsPrec n OpenBrace  = showString "{ "
151 >   showsPrec n ClosingBrace = showString "} "
152 >   showsPrec n Colon = showString ": "
153 >   showsPrec n Semicolon = showString "; "
154 >   showsPrec n DoubleColon = showString ":: "
155
156
157 > postlexer = map f
158 >   where f (Symbol "%%") = DoublePercent
159 >         f (Symbol "%")  = Percent
160 >         f (Symbol "{")  = OpenBrace
161 >         f (Symbol "}")  = ClosingBrace
162 >         f (Symbol "::") = DoubleColon
163 >         f (Symbol ":")  = Colon
164 >         f (Symbol ";")  = Semicolon
165 >         f (Symbol "|")  = Bar
166 >         f (Symbol s)    = Symbol' s
167 >         f (Ident  s)    = Ident' s
168 >         f (String s)    = String' s
169
170 > getIdent' (Ident' x) = x
171 > getString' (String' x) = x
172
173 > theHappyParser = localHappyParser . postlexer . lexer . unlit
174
175 > }