parse.icl 155 KB
Newer Older
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
1
implementation module parse
Pieter Koopman's avatar
Pieter Koopman committed
2

Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
3
import StdEnv
4
import scanner, syntax, hashtable, utilities, predef, compilerSwitches
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
5
6

ParseOnly :== False
7
8

//import RWSDebug
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
9

10
11
12
toLineAndColumn {fp_line, fp_col}
	=	{lc_line = fp_line, lc_column = fp_col}

Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
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
// +++ move to utilities?

groupBy :: (a a -> Bool) [a] -> [[a]]
groupBy eq []
    =   []
groupBy eq [h : t]
    =   [[h : this] : groupBy eq other]
    where
        (this, other)
            =   span (eq h) t

/*

Parser for Clean 2.0

Conventions:

- Parsing funtions with a name of the form try.. can fail without generating an error.
  The parser will try an other alternative.
- Parsing functions with a name of the form want.. should succeed. If these functions
  fail an error message is generated.
- Functions with names containing the character '_' are local functions.
- All functions should consume the tokens taken form the state or given as argument,
  or put these tokens back themselves.

*/

::	*ParseErrorAdmin = 
	{	pea_file	:: !*File
	,	pea_ok		:: !Bool
	}

:: *ParseState =
	{	ps_scanState		:: !ScanState
	,	ps_error			:: !*ParseErrorAdmin
	,	ps_skipping			:: !Bool
	,	ps_hash_table		:: !*HashTable
	,	ps_pre_def_symbols	:: !*PredefinedSymbols
51
	,	ps_support_generics :: !Bool // AA: compiler option "-generics"
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
52
	}
clean's avatar
clean committed
53
/*
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
54
55
56
57
appScanState :: (ScanState -> ScanState) !ParseState -> ParseState
appScanState f pState=:{ps_scanState}
	#	ps_scanState = f ps_scanState
	=	{	pState & ps_scanState = ps_scanState }
clean's avatar
clean committed
58
59
60
61
62
63
*/
appScanState f pState:==appScanState pState
	where
	appScanState pState=:{ps_scanState}
		#	ps_scanState = f ps_scanState
		=	{	pState & ps_scanState = ps_scanState }
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
64

clean's avatar
clean committed
65
/*
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
66
67
68
69
accScanState :: (ScanState -> (.t,ScanState)) !ParseState -> (.t,ParseState)
accScanState f pState=:{ps_scanState}
	#	( x, ps_scanState) = f ps_scanState
	=	( x, {pState & ps_scanState = ps_scanState })
clean's avatar
clean committed
70
71
72
73
74
75
*/
accScanState f pState:== accScanState pState
	where
		accScanState pState=:{ps_scanState}
			#	( x, ps_scanState) = f ps_scanState
			=	( x, {pState & ps_scanState = ps_scanState })
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
76

77
78
79
80
instance getFilename ParseState
where
	getFilename pState = accScanState getFilename pState

Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
81
82
83
84
makeStringTypeSymbol pState=:{ps_pre_def_symbols}
	#! string_id = ps_pre_def_symbols.[PD_StringType]
	= (MakeNewTypeSymbIdent string_id.pds_ident 0, pState)

85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
makeListTypeSymbol :: Int Int !*ParseState -> *(!TypeSymbIdent,!*ParseState)
makeListTypeSymbol head_strictness arity pState=:{ps_pre_def_symbols}
	# pre_def_list_index=if (head_strictness==HeadLazy)
							PD_ListType
						(if (head_strictness==HeadStrict)
							PD_StrictListType
							PD_UnboxedListType)
	#! list_id = ps_pre_def_symbols.[pre_def_list_index]
	= (MakeNewTypeSymbIdent list_id.pds_ident arity, pState)

makeTailStrictListTypeSymbol :: Int Int !*ParseState -> *(!TypeSymbIdent,!*ParseState)
makeTailStrictListTypeSymbol head_strictness arity pState=:{ps_pre_def_symbols}
	# pre_def_list_index=if (head_strictness==HeadLazy)
							PD_TailStrictListType
						(if (head_strictness==HeadStrict)
							PD_StrictTailStrictListType
							PD_UnboxedTailStrictListType)
	#! list_id = ps_pre_def_symbols.[pre_def_list_index]
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
	= (MakeNewTypeSymbIdent list_id.pds_ident arity, pState)

makeLazyArraySymbol arity pState=:{ps_pre_def_symbols}
	#! lazy_array_id = ps_pre_def_symbols.[PD_LazyArrayType]
	= (MakeNewTypeSymbIdent lazy_array_id.pds_ident arity, pState)

makeStrictArraySymbol arity	pState=:{ps_pre_def_symbols}
	#! strict_array_id = ps_pre_def_symbols.[PD_StrictArrayType]
	= (MakeNewTypeSymbIdent strict_array_id.pds_ident arity, pState)

makeUnboxedArraySymbol arity pState=:{ps_pre_def_symbols}
	#! unboxed_array_id = ps_pre_def_symbols.[PD_UnboxedArrayType]
	= (MakeNewTypeSymbIdent unboxed_array_id.pds_ident arity, pState)

makeTupleTypeSymbol form_arity act_arity  pState=:{ps_pre_def_symbols}
	#! tuple_id = ps_pre_def_symbols.[GetTupleTypeIndex form_arity]
	= (MakeNewTypeSymbIdent tuple_id.pds_ident act_arity, pState)
	
class try a	 :: !Token !*ParseState -> (!Optional a, !*ParseState)
class want a :: !*ParseState -> (!a, !*ParseState)

124
125
126
127
128
129
130
stringToIdent s i p :== (ident,parse_state)
	where
		({boxed_ident=ident},parse_state) = stringToBoxedIdent s i p

//stringToIdent :: !String !IdentClass !*ParseState -> (!Ident, !*ParseState)
stringToBoxedIdent :: !String !IdentClass !*ParseState -> (!BoxedIdent, !*ParseState)
stringToBoxedIdent ident ident_class pState=:{ps_hash_table}
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
131
132
133
	# (ident, ps_hash_table) = putIdentInHashTable ident ident_class ps_hash_table
	= (ident, { pState & ps_hash_table = ps_hash_table } )

134
135
136
137
138
139
140
internalIdent s p :== (ident,parse_state)
	where
		({boxed_ident=ident},parse_state) = internaBoxedlIdent s p

//internalIdent :: !String !*ParseState -> (!Ident, !*ParseState)
internaBoxedlIdent :: !String !*ParseState -> (!BoxedIdent, !*ParseState)
internaBoxedlIdent prefix pState
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
141
	# ({fp_line,fp_col},pState=:{ps_hash_table})	= getPosition pState
142
143
144
// MW4 was: (changed to make it compatible with conventions used in postparse)
// 	  case_string									= prefix +++ toString fp_line +++ "_" +++ toString fp_col
	  case_string									= prefix +++ ";" +++ toString fp_line +++ ";" +++ toString fp_col
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
145
146
147
148
149
150
151
152
153
	  (case_ident, ps_hash_table)					= putIdentInHashTable case_string IC_Expression ps_hash_table
	= (case_ident, { pState & ps_hash_table = ps_hash_table } )

erroneousIdent = { id_name = "", id_info = nilPtr }

/*
	Some general overloaded parsing routines
*/

Pieter Koopman's avatar
Pieter Koopman committed
154
155
wantSequence :: !Token !ScanContext !*ParseState -> (!.[a],!*ParseState) | want a
wantSequence separator scanContext pState
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
156
	# (first, pState) = want pState
Pieter Koopman's avatar
Pieter Koopman committed
157
	  (token, pState) = nextToken scanContext pState
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
158
	| separator == token
Pieter Koopman's avatar
Pieter Koopman committed
159
		# (rest, pState) = wantSequence separator scanContext pState
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
160
161
162
163
		= ([first : rest], pState)
	// otherwise // separator <> token
	= ([first], tokenBack pState)
