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
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
|
/**********************************************************************
* *
* *
* Declarations *
* *
* *
**********************************************************************/
#include "hspincl.h"
#include "constants.h"
#include "utils.h"
#define PARSER_VERSION "1.3-???"
tree root; /* The root of the built syntax tree. */
list Lnil;
BOOLEAN nonstandardFlag = FALSE; /* Set if non-std Haskell extensions to be used. */
BOOLEAN acceptPrim = FALSE; /* Set if Int#, etc., may be used */
BOOLEAN haskell1_2Flag = FALSE; /* Set if we are compiling for 1.2 */
BOOLEAN etags = FALSE; /* Set if we're parsing only to produce tags. */
BOOLEAN hashIds = FALSE; /* Set if Identifiers should be hashed. */
BOOLEAN ignoreSCC = TRUE; /* Set if we ignore/filter scc expressions. */
BOOLEAN implicitPrelude = TRUE; /* Set if we implicitly import the Prelude. */
BOOLEAN ignorePragmas = FALSE; /* Set if we want to ignore pragmas */
/* From time to time, the format of interface files may change.
So that we don't get gratuitous syntax errors or silently slurp in
junk info, two things: (a) the compiler injects a "this is a
version N interface":
{-# GHC_PRAGMA INTERFACE VERSION <n> #-}
(b) this parser has a "minimum acceptable version", below which it
refuses to parse the pragmas (it just considers them as comments).
It also has a "maximum acceptable version", above which...
The minimum is so a new parser won't try to grok overly-old
interfaces; the maximum (usually the current version number when
the parser was released) is so an old parser will not try to grok
since-upgraded interfaces.
If an interface has no INTERFACE VERSION line, it is taken to be
version 0.
*/
int minAcceptablePragmaVersion = 7; /* 1.3-xx ONLY */
int maxAcceptablePragmaVersion = 7; /* 1.3-xx+ */
int thisIfacePragmaVersion = 0;
char *input_file_dir; /* The directory where the input file is. */
char HiSuffix[64] = ".hi"; /* can be changed with -h flag */
char PreludeHiSuffix[64] = ".hi"; /* can be changed with -g flag */
static BOOLEAN verbose = FALSE; /* Set for verbose messages. */
/* Forward decls */
static void who_am_i PROTO((void));
/**********************************************************************
* *
* *
* Utility Functions *
* *
* *
**********************************************************************/
# include <stdio.h>
# include "constants.h"
# include "hspincl.h"
# include "utils.h"
void
process_args(argc,argv)
int argc;
char **argv;
{
BOOLEAN keep_munging_option = FALSE;
imports_dirlist = mklnil();
sys_imports_dirlist = mklnil();
argc--, argv++;
while (argc > 0 && argv[0][0] == '-') {
keep_munging_option = TRUE;
while (keep_munging_option && *++*argv != '\0') {
switch(**argv) {
/* -I dir */
case 'I':
imports_dirlist = lapp(imports_dirlist,*argv+1);
keep_munging_option = FALSE;
break;
/* -J dir (for system imports) */
case 'J':
sys_imports_dirlist = lapp(sys_imports_dirlist,*argv+1);
keep_munging_option = FALSE;
break;
case 'g':
strcpy(PreludeHiSuffix, *argv+1);
keep_munging_option = FALSE;
break;
case 'h':
strcpy(HiSuffix, *argv+1);
keep_munging_option = FALSE;
break;
case 'v':
who_am_i(); /* identify myself */
verbose = TRUE;
break;
case 'N':
nonstandardFlag = TRUE;
acceptPrim = TRUE;
break;
case '2':
haskell1_2Flag = TRUE;
break;
case 'S':
ignoreSCC = FALSE;
break;
case 'p':
ignorePragmas = TRUE;
break;
case 'P':
implicitPrelude = FALSE;
break;
case 'D':
#ifdef HSP_DEBUG
{ extern int yydebug;
yydebug = 1;
}
#endif
break;
/* -Hn -- Use Hash Table, Size n (if given) */
case 'H':
hashIds = TRUE;
if(*(*argv+1)!= '\0')
hash_table_size = atoi(*argv+1);
break;
case 'E':
etags = TRUE;
break;
}
}
argc--, argv++;
}
if(argc >= 1 && freopen(argv[0], "r", stdin) == NULL) {
fprintf(stderr, "Cannot open %s.\n", argv[0]);
exit(1);
}
if(argc >= 2 && freopen(argv[1], "w", stdout) == NULL) {
fprintf(stderr, "Cannot open %s.\n", argv[1]);
exit(1);
}
/* By default, imports come from the directory of the source file */
if ( argc >= 1 )
{
char *endchar;
input_file_dir = xmalloc (strlen(argv[0]) + 1);
strcpy(input_file_dir, argv[0]);
#ifdef macintosh
endchar = rindex(input_file_dir, (int) ':');
#else
endchar = rindex(input_file_dir, (int) '/');
#endif /* ! macintosh */
if ( endchar == NULL )
{
free(input_file_dir);
input_file_dir = ".";
}
else
*endchar = '\0';
}
/* No input file -- imports come from the current directory first */
else
input_file_dir = ".";
imports_dirlist = mklcons( input_file_dir, imports_dirlist );
if (verbose)
{
fprintf(stderr,"Hash Table Contains %d entries\n",hash_table_size);
if(acceptPrim)
fprintf(stderr,"Allowing special syntax for Unboxed Values\n");
}
}
void
error(s)
char *s;
{
fprintf(stderr, "PARSER: Error %s\n", s);
exit(1);
}
static void
who_am_i(void)
{
fprintf(stderr,"Glasgow Haskell parser, version %s\n", PARSER_VERSION);
}
list
lconc(l1, l2)
list l1;
list l2;
{
list t;
if (tlist(l1) == lnil)
return(l2);
for(t = l1; tlist(ltl(t)) != lnil; t = ltl(t))
;
ltl(t) = l2;
return(l1);
}
list
lapp(list l1, VOID_STAR l2)
{
list t;
if (tlist(l1) == lnil)
return(mklcons(l2, mklnil()));
for(t = l1; tlist(ltl(t)) != lnil; t = ltl(t))
;
ltl(t) = mklcons(l2, mklnil());
return(l1);
}
|
