scanner.icl 66.3 KB
Newer Older
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
1
2
implementation module scanner

John van Groningen's avatar
John van Groningen committed
3
import	StdEnv, compare_constructor, general, compilerSwitches
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
4
5
6

from utilities import revCharListToString, isSpecialChar

7
8
9
10
11
// RWS Proof ... ::	SearchPaths	:== [String]
:: SearchPaths = 
	{ sp_locations   :: [(String, String)]       // (module, path)
	, sp_paths       :: [String]
	}
12
13

:: ModTimeFunction f
John van Groningen's avatar
John van Groningen committed
14
	:== ({#Char} f -> *(!{#Char}, !f))
15

16
// ... RWS
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
17

clean's avatar
clean committed
18
19
20
21
22
23
24
25
26
27
28
29
30
31
::	*ScanState = ScanState !RScanState

instance getFilename ScanState
where
	getFilename (ScanState scan_state)
		# (file_name,scan_state) = getFilename scan_state
		= (file_name,ScanState scan_state)

instance tokenBack ScanState
where
	tokenBack (ScanState scan_state) = ScanState (tokenBack scan_state)

instance nextToken ScanState
where
32
	nextToken context (ScanState scan_state=:{ss_scanOptions})
clean's avatar
clean committed
33
		# (token,scan_state) = nextToken context scan_state
34
35
36
37
38
39
40
41
42
		= (replaceUnderscoreToken token ((ss_scanOptions bitand ScanOptionUnderscoreIdentsBit) <> 0),
				ScanState scan_state)
		where
			replaceUnderscoreToken :: Token !Bool -> Token
			replaceUnderscoreToken (UnderscoreIdentToken name) underscoreModule
				| underscoreModule
					=	IdentToken name
			replaceUnderscoreToken token _
				=	token
clean's avatar
clean committed
43
44
45
46
47
48

instance currentToken ScanState
where
	currentToken (ScanState scan_state)
		# (token,scan_state) = currentToken scan_state
		= (token,ScanState scan_state) 
49
/*
clean's avatar
clean committed
50
51
52
53
54
55
56
instance insertToken ScanState
where
	insertToken token context (ScanState scan_state) = ScanState (insertToken token context scan_state)

instance replaceToken ScanState
where
	replaceToken token (ScanState scan_state) = ScanState (replaceToken token scan_state)
57
*/
clean's avatar
clean committed
58
59
60
61
instance getPosition ScanState
where
	getPosition (ScanState scan_state)
		# (position,scan_state) = getPosition scan_state
62
		= (position,ScanState scan_state)
clean's avatar
clean committed
63
64

::	* RScanState =
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
65
66
	{	ss_input		::	ScanInput
	,	ss_offsides		::	! [(Int, Bool) ]	// (column, defines newDefinition)
67
	,	ss_scanOptions	::	! Int
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
68
69
70
	,	ss_tokenBuffer	::	! Buffer LongToken
	}

71
ScanOptionUseLayoutBit :== 1
72
ScanOptionUnderscoreIdentsBit :== 2
73

74
75
ScanOptionNoNewOffsideForSeqLetBit:==4;

Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
76
::	* ScanInput
77
	=	Input			Input
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
78
79
80
	|	PushedToken		LongToken ScanInput

::	* Input =
Pieter Koopman's avatar
Pieter Koopman committed
81
	{	inp_stream		::	! * InputStream
clean's avatar
clean committed
82
	,	inp_filename	::	!String
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
83
84
85
86
87
	,	inp_pos			::	! FilePosition
	,	inp_tabsize		::	! Int
	}

::	* InputStream
Pieter Koopman's avatar
Pieter Koopman committed
88
	=	InFile			* File
89
	|	OldLine 		!Int !{#Char} !InputStream
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
90
91
92
93
94
95
96
97

::	FilePosition =
	{	fp_line			::	! Int
	,	fp_col			::	! Int
	}

::	LongToken =
	{	lt_position		::	! FilePosition	// Start position of this token
98
	,	lt_index		::	! Int			// The index in the current line
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
99
	,	lt_token		::	! Token			// The token itself
Pieter Koopman's avatar
Pieter Koopman committed
100
	,	lt_context		::	! ScanContext	// The context of the token
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
101
102
	}

John van Groningen's avatar
John van Groningen committed
103
104
::	*Buffer x:==SBuffer x
::	SBuffer x
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
105
106
107
108
109
110
111
	=	Buffer0
	|	Buffer1 x
	|	Buffer2 x x
	|	Buffer3 x x x // buffer size is 3.

::	Token
	= 	IdentToken ! .String	//		an identifier
112
	| 	UnderscoreIdentToken !.String//	an identifier that starts with a '_'
113
	| 	QualifiedIdentToken !String !.String	//	a qualified identifier
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
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
	|	IntToken !.String		//		an integer
	|	RealToken !.String		//		a real
	|	StringToken !.String	//		a string
	|	CharToken !.String		//		a character
	|	CharListToken !.String	//		a character list '{char}*'
	|	BoolToken !Bool			//		a boolean
	|	OpenToken				//		(
	|	CloseToken				//		)
	|	CurlyOpenToken			//		{
	|	CurlyCloseToken			//		}
	|	SquareOpenToken			//		[
	|	SquareCloseToken		//		]

	|	DotToken				//		.
	|	SemicolonToken			//		;
	|	ColonToken				//		:
	|	DoubleColonToken		//		::
	|	CommaToken				//		,
	|	ExclamationToken		//		!
	|	BarToken				//		|
	|	ArrowToken				//		->
	|	DoubleArrowToken		//		=>
	|	EqualToken				//		=
	|	DefinesColonToken		//		=:
	|	ColonDefinesToken		//		:==
	|	WildCardToken			//		_
	|	BackSlashToken			//		\
	|	DoubleBackSlashToken	//		\\
	|	LeftArrowToken			//		<-
	|	LeftArrowColonToken		//		<-:
144
	|	LeftArrowWithBarToken	//		<|-
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
145
146
147
148
149
150
151
152
153
154
155
156
157
158
	|	DotDotToken				//		..
	|	AndToken				//		&
	|	HashToken				//		#
	|	AsteriskToken			//		*
	|	LessThanOrEqualToken	//		<=

	|	ModuleToken				//		module
	|	ImpModuleToken			//		implementation
	|	DefModuleToken			//		definition
	|	SysModuleToken			//		system

	|	ImportToken				//		import
	|	FromToken				//		from
	|	SpecialToken			//		special
John van Groningen's avatar
John van Groningen committed
159
	|	ForeignToken			//		foreign
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
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

	|	IntTypeToken			//		Int
	|	CharTypeToken			//		Char
	|	RealTypeToken			//		Real
	|	BoolTypeToken			//		Bool
	|	StringTypeToken			//		String
	|	FileTypeToken			//		File
	|	WorldTypeToken			//		World
	|	ClassToken				//		class
	|	InstanceToken			//		instance
	|	OtherwiseToken			//		otherwise

	|	IfToken					//		if
	|	WhereToken				//		where
	|	WithToken				//		with
	|	CaseToken				//		case
	|	OfToken					//		of
	|	LetToken Bool			//		let!, let
	|	SeqLetToken Bool		//		#!, #
	|	InToken					//		in

	|	DynamicToken			//		dynamic
	|	DynamicTypeToken		//		Dynamic

	|	PriorityToken Priority	//		infixX N

	|	CodeToken				//		code
	|	InlineToken				//		inline
	|	CodeBlockToken [String]	//		{...}

	|	NewDefinitionToken		//		generated automatically, OffsideToken.
	|	EndGroupToken			//		generated automatically
	|	EndOfFileToken			//		end of file
	|	ErrorToken String		//		an error has occured

195
	| 	GenericToken			//		generic
196
	| 	DeriveToken				//		derive
197
198
	|	GenericOpenToken		//		{|
	|	GenericCloseToken		//		|}
199
	|	GenericOfToken			//		of
200

201
202
203
	|	ExistsToken				//		E.
	|	ForAllToken				//		A.

204

Pieter Koopman's avatar
Pieter Koopman committed
205
::	ScanContext
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
206
207
208
209
	=	GeneralContext
	|	TypeContext
	|	FunctionContext
	|	CodeContext
210
	| 	GenericContext
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
211

Pieter Koopman's avatar
Pieter Koopman committed
212
instance == ScanContext
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
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
where
	(==) co1 co2 = equal_constructor co1 co2

::	Assoc
	=	LeftAssoc
	|	RightAssoc
	|	NoAssoc

::	Priority
	=	Prio Assoc Int
	|	NoPrio

//
//	Macros for error messages
//
ScanErrIllegal	:== "illegal char in input"
ScanErrCharErr	:== "wrong character denotation"
ScanErrNLString	:== "new line in string denotation"

class getFilename state :: !*state -> (!String,!*state)

instance getFilename ScanInput
where
	getFilename (Input input)
		# (filename,input) = input!inp_filename
		= (filename,Input input)
	getFilename (PushedToken tok input)
		# (filename,input) = getFilename input
		= (filename,PushedToken tok input)

clean's avatar
clean committed
243
instance getFilename RScanState
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
244
245
246
247
248
249
250
where
	getFilename scanState=:{ss_input}
		# (filename,ss_input) = getFilename ss_input
		= (filename,{scanState & ss_input = ss_input })

class getPosition state :: !*state -> (!FilePosition,!*state)  // Position of current Token (or Char)

clean's avatar
clean committed
251
instance getPosition RScanState
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
252
253
254
255
where
	getPosition scanState=:{ss_tokenBuffer}
		| isEmptyBuffer ss_tokenBuffer
			= getCharPosition scanState
John van Groningen's avatar
John van Groningen committed
256
257
		# (ltok,ss_tokenBuffer) = head ss_tokenBuffer
		= (ltok.lt_position, {scanState & ss_tokenBuffer=ss_tokenBuffer})
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
258
259
260
261
262
263
264

instance getPosition Input
where
	getPosition input=:{inp_pos} = (inp_pos, input)

class getCharPosition state :: !*state -> (FilePosition,!*state)

clean's avatar
clean committed
265
instance getCharPosition RScanState
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
266
267
268
269
270
271
272
273
274
275
where
	getCharPosition scanState=:{ss_input=Input input}
		# (pos,input) = getPosition input
		= (pos,{ scanState & ss_input = Input input })
	getCharPosition scanState=:{ss_input=PushedToken longToken _}
		= (longToken.lt_position,scanState)

instance getCharPosition Input
where getCharPosition input=:{inp_pos} = (inp_pos, input)

276
277
278
279
280
281
282
283
284
285
286
287
288
class getIndex input :: !*input -> (!Int, !*input)

instance getIndex InputStream
where
	getIndex input=:(OldLine index _ _) = (index-1,input)
	getIndex input = (0,input)

instance getIndex Input
where
	getIndex input=:{inp_stream=stream}
		# (index,stream) = getIndex stream
		= (index,{input & inp_stream=stream})

Pieter Koopman's avatar
Pieter Koopman committed
289
class nextToken state :: !ScanContext !*state -> (!Token, !*state)
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
290

clean's avatar
clean committed
291
instance nextToken RScanState
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
292
where
293
	nextToken newContext (scanState=:{ss_input=inp=:PushedToken token=:{lt_position,lt_token,lt_context,lt_index} rest_inp,ss_tokenBuffer,ss_offsides,ss_scanOptions})
294
295
296
		| lt_context == newContext || notContextDependent lt_token
		=	(	lt_token
			,	{ scanState & ss_input = rest_inp , ss_tokenBuffer	= store token ss_tokenBuffer }
297
			)  -->> ("nextToken: pushed token", lt_token)
298
299
		= token_back rest_inp
		where
300
			token_back input=:(Input {inp_pos,inp_stream=OldLine currentIndex string stream,inp_filename,inp_tabsize}) // one old token in wrong context.
301
302
				|	inp_pos.fp_line == lt_position.fp_line
				#	old_input
303
					 =	{ inp_stream	= OldLine (lt_index+1) string stream
304
305
306
307
						, inp_filename	= inp_filename
						, inp_pos		= lt_position
						, inp_tabsize	= inp_tabsize
						} -->> ("token_back in input", lt_token)
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
				#	c				= string.[lt_index]
				#	(token, inp)	= Scan c old_input newContext
				= ( token
				  , {	ss_input 		= Input inp
					,	ss_tokenBuffer	= store
											{	lt_position 	= lt_position
											,	lt_index		= lt_index
											,	lt_token		= token
											,	lt_context		= newContext
											}
											(pop ss_tokenBuffer)
					,	ss_offsides=ss_offsides
					,	ss_scanOptions=ss_scanOptions
					}
				  )	 -->> ("renewed token",token,lt_position)
323
				=	(	lt_token
324
					,	{ss_input = input , ss_tokenBuffer	= store token ss_tokenBuffer, ss_offsides=ss_offsides, ss_scanOptions=ss_scanOptions}
325
326
327
					) -->> ("unable to push token_back in input; line is lost",(inp_pos.fp_line,lt_position.fp_line), lt_token)
			token_back input
				=	(	lt_token
328
					,	{ss_input = input , ss_tokenBuffer	= store token ss_tokenBuffer, ss_offsides=ss_offsides, ss_scanOptions=ss_scanOptions}
329
330
					) -->> ("unable to push token_back in input; generated token", lt_token)

331
	nextToken context {ss_input=Input inp,ss_tokenBuffer,ss_offsides,ss_scanOptions}
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
332
		# (error, c, inp) 	= SkipWhites inp
333
334
		  (pos, inp)		= inp!inp_pos
		  (index,inp)		= getIndex inp
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
335
		= case error of
Pieter Koopman's avatar
Pieter Koopman committed
336
337
338
339
			Yes string
				->	( ErrorToken string
							,	{	ss_tokenBuffer	= store
												{	lt_position 	= pos
340
												,	lt_index		= index
Pieter Koopman's avatar
Pieter Koopman committed
341
												,	lt_token		= ErrorToken string
342
												,	lt_context		= context
Pieter Koopman's avatar
Pieter Koopman committed
343
344
345
												}
												ss_tokenBuffer,
									ss_input=Input inp,
346
									ss_offsides=ss_offsides,	ss_scanOptions=ss_scanOptions
Pieter Koopman's avatar
Pieter Koopman committed
347
348
349
350
351
352
								}
							) -->> ("Error token generated",string)
			no
				#	(eof, inp)	= EndOfInput inp
				|	eof && c == NewLineChar
					#	newToken	= EndOfFileToken
353
					->	checkOffside pos index newToken
Pieter Koopman's avatar
Pieter Koopman committed
354
355
							{ ss_tokenBuffer	= store
													{	lt_position 	= pos
356
													,	lt_index		= index
Pieter Koopman's avatar
Pieter Koopman committed
357
													,	lt_token		= newToken
358
													,	lt_context		= context
Pieter Koopman's avatar
Pieter Koopman committed
359
360
361
													}
													ss_tokenBuffer
							, ss_input = Input inp,
362
							ss_offsides=ss_offsides,	ss_scanOptions=ss_scanOptions
Pieter Koopman's avatar
Pieter Koopman committed
363
364
							} // -->> ("Token", EndOfFileToken,pos)
				// otherwise // ~ (eof && c == NewLineChar)
365
366
					#	(token, inp)	= Scan c inp context
					-> checkOffside pos index token
Pieter Koopman's avatar
Pieter Koopman committed
367
368
369
						{ ss_input 			= Input inp
						, ss_tokenBuffer	= store
												{	lt_position 	= pos
370
												,	lt_index		= index
Pieter Koopman's avatar
Pieter Koopman committed
371
												,	lt_token		= token
372
												,	lt_context		= context
Pieter Koopman's avatar
Pieter Koopman committed
373
374
												}
												ss_tokenBuffer,
375
							ss_offsides=ss_offsides,	ss_scanOptions=ss_scanOptions
376
						}	 -->> (token,pos)
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
377
378
	nextToken _ _ = abort "Scanner: Error in nextToken"

John van Groningen's avatar
John van Groningen committed
379
class tokenBack state :: !*state -> *state
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
380

clean's avatar
clean committed
381
instance tokenBack RScanState
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
382
383
384
385
386
387
388
where
	tokenBack scanState=:{ss_tokenBuffer, ss_input}
		| isEmptyBuffer ss_tokenBuffer = abort "tokenBack with empty token buffer"
		# (tok, buf) = get ss_tokenBuffer
		=	{ scanState
			& ss_tokenBuffer	= buf
			, ss_input			= PushedToken tok ss_input
Pieter Koopman's avatar
Pieter Koopman committed
389
		} // -->> ("tokenBack", tok, buf)
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
390
391
392

class currentToken state :: !*state -> (!Token, !*state)

clean's avatar
clean committed
393
instance currentToken RScanState
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
394
395
396
where currentToken scanState=:{ss_tokenBuffer}
		| isEmptyBuffer ss_tokenBuffer
			= (ErrorToken "dummy", scanState)
John van Groningen's avatar
John van Groningen committed
397
398
			# (ltok,ss_tokenBuffer) = head ss_tokenBuffer
			= (ltok.lt_token, {scanState & ss_tokenBuffer=ss_tokenBuffer})
399
/*
Pieter Koopman's avatar
Pieter Koopman committed
400
class insertToken state :: !Token !ScanContext !*state -> *state
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
401

clean's avatar
clean committed
402
instance insertToken RScanState
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
403
404
where
	insertToken t c scanState
405
		#	(pos, scanState=:{ss_input}) = getPosition scanState
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
406
407
408
		=	{ scanState
			& ss_input = PushedToken
							{ lt_position	= pos
409
							, lt_index		= pos.fp_col
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
410
							, lt_token		= t
411
							, lt_context	= c
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
412
413
414
							}
							ss_input
			}
415
*/
416
notContextDependent :: !Token -> Bool
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
notContextDependent token
 = case token of
	NewDefinitionToken	-> True
	EndGroupToken		-> True
	EndOfFileToken		-> True
	InToken				-> True
	ErrorToken _		-> True
	CodeBlockToken _	-> True
	OpenToken			-> True
	CloseToken			-> True
	CurlyOpenToken		-> True
	CurlyCloseToken		-> True
	SquareOpenToken		-> True
	SquareCloseToken	-> True
	SemicolonToken		-> True
	CommaToken			-> True
	ClassToken			-> True
	InstanceToken		-> True
	OtherwiseToken		-> True
	IfToken				-> True
	WhereToken			-> True
	WithToken			-> True
	_					-> False
440
/*
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
441
442
class replaceToken state :: !Token !*state -> *state

clean's avatar
clean committed
443
instance replaceToken RScanState
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
444
445
446
447
448
449
where
	replaceToken tok scanState=:{ss_tokenBuffer}
		# (longToken,buffer) = get ss_tokenBuffer
		= { scanState
		  & ss_tokenBuffer = store { longToken & lt_token = tok } buffer
		  }
450
*/
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
451
SkipWhites :: !Input -> (!Optional String, !Char, !Input)
Pieter Koopman's avatar
Pieter Koopman committed
452
453
454
SkipWhites {inp_stream=OldLine i line stream,inp_pos={fp_line,fp_col},inp_tabsize,inp_filename}
	| i<size line
		= skip_whites_in_line i fp_col fp_line line inp_tabsize stream inp_filename
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
455
456
SkipWhites input
	# (eof, c, input)		= ReadChar input
457
	| eof					= (No, NewLineChar, input)
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
458
459
460
	| IsWhiteSpace c		= SkipWhites input
							= TryScanComment c input

Pieter Koopman's avatar
Pieter Koopman committed
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
skip_whites_in_line :: !Int !Int !Int !{#Char} !Int !*InputStream !String -> *(!Optional String,!Char,!*Input);
skip_whites_in_line i fp_col fp_line line tabsize stream inp_filename
	| i<size line
		# c=line.[i]
		| c==' ' || c == '\f' || c == '\v'
			= skip_whites_in_line (i+1) (fp_col+1) fp_line line tabsize stream inp_filename
		| c=='\t'
			= skip_whites_in_line (i+1) (tabsize * (fp_col / tabsize + 1)) fp_line line tabsize stream inp_filename
		| c==LFChar || c==CRChar
			# pos = {fp_line = fp_line + 1, fp_col = 0}
//			#	(c,stream)	= correctNewline_OldLine c i tabsize line stream
			=	SkipWhites  {
						inp_filename=inp_filename,inp_tabsize=tabsize,
						inp_stream = stream
					,	inp_pos	= pos
					}
			#	pos = {fp_line=fp_line,fp_col = fp_col + 1}
			=	TryScanComment c {
						inp_filename=inp_filename,inp_tabsize=tabsize,
						inp_stream = OldLine (i+1) line stream
					,	inp_pos	= pos
					}
	#	pos = {fp_line=fp_line, fp_col = fp_col}
	= SkipWhites {
				inp_filename=inp_filename,inp_tabsize=tabsize,
				inp_stream = stream
			,	inp_pos	= pos
			}

Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
490
491
TryScanComment :: !Char !Input -> (!Optional String, !Char, !Input)
TryScanComment c1=:'/' input
Pieter Koopman's avatar
Pieter Koopman committed
492
	# (eof,c2, input)		= ReadNormalChar input
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
493
494
495
496
497
498
499
500
501
502
503
	| eof					= (No, c1, input)
	= case c2 of
		'/' -> SkipWhites (SkipToEndOfLine input)
		'*' -> case ScanComment input of
				(No,input)	-> SkipWhites input
				(er,input)	-> (er, c1, input)
		_   -> (No, c1, charBack input)
TryScanComment c input
	= (No, c, input)

ScanComment	:: !Input -> (!Optional String, !Input)
Pieter Koopman's avatar
Pieter Koopman committed
504
505
506
ScanComment {inp_stream=OldLine i line stream,inp_pos={fp_line,fp_col},inp_tabsize,inp_filename}
	| i<size line
		= scan_comment_in_line i fp_col fp_line line inp_tabsize stream inp_filename
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
507
508
509
ScanComment input
	# (eof1, c1, input)	= ReadChar input
	| eof1				= (Yes "end of file encountered inside comment", input)
Pieter Koopman's avatar
Pieter Koopman committed
510
511
512
513
		= ScanComment2 c1 input;

ScanComment2	:: !Char !Input -> (!Optional String, !Input)
ScanComment2 c1 input
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
514
515
516
517
518
519
520
521
522
523
	| c1 == '/'
		# (eof2, c2, input)	= ReadChar input
		| eof2				= (Yes "end of file encountered inside comment", input)
							= case c2 of
								'/'	->	ScanComment (SkipToEndOfLine input)
								'*'	->	case ScanComment input of
											(No, input) -> ScanComment input
											error		-> error
								_	->	ScanComment input
	| c1 == '*'
Pieter Koopman's avatar
Pieter Koopman committed
524
525
526
527
528
529
		# (eol2, c2, input)	= ReadNormalChar input
		| eol2	
			# (eof2, c2, input)	= ReadChar input
			| eof2
			= (Yes "end of file encountered inside comment", input)
			= ScanComment input
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
530
		| c2 == '/'			= (No, input)
Pieter Koopman's avatar
Pieter Koopman committed
531
532
533
		| c2 == '*'
//					= ScanComment (charBack input)
					= ScanComment2 c2 input
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
534
535
536
							= ScanComment input
	| otherwise				= ScanComment input

Pieter Koopman's avatar
Pieter Koopman committed
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
scan_comment_in_line :: !Int !Int !Int !{#Char} !Int !*InputStream !String -> (!Optional String, !Input)
scan_comment_in_line i fp_col fp_line line tabsize stream inp_filename
	| i<size line
		# c=line.[i]
		| c=='\t'
			= scan_comment_in_line (i+1) (tabsize * (fp_col / tabsize + 1)) fp_line line tabsize stream inp_filename
		| c==LFChar || c==CRChar
			# pos = {fp_line = fp_line + 1, fp_col = 0}
//			#	(c,stream)	= correctNewline_OldLine c i tabsize line stream
			=	ScanComment {
						inp_filename=inp_filename,inp_tabsize=tabsize,
						inp_stream = stream
					,	inp_pos	= pos
					}
		| c=='/' || c=='*'
			= ScanComment2 c {
								inp_filename=inp_filename,inp_tabsize=tabsize,
								inp_stream = OldLine (i+1) line stream
							,	inp_pos	= {fp_line=fp_line, fp_col = fp_col+1}
							}
			= scan_comment_in_line (i+1) (fp_col+1) fp_line line tabsize stream inp_filename
	= ScanComment {
				inp_filename=inp_filename,inp_tabsize=tabsize,
				inp_stream = stream
			,	inp_pos	= {fp_line=fp_line, fp_col = fp_col}
			}

John van Groningen's avatar
John van Groningen committed
564
SkipToEndOfLine	:: !Input -> Input
Pieter Koopman's avatar
Pieter Koopman committed
565
566
567
SkipToEndOfLine input=:{inp_stream=OldLine i line stream,inp_pos={fp_line,fp_col}}
	| i<size line
		= {input & inp_stream=stream,inp_pos={fp_line=fp_line+1,fp_col=0}}
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
568
569
570
571
572
SkipToEndOfLine input
	# (eof, c, input)	= ReadChar input
	| eof				= input
	| c==NewLineChar	= input
			= SkipToEndOfLine input
Pieter Koopman's avatar
Pieter Koopman committed
573

Pieter Koopman's avatar
Pieter Koopman committed
574
Scan :: !Char !Input !ScanContext -> (!Token, !Input)
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
575
576
577
Scan '(' input co			= (OpenToken, input)
Scan ')' input co			= (CloseToken, input)
Scan '{' input CodeContext	= ScanCodeBlock input
578
579
580
581
582
583
//Scan '{' input co			= (CurlyOpenToken, input)
Scan c0=:'{' input co
	# (eof, c1, input)		= ReadNormalChar input
	| eof					= (CurlyOpenToken, input)
	| c1 == '|'				= (GenericOpenToken, input)
							= (CurlyOpenToken, charBack input)
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
584
585
586
587
Scan '}' input co			= (CurlyCloseToken, input)
Scan '[' input co			= (SquareOpenToken, input)
Scan ']' input co			= (SquareCloseToken, input)
Scan c0=:'|' input co
Pieter Koopman's avatar
Pieter Koopman committed
588
	# (eof, c1, input)		= ReadNormalChar input
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
589
	| eof					= (BarToken, input)
590
	| c1 == '}'				= (GenericCloseToken, input) // AA
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
591
592
593
594
595
596
597
598
599
	| isSpecialChar c1		= ScanOperator 1 input [c1, c0] co
							= (BarToken, charBack input)
Scan ',' input co			= (CommaToken, input)
Scan ';' input co			= (SemicolonToken, input)
Scan '#' input TypeContext	= (HashToken, input)
Scan c0=:'#' input co
	# (strict, input)		= determineStrictness input
	| strict
		= (SeqLetToken strict, input)
Pieter Koopman's avatar
Pieter Koopman committed
600
	# (eof,c1, input)		= ReadNormalChar input
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
601
602
603
604
605
606
607
	| eof
		= (SeqLetToken False, input)
	| isSpecialChar c1
		= ScanOperator 1 input [c1, c0] co
	// otherwise
		= (SeqLetToken strict, charBack input)
Scan '*' input TypeContext	= (AsteriskToken, input)
608
609
Scan c0=:'&' input co		= possibleKeyToken AndToken [c0] co input
/*	# (eof, c1, input)		= ReadNormalChar input
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
610
611
	| eof					= (AndToken, input)
	| isSpecialChar c1		= ScanOperator 1 input [c1, c0] co
612
							= (AndToken, charBack input) */
613
Scan c0=:'.' input co	// PK incorrect ?
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
614
615
616
	= case co of
		TypeContext
						-> (DotToken, input)
Pieter Koopman's avatar
Pieter Koopman committed
617
		_	# (eof, c1, input) = ReadNormalChar input
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
618
			| eof		-> (DotToken, input)
Pieter Koopman's avatar
Pieter Koopman committed
619
			| c1 == '.'
Pieter Koopman's avatar
Pieter Koopman committed
620
				# (eof, c2, input) = ReadNormalChar input
Pieter Koopman's avatar
Pieter Koopman committed
621
622
				| eof		-> (DotDotToken, input)
				| isSpecialChar c2
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
623
624
						-> ScanOperator 2 input [c2, c1, c0] co
						-> (DotDotToken, charBack input)
Pieter Koopman's avatar
Pieter Koopman committed
625
626
627
			| isSpecialChar c1
						-> ScanOperator 1 input [c1, c0] co
						-> (DotToken, charBack input)
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
628
Scan '!' input TypeContext	= (ExclamationToken, input)
629
Scan c0=:'\\' input co
Pieter Koopman's avatar
Pieter Koopman committed
630
	# (eof, c, input)		= ReadNormalChar input
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
631
	| eof					= (BackSlashToken, input)
632
633
	| c == '\\'				= possibleKeyToken DoubleBackSlashToken [c, c0] co input
	| isSpecialChar c		= ScanOperator 1 input [c, c0] co
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
634
							= (BackSlashToken, charBack input)
635
Scan c0=:'_' input=:{inp_stream=OldLine i line stream,inp_pos} co
636
637
638
639
640
641
642
643
644
	# size	= size line
	# end_i	= scan_underscores i size line
		with
			scan_underscores :: !Int !Int !{#Char} -> Int
			scan_underscores i size line
				| i<size && line.[i] == '_'
					= scan_underscores (i+1) size line
					= i
	| end_i<size && IsIdentChar line.[end_i] co
645
646
647
648
649
650
651
		= replaceIdentToken (ScanIdentFast (end_i-i+1) {input & inp_stream=OldLine end_i line stream} co)
		with
			replaceIdentToken :: (Token, *state) -> (Token, *state)
			replaceIdentToken (IdentToken name, s)
				=	(UnderscoreIdentToken name, s)
			replaceIdentToken tokenAndState
				=	tokenAndState
652
653
654
655
656
	| end_i==i
		= (WildCardToken, input)
		# pos = {inp_pos & fp_col = inp_pos.fp_col + (end_i-i)}
		# input =  {input & inp_stream=OldLine end_i line stream,inp_pos=pos}
		= (ErrorToken (line % (i-1,end_i-1)+++" is an illegal token"),input)
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
657
Scan c0=:'<' input TypeContext
Pieter Koopman's avatar
Pieter Koopman committed
658
	# (eof, c1, input)		= ReadNormalChar input
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
659
660
661
662
	| eof					= (ErrorToken "< just before end of file in TypeContext", input)
	| c1 == '='				= (LessThanOrEqualToken, input)
							=  ScanOperator 0 (charBack input) [c0] TypeContext
Scan c0=:'<' input co
Pieter Koopman's avatar
Pieter Koopman committed
663
	# (eof, c1, input)		= ReadNormalChar input
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
664
	| eof 					= (IdentToken "<", input)
665
666
667
668
669
670
671
672
673
674
675
676
677
678
	| c1 <> '-'
		| c1<>'|'
			= ScanOperator 0 (charBack input) [c0] co
		# (eof, c2, input)	= ReadNormalChar input
		| eof
			= (IdentToken "<|",input)
		| c2=='-'
			# (eof, c3, input)	= ReadNormalChar input
			| eof				= (LeftArrowWithBarToken, input)
			| isSpecialChar c3	= ScanOperator 3 input [c3, c2, c1, c0] co
								= (LeftArrowWithBarToken, charBack input)
		| isSpecialChar c2
			= ScanOperator 2 input [c2, c1, c0] co
			= (IdentToken "<|", charBack input)
Pieter Koopman's avatar
Pieter Koopman committed
679
	# (eof, c2, input)		= ReadNormalChar input
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
680
681
	| eof					= (LeftArrowToken, input)
	| c2 == ':'	
Pieter Koopman's avatar
Pieter Koopman committed
682
		# (eof, c3, input)		= ReadNormalChar input
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
683
684
685
686
687
688
		| eof					= (LeftArrowColonToken, input)
		| isSpecialChar c3		= ScanOperator 3 input [c3, c2, c1, c0] co
								= (LeftArrowColonToken, charBack input)
	| isSpecialChar c2		= ScanOperator 2 input [c2, c1, c0] co
							= (LeftArrowToken, charBack input)
Scan c0=:'-' input co
Pieter Koopman's avatar
Pieter Koopman committed
689
690
691
	# (previous_char,input) = GetPreviousChar input;

	# (eof, c1, input)		= ReadNormalChar input
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
692
	| eof					= (IdentToken "-", input)
Pieter Koopman's avatar
Pieter Koopman committed
693
694
695
	| IsDigit c1 && new_exp_char previous_char
		= ScanNumeral 1 input [c1,c0]

Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
696
	| c1 <> '>'				= ScanOperator 0 (charBack input) [c0] co
697
	| co == TypeContext		= (ArrowToken, input)
Pieter Koopman's avatar
Pieter Koopman committed
698
	# (eof, c2, input)		= ReadNormalChar input		
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
699
700
701
702
	| eof					= (ArrowToken, input)
	| isSpecialChar c2		= ScanOperator 2 input [c2, c1, c0] co
							= (ArrowToken, charBack input)
Scan c0=:'+' input co
Pieter Koopman's avatar
Pieter Koopman committed
703
704
705
	# (previous_char,input) = GetPreviousChar input;

	# (eof, c1, input)		= ReadNormalChar input
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
706
	| eof					= (IdentToken "+", input)
Pieter Koopman's avatar
Pieter Koopman committed
707
708
	| IsDigit c1 && new_exp_char previous_char
		= ScanNumeral 1 input [c1,c0]
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
709
710
							= ScanOperator 0 (charBack input) [c0] co
Scan c0=:'=' input co
Pieter Koopman's avatar
Pieter Koopman committed
711
	# (eof, c, input)		= ReadNormalChar input
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
712
	| eof					= (EqualToken, input)
713
714
	| c == ':'				= possibleKeyToken DefinesColonToken [c, c0] co input
	| c == '>'				= possibleKeyToken DoubleArrowToken [c, c0] co input
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
715
716
717
	| isSpecialChar c		= ScanOperator 1 input [c, c0] co
							= (EqualToken, charBack input)
Scan c0=:':' input co
Pieter Koopman's avatar
Pieter Koopman committed
718
	# (eof,c1, input)		= ReadNormalChar input
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
719
	| eof					= (ColonToken, input)
Pieter Koopman's avatar
Pieter Koopman committed
720
721
722
	| c1 == ':'
		# (eof, c2, input)	= ReadNormalChar input
		| eof				= (DoubleColonToken, input)
723
		| isSpecialChar c2	&& ~(c2=='!' || c2=='*' || c2=='.') // for type rules and the like
Pieter Koopman's avatar
Pieter Koopman committed
724
725
726
727
728
729
							= ScanOperator 2 input [c2, c1, c0] co
							= (DoubleColonToken, charBack input)
	| c1 == '='
		# (eof, c2, input)	= ReadNormalChar input
		| eof				= ScanOperator 1 input [c1, c0] co
		| c2 == '='			= (ColonDefinesToken, input)
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
730
							= ScanOperator 1 (charBack input) [c1, c0] co
Pieter Koopman's avatar
Pieter Koopman committed
731
732
733
	// c1 <> '='
	| isSpecialChar c1		= ScanOperator 1 input [c1, c0] co
							= (ColonToken, charBack input)
734
Scan '\'' input co			= ScanChar input
735
Scan c0=:'\"' input co		= ScanString 0 [c0] input
736

737
738
739
740
741
742
743
744
745
746
Scan 'E' input TypeContext
	# (eof,c1,input)		= ReadNormalChar input
	| eof					= (IdentToken "E", input)
	| c1 == '.'				= (ExistsToken, input)
							= ScanIdentFast 1 (charBack input) TypeContext
Scan 'A' input TypeContext
	# (eof,c1,input)		= ReadNormalChar input
	| eof					= (IdentToken "A", input)
	| c1 == '.'				= (ForAllToken, input)
							= ScanIdentFast 1 (charBack input) TypeContext
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
747
748
Scan c    input co
	| IsDigit c				= ScanNumeral 0 input [c]
Pieter Koopman's avatar
Pieter Koopman committed
749
750
	| IsIdentChar c	co	
		= ScanIdentFast 1 input co
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
751
752
	| isSpecialChar c		= ScanOperator 0 input [c] co
							= (ErrorToken ScanErrIllegal, input)
753

Pieter Koopman's avatar
Pieter Koopman committed
754
possibleKeyToken :: !Token ![Char] !ScanContext !Input -> (!Token, !Input)
755
756
757
possibleKeyToken token reversedPrefix context input
	# (eof, c, input)		= ReadNormalChar input
	| eof					= (token, input)
758
	| isSpecialChar c		= ScanOperator (length reversedPrefix) input [c : reversedPrefix] context
759
760
							= (token, charBack input)

Pieter Koopman's avatar
Pieter Koopman committed
761
762
763
new_exp_char ',' = True
new_exp_char '[' = True
new_exp_char '(' = True
764
new_exp_char '{' = True
Pieter Koopman's avatar
Pieter Koopman committed
765
766
767
new_exp_char '/' = True // to handle end of comment symbol: */
new_exp_char c	 = isSpace c

Pieter Koopman's avatar
Pieter Koopman committed
768
ScanIdentFast :: !Int !Input !ScanContext -> (!Token, !Input)
Pieter Koopman's avatar
Pieter Koopman committed
769
ScanIdentFast n input=:{inp_stream=OldLine i line stream,inp_pos} co
770
	# (end_i,qualified) = ScanIdentCharsInString i line co
Pieter Koopman's avatar
Pieter Koopman committed
771
		with
772
			ScanIdentCharsInString :: !Int !{#Char} !ScanContext -> (!Int,!Bool)
Pieter Koopman's avatar
Pieter Koopman committed
773
			ScanIdentCharsInString i line co
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
				| i<size line
					| IsIdentChar line.[i] co
						= ScanIdentCharsInString (i+1) line co
						= (i,line.[i]=='@')
					= (i,False)
	| not qualified
		# pos = {inp_pos & fp_col = inp_pos.fp_col + (end_i-i)}
		# input =  {input & inp_stream=OldLine end_i line stream,inp_pos=pos}
		= CheckReservedIdent co (line % (i-n,end_i-1)) input
	# i2=end_i+1
	| i2==size line
		# pos = {inp_pos & fp_col = inp_pos.fp_col + (end_i-i)}
		# input =  {input & inp_stream=OldLine end_i line stream,inp_pos=pos}
		= CheckReservedIdent co (line % (i-n,end_i-1)) input
	# c=line.[i2]
	| IsIdentChar c co
		# module_name = line % (i-n,end_i-1)
		# end_i = ScanIdentCharsInString (i2+1) line co
			with
				ScanIdentCharsInString :: !Int !{#Char} !ScanContext -> Int
				ScanIdentCharsInString i line co
					| i<size line && IsIdentChar line.[i] co
						= ScanIdentCharsInString (i+1) line co
						= i
		# ident_name = line % (i2,end_i-1)
		# pos = {inp_pos & fp_col = inp_pos.fp_col + (end_i-i)}
		# input =  {input & inp_stream=OldLine end_i line stream,inp_pos=pos}
		= (QualifiedIdentToken module_name ident_name,input)
	| isSpecialChar c
		# module_name = line % (i-n,end_i-1)
		# end_i = ScanSpecialCharsInString (i2+1) line
			with
				ScanSpecialCharsInString :: !Int !{#Char} -> Int
				ScanSpecialCharsInString i line
					| i<size line && isSpecialChar line.[i]
						= ScanSpecialCharsInString (i+1) line
						= i
		# ident_name = line % (i2,end_i-1)
		# pos = {inp_pos & fp_col = inp_pos.fp_col + (end_i-i)}
		# input =  {input & inp_stream=OldLine end_i line stream,inp_pos=pos}
		= (QualifiedIdentToken module_name ident_name,input)
		# pos = {inp_pos & fp_col = inp_pos.fp_col + (end_i-i)}
		# input =  {input & inp_stream=OldLine end_i line stream,inp_pos=pos}
		= CheckReservedIdent co (line % (i-n,end_i-1)) input
818

Pieter Koopman's avatar
Pieter Koopman committed
819
ScanOperator :: !Int !Input ![Char] !ScanContext -> (!Token, !Input)
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
820
ScanOperator n input token co
Pieter Koopman's avatar
Pieter Koopman committed
821
	#  (eof, c, input)		= ReadNormalChar input
822
	| eof					= CheckReservedOperator (revCharListToString n token) input
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
823
	| isSpecialChar c		= ScanOperator (n + 1) input [c:token] co
824
825
826
827
828
829
830
831
							= CheckReservedOperator (revCharListToString n token) (charBack input)

CheckReservedIdent :: !ScanContext !String !Input -> (!Token, !Input)
CheckReservedIdent GeneralContext   s i = CheckGeneralContext s i
CheckReservedIdent TypeContext      s i = CheckTypeContext s i
CheckReservedIdent FunctionContext	s i = CheckFunctContext s i
CheckReservedIdent CodeContext		s i = CheckCodeContext s i
CheckReservedIdent GenericContext	s i = CheckGenericContext s i
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
832

833
834
835
836
CheckReservedOperator :: !String !Input -> (!Token, !Input)
CheckReservedOperator "!"  input =	(ExclamationToken, input)
CheckReservedOperator "*/" input =	(ErrorToken "Unexpected end of comment, */", input)
CheckReservedOperator s    input =	(IdentToken s, input)
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
837

838
CheckGeneralContext :: !String !Input -> (!Token, !Input)
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
CheckGeneralContext s input
 = case s of
	"module"     		-> (ModuleToken		, input)
	"definition"  		-> (DefModuleToken	, input)
	"implementation"	-> (ImpModuleToken	, input)
	"system"			-> (SysModuleToken	, input)
	"from" 				-> (FromToken		, input)
	"in"  	    		-> (InToken			, input)
	s					-> CheckEveryContext s input

CheckEveryContext :: !String !Input -> (!Token, !Input)
CheckEveryContext s input
 = case s of
	"where"		->	(WhereToken			, input)
	"with"		->	(WithToken			, input)
	"class" 	->	(ClassToken			, input)
	"instance"	->	(InstanceToken		, input)
856
	"generic" 	->	(GenericToken		, input)
857
	"derive"	-> 	(DeriveToken		, input)
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
858
859
860
861
862
863
864
865
866
867
868
869
870
	"otherwise"	->	(OtherwiseToken		, input)
	"infixr"	#	(error, n, input) = GetPrio  input
				->	case error of
						Yes err -> (ErrorToken err						, input)  //-->> ("Error token generated: "+err)
						No		-> (PriorityToken (Prio RightAssoc n)	, input)
	"infixl"	#	(error, n, input) = GetPrio  input
				->	case error of
						Yes err -> (ErrorToken err						, input)  //-->> ("Error token generated: "+err)
						No		-> (PriorityToken (Prio LeftAssoc n)	, input)
	"infix"		#	(error, n, input) = GetPrio  input
				->	case error of
						Yes err -> (ErrorToken err						, input)  //-->> ("Error token generated: "+err)
						No		-> (PriorityToken (Prio NoAssoc n)		, input)
Pieter Koopman's avatar
Pieter Koopman committed
871
	"import" -> (ImportToken,input)
John van Groningen's avatar
John van Groningen committed
872
	"foreign" -> (ForeignToken,input)
Pieter Koopman's avatar
Pieter Koopman committed
873
   	s			->	(IdentToken s		, input)
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
874
875
876
877
878
879
880
881
882
883
884
885
886
887

CheckTypeContext :: !String !Input -> (!Token, !Input)
CheckTypeContext s input
 = case s of
 	"Int"		->	(IntTypeToken		, input)
	"Char"		->	(CharTypeToken		, input)
	"Real"		->	(RealTypeToken		, input)
	"Bool"		->	(BoolTypeToken		, input)
	"String"	->	(StringTypeToken	, input)
	"File"		->	(FileTypeToken		, input)
	"World"		->	(WorldTypeToken		, input)
	"Dynamic"	->	(DynamicTypeToken	, input)
	"special"	->	(SpecialToken		, input)
	"from" 		->	(FromToken			, input)
888
	"of"		->  (OfToken			, input) // AA
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
	s			->	CheckEveryContext s input

CheckFunctContext :: !String !Input -> (!Token, !Input)
CheckFunctContext s input
 = case s of
	"if"		->	(IfToken			, input)
	"True"		->	(BoolToken True		, input)
	"False"		->	(BoolToken False	, input)
	"case"		->	(CaseToken			, input)
	"of"		->	(OfToken			, input)
	"system"	->	(SysModuleToken		, input)
	"from"		->	(FromToken			, input)
	"let" 	    #	(strict, input) = determineStrictness input
				->	(LetToken strict, input)
//	"Let" 	    #	(strict, input) = determineStrictness input
//				->	(SeqLetToken strict	, input)
	"in"  	    ->	(InToken			, input)
	"dynamic"  	->	(DynamicToken		, input)
	"code"		->	(CodeToken			, input)
	s			->	CheckEveryContext s input

CheckCodeContext :: !String !Input -> (!Token, !Input)
CheckCodeContext s input
 = case s of
	"inline"	->	(InlineToken		, input)
	s			->	CheckEveryContext s input	

916
917
918
919
920
921
CheckGenericContext :: !String !Input -> (!Token, !Input)
CheckGenericContext s input
 = case s of
	"of"	->	(GenericOfToken		, input)
	s			->	CheckEveryContext s input	

Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
922
923
924
925
926
927
GetPrio :: !Input -> (!Optional String, !Int, !Input)
GetPrio input
	# (error, c, input) = SkipWhites input
	| IsDigit c
		= (error, digitToInt c, input)
		= (error, defaultPrio , charBack input)
928
where defaultPrio = 9
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
929
930
931

determineStrictness :: !Input -> (!Bool, !Input)
determineStrictness input
Pieter Koopman's avatar
Pieter Koopman committed
932
	# (eof, c, input)		= ReadNormalChar input
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
	| eof					= (False, input)
	| c == '!'				= (True, input)
							= (False, charBack input)

ScanCodeBlock :: !Input -> (!Token, !Input)
ScanCodeBlock input
	= scan_code_block [] input
where
	scan_code_block :: ![String] !Input -> (!Token,!Input)
	scan_code_block acc input
		# (eof, c, input)	= ReadChar input
		| c == '}'
			= (CodeBlockToken (reverse acc), input)
		| isNewLine c
			| eof
				= (ErrorToken "eof in code block", input)
				= scan_code_block acc input
		| IsWhiteSpace c
				= scan_code_block acc input
		# (line, input)		= ReadLine input
		= scan_code_block [toString c+stripNewline line:acc] input

stripNewline :: !String -> String
stripNewline string
	# size = size string
	= case size of
		0 -> string
		1 | isNewLine string.[0]
			-> ""
			-> string
		_ | isNewLine string.[size-1]
			| isNewLine string.[size-2]
				-> string%(0,size-3)
				-> string%(0,size-2)
			-> string

ScanNumeral	:: !Int !Input [Char] -> (!Token, !Input)
ScanNumeral n input chars=:['0':r]
	| isEmpty r || r == ['+']
Pieter Koopman's avatar
Pieter Koopman committed
972
		# (eof, c, input)		= ReadNormalChar input
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
973
974
		| eof					= (IntToken (revCharListToString n chars), input)
		| c == 'x'
Pieter Koopman's avatar
Pieter Koopman committed
975
			# (eof, c1, input)	= ReadNormalChar input
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
976
977
978
979
980
981
982
			| eof				= (IntToken "0", charBack input)
			| isHexDigit c1		= ScanHexNumeral (hexDigitToInt c1) input
								= (IntToken "0", charBack (charBack input))
		| isOctDigit c			= ScanOctNumeral (digitToInt c) input
		| c == '.'				= TestFraction n input chars
								= (IntToken "0", charBack input)
	| r == ['-']
Pieter Koopman's avatar
Pieter Koopman committed
983
		# (eof, c, input)		= ReadNormalChar input
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
984
985
		| eof					= (IntToken (revCharListToString n chars), input)
		| c == 'x'
Pieter Koopman's avatar
Pieter Koopman committed
986
			# (eof, c1, input)	= ReadNormalChar input
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
987
988
989
990
991
992
993
			| eof				= (IntToken "0", charBack input)
			| isHexDigit c1		= ScanHexNumeral (~ (hexDigitToInt c1)) input
								= (IntToken "0", charBack (charBack input))
		| isOctDigit c			= ScanOctNumeral (~ (digitToInt c)) input
		| c == '.'				= TestFraction n input chars
								= (IntToken "0", charBack input)
ScanNumeral n input chars
Pieter Koopman's avatar
Pieter Koopman committed
994
	# (eof, c, input)		= ReadNormalChar input
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
995
996
997
998
	| eof					= (IntToken (revCharListToString n chars), input)
	| IsDigit c				= ScanNumeral (n + 1) input [c:chars]
	| c == 'E'				= ScanExponentSign (n + 1) input [c:chars]
	| c == '.'				= TestFraction n input chars
John van Groningen's avatar
John van Groningen committed
999
1000
							#! s = revCharListToString n chars
							= (IntToken s, charBack input)
For faster browsing, not all history is shown. View entire blame