/*
Pieter Koopman's avatar
Pieter Koopman committed
164
165
optionalSequence start_token separator scanContext pState
	# (token, pState) = nextToken scanContext pState
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
166
	| token == start_token
Pieter Koopman's avatar
Pieter Koopman committed
167
		= wantSequence separator scanContext pState
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
168
169
170
171
172
173
174
175
176
177
178
179
180
		= ([], tokenBack pState)
*/
parseList try_fun pState :== parse_list pState // try_fun *
//parseList try_fun pState = parse_list pState
	where
	//	parse_list :: !*ParseState -> (tree, *ParseState)
		parse_list pState
			# (succ, tree, pState) = try_fun pState
			| succ
				# (trees, pState) = parse_list pState
				= ([tree : trees], pState)
			= ([], pState)

Pieter Koopman's avatar
Pieter Koopman committed
181
182
//wantSepList msg sep_token scanContext try_fun pState = want_list msg pState
wantSepList msg sep_token scanContext try_fun pState :== want_list msg pState // try_fun (sep_token tryfun)*
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
183
184
185
186
	where
		want_list msg pState
			# (succ, tree, pState) = try_fun pState
			| succ
Pieter Koopman's avatar
Pieter Koopman committed
187
			 	# (token, pState) = nextToken scanContext pState
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
188
			 	| token == sep_token
Pieter Koopman's avatar
Pieter Koopman committed
189
					# (trees, pState) = optSepList sep_token scanContext try_fun pState
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
190
191
192
193
					= ([tree : trees], pState)
				// otherwise // token <> sep_token
					= ([tree], tokenBack pState)
				# (token, pState) = nextToken GeneralContext pState
194
				= ([tree], parseError ("wantList of "+msg) (Yes token) msg pState)
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
195

Pieter Koopman's avatar
Pieter Koopman committed
196
197
//optSepList sep_token scanContext try_fun pState = want_list msg pState
optSepList sep_token scanContext try_fun pState :== want_list pState // [ try_fun (sep_token tryfun)* ]
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
198
199
200
201
	where
		want_list pState
			# (succ, tree, pState) = try_fun pState
			| succ
Pieter Koopman's avatar
Pieter Koopman committed
202
			 	# (token, pState) = nextToken scanContext pState
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
			 	| token == sep_token
					# (trees, pState) = want_list pState
					= ([tree : trees], pState)
				// otherwise // token <> sep_token
					= ([tree], tokenBack pState)
			= ([], pState)

//wantList msg try_fun pState = want_list msg pState
wantList msg try_fun pState :== want_list msg pState // try_fun +
	where
		want_list msg pState
			# (succ, tree, pState) = try_fun pState
			| succ
				# (trees, pState) = parseList try_fun pState
				= ([tree : trees], pState)
				# (token, pState) = nextToken GeneralContext pState
219
				= ([tree], parseError ("wantList of "+msg) (Yes token) msg pState)
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
220
221
222
223
224
225
226
227
/*
instance want (a,b) | want a & want b
where
	want pState
		# (x, pState) = want pState
		  (y, pState) = want pState
		= ((x,y), pState)
*/
Pieter Koopman's avatar
Pieter Koopman committed
228
229
wantModuleIdents :: !ScanContext !IdentClass !ParseState -> (![Ident], !ParseState)
wantModuleIdents scanContext ident_class pState
230
	# (first_name, pState) = wantModuleName pState
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
231
	  (first_ident, pState) = stringToIdent first_name ident_class pState
Pieter Koopman's avatar
Pieter Koopman committed
232
	  (token, pState) = nextToken scanContext pState
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
233
	| token == CommaToken
Pieter Koopman's avatar
Pieter Koopman committed
234
		# (rest, pState) = wantModuleIdents scanContext ident_class pState
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
		= ([first_ident : rest], pState)
	= ([first_ident], tokenBack pState)

optionalPriority :: !Bool !Token !ParseState -> (Priority, !ParseState)
optionalPriority isinfix (PriorityToken prio) pState
	= (prio, pState)
optionalPriority isinfix token pState
	| isinfix
		= (DummyPriority, tokenBack pState)
		= (NoPrio, tokenBack pState)

/*
	Modules
*/

::	ParseContext	:== Int

cICLContext			:== 1
cGlobalContext		:== 2
cDCLContext			:== 0
cLocalContext		:== 1

257
258
259
260
261
262
263
264
265
266
267
// RWS ...
/*
	A cClassOrInstanceDefsContext is a further restriction on a
	local context, because no local node defs are allowed
	This context stuff is getting far too complicated.
	Possible solution: accept everything in the parser and
	discriminate in postparse, depending on the context.
*/
cClassOrInstanceDefsContext :== 4
// ... RWS

Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
268
269
270
271
SetGlobalContext iclmodule
	| iclmodule
		= cICLContext bitor cGlobalContext
		= cDCLContext bitor cGlobalContext
272

Pieter Koopman's avatar
Pieter Koopman committed
273
SetLocalContext parseContext 	:== parseContext bitand (bitnot cGlobalContext)
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
274

275
// RWS ...
Pieter Koopman's avatar
Pieter Koopman committed
276
SetClassOrInstanceDefsContext parseContext :== SetLocalContext (parseContext bitor cClassOrInstanceDefsContext)
277
278
// ... RWS

Pieter Koopman's avatar
Pieter Koopman committed
279
280
isLocalContext parseContext	:== parseContext bitand cGlobalContext == 0
isGlobalContext parseContext	:== not (isLocalContext parseContext)
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
281

Pieter Koopman's avatar
Pieter Koopman committed
282
283
isDclContext parseContext	:== parseContext bitand cICLContext == 0
isIclContext parseContext	:== not (isDclContext parseContext)
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
284

285
// RWS ...
Pieter Koopman's avatar
Pieter Koopman committed
286
isClassOrInstanceDefsContext parseContext	:== parseContext bitand cClassOrInstanceDefsContext <> 0
287
288
// ... RWS

Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
289
290
291
cWantIclFile :== True	
cWantDclFile :== False	

292
wantModule :: !Bool !Ident !Position !Bool !*HashTable !*File !SearchPaths !*PredefinedSymbols (ModTimeFunction *Files) !*Files
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
293
	-> (!Bool, !ParsedModule, !*HashTable, !*File, !*PredefinedSymbols, !*Files)
294
295
296
wantModule iclmodule file_id=:{id_name} import_file_position support_generics hash_table error searchPaths pre_def_symbols modtimefunction files
	= case openScanner file_name searchPaths modtimefunction files of
		(Yes (scanState, modification_time), files)
297
			# hash_table=set_hte_mark (if iclmodule 1 0) hash_table
298
			# (ok,mod,hash_table,file,pre_def_symbols,files) = initModule file_name modification_time scanState hash_table error pre_def_symbols files
299
300
301
			# hash_table=set_hte_mark 0 hash_table
			->(ok,mod,hash_table,file,pre_def_symbols,files)
		(No, files)
302
			-> let mod = { mod_name = file_id,  mod_modification_time = "", mod_type = MK_None, mod_imports = [], mod_imported_objects = [], mod_defs = [] } in
303
			  (False, mod, hash_table, error <<< "Error " <<< import_file_position <<< ": "  <<< file_name <<< " could not be imported\n", pre_def_symbols, files)
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
304
where
305
	file_name = if iclmodule (id_name +++ ".icl") (id_name +++ ".dcl")
306
	initModule :: String String ScanState !*HashTable !*File !*PredefinedSymbols *Files
307
				-> (!Bool, !ParsedModule, !*HashTable, !*File, !*PredefinedSymbols, !*Files)
308
	initModule file_name modification_time scanState hash_table error pre_def_symbols files
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
309
310
311
312
313
314
315
		# (succ, mod_type, mod_name, scanState) = try_module_header iclmodule scanState
		| succ
			# pState				=	{ ps_scanState = scanState
										, ps_error = { pea_file = error, pea_ok = True }
										, ps_skipping = False
										, ps_hash_table = hash_table
										, ps_pre_def_symbols = pre_def_symbols
316
										, ps_support_generics = support_generics
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
317
318
319
320
321
										}
			  pState				= verify_name mod_name id_name file_name pState
		  	  (mod_ident, pState)	= stringToIdent mod_name IC_Module pState
		  	  pState				= check_layout_rule pState
		  	  (defs, pState)		= want_definitions (SetGlobalContext iclmodule) pState
322
323
324
// MV ...
			# (defs, pState)		= add_module_id mod_name defs pState;
// ... MV			  				
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
325
326
			  {ps_scanState,ps_hash_table,ps_error,ps_pre_def_symbols}
			  						= pState
327
			  defs = if (ParseOnly && id_name <> "StdOverloaded" && id_name <> "StdArray" && id_name <> "StdEnum" && id_name <> "StdBool" && id_name <> "StdDynamics" && id_name <> "StdGeneric")
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
328
329
						[PD_Import imports \\ PD_Import imports <- defs]
						defs
330
			  mod					= { mod_name = mod_ident, mod_modification_time = modification_time, mod_type = mod_type, mod_imports = [], mod_imported_objects = [], mod_defs = defs }
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
331
332
333
334
335
336
337
			= ( ps_error.pea_ok
			  , mod, ps_hash_table
			  , ps_error.pea_file
			  , ps_pre_def_symbols
			  , closeScanner ps_scanState files
			  )
		// otherwise // ~ succ
338
		# ({fp_line}, scanState) = getPosition scanState
339
		  mod = { mod_name = file_id,  mod_modification_time = modification_time, mod_type = mod_type, mod_imports = [], mod_imported_objects = [], mod_defs = [] }
Martin Wierich's avatar
Martin Wierich committed
340
		= (False, mod, hash_table, error <<< "Error [" <<< file_name <<< ',' <<< fp_line <<< "]: incorrect module header",
341
			pre_def_symbols, closeScanner scanState files)
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
	where
// MV...
		add_module_id mod_name defs pState
			| not iclmodule
				= (defs,pState);
	
			// It is essential that the type name denoted by ident is an unique type name within the application. Otherwise
			// the static linker will choose one implementation (because the type names are equal) and map the other to the
			// chosen implementation.
			// The zero arity of the _Module constructor makes the code generator, pre-allocate _Module in .data section of
			// the final executable. The module name needed by the dynamic run-time system can then be determined by looking
			// at the descriptor. If however all implementations were mapped to a single one, the dynamic rts could not use
			// the module name anymore because they are all the same.
			# (ident,   pState)	= stringToIdent ("_" +++ mod_name +++ "_Module") IC_Type pState
			# td				= MakeTypeDef ident [] (ConsList []) TA_None [] NoPos
				
358
			# (pc_cons_name, pState) = stringToIdent "__Module" IC_Expression pState
359
360
361
362
363
364
365
366
367
368
369
370
371
			# cons
				= { 
					pc_cons_name		= pc_cons_name
				,	pc_arg_types		= []
				,	pc_cons_arity		= 0
				,	pc_cons_prio		= NoPrio
				,	pc_exi_vars			= []
				,	pc_cons_pos			= NoPos
				}
			# td
				= { td & td_rhs = ConsList [cons] }
			= ([PD_Type td:defs],pState) 
// ...MV
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399

	try_module_header :: !Bool !ScanState -> (!Bool,!ModuleKind,!String,!ScanState)
	try_module_header is_icl_mod scanState
		# (token, scanState) = nextToken GeneralContext scanState
		| is_icl_mod
			| token == ModuleToken
				# (token, scanState) = nextToken GeneralContext scanState
				= try_module_name token MK_Main scanState
			| token == ImpModuleToken 
				= try_module_token MK_Module scanState
			| token == SysModuleToken
				= try_module_token MK_System scanState
				= (False, MK_None, "", tokenBack scanState)
		| token == DefModuleToken
		  	= try_module_token MK_Module scanState
		| token == SysModuleToken
		  	= try_module_token MK_System scanState
			= (False, MK_None, "", tokenBack scanState)

	try_module_token :: !ModuleKind !ScanState -> (!Bool,!ModuleKind!,!String,!ScanState)
	try_module_token mod_type scanState
		# (token, scanState) = nextToken GeneralContext scanState
		| token == ModuleToken
			# (token, scanState) = nextToken GeneralContext scanState
 			= try_module_name token mod_type scanState
			= (False, mod_type, "", tokenBack scanState)

	try_module_name (IdentToken name) mod_type scanState
Pieter Koopman's avatar
Pieter Koopman committed
400
		= (True, mod_type, name, scanState)
401
	try_module_name (UnderscoreIdentToken name) mod_type scanState
Pieter Koopman's avatar
Pieter Koopman committed
402
		= (True, mod_type, name, setUseUnderscoreIdents True scanState)
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
403
404
405
	try_module_name token mod_type scanState
		= (False, mod_type, "", tokenBack scanState)
	
406
	verify_name name id_name file_name pState
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
407
408
		| name == id_name
	  		= pState
409
410
			# ({fp_line}, pState=:{ps_error={pea_file}}) = getPosition pState
 			  pea_file = pea_file <<< '[' <<< file_name <<< ',' <<< fp_line <<< "]: module name \"" <<< name 
411
	  						<<< "\" does not match file name: \"" <<< file_name <<<"\"\n"
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
412
413
414
415
416
417
418
419
420
			= { pState & ps_error = { pea_file = pea_file, pea_ok = False }}

	check_layout_rule pState
		# (token, pState)	= nextToken GeneralContext pState
		  use_layout		= token <> SemicolonToken && token <> EndOfFileToken // '&& token <> EndOfFileToken' to handle end groups of empty modules
		| use_layout		= appScanState (setUseLayout use_layout) (tokenBack pState)
							= appScanState (setUseLayout use_layout) pState

	want_definitions :: !ParseContext !ParseState -> (![ParsedDefinition], !ParseState)
Pieter Koopman's avatar
Pieter Koopman committed
421
	want_definitions parseContext pState
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
422
423
424
425
		= want_acc_definitions [] pState
	where
		want_acc_definitions :: ![ParsedDefinition] !ParseState -> (![ParsedDefinition], !ParseState)
		want_acc_definitions acc pState
Pieter Koopman's avatar
Pieter Koopman committed
426
			# (defs, pState)	= wantDefinitions parseContext pState
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
427
428
429
430
431
432
433
434
435
436
437
438
439
			  acc				= acc ++ defs
			  pState			= wantEndModule pState
			  (token, pState)	= nextToken FunctionContext pState
			| token == EndOfFileToken
				= (acc,  pState)
				# pState		= parseError "want definitions" (Yes token) "End of file" pState
				  pState		= wantEndOfDefinition "definitions" pState
				= want_acc_definitions acc pState
/*
	[Definition] on local and global level
*/

wantDefinitions :: !ParseContext !ParseState -> (![ParsedDefinition], !ParseState)
Pieter Koopman's avatar
Pieter Koopman committed
440
441
wantDefinitions parseContext pState
	= parseList (tryDefinition parseContext) pState
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
442
443
444
445
446
447
448

DummyPriority	:== Prio LeftAssoc 9

cHasPriority 	:== True
cHasNoPriority	:== False

tryDefinition :: !ParseContext !ParseState -> (!Bool, ParsedDefinition, !ParseState)
Pieter Koopman's avatar
Pieter Koopman committed
449
tryDefinition parseContext pState
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
450
451
	# (token, pState)			= nextToken GeneralContext pState
	  (fname, linenr, pState)	= getFileAndLineNr pState
Pieter Koopman's avatar
Pieter Koopman committed
452
	= try_definition parseContext token (LinePos fname linenr) pState
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
453
454
where
	try_definition :: !ParseContext !Token !Position !ParseState -> (!Bool, ParsedDefinition, !ParseState)
Pieter Koopman's avatar
Pieter Koopman committed
455
456
	try_definition parseContext DoubleColonToken pos pState
		| ~(isGlobalContext parseContext)
457
			= (False,abort "no def(3)",parseError "definition" No "type definitions only at the global level" (tokenBack pState))
Pieter Koopman's avatar
Pieter Koopman committed
458
			# (def, pState) = wantTypeDef parseContext pos pState
Pieter Koopman's avatar
Pieter Koopman committed
459
			= (True, def, pState)
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
460
	try_definition _ ImportToken pos pState
Pieter Koopman's avatar
Pieter Koopman committed
461
		| ~(isGlobalContext parseContext)
462
			= (False,abort "no def(3)",parseError "definition" No "imports only at the global level" pState)
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
463
		# (token, pState) = nextToken FunctionContext pState
Pieter Koopman's avatar
Pieter Koopman committed
464
		| token == CodeToken && isIclContext parseContext
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
465
466
467
468
469
470
		# (importedObjects, pState) = wantCodeImports pState
		= (True, PD_ImportedObjects importedObjects, pState)
		# pState = tokenBack pState
		# (imports, pState) = wantImports pState
   		= (True, PD_Import imports, pState)
	try_definition _ FromToken pos pState
Pieter Koopman's avatar
Pieter Koopman committed
471
		| ~(isGlobalContext parseContext)
472
			= (False,abort "no def(3)",parseError "definition" No "imports only at the global level" pState)
Pieter Koopman's avatar
Pieter Koopman committed
473
474
			# (imp, pState) = wantFromImports pState
	   		= (True, PD_Import [imp], pState) -->> imp
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
475
476
477
478
479
/*	try_definition _ ExportToken pos pState
		# (exports, pState) = wantExportDef pState
   		= (True, PD_Export exports, pState)
	try_definition _ ExportAllToken pos pState
   		= (True, PD_Export ExportAll, pState)
Pieter Koopman's avatar
Pieter Koopman committed
480
481
*/	try_definition parseContext ClassToken pos pState
		| ~(isGlobalContext parseContext)
Pieter Koopman's avatar
Pieter Koopman committed
482
			= (False,abort "no def(2)",parseError "definition" No "class definitions are only at the global level" pState)
Pieter Koopman's avatar
Pieter Koopman committed
483
	   		# (classdef, pState) = wantClassDefinition parseContext pos pState
Pieter Koopman's avatar
Pieter Koopman committed
484
	   		= (True, classdef, pState)
485
	// AA..
Pieter Koopman's avatar
Pieter Koopman committed
486
487
	try_definition parseContext GenericToken pos pState
		| ~(isGlobalContext parseContext)
488
			= (False,abort "no def(2)",parseError "definition" No "generic definitions are only at the global level" pState)
Pieter Koopman's avatar
Pieter Koopman committed
489
	   		# (gendef, pState) = wantGenericDefinition parseContext pos pState
490
491
	   		= (True, gendef, pState)	 
	// ..AA  		
Pieter Koopman's avatar
Pieter Koopman committed
492
493
	try_definition parseContext InstanceToken pos pState
		| ~(isGlobalContext parseContext)
Pieter Koopman's avatar
Pieter Koopman committed
494
			= (False,abort "no def(2)",parseError "definition" No "instance declarations are only at the global level" pState)
Pieter Koopman's avatar
Pieter Koopman committed
495
	   		# (instdef, pState) = wantInstanceDeclaration parseContext pos pState
Pieter Koopman's avatar
Pieter Koopman committed
496
	   		= (True, instdef, pState)
Pieter Koopman's avatar
Pieter Koopman committed
497
	try_definition parseContext token pos pState
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
498
499
500
		| isLhsStartToken token
			# (lhs, pState) = want_lhs_of_def token pState
		      (token, pState) = nextToken FunctionContext pState
Pieter Koopman's avatar
Pieter Koopman committed
501
		      (def, pState) = want_rhs_of_def parseContext lhs token (determine_position lhs pos) pState
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
			= (True, def, pState) -->>  def
			with
				determine_position (Yes (name, _), _)	(LinePos f l) = FunPos f l name.id_name
		 		determine_position lhs           		pos           = pos
		= (False, abort "no def(1)", tokenBack pState)

	want_lhs_of_def :: !Token !ParseState -> (!(Optional (Ident, Bool), ![ParsedExpr]), !ParseState)
	want_lhs_of_def token pState
		# (succ, fname, is_infix, pState) = try_function_symbol token pState
		| succ
			# (args, pState) = parseList trySimpleLhsExpression pState
			= ((Yes (fname, is_infix), args), pState)
			# (_, exp, pState) = trySimpleLhsExpression pState
			= ((No, [exp]), pState)
	where
		try_function_symbol :: !Token !ParseState -> (!Bool, Ident, !Bool, !ParseState) // (Success, Ident, Infix, ParseState)
		try_function_symbol (IdentToken name) pState
			# (id, pState) = stringToIdent name IC_Expression pState
			= (True, id, False, pState)
		try_function_symbol OpenToken pState
			# (token, pState) = nextToken FunctionContext pState
			= case token of
				(IdentToken name)
					# (token, pState) = nextToken FunctionContext pState
					| CloseToken == token
						# (id, pState) = stringToIdent name IC_Expression pState
						-> (True, id, True, pState)
						-> (False, abort "no name", False, tokenBack (tokenBack (tokenBack pState)))
				_
					-> (False,  abort "no name", False, tokenBack (tokenBack pState))
		try_function_symbol token pState
			= (False, abort "name", False, tokenBack pState)

	want_rhs_of_def :: !ParseContext !(Optional (Ident, Bool), [ParsedExpr]) !Token !Position !ParseState -> (ParsedDefinition, !ParseState)
Pieter Koopman's avatar
Pieter Koopman committed
536
	want_rhs_of_def parseContext (opt_name, args) DoubleColonToken pos pState
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
537
538
		# (name, is_infix, pState) = check_name_and_fixity opt_name cHasNoPriority pState
		  (tspec, pState) = want pState		//	SymbolType
Pieter Koopman's avatar
Pieter Koopman committed
539
		| isDclContext parseContext
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
540
541
542
			# (specials, pState) = optionalSpecials pState
			= (PD_TypeSpec pos name (if is_infix DummyPriority NoPrio) (Yes tspec) specials, wantEndOfDefinition "type definition (1)" pState)
			= (PD_TypeSpec pos name (if is_infix DummyPriority NoPrio) (Yes tspec) SP_None, wantEndOfDefinition "type definition (2)" pState)
Pieter Koopman's avatar
Pieter Koopman committed
543
	want_rhs_of_def parseContext (opt_name, args) (PriorityToken prio) pos pState
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
544
545
546
547
		# (name, _, pState) = check_name_and_fixity opt_name cHasPriority pState
		  (token, pState) = nextToken TypeContext pState
		| token == DoubleColonToken
		  	# (tspec, pState) = want pState
Pieter Koopman's avatar
Pieter Koopman committed
548
			| isDclContext parseContext
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
549
550
551
552
				# (specials, pState) = optionalSpecials pState
				= (PD_TypeSpec pos name prio (Yes tspec) specials, wantEndOfDefinition "type definition (3)" pState)
				= (PD_TypeSpec pos name prio (Yes tspec) SP_None, wantEndOfDefinition "type definition (4)" pState)
			= (PD_TypeSpec pos name prio No SP_None, wantEndOfDefinition "type defenition (5)" (tokenBack pState))
Pieter Koopman's avatar
Pieter Koopman committed
553
	want_rhs_of_def parseContext (No, args) token pos pState
Pieter Koopman's avatar
Pieter Koopman committed
554
		# pState			= want_node_def_token pState token
555
		# (ss_useLayout, pState) = accScanState UseLayout pState
Pieter Koopman's avatar
Pieter Koopman committed
556
557
558
		  localsExpected	= ~ ss_useLayout
		  (rhs, pState)		= wantRhs isEqualToken localsExpected (tokenBack pState)
		| isGlobalContext parseContext
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
559
560
561
562
563
564
565
566
567
 			= (PD_NodeDef pos (combine_args args) rhs, parseError "RHS" No "<global definition>" pState)
 			= (PD_NodeDef pos (combine_args args) rhs, pState)
	where		
		want_node_def_token s EqualToken		= s
		want_node_def_token s DefinesColonToken = replaceToken EqualToken s
		want_node_def_token s token				= parseError "RHS" (Yes token) "defines token (= or =:)" s

		combine_args [arg]	= arg
		combine_args args	= PE_List args
Pieter Koopman's avatar
Pieter Koopman committed
568
569
570
	want_rhs_of_def parseContext (Yes (name, False), []) token pos pState
		| isIclContext parseContext && isLocalContext parseContext && token == EqualToken &&
		  isLowerCaseName name.id_name && not (isClassOrInstanceDefsContext parseContext)
Pieter Koopman's avatar
Pieter Koopman committed
571
			# (rhs, pState) = wantRhs (\_ -> True) False (tokenBack pState)
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
572
			= (PD_NodeDef pos (PE_Ident name) rhs, pState)
573

