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

3
import	StdEnv, compare_constructor, general
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
4
5

from utilities import revCharListToString, isSpecialChar
6
import DirectorySeparator
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
7

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

:: ModTimeFunction f
14
	:== ({#Char} f -> *({#Char}, f))
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
15

clean's avatar
clean committed
16
17
18
19
20
21
22
23
24
25
26
27
28
29
::	*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
30
	nextToken context (ScanState scan_state=:{ss_scanOptions})
clean's avatar
clean committed
31
		# (token,scan_state) = nextToken context scan_state
32
33
34
35
36
37
38
39
40
		= (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
41
42
43
44
45
46
47
48
49
50
51

instance currentToken ScanState
where
	currentToken (ScanState scan_state)
		# (token,scan_state) = currentToken scan_state
		= (token,ScanState scan_state) 

instance getPosition ScanState
where
	getPosition (ScanState scan_state)
		# (position,scan_state) = getPosition scan_state
52
		= (position,ScanState scan_state)
clean's avatar
clean committed
53

54
55
56
57
58
instance getCurrentAndPrevious2Positions ScanState
where
	getCurrentAndPrevious2Positions scanState=:(ScanState {ss_tokenBuffer=Buffer3 x y z})
		= (x.lt_position, y.lt_position, z.lt_position, scanState)

clean's avatar
clean committed
59
::	* RScanState =
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
60
61
	{	ss_input		::	ScanInput
	,	ss_offsides		::	! [(Int, Bool) ]	// (column, defines newDefinition)
62
	,	ss_scanOptions	::	! Int
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
63
64
65
	,	ss_tokenBuffer	::	! Buffer LongToken
	}

66
ScanOptionUseLayoutBit :== 1
67
ScanOptionUnderscoreIdentsBit :== 2
68

69
70
ScanOptionNoNewOffsideForSeqLetBit:==4;

Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
71
::	* ScanInput
72
	=	Input			Input
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
73
74
75
	|	PushedToken		LongToken ScanInput

::	* Input =
Pieter Koopman's avatar
Pieter Koopman committed
76
	{	inp_stream		::	! * InputStream
clean's avatar
clean committed
77
	,	inp_filename	::	!String
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
78
79
80
81
82
	,	inp_pos			::	! FilePosition
	,	inp_tabsize		::	! Int
	}

::	* InputStream
Pieter Koopman's avatar
Pieter Koopman committed
83
	=	InFile			* File
84
	|	OldLine 		!Int !{#Char} !InputStream
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
85
86
87
88
89
90
91
92

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

::	LongToken =
	{	lt_position		::	! FilePosition	// Start position of this token
93
	,	lt_index		::	! Int			// The index in the current line
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
94
	,	lt_token		::	! Token			// The token itself
Pieter Koopman's avatar
Pieter Koopman committed
95
	,	lt_context		::	! ScanContext	// The context of the token
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
96
97
	}

John van Groningen's avatar
John van Groningen committed
98
99
::	*Buffer x:==SBuffer x
::	SBuffer x
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
100
101
102
103
104
105
106
	=	Buffer0
	|	Buffer1 x
	|	Buffer2 x x
	|	Buffer3 x x x // buffer size is 3.

::	Token
	= 	IdentToken ! .String	//		an identifier
107
	| 	UnderscoreIdentToken !.String//	an identifier that starts with a '_'
108
	| 	QualifiedIdentToken !String !.String	//	a qualified identifier
109
	|	MaybeIdentToken !Int
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
	|	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			//		<-
139
140
	|	LeftArrowWithExclamationToken	//	<!-
	|	LeftArrowWithCaretToken	//		<^-
141
	|	LeftArrowWithBarToken	//		<|-
142
	|	LeftArrowColonToken		//		<-:
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
143
144
145
146
147
148
149
150
151
152
153
154
155
156
	|	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
157
	|	ForeignToken			//		foreign
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192

	|	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

193
	| 	GenericToken			//		generic
194
	| 	DeriveToken				//		derive
195
196
	|	GenericOpenToken		//		{|
	|	GenericCloseToken		//		|}
197
	|	GenericOfToken			//		of
198
	|	GenericWithToken		//		with
199

200
	|	ExistsToken				//		E.
201
	|	ExistsExternalToken		//		E.^
202
203
	|	ForAllToken				//		A.

204
205
206
207
208
209
210
211
212
213
214
215
LazyJustToken :== 0
LazyNoneToken :== 1
StrictJustToken :== 2
StrictNoneToken :== 3
UnboxedJustToken :== 4
UnboxedNoneToken :== 5
OverloadedJustToken :== 6
OverloadedNoneToken :== 7
LazyMaybeToken :== 8
StrictMaybeToken :== 9
UnboxedMaybeToken :== 10

Pieter Koopman's avatar
Pieter Koopman committed
216
::	ScanContext
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
217
218
219
220
	=	GeneralContext
	|	TypeContext
	|	FunctionContext
	|	CodeContext
221
	| 	GenericContext
John van Groningen's avatar
John van Groningen committed
222
	|	ModuleNameContext
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
223

Pieter Koopman's avatar
Pieter Koopman committed
224
instance == ScanContext
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
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
255
instance getFilename RScanState
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
256
257
258
259
260
261
262
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
263
instance getPosition RScanState
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
264
265
266
267
where
	getPosition scanState=:{ss_tokenBuffer}
		| isEmptyBuffer ss_tokenBuffer
			= getCharPosition scanState
John van Groningen's avatar
John van Groningen committed
268
269
		# (ltok,ss_tokenBuffer) = head ss_tokenBuffer
		= (ltok.lt_position, {scanState & ss_tokenBuffer=ss_tokenBuffer})
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
270
271
272
273
274
275
276

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

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

clean's avatar
clean committed
277
instance getCharPosition RScanState
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
278
279
280
281
282
283
284
285
286
287
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)

288
289
290
291
292
293
294
295
296
297
298
299
300
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
301
class nextToken state :: !ScanContext !*state -> (!Token, !*state)
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
302

clean's avatar
clean committed
303
instance nextToken RScanState
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
304
where
305
	nextToken newContext (scanState=:{ss_input=inp=:PushedToken token=:{lt_position,lt_token,lt_context,lt_index} rest_inp,ss_tokenBuffer,ss_offsides,ss_scanOptions})
306
307
308
		| lt_context == newContext || notContextDependent lt_token
		=	(	lt_token
			,	{ scanState & ss_input = rest_inp , ss_tokenBuffer	= store token ss_tokenBuffer }
309
			)  -->> ("nextToken: pushed token", lt_token)
310
311
		= token_back rest_inp
		where
312
			token_back input=:(Input {inp_pos,inp_stream=OldLine currentIndex string stream,inp_filename,inp_tabsize}) // one old token in wrong context.
313
314
				|	inp_pos.fp_line == lt_position.fp_line
				#	old_input
315
					 =	{ inp_stream	= OldLine (lt_index+1) string stream
316
317
318
319
						, inp_filename	= inp_filename
						, inp_pos		= lt_position
						, inp_tabsize	= inp_tabsize
						} -->> ("token_back in input", lt_token)
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
				#	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)
335
				=	(	lt_token
336
					,	{ss_input = input , ss_tokenBuffer	= store token ss_tokenBuffer, ss_offsides=ss_offsides, ss_scanOptions=ss_scanOptions}
337
338
339
					) -->> ("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
340
					,	{ss_input = input , ss_tokenBuffer	= store token ss_tokenBuffer, ss_offsides=ss_offsides, ss_scanOptions=ss_scanOptions}
341
342
					) -->> ("unable to push token_back in input; generated token", lt_token)

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

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

clean's avatar
clean committed
393
instance tokenBack RScanState
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
394
395
396
397
398
399
where
	tokenBack scanState=:{ss_tokenBuffer, ss_input}
		# (tok, buf) = get ss_tokenBuffer
		=	{ scanState
			& ss_tokenBuffer	= buf
			, ss_input			= PushedToken tok ss_input
Pieter Koopman's avatar
Pieter Koopman committed
400
		} // -->> ("tokenBack", tok, buf)
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
401
402
403

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

clean's avatar
clean committed
404
instance currentToken RScanState
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
405
406
407
where currentToken scanState=:{ss_tokenBuffer}
		| isEmptyBuffer ss_tokenBuffer
			= (ErrorToken "dummy", scanState)
John van Groningen's avatar
John van Groningen committed
408
409
			# (ltok,ss_tokenBuffer) = head ss_tokenBuffer
			= (ltok.lt_token, {scanState & ss_tokenBuffer=ss_tokenBuffer})
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
410

411
412
413
414
415
416
417
418
419
420
421
insertBeforeStoredToken :: !LongToken !RScanState -> RScanState
insertBeforeStoredToken l_token scanState=:{ss_tokenBuffer=Buffer1 x,ss_input}
	# ss_tokenBuffer = Buffer1 l_token
	= {scanState & ss_tokenBuffer = ss_tokenBuffer, ss_input = PushedToken x ss_input}
insertBeforeStoredToken l_token scanState=:{ss_tokenBuffer=Buffer2 x y,ss_input}
	# ss_tokenBuffer = Buffer2 l_token y
	= {scanState & ss_tokenBuffer = ss_tokenBuffer, ss_input = PushedToken x ss_input}
insertBeforeStoredToken l_token scanState=:{ss_tokenBuffer=Buffer3 x y z,ss_input}
	# ss_tokenBuffer = Buffer3 l_token y z
	= {scanState & ss_tokenBuffer = ss_tokenBuffer, ss_input = PushedToken x ss_input}

422
notContextDependent :: !Token -> Bool
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
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
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
446
447

SkipWhites :: !Input -> (!Optional String, !Char, !Input)
Pieter Koopman's avatar
Pieter Koopman committed
448
449
450
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
451
452
SkipWhites input
	# (eof, c, input)		= ReadChar input
453
	| eof					= (No, NewLineChar, input)
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
454
455
456
	| IsWhiteSpace c		= SkipWhites input
							= TryScanComment c input

Pieter Koopman's avatar
Pieter Koopman committed
457
458
459
460
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
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
486
487
TryScanComment :: !Char !Input -> (!Optional String, !Char, !Input)
TryScanComment c1=:'/' input
Pieter Koopman's avatar
Pieter Koopman committed
488
	# (eof,c2, input)		= ReadNormalChar input
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
489
490
491
492
493
494
495
496
497
498
499
	| 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
500
501
502
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
503
504
505
ScanComment input
	# (eof1, c1, input)	= ReadChar input
	| eof1				= (Yes "end of file encountered inside comment", input)
Pieter Koopman's avatar
Pieter Koopman committed
506
507
508
509
		= ScanComment2 c1 input;

ScanComment2	:: !Char !Input -> (!Optional String, !Input)
ScanComment2 c1 input
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
510
511
512
513
514
515
516
	| 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
517
											error -> error
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
518
519
								_	->	ScanComment input
	| c1 == '*'
Pieter Koopman's avatar
Pieter Koopman committed
520
521
522
523
524
525
		# (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
526
		| c2 == '/'			= (No, input)
Pieter Koopman's avatar
Pieter Koopman committed
527
528
529
		| c2 == '*'
//					= ScanComment (charBack input)
					= ScanComment2 c2 input
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
530
531
532
							= ScanComment input
	| otherwise				= ScanComment input

Pieter Koopman's avatar
Pieter Koopman committed
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
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
560
SkipToEndOfLine	:: !Input -> Input
Pieter Koopman's avatar
Pieter Koopman committed
561
562
563
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
564
565
566
567
568
SkipToEndOfLine input
	# (eof, c, input)	= ReadChar input
	| eof				= input
	| c==NewLineChar	= input
			= SkipToEndOfLine input
Pieter Koopman's avatar
Pieter Koopman committed
569

Pieter Koopman's avatar
Pieter Koopman committed
570
Scan :: !Char !Input !ScanContext -> (!Token, !Input)
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
571
572
573
Scan '(' input co			= (OpenToken, input)
Scan ')' input co			= (CloseToken, input)
Scan '{' input CodeContext	= ScanCodeBlock input
574
575
576
577
578
579
//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
580
581
582
583
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
584
	# (eof, c1, input)		= ReadNormalChar input
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
585
	| eof					= (BarToken, input)
586
	| c1 == '}'				= (GenericCloseToken, input) // AA
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
587
588
589
590
591
592
593
594
595
	| 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
596
	# (eof,c1, input)		= ReadNormalChar input
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
597
598
599
600
601
602
603
	| eof
		= (SeqLetToken False, input)
	| isSpecialChar c1
		= ScanOperator 1 input [c1, c0] co
	// otherwise
		= (SeqLetToken strict, charBack input)
Scan '*' input TypeContext	= (AsteriskToken, input)
604
605
Scan c0=:'&' input co		= possibleKeyToken AndToken [c0] co input
/*	# (eof, c1, input)		= ReadNormalChar input
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
606
607
	| eof					= (AndToken, input)
	| isSpecialChar c1		= ScanOperator 1 input [c1, c0] co
608
							= (AndToken, charBack input) */
609
Scan c0=:'.' input co	// PK incorrect ?
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
610
611
612
	= case co of
		TypeContext
						-> (DotToken, input)
Pieter Koopman's avatar
Pieter Koopman committed
613
		_	# (eof, c1, input) = ReadNormalChar input
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
614
			| eof		-> (DotToken, input)
Pieter Koopman's avatar
Pieter Koopman committed
615
			| c1 == '.'
Pieter Koopman's avatar
Pieter Koopman committed
616
				# (eof, c2, input) = ReadNormalChar input
Pieter Koopman's avatar
Pieter Koopman committed
617
618
				| eof		-> (DotDotToken, input)
				| isSpecialChar c2
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
619
620
						-> ScanOperator 2 input [c2, c1, c0] co
						-> (DotDotToken, charBack input)
Pieter Koopman's avatar
Pieter Koopman committed
621
622
623
			| isSpecialChar c1
						-> ScanOperator 1 input [c1, c0] co
						-> (DotToken, charBack input)
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
624
Scan '!' input TypeContext	= (ExclamationToken, input)
625
Scan c0=:'\\' input co
Pieter Koopman's avatar
Pieter Koopman committed
626
	# (eof, c, input)		= ReadNormalChar input
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
627
	| eof					= (BackSlashToken, input)
628
629
	| c == '\\'				= possibleKeyToken DoubleBackSlashToken [c, c0] co input
	| isSpecialChar c		= ScanOperator 1 input [c, c0] co
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
630
							= (BackSlashToken, charBack input)
631
Scan c0=:'_' input=:{inp_stream=OldLine i line stream,inp_pos} co
632
633
634
635
636
637
638
639
	# 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
640
	| end_i<size && IsIdentChar line.[end_i]
641
642
643
644
645
646
647
		= 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
648
649
650
651
652
	| 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
653
Scan c0=:'<' input TypeContext
Pieter Koopman's avatar
Pieter Koopman committed
654
	# (eof, c1, input)		= ReadNormalChar input
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
655
656
657
658
	| 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
659
	# (eof, c1, input)		= ReadNormalChar input
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
660
	| eof 					= (IdentToken "<", input)
661
	| c1 <> '-'
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
		| c1=='|'
			# (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)
		| c1=='!'
			# (eof, c2, input)	= ReadNormalChar input
			| eof
				= (IdentToken "<!",input)
			| c2=='-'
				# (eof, c3, input)	= ReadNormalChar input
				| eof				= (LeftArrowWithExclamationToken, input)
				| isSpecialChar c3	= ScanOperator 3 input [c3, c2, c1, c0] co
									= (LeftArrowWithExclamationToken, charBack input)
			| isSpecialChar c2
				= ScanOperator 2 input [c2, c1, c0] co
				= (IdentToken "<!", charBack input)
686
687
688
689
690
691
692
693
694
695
696
697
		| c1=='^'
			# (eof, c2, input)	= ReadNormalChar input
			| eof
				= (IdentToken "<^",input)
			| c2=='-'
				# (eof, c3, input)	= ReadNormalChar input
				| eof				= (LeftArrowWithCaretToken, input)
				| isSpecialChar c3	= ScanOperator 3 input [c3, c2, c1, c0] co
									= (LeftArrowWithCaretToken, charBack input)
			| isSpecialChar c2
				= ScanOperator 2 input [c2, c1, c0] co
				= (IdentToken "<^", charBack input)
698
			= ScanOperator 0 (charBack input) [c0] co
Pieter Koopman's avatar
Pieter Koopman committed
699
	# (eof, c2, input)		= ReadNormalChar input
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
700
701
	| eof					= (LeftArrowToken, input)
	| c2 == ':'	
Pieter Koopman's avatar
Pieter Koopman committed
702
		# (eof, c3, input)		= ReadNormalChar input
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
703
704
705
706
707
708
		| 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
709
710
711
	# (previous_char,input) = GetPreviousChar input;

	# (eof, c1, input)		= ReadNormalChar input
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
712
	| eof					= (IdentToken "-", input)
Pieter Koopman's avatar
Pieter Koopman committed
713
714
715
	| IsDigit c1 && new_exp_char previous_char
		= ScanNumeral 1 input [c1,c0]

Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
716
	| c1 <> '>'				= ScanOperator 0 (charBack input) [c0] co
717
	| co == TypeContext		= (ArrowToken, input)
Pieter Koopman's avatar
Pieter Koopman committed
718
	# (eof, c2, input)		= ReadNormalChar input		
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
719
720
721
722
	| 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
723
724
725
	# (previous_char,input) = GetPreviousChar input;

	# (eof, c1, input)		= ReadNormalChar input
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
726
	| eof					= (IdentToken "+", input)
Pieter Koopman's avatar
Pieter Koopman committed
727
728
	| IsDigit c1 && new_exp_char previous_char
		= ScanNumeral 1 input [c1,c0]
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
729
730
							= ScanOperator 0 (charBack input) [c0] co
Scan c0=:'=' input co
Pieter Koopman's avatar
Pieter Koopman committed
731
	# (eof, c, input)		= ReadNormalChar input
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
732
	| eof					= (EqualToken, input)
733
734
	| c == ':'				= possibleKeyToken DefinesColonToken [c, c0] co input
	| c == '>'				= possibleKeyToken DoubleArrowToken [c, c0] co input
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
735
736
737
	| isSpecialChar c		= ScanOperator 1 input [c, c0] co
							= (EqualToken, charBack input)
Scan c0=:':' input co
Pieter Koopman's avatar
Pieter Koopman committed
738
	# (eof,c1, input)		= ReadNormalChar input
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
739
	| eof					= (ColonToken, input)
Pieter Koopman's avatar
Pieter Koopman committed
740
741
742
	| c1 == ':'
		# (eof, c2, input)	= ReadNormalChar input
		| eof				= (DoubleColonToken, input)
743
		| isSpecialChar c2	&& ~(c2=='!' || c2=='*' || c2=='.') // for type rules and the like
Pieter Koopman's avatar
Pieter Koopman committed
744
745
746
747
748
749
							= 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
750
							= ScanOperator 1 (charBack input) [c1, c0] co
Pieter Koopman's avatar
Pieter Koopman committed
751
752
753
	// c1 <> '='
	| isSpecialChar c1		= ScanOperator 1 input [c1, c0] co
							= (ColonToken, charBack input)
754
Scan '\'' input co			= ScanChar input
755
Scan c0=:'\"' input co		= ScanString 0 [c0] input
756
757
Scan '?' input co
	= ScanQuestionMark input co
758
759
760
Scan 'E' input TypeContext
	# (eof,c1,input)		= ReadNormalChar input
	| eof					= (IdentToken "E", input)
761
762
763
764
765
766
	| c1 == '.'
		# (eof,c2,input)	= ReadNormalChar input
		| eof				= (ExistsToken, input)
		| c2=='^'			= (ExistsExternalToken, input)
							= (ExistsToken, charBack input)
		= ScanIdentFast 1 (charBack input) TypeContext
767
768
769
770
771
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
772
773
Scan c    input co
	| IsDigit c				= ScanNumeral 0 input [c]
774
	| IsIdentChar c			= ScanIdentFast 1 input co
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
775
776
	| isSpecialChar c		= ScanOperator 0 input [c] co
							= (ErrorToken ScanErrIllegal, input)
777

778
779
780
781
782
ScanQuestionMark :: !Input !ScanContext -> (!Token, !Input)
ScanQuestionMark input=:{inp_stream=OldLine i line stream,inp_pos,inp_filename,inp_tabsize} co=:FunctionContext
	| i+3>size line
		= ScanOperator 0 input ['?'] co
	| line.[i]=='J' && line.[i+1]=='u' && line.[i+2]=='s' && line.[i+3]=='t'
783
		&& (i+4==size line || not (IsIdentChar line.[i+4]))
784
785
786
787
788
		# inp_pos & fp_col = inp_pos.fp_col + 4
		  input = {inp_stream = OldLine (i+4) line stream, inp_pos = inp_pos,
				   inp_filename = inp_filename, inp_tabsize = inp_tabsize}
		= (MaybeIdentToken StrictJustToken, input)
	| line.[i]=='N' && line.[i+1]=='o' && line.[i+2]=='n' && line.[i+3]=='e'
789
		&& (i+4==size line || not (IsIdentChar line.[i+4]))
790
791
792
793
794
795
796
797
		# inp_pos & fp_col = inp_pos.fp_col + 4
		  input = {inp_stream = OldLine (i+4) line stream, inp_pos = inp_pos,
				   inp_filename = inp_filename, inp_tabsize = inp_tabsize}
		= (MaybeIdentToken StrictNoneToken, input)
	| i+4>size line
		= ScanOperator 0 input ['?'] co
	| line.[i]=='#'
		| line.[i+1]=='J' && line.[i+2]=='u' && line.[i+3]=='s' && line.[i+4]=='t'
798
			&& (i+5==size line || not (IsIdentChar line.[i+5]))
799
800
801
802
803
			# inp_pos & fp_col = inp_pos.fp_col + 5
			  input = {inp_stream = OldLine (i+5) line stream, inp_pos = inp_pos,
					   inp_filename = inp_filename, inp_tabsize = inp_tabsize}
			= (MaybeIdentToken UnboxedJustToken, input)
		| line.[i+1]=='N' && line.[i+2]=='o' && line.[i+3]=='n' && line.[i+4]=='e'
804
			&& (i+5==size line || not (IsIdentChar line.[i+5]))
805
806
807
808
809
810
811
			# inp_pos & fp_col = inp_pos.fp_col + 5
			  input = {inp_stream = OldLine (i+5) line stream, inp_pos = inp_pos,
					   inp_filename = inp_filename, inp_tabsize = inp_tabsize}
			= (MaybeIdentToken UnboxedNoneToken, input)
			= ScanOperator 0 input ['?'] co
	| line.[i]=='|'
		| line.[i+1]=='J' && line.[i+2]=='u' && line.[i+3]=='s' && line.[i+4]=='t'
812
			&& (i+5==size line || not (IsIdentChar line.[i+5]))
813
814
815
816
817
			# inp_pos & fp_col = inp_pos.fp_col + 5
			  input = {inp_stream = OldLine (i+5) line stream, inp_pos = inp_pos,
					   inp_filename = inp_filename, inp_tabsize = inp_tabsize}
			= (MaybeIdentToken OverloadedJustToken, input)
		| line.[i+1]=='N' && line.[i+2]=='o' && line.[i+3]=='n' && line.[i+4]=='e'
818
			&& (i+5==size line || not (IsIdentChar line.[i+5]))
819
820
821
822
823
824
825
			# inp_pos & fp_col = inp_pos.fp_col + 5
			  input = {inp_stream = OldLine (i+5) line stream, inp_pos = inp_pos,
					   inp_filename = inp_filename, inp_tabsize = inp_tabsize}
			= (MaybeIdentToken OverloadedNoneToken, input)
			= ScanOperator 0 input ['?'] co
	| line.[i]=='^'
		| line.[i+1]=='J' && line.[i+2]=='u' && line.[i+3]=='s' && line.[i+4]=='t'
826
			&& (i+5==size line || not (IsIdentChar line.[i+5]))
827
828
829
830
831
			# inp_pos & fp_col = inp_pos.fp_col + 5
			  input = {inp_stream = OldLine (i+5) line stream, inp_pos = inp_pos,
					   inp_filename = inp_filename, inp_tabsize = inp_tabsize}
			= (MaybeIdentToken LazyJustToken, input)
		| line.[i+1]=='N' && line.[i+2]=='o' && line.[i+3]=='n' && line.[i+4]=='e'
832
			&& (i+5==size line || not (IsIdentChar line.[i+5]))
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
			# inp_pos & fp_col = inp_pos.fp_col + 5
			  input = {inp_stream = OldLine (i+5) line stream, inp_pos = inp_pos,
					   inp_filename = inp_filename, inp_tabsize = inp_tabsize}
			= (MaybeIdentToken LazyNoneToken, input)
			= ScanOperator 0 input ['?'] co
		= ScanOperator 0 input ['?'] co
ScanQuestionMark input=:{inp_stream=OldLine i line stream,inp_pos,inp_filename,inp_tabsize} co=:TypeContext
	| i==size line || not (isSpecialChar line.[i])
		= (MaybeIdentToken StrictMaybeToken, input)
	| line.[i]=='#' && (i+1==size line || not (isSpecialChar line.[i+1]))
		# inp_pos & fp_col = inp_pos.fp_col + 1
		  input = {inp_stream = OldLine (i+1) line stream, inp_pos = inp_pos,
				   inp_filename = inp_filename, inp_tabsize = inp_tabsize}
		= (MaybeIdentToken UnboxedMaybeToken, input)
	| line.[i]=='^' && (i+1==size line || not (isSpecialChar line.[i+1]))
		# inp_pos & fp_col = inp_pos.fp_col + 1
		  input = {inp_stream = OldLine (i+1) line stream, inp_pos = inp_pos,
				   inp_filename = inp_filename, inp_tabsize = inp_tabsize}
		= (MaybeIdentToken LazyMaybeToken, input)
		= ScanOperator 0 input ['?'] co
ScanQuestionMark input co
	= ScanOperator 0 input ['?'] co

Pieter Koopman's avatar
Pieter Koopman committed
856
possibleKeyToken :: !Token ![Char] !ScanContext !Input -> (!Token, !Input)
857
858
859
possibleKeyToken token reversedPrefix context input
	# (eof, c, input)		= ReadNormalChar input
	| eof					= (token, input)
860
	| isSpecialChar c		= ScanOperator (length reversedPrefix) input [c : reversedPrefix] context
861
862
							= (token, charBack input)

Pieter Koopman's avatar
Pieter Koopman committed
863
864
865
new_exp_char ',' = True
new_exp_char '[' = True
new_exp_char '(' = True
866
new_exp_char '{' = True
Pieter Koopman's avatar
Pieter Koopman committed
867
868
869
new_exp_char '/' = True // to handle end of comment symbol: */
new_exp_char c	 = isSpace c

Pieter Koopman's avatar
Pieter Koopman committed
870
ScanIdentFast :: !Int !Input !ScanContext -> (!Token, !Input)
John van Groningen's avatar
John van Groningen committed
871
872
873
874
875
876
877
878
879
880
881
882
883
ScanIdentFast n input=:{inp_stream=OldLine i line stream,inp_pos} ModuleNameContext
	# end_i = ScanModuleNameCharsInString i line
		with
			ScanModuleNameCharsInString :: !Int !{#Char} -> Int
			ScanModuleNameCharsInString i line
				| i<size line
					| IsModuleNameChar line.[i]
						= ScanModuleNameCharsInString (i+1) line
						= i
					= i
	# pos = {inp_pos & fp_col = inp_pos.fp_col + (end_i-i)}
	# input =  {input & inp_stream=OldLine end_i line stream,inp_pos=pos}
	= (IdentToken (line % (i-n,end_i-1)), input)
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
ScanIdentFast n input=:{inp_stream=OldLine i line stream,inp_pos} co=:TypeContext
	# end_i = ScanTypeIdentCharsInString i line
		with
			ScanTypeIdentCharsInString :: !Int !{#Char} -> Int
			ScanTypeIdentCharsInString i line
				| i<size line
					| IsIdentChar line.[i]
						= ScanTypeIdentCharsInString (i+1) line
					| line.[i]=='^'
						= i+1
						= i
					= i
	# 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
Pieter Koopman's avatar
Pieter Koopman committed
899
ScanIdentFast n input=:{inp_stream=OldLine i line stream,inp_pos} co
900
	# end_i = ScanIdentCharsInString i line
Pieter Koopman's avatar
Pieter Koopman committed
901
		with
902
903
			ScanIdentCharsInString :: !Int !{#Char} -> Int
			ScanIdentCharsInString i line
904
				| i<size line
905
906
					| IsIdentChar line.[i]
						= ScanIdentCharsInString (i+1) line
907
						= i
John van Groningen's avatar
John van Groningen committed
908
909
910
911
					= i
	# 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
912

Pieter Koopman's avatar
Pieter Koopman committed
913
ScanOperator :: !Int !Input ![Char] !ScanContext -> (!Token, !Input)
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
914
ScanOperator n input token co
Pieter Koopman's avatar
Pieter Koopman committed
915
	#  (eof, c, input)		= ReadNormalChar input
916
	| eof					= CheckReservedOperator (revCharListToString n token) input
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
917
	| isSpecialChar c		= ScanOperator (n + 1) input [c:token] co
918
919
920
921
922
923
924
925
							= 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
John van Groningen's avatar
John van Groningen committed
926
// not called with ModuleNameContext
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
927

928
929
930
931
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
932

933
CheckGeneralContext :: !String !Input -> (!Token, !Input)
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
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)
951
	"generic" 	->	(GenericToken		, input)
952
	"derive"	-> 	(DeriveToken		, input)
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
953
954
955
956
957
958
959
960
961
962
963
964
965
	"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
966
	"import" -> (ImportToken,input)
John van Groningen's avatar
John van Groningen committed
967
	"foreign" -> (ForeignToken,input)
Pieter Koopman's avatar
Pieter Koopman committed
968
   	s			->	(IdentToken s		, input)
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
969
970
971
972
973
974
975
976
977
978
979
980
981
982

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)
983
	"of"		->  (OfToken			, input) // AA
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
	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)
	"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	

1009
1010
1011
CheckGenericContext :: !String !Input -> (!Token, !Input)
CheckGenericContext s input
 = case s of
1012
1013
	"of"		->	(GenericOfToken,	input)
	"with"		->	(GenericWithToken,	input)
1014
1015
	s			->	CheckEveryContext s input	

Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
1016
1017
1018
1019
1020
GetPrio :: !Input -> (!Optional String, !Int, !Input)
GetPrio input
	# (error, c, input) = SkipWhites input
	| IsDigit c
		= (error, digitToInt c, input)
1021
	| c<>NewLineChar // not eof ?
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
1022
		= (error, defaultPrio , charBack input)
1023
		= (error, defaultPrio , input)
1024
where defaultPrio = 9
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
1025
1026
1027

determineStrictness :: !Input -> (!Bool, !Input)
determineStrictness input
Pieter Koopman's avatar
Pieter Koopman committed
1028
	# (eof, c, input)		= ReadNormalChar input
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
1029
1030
1031
1032
1033
1034
	| eof					= (False, input)
	| c == '!'				= (True, input)
							= (False, charBack input)

ScanCodeBlock :: !Input -> (!Token, !Input)
ScanCodeBlock input
1035
	= scan_begin_code_block input
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
1036
where
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
1085
1086
1087
1088
1089
1090
1091
	scan_begin_code_block :: !Input -> (!Token,!Input)
	scan_begin_code_block input
		# (eof, c, input) = ReadChar input
		| c == '}'
			= (CodeBlockToken [], input)
		| isNewLine c
			| eof
				= (ErrorToken "eof in code block", input)
				= scan_begin_code_block input
		| IsWhiteSpace c
			= scan_begin_code_block input
		# (line, input) = ReadLine input
		# line = toString c+++stripNewline line;
		| line.[size line-1]=='}'
			#! line = line % (0,skip_white_space_left (size line-2) line);
			# lines = split_line_at_semicolon 0 line
			= (CodeBlockToken lines, input)
			= scan_code_block [line] input

	skip_white_space_left :: !Int !{#Char} -> Int
	skip_white_space_left i s
		| i>=0 && (s.[i]==' ' || s.[i]=='\t')
			= skip_white_space_left (i-1) s
			= i

	split_line_at_semicolon i line
		# sc_i = skip_to_semicolon i line
		| sc_i<0
			| i==0
				= [line]
				= [line % (i,size line-1)]
		#! s = line % (i,skip_white_space_left (sc_i-1) i line)
		# i = skip_white_space_right (sc_i+1) line
		# sl = split_line_at_semicolon i line
		= [s:sl];
	where
		skip_to_semicolon i line
			| i<size line
				| line.[i]<>';'
					= skip_to_semicolon (i+1) line;
					= i;
				= -1;

		skip_white_space_left :: !Int !Int !{#Char} -> Int
		skip_white_space_left i b_i s
			| i>=b_i && (s.[i]==' ' || s.[i]=='\t')
				= skip_white_space_left (i-1) b_i s
				= i

		skip_white_space_right :: !Int !{#Char} -> Int
		skip_white_space_right i s
			| i<size line && (s.[i]==' ' || s.[i]=='\t')
				= skip_white_space_right (i+1) s
				= i

Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
<