Pieter Koopman's avatar
Pieter Koopman committed
574
	want_rhs_of_def parseContext (Yes (name, is_infix), args) token pos pState
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
575
576
		# (fun_kind, code_allowed, pState)  = token_to_fun_kind pState token
		  (token, pState) = nextToken FunctionContext pState
Pieter Koopman's avatar
Pieter Koopman committed
577
		| isIclContext parseContext && token == CodeToken
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
578
579
580
581
582
583
			# (rhs, pState) = wantCodeRhs pState
			| code_allowed
  				= (PD_Function pos name is_infix args rhs fun_kind, pState)
  			// otherwise // ~ code_allowed
  				= (PD_Function pos name is_infix args rhs fun_kind, parseError "rhs of def" No "no code" pState)
		# pState = tokenBack (tokenBack pState)
584
		  (ss_useLayout, pState) = accScanState UseLayout pState
Pieter Koopman's avatar
Pieter Koopman committed
585
586
		  localsExpected = isNotEmpty args || isGlobalContext parseContext || ~ ss_useLayout
		  (rhs, pState) = wantRhs (isRhsStartToken parseContext) localsExpected pState
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
587
		= case fun_kind of
Pieter Koopman's avatar
Pieter Koopman committed
588
			FK_Function _  | isDclContext parseContext
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
589
				->	(PD_Function pos name is_infix args rhs fun_kind, parseError "RHS" No "<type specification>" pState)
Pieter Koopman's avatar
Pieter Koopman committed
590
			FK_Caf | isNotEmpty args
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
591
592
593
				->	(PD_Function pos name is_infix []   rhs fun_kind, parseError "CAF" No "No arguments for a CAF" pState)
  			_	->	(PD_Function pos name is_infix args rhs fun_kind, pState)
	where
594
595
596
		token_to_fun_kind s BarToken			= (FK_Function cNameNotLocationDependent, False,  s)
		token_to_fun_kind s (SeqLetToken _)		= (FK_Function cNameNotLocationDependent, False,  s)
		token_to_fun_kind s EqualToken			= (FK_Function cNameNotLocationDependent, True,  s)
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
597
		token_to_fun_kind s ColonDefinesToken	= (FK_Macro, False, s)
598
		token_to_fun_kind s DoubleArrowToken	= (FK_Function cNameNotLocationDependent, True, s)
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
599
600
601
602
603
604
605
606
607
608
609
610
611
612
		token_to_fun_kind s DefinesColonToken	= (FK_Caf, False, s)
		token_to_fun_kind s token 				= (FK_Unknown, False, parseError "RHS" (Yes token) "defines token (=, => or =:) or argument" s)

	check_name_and_fixity No hasprio pState
		= (erroneousIdent, False, parseError "Definition" No "identifier" pState)
	check_name_and_fixity (Yes (name,is_infix)) hasprio pState
		| not is_infix	&& hasprio	//	XXXXXXX
			= (name, False, parseError "Definition" No "Infix operator should be inside parentheses; no infix" pState)
			= (name, is_infix, pState)

isEqualToken :: !Token -> Bool
isEqualToken EqualToken			= True
isEqualToken _					= False

Pieter Koopman's avatar
Pieter Koopman committed
613
614
isRhsStartToken :: !ParseContext !Token -> Bool
isRhsStartToken parseContext EqualToken			= True
615
isRhsStartToken parseContext ColonDefinesToken	= True
Pieter Koopman's avatar
Pieter Koopman committed
616
617
isRhsStartToken parseContext DefinesColonToken	= isGlobalContext parseContext
isRhsStartToken parseContext _					= False
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
618
619
620
621
622

optionalSpecials :: !ParseState -> (!Specials, !ParseState)
optionalSpecials pState
	# (token, pState) = nextToken TypeContext pState
	| token == SpecialToken
623
624
		# (token, pState) = nextToken GeneralContext pState
		  pState = begin_special_group token pState
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
625
		# (specials, pState) = wantList "<special statement>" try_substitutions pState
626
		= (SP_ParsedSubstitutions specials, end_special_group pState)
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
	// otherwise // token <> SpecialToken
		= (SP_None, tokenBack pState)
where
	try_substitutions pState
		# (succ, type_var, pState) = tryTypeVar pState
		| succ
			# (subst, pState) = want_rest_substitutions type_var pState
			= (True, subst, wantEndOfDefinition "substitution" pState)
			= (False, [], pState)
	
	want_rest_substitutions type_var pState
		# pState = wantToken GeneralContext "specials" EqualToken pState
		  (type, pState) = want pState
		  (token, pState) = nextToken GeneralContext pState
		| token == CommaToken
			# (next_type_var, pState) = want pState
			  (substs, pState) = want_rest_substitutions next_type_var pState
			= ([{ bind_src = type, bind_dst = type_var } : substs], pState)
			= ([{ bind_src = type, bind_dst = type_var }], tokenBack pState)
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678

	begin_special_group token pState // For JvG layout
		# (token, pState)
			= case token of
				SemicolonToken	->	nextToken TypeContext pState
				_				->	(token, pState)
		# (ss_useLayout, pState) = accScanState UseLayout pState
		| ss_useLayout
			| token == CurlyOpenToken 
				= parseError "substitution" (Yes CurlyOpenToken) "in layout mode the keyword where is" pState
			// otherwise
				= tokenBack pState
		// not ss_useLayout
			| token == CurlyOpenToken 
				= pState
			// otherwise
				= tokenBack (parseError "substitution" (Yes token) "{" pState) 

	end_special_group pState
		# (ss_useLayout, pState) = accScanState UseLayout pState
		  (token, pState) = nextToken FunctionContext pState
		| token == EndOfFileToken && ss_useLayout
			= tokenBack pState
		| ss_useLayout
			= case token of
				EndGroupToken	->	pState
				_				->	parseError "substitution" (Yes token) "end of substitution with layout" pState
		// ~ ss_useLayout
		| token == CurlyCloseToken
			= pState
		// otherwise // token <> CurlyCloseToken
			= parseError "substitution" (Yes token) "end of substitution with layout, }," pState

Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
679
680
681
682
683
684
685
/*
	For parsing right-hand sides of functions only
*/

wantCodeRhs :: !ParseState -> (Rhs, !ParseState)
wantCodeRhs pState
	# (expr, pState)	= want_code_expr pState
686
	  (file_name, line_nr, pState)	= getFileAndLineNr pState // MW++
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
687
688
689
690
	= (	{ rhs_alts		= UnGuardedExpr
							{ ewl_nodes		= []
							, ewl_locals	= LocalParsedDefs []
							, ewl_expr		= expr
691
							, ewl_position	= LinePos file_name line_nr // MW++
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
692
693
694
							}
		, rhs_locals	= LocalParsedDefs []
		}
695
	  , wantEndCodeRhs pState
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
	  )
where
	want_code_expr :: !ParseState -> (!ParsedExpr, !ParseState)
	want_code_expr pState
		# (token, pState) = nextToken CodeContext pState
		= case token of
			OpenToken
				#	(input, pState)	= want_bindings [] True pState
					pState			= wantToken CodeContext "input bindings of code block" CloseToken pState
					pState			= wantToken CodeContext "output bindings of code block" OpenToken pState
					(out, pState)	= want_bindings [] False pState
					pState			= wantToken CodeContext "output bindings of code block" CloseToken pState
					(token, pState)	= nextToken CodeContext pState
				->	case token of
						CodeBlockToken the_code
							-> (PE_Any_Code input out the_code, pState)
						_	-> (PE_Any_Code input out []  , parseError "code rhs (any code)" (Yes token) "code block" pState)
			InlineToken
			 	#	(token, pState) = nextToken CodeContext pState
			 	->	case token of
			 			CodeBlockToken the_code
			 				-> (PE_ABC_Code the_code True, pState)
			 			token
			 				-> (PE_ABC_Code [] True,  parseError "inline code" (Yes token) "code block" pState)
			CodeBlockToken the_code
				-> (PE_ABC_Code the_code False, pState)
			token
				-> (PE_Empty, parseError "code rhs" (Yes token) "<code rhs>" pState)

	want_bindings :: !(CodeBinding Ident) !Bool !ParseState -> (!CodeBinding Ident, !ParseState)
	want_bindings acc mayBeEmpty pState
		# (token, pState)	= nextToken CodeContext pState
		= case token of
			IdentToken name
				#	(token, pState)	= nextToken CodeContext pState
				|	token == EqualToken || token == DefinesColonToken
					#	(token, pState)	= nextToken CodeContext pState
					->	case token of
							IdentToken value
								#	(ident, pState)	= stringToIdent name IC_Expression pState
									acc				= [{ bind_dst = ident, bind_src = value }: acc]
									(token, pState)	= nextToken CodeContext pState
								|	token == CommaToken
									->	want_bindings acc mayBeEmpty pState
								//	token <> CommaToken
									->	(reverse acc, tokenBack pState)
							token
								-> (acc, parseError "bindings in code block" (Yes token) "value" pState)
				//	token <> EqualToken && token <> DefinesColonToken
					->	(acc, parseError "bindings in code block" (Yes token) "= or =:" pState)
			CloseToken
				| mayBeEmpty
					-> (acc, tokenBack pState) // to handle empty input bindings
					-> (acc, parseError "code bindings" (Yes token) "output bindings" pState)
			token
				-> (acc, parseError "bindings in code block" (Yes token) "identifier" pState)
/*
	For parsing right-hand sides of functions and case expressions
*/


/* Syntax:
	FunctionAltDefRhs	=	FunctionBody						// Rhs
							[ LocalFunctionAltDefs ]
	FunctionBody		=	exprWithLocals						// OptGuardedAlts	: GuardedAlts
						|	GuardedAlts 						//					: UnGuardedExpr
	GuardedAlts			=	{ [ LetBefore ] '|' [ StrictLet ] Guard FunctionBody }+ [ ExprWithLocals ]
	ExprWithLocals		=	[ LetBefore ] sep RootExpression endOfDefinition [ LocalFunctionDefs ]
*/

Pieter Koopman's avatar
Pieter Koopman committed
766
767
wantRhs :: !(!Token -> Bool) !Bool !ParseState -> (Rhs, !ParseState) // FunctionAltDefRhs
wantRhs separator localsExpected pState
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
768
	# (alts, pState)	= want_LetsFunctionBody separator pState
Pieter Koopman's avatar
Pieter Koopman committed
769
	  (locals, pState)	= optionalLocals WhereToken localsExpected pState
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
770
771
772
773
774
775
776
777
778
779
780
	= ({ rhs_alts = alts, rhs_locals = locals}, pState)
where
	want_LetsFunctionBody :: !(!Token -> Bool) !ParseState -> (!OptGuardedAlts, !ParseState) 
	want_LetsFunctionBody sep pState
		# (token, pState)			= nextToken FunctionContext pState
		  (nodeDefs, token, pState)	= want_LetBefores token pState
		= want_FunctionBody token nodeDefs [] sep pState

	want_FunctionBody :: !Token ![NodeDefWithLocals] ![GuardedExpr] !(Token -> Bool) !ParseState -> (!OptGuardedAlts, !ParseState)
	want_FunctionBody BarToken nodeDefs alts sep pState
//		#	(lets, pState)				= want_StrictLet pState // removed from 2.0
781
		#	(file_name, line_nr, pState)= getFileAndLineNr pState
782
			(token, pState)				= nextToken FunctionContext pState
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
783
784
785
		|	token == OtherwiseToken
			#	(token, pState)				= nextToken FunctionContext pState
				(nodeDefs2, token, pState)	= want_LetBefores token pState
786
787
			= want_FunctionBody token (nodeDefs ++ nodeDefs2) alts sep pState // to allow | otherwise | c1 = .. | c2 = ..
/* PK ??? 
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
788
789
790
			=	case token of
				BarToken
					#	pState = parseError "RHS: default alternative" No "root expression instead of guarded expression" pState
Pieter Koopman's avatar
Pieter Koopman committed
791
792
					->	root_expression True token (nodeDefs ++ nodeDefs2) (reverse alts) sep pState
				_	->	root_expression True token (nodeDefs ++ nodeDefs2) (reverse alts) sep pState
793
*/		|	token == LetToken True
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
794
			#	pState	= parseError "RHS" No "No 'let!' in this version of Clean" pState
Pieter Koopman's avatar
Pieter Koopman committed
795
			=	root_expression True token nodeDefs (reverse alts) sep pState
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
796
797
798
799
800
801
802
803
		#	(guard, pState)				= wantRhsExpressionT token pState
			(token, pState)				= nextToken FunctionContext pState
			(nodeDefs2, token, pState)	= want_LetBefores token pState
		|	token == BarToken // nested guard
			#	(position, pState)			= getPosition pState
				offside						= position.fp_col
				(expr, pState)				= want_FunctionBody token nodeDefs2 [] sep pState
				pState						= wantEndNestedGuard (default_found expr) offside pState
804
				alt							= { alt_nodes = nodeDefs, alt_guard = guard, alt_expr = expr,
805
												alt_ident = guard_ident line_nr, alt_position = LinePos file_name line_nr }
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
806
807
808
809
				(token, pState)				= nextToken FunctionContext pState
				(nodeDefs, token, pState)	= want_LetBefores token pState
			=	want_FunctionBody token nodeDefs [alt:alts] sep pState
		// otherwise
Pieter Koopman's avatar
Pieter Koopman committed
810
			#	(expr, pState)				= root_expression True token nodeDefs2 [] sep pState
811
				alt							= { alt_nodes = nodeDefs, alt_guard = guard, alt_expr = expr,
812
												alt_ident = guard_ident line_nr, alt_position = LinePos file_name line_nr }
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
813
814
815
				(token, pState)				= nextToken FunctionContext pState
				(nodeDefs, token, pState)	= want_LetBefores token pState
			=	want_FunctionBody token nodeDefs [alt:alts] sep pState
816
817
818
	  where
	  	guard_ident line_nr
			= { id_name = "_g;" +++ toString line_nr +++ ";", id_info = nilPtr }
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
819
	want_FunctionBody token nodeDefs alts sep pState
Pieter Koopman's avatar
Pieter Koopman committed
820
		=	root_expression localsExpected token nodeDefs (reverse alts) sep pState
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
821
	
Pieter Koopman's avatar
Pieter Koopman committed
822
	root_expression :: !Bool !Token ![NodeDefWithLocals] ![GuardedExpr] !(Token -> Bool) !ParseState -> (!OptGuardedAlts, !ParseState)
823
824
825
826
827
828
829
830
831
832
833
834
835
836
	root_expression withExpected token nodeDefs alts sep pState
		# (optional_expr,pState) = want_OptExprWithLocals withExpected token nodeDefs sep pState
		= build_root token optional_expr alts nodeDefs pState
	where
		build_root :: !Token !(Optional ExprWithLocalDefs) ![GuardedExpr] ![NodeDefWithLocals] !ParseState -> (!OptGuardedAlts, !ParseState)
		build_root _ (Yes expr) [] _ pState
			= ( UnGuardedExpr expr, pState)
		build_root _ No alts=:[_:_] [] pState
			= (GuardedAlts alts No, pState)
		build_root _ optional_expr alts=:[_:_] _ pState
			= (GuardedAlts alts optional_expr, pState)
		build_root token _ _ _ pState
			# (file_name, line_nr, pState)	= getFileAndLineNr pState // MW++
			=	(UnGuardedExpr {ewl_nodes = [], ewl_expr = PE_Empty, ewl_locals = LocalParsedDefs [],
837
												ewl_position = LinePos file_name line_nr}
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
838
839
							, parseError "RHS: root expression" (Yes token) "= <ExprWithLocals>" pState
							)
840

Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
841
842
843
	default_found (GuardedAlts _ No)	= False
	default_found _						= True

Pieter Koopman's avatar
Pieter Koopman committed
844
845
846
847
	want_OptExprWithLocals :: !Bool !Token ![NodeDefWithLocals] !(Token -> Bool) !ParseState -> (!Optional !ExprWithLocalDefs, !ParseState)
	want_OptExprWithLocals withExpected DoubleArrowToken nodeDefs sep pState
		= want_OptExprWithLocals True EqualToken nodeDefs sep (replaceToken EqualToken pState)
	want_OptExprWithLocals withExpected token nodeDefs sep pState
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
848
		| sep token
849
850
		# (file_name, line_nr, pState)	= getFileAndLineNr pState // MW++
		  (expr, pState)	= wantExpression cIsNotAPattern pState
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
851
		  pState			= wantEndRootExpression pState
Pieter Koopman's avatar
Pieter Koopman committed
852
		  (locals,pState)	= optionalLocals WithToken withExpected pState
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
853
854
855
		= ( Yes	{ ewl_nodes		= nodeDefs
				, ewl_expr		= expr
				, ewl_locals	= locals
856
				, ewl_position	= LinePos file_name line_nr // MW++
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
				}
		  , pState
		  )
		= (No, tokenBack pState)
	
/*	want_StrictLet :: !ParseState -> ([NodeDefWithLocals] , !ParseState) // Removed from the language !?
	want_StrictLet pState
		# (token, pState)	= nextToken FunctionContext pState
		| token == LetToken True
			# (let_defs, pState)	= wantList "<sequential node defs>" (try_LetDef True) pState
			  pState				= wantToken FunctionContext "strict let" InToken pState
			= (let_defs, pState)
		= ([], tokenBack pState)
*/ 
	want_LetBefores :: !Token !ParseState -> (![NodeDefWithLocals], !Token, !ParseState)
	want_LetBefores (SeqLetToken strict) pState
		# (let_defs, pState)				= wantList "<sequential node defs>" (try_LetDef strict) pState
		  (token, pState)					= nextToken FunctionContext pState
		  (token, pState)					= opt_End_Group token pState
		  (more_let_defs, token, pState)	= want_LetBefores token pState
		= (let_defs ++ more_let_defs, token, pState)
		where
			opt_End_Group token pState
			 #	(ss_useLayout, pState) = accScanState UseLayout pState
			 |	ss_useLayout
			 	| token == EndGroupToken
			 		= nextToken FunctionContext pState
			 	// otherwise // token <> EndGroupToken
			 		= (ErrorToken "End group missing in let befores", parseError "RHS: Let befores" (Yes token) "Generated End Group (due to layout)" pState)
			 |	otherwise // not ss_useLayout
			 =	(token, pState)
	want_LetBefores token pState
		= ([], token, pState)
	
	try_LetDef :: !Bool !ParseState -> (!Bool, NodeDefWithLocals, !ParseState)
	try_LetDef strict pState
		# (succ, lhs_exp, pState)	= trySimpleLhsExpression pState
		| succ
			# pState			= wantToken FunctionContext "let definition" EqualToken pState
896
897
			  (file_name, line_nr, pState)
			  					= getFileAndLineNr pState // MW++
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
898
899
			  (rhs_exp, pState) = wantExpression cIsNotAPattern pState
			  pState			= wantEndRootExpression pState -->> ("#",lhs_exp,"=",rhs_exp)
Pieter Koopman's avatar
Pieter Koopman committed
900
	  	  	  (locals , pState) = optionalLocals WithToken localsExpected pState
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
901
902
903
904
905
906
			=	( True
				, {	ndwl_strict	= strict
				  ,	ndwl_def	= { bind_dst = lhs_exp
				  				  , bind_src = rhs_exp
				  				  }
				  , ndwl_locals	= locals
907
908
				  , ndwl_position
				  				= LinePos file_name line_nr // MW++
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
909
910
911
912
913
914
				  }
				, pState
				)
		// otherwise // ~ succ
			= (False, abort "no definition", pState)

Pieter Koopman's avatar
Pieter Koopman committed
915
916
optionalLocals :: !Token !Bool !ParseState -> (!LocalDefs, !ParseState)
optionalLocals dem_token localsExpected pState
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
917
918
919
920
    # (off_token, pState) = nextToken FunctionContext pState
	| dem_token == off_token
		= wantLocals pState
	# (ss_useLayout, pState) = accScanState UseLayout pState
Pieter Koopman's avatar
Pieter Koopman committed
921
	| off_token == CurlyOpenToken && ~ ss_useLayout && localsExpected
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
		= wantLocals (tokenBack pState)
	// otherwise
		= (LocalParsedDefs [], tokenBack pState)

wantLocals :: !ParseState -> (LocalDefs, !ParseState)
wantLocals pState
	# pState			= wantBeginGroup "local definitions" pState
	  (defs, pState)	= wantDefinitions cLocalContext pState
	= (LocalParsedDefs defs, wantEndLocals pState)

/*
	imports and exports
*/

wantImports :: !ParseState -> (![ParsedImport], !ParseState)
wantImports pState
938
	# (names, pState) = wantModuleIdents FunctionContext IC_Module pState
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
939
940
	  (file_name, line_nr, pState)	= getFileAndLineNr pState
	  pState = wantEndOfDefinition "imports" pState
Martin Wierich's avatar
Martin Wierich committed
941
	= (map (\name -> { import_module = name, import_symbols = [], import_file_position = LinePos file_name line_nr}) names, pState)
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
942
943
944

wantFromImports :: !ParseState -> (!ParsedImport, !ParseState)
wantFromImports pState
945
	# (mod_name, pState) = wantModuleName pState
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
946
947
948
949
950
	  (mod_ident, pState) = stringToIdent mod_name IC_Module pState
	  pState = wantToken GeneralContext "from imports" ImportToken pState
	  (file_name, line_nr, pState)	= getFileAndLineNr pState
	  (import_symbols, pState) = wantSequence CommaToken GeneralContext pState
	  pState = wantEndOfDefinition "from imports" pState
Martin Wierich's avatar
Martin Wierich committed
951
	= ( { import_module = mod_ident, import_symbols = import_symbols, import_file_position = LinePos file_name line_nr }, pState)
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976

instance want ImportedObject where
	want pState
		# (token, pState) = nextToken GeneralContext pState
		| token == IdentToken "library"
	  		# (token, pState) = nextToken GeneralContext pState
			= want_import_string token cIsImportedLibrary pState
			= want_import_string token cIsImportedObject pState
		where		
			want_import_string :: Token Bool ParseState -> (ImportedObject, ParseState)
			want_import_string (StringToken string) isLibrary pState
				=	({io_is_library = isLibrary, io_name = string}, pState)
			want_import_string token isLibrary pState
				=	({io_is_library = isLibrary, io_name = ""}, parseError "import code declaration" (Yes token) "imported item" pState)

wantCodeImports :: !ParseState -> (![ImportedObject], !ParseState)
wantCodeImports pState
	# pState = wantToken GeneralContext "import code declaration" FromToken pState
	  (importObjects, pState) = wantSequence CommaToken GeneralContext pState
	= (importObjects, wantEndOfDefinition "import code declaration" pState)

instance want ImportDeclaration
where
	want pState
		# (token, pState) = nextToken GeneralContext pState
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
// MW5..
		= (switch_import_syntax want_1_3_import_declaration want_2_0_import_declaration) token pState

want_1_3_import_declaration token pState
	= case token of
			IdentToken name
				#	(fun_id, pState)		= stringToIdent name IC_Expression pState
					(type_id, pState)		= stringToIdent name IC_Type pState
					(class_id, pState)		= stringToIdent name IC_Class pState
				->	(ID_OldSyntax [fun_id, type_id, class_id], pState)
			token
				#	(fun_id, pState)		= stringToIdent "dummy" IC_Expression pState
				->	( ID_Function { ii_ident = fun_id, ii_extended = False }
					, parseError "from import" (Yes token) "imported item" pState
					)

want_2_0_import_declaration token pState
// ..MW5
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
995
996
		= case token of
			DoubleColonToken
997
				# (name, pState)				= wantConstructorName "import type" pState
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
998
999
1000
				  (type_id, pState)				= stringToIdent name IC_Type pState
				  (ii_extended, token, pState)	= optional_extension_with_next_token pState
				| token == OpenToken
1001
				  	#	(conses, pState)			= want_names (wantConstructorName "import type (..)") IC_Expression CloseToken pState
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
				  	->	(ID_Type { ii_ident = type_id, ii_extended = ii_extended } (Yes conses), pState)
				| token == CurlyOpenToken
				  	#	(fields, pState) = want_names (wantLowerCaseName "import record fields") (IC_Field type_id) CurlyCloseToken pState
				  	->	(ID_Record { ii_ident = type_id, ii_extended = ii_extended } (Yes fields), pState)
				  	->	(ID_Type { ii_ident = type_id, ii_extended = ii_extended } No, tokenBack pState)
			ClassToken
				# (name, pState)				= want pState
				  (class_id, pState)			= stringToIdent name IC_Class pState
				  (ii_extended, token, pState)	= optional_extension_with_next_token pState
				| token == OpenToken
				  	#	(members, pState)			= want_names want IC_Expression CloseToken pState
				  	->	(ID_Class { ii_ident = class_id, ii_extended = ii_extended } (Yes members), pState)
1014
				  	->	(ID_Class { ii_ident = class_id, ii_extended = ii_extended } No, tokenBack pState)
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
1015
1016
			InstanceToken
				#	(class_name, pState)	= want pState
Martin Wierich's avatar
Martin Wierich committed
1017
//					(ii_extended, pState)	= optional_extension pState // MW: removed but still not ok
1018
					ii_extended				= False
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
					(types, pState)			= wantList "instance types" tryBrackType pState
					(class_id, pState)		= stringToIdent class_name IC_Class pState
					(inst_id, pState)		= stringToIdent class_name (IC_Instance types) pState
					(context, pState)		= optionalContext pState
				->	(ID_Instance { ii_ident = class_id, ii_extended = ii_extended } inst_id (types,context), pState)
			IdentToken fun_name
				#	(fun_id, pState)		= stringToIdent fun_name IC_Expression pState
					(ii_extended, pState)	= optional_extension pState
				->	(ID_Function { ii_ident = fun_id, ii_extended = ii_extended }, pState)
			token
				#	(fun_id, pState)		= stringToIdent "dummy" IC_Expression pState
				->	( ID_Function { ii_ident = fun_id, ii_extended = False }
					, parseError "from import" (Yes token) "imported item" pState
					)
	where				
		want_names want_fun ident_kind close_token pState
			# (token, pState) = nextToken FunctionContext pState
			| token == DotDotToken
				= ([], wantToken FunctionContext "import declaration" close_token pState)
				= want_list_of_names want_fun ident_kind close_token (tokenBack pState)

		want_list_of_names want_fun ident_kind close_token pState
			# (name, pState) = want_fun pState
			  (name_id, pState)	= stringToIdent name ident_kind pState
			  (ii_extended, token, pState) = optional_extension_with_next_token pState
			| token == CommaToken
				# (names, pState) = want_list_of_names want_fun ident_kind close_token pState
				= ([{ ii_ident = name_id, ii_extended = ii_extended } : names], pState)
			| token == close_token
				= ([{ ii_ident = name_id, ii_extended = ii_extended }], pState)
				= ([{ ii_ident = name_id, ii_extended = ii_extended }], parseError "ImportDeclaration" (Yes token) ")" pState)
			
		optional_extension pState
			# (token, pState) = nextToken FunctionContext pState
			| token == DotDotToken
				= (True, pState)
				= (False, tokenBack pState)			
			
		optional_extension_with_next_token pState
			# (token, pState) = nextToken FunctionContext pState
			| token == DotDotToken
				# (token, pState) = nextToken FunctionContext pState
				= (True, token, pState)
				= (False, token, pState)

/*						
wantExportDef :: !ParseState -> (!Export, !ParseState)
wantExportDef pState
	# (name, pState) = want pState
	  (ident, pState) = stringToIdent name IC_Class pState
	  (types, pState) = wantList "instance types" trySimpleType pState
	  pState = wantEndOfDefinition "exports" pState
	= ({ export_class = ident, export_types = types}, pState)
*/
/*
	Classes and instances
*/

cIsAGlobalContext		:== True
cIsNotAGlobalContext	:== False

cMightBeAClass			:== True
cIsNotAClass			:== False

		
wantClassDefinition :: !ParseContext !Position !ParseState -> (!ParsedDefinition, !ParseState)
Pieter Koopman's avatar
Pieter Koopman committed
1085
wantClassDefinition parseContext pos pState
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
1086
1087
1088
1089
1090
1091
1092
1093
	# (might_be_a_class, class_or_member_name, prio, pState) = want_class_or_member_name pState
	  (class_variables, pState) = wantList "class variable(s)" try_class_variable pState
	  (class_arity, class_args, class_cons_vars) = convert_class_variables class_variables 0 0
	  (contexts, pState) = optionalContext pState
  	  (token, pState) = nextToken TypeContext pState
  	| token == DoubleColonToken
		= want_overloaded_function pos class_or_member_name prio class_arity class_args class_cons_vars contexts pState
	| might_be_a_class
Pieter Koopman's avatar
Pieter Koopman committed
1094
1095
		# (begin_members, pState) = begin_member_group token pState
		| begin_members
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
1096
			# (class_id, pState) = stringToIdent class_or_member_name IC_Class pState
Pieter Koopman's avatar
Pieter Koopman committed
1097
1098
// RWS ...		 	  (members, pState) = wantDefinitions (SetLocalContext parseContext) pState
		 	  (members, pState) = wantDefinitions (SetClassOrInstanceDefsContext parseContext) pState
1099
// ... RWS 
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
1100
1101
  		  	  class_def = { class_name = class_id, class_arity = class_arity, class_args = class_args,
	    					class_context = contexts, class_pos = pos, class_members = {}, class_cons_vars = class_cons_vars,
1102
1103
	    					class_dictionary = { ds_ident = { class_id & id_info = nilPtr }, ds_arity = 0, ds_index = NoIndex},
							class_arg_kinds = [] }
Pieter Koopman's avatar
Pieter Koopman committed
1104
1105
	    	  pState = wantEndGroup "class" pState
			= (PD_Class class_def members, pState)
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
1106
1107
1108
1109
1110
1111
1112
		| isEmpty contexts
			= (PD_Erroneous, parseError "Class Definition" (Yes token) "<class definition>: contexts" pState)
		// otherwise
			# pState = tokenBack pState
			  (class_id, pState) = stringToIdent class_or_member_name IC_Class pState
  			  class_def = { class_name = class_id, class_arity = class_arity, class_args = class_args,
							class_context = contexts, class_pos = pos, class_members = {}, class_cons_vars = class_cons_vars, 
1113
1114
							class_dictionary = { ds_ident = { class_id & id_info = nilPtr }, ds_arity = 0, ds_index = NoIndex },
							class_arg_kinds = []}
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
1115
1116
1117
1118
	  		  pState = wantEndOfDefinition "class definition" pState
			= (PD_Class class_def [], pState)
		= (PD_Erroneous, parseError "Class Definition" (Yes token) "<class definition>" pState)
	where
Pieter Koopman's avatar
Pieter Koopman committed
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
		begin_member_group token pState // For JvG layout
			# (token, pState)
				= case token of
					SemicolonToken	->	nextToken TypeContext pState
					_				->	(token, pState)
			# (ss_useLayout, pState) = accScanState UseLayout pState
			| token == WhereToken
				# (token, pState) = nextToken TypeContext pState
				| token == CurlyOpenToken
					| ss_useLayout
						= (True, parseError "class definition" No "No { in layout mode" pState) 
						= (True, pState)
					= (True, tokenBack pState)
			| token == CurlyOpenToken 
				| ss_useLayout
					= (True, parseError "class definition" (Yes CurlyOpenToken) "in layout mode the keyword where is" pState) 
					= (True, pState)
				= (False, pState) // token is still known: no tokenBack
		
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
1138
		want_class_or_member_name pState 
1139
1140
// PK			# (token, pState) = nextToken TypeContext pState
			# (token, pState) = nextToken GeneralContext pState
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
			| token == OpenToken
				# (member_name, pState) = want pState
				  pState = wantToken GeneralContext "class definition" CloseToken pState
				  (token, pState) = nextToken FunctionContext pState
				  (prio, pState) = optionalPriority cIsInfix token pState  
				= (cIsNotAClass, member_name, prio, pState)
 				# (class_name, pState) = want_name token pState
				= (cMightBeAClass, class_name, NoPrio, pState)
		where
			want_name (IdentToken name) pState
				= (name, pState)
			want_name token pState
				= ("", parseError "Class Definition" (Yes token) "<identifier>" pState)

		want_overloaded_function pos member_name prio class_arity class_args class_cons_vars contexts pState
			# (tspec, pState) = want pState
			  (member_id, pState) = stringToIdent member_name IC_Expression pState
			  (class_id, pState) = stringToIdent member_name