Full path for parse warnings / errors (see #3)HEADmaster

1 files changed, 95 insertions, 37 deletions

diff --git a/frontend/scanner.icl b/frontend/scanner.icl
index 2739ea8..1b77337 100644
--- a/frontend/scanner.icl
+++ b/frontend/scanner.icl
@@ -24,6 +24,12 @@ where
 		# (file_name,scan_state) = getFilename scan_state
 		= (file_name,ScanState scan_state)
 
+instance getFilepath ScanState
+where
+	getFilepath (ScanState scan_state)
+		# (file_path,scan_state) = getFilepath scan_state
+		= (file_path,ScanState scan_state)
+
 instance tokenBack ScanState
 where
 	tokenBack (ScanState scan_state) = ScanState (tokenBack scan_state)
@@ -81,6 +87,7 @@ ScanOptionNoNewOffsideForSeqLetBit:==4;
 ::	* Input =
 	{	inp_stream		::	! * InputStream
 	,	inp_filename	::	!String
+	,	inp_path		::	!String
 	,	inp_pos			::	! FilePosition
 	,	inp_tabsize		::	! Int
 	}
@@ -248,6 +255,30 @@ where
 		# (filename,ss_input) = getFilename ss_input
 		= (filename,{scanState & ss_input = ss_input })
 
+instance getFilepath ScanInput
+where
+	getFilepath (Input input)
+		# (filepath,input) = input!inp_path
+		# (filename,input) = input!inp_filename
+		= (filepath +++ replace_all_but_last '.' DirectorySeparator filename,Input input)
+	where
+		replace_all_but_last :: !Char !Char !{#Char} -> {#Char}
+		replace_all_but_last x y arr = {if (e==x && contains i x arr) y e \\ e <-: arr & i <- [1..]}
+
+		contains :: !Int !Char !{#Char} -> Bool
+		contains n c s
+		| n >= size s - 1 = False
+		| otherwise       = s.[n] == c || contains (n+1) c s
+	getFilepath (PushedToken tok input)
+		# (filepath,input) = getFilepath input
+		= (filepath,PushedToken tok input)
+
+instance getFilepath RScanState
+where
+	getFilepath scanState=:{ss_input}
+		# (filepath,ss_input) = getFilepath ss_input
+		= (filepath,{scanState & ss_input = ss_input })
+
 class getPosition state :: !*state -> (!FilePosition,!*state)  // Position of current Token (or Char)
 
 instance getPosition RScanState
@@ -299,11 +330,12 @@ where
 			)  -->> ("nextToken: pushed token", lt_token)
 		= token_back rest_inp
 		where
-			token_back input=:(Input {inp_pos,inp_stream=OldLine currentIndex string stream,inp_filename,inp_tabsize}) // one old token in wrong context.
+			token_back input=:(Input {inp_pos,inp_stream=OldLine currentIndex string stream,inp_filename,inp_path,inp_tabsize}) // one old token in wrong context.
 				|	inp_pos.fp_line == lt_position.fp_line
 				#	old_input
 					 =	{ inp_stream	= OldLine (lt_index+1) string stream
 						, inp_filename	= inp_filename
+						, inp_path		= inp_path
 						, inp_pos		= lt_position
 						, inp_tabsize	= inp_tabsize
 						} -->> ("token_back in input", lt_token)
@@ -451,40 +483,46 @@ where
 		  }
 */
 SkipWhites :: !Input -> (!Optional String, !Char, !Input)
-SkipWhites {inp_stream=OldLine i line stream,inp_pos={fp_line,fp_col},inp_tabsize,inp_filename}
+SkipWhites {inp_stream=OldLine i line stream,inp_pos={fp_line,fp_col},inp_tabsize,inp_filename,inp_path}
 	| i<size line
-		= skip_whites_in_line i fp_col fp_line line inp_tabsize stream inp_filename
+		= skip_whites_in_line i fp_col fp_line line inp_tabsize stream inp_path inp_filename
 SkipWhites input
 	# (eof, c, input)		= ReadChar input
 	| eof					= (No, NewLineChar, input)
 	| IsWhiteSpace c		= SkipWhites input
 							= TryScanComment c input
 
-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
+skip_whites_in_line :: !Int !Int !Int !{#Char} !Int !*InputStream !String !String -> *(!Optional String,!Char,!*Input);
+skip_whites_in_line i fp_col fp_line line tabsize stream inp_path 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
+			= skip_whites_in_line (i+1) (fp_col+1) fp_line line tabsize stream inp_path inp_filename
 		| c=='\t'
-			= skip_whites_in_line (i+1) (tabsize * (fp_col / tabsize + 1)) fp_line line tabsize stream inp_filename
+			= skip_whites_in_line (i+1) (tabsize * (fp_col / tabsize + 1)) fp_line line tabsize stream inp_path 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_path=inp_path,
+						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_path=inp_path,
+						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_path=inp_path,
+				inp_filename=inp_filename,
+				inp_tabsize=tabsize,
 				inp_stream = stream
 			,	inp_pos	= pos
 			}
@@ -503,9 +541,9 @@ TryScanComment c input
 	= (No, c, input)
 
 ScanComment	:: !Input -> (!Optional String, !Input)
-ScanComment {inp_stream=OldLine i line stream,inp_pos={fp_line,fp_col},inp_tabsize,inp_filename}
+ScanComment {inp_stream=OldLine i line stream,inp_pos={fp_line,fp_col},inp_tabsize,inp_filename,inp_path}
 	| i<size line
-		= scan_comment_in_line i fp_col fp_line line inp_tabsize stream inp_filename
+		= scan_comment_in_line i fp_col fp_line line inp_tabsize stream inp_path inp_filename
 ScanComment input
 	# (eof1, c1, input)	= ReadChar input
 	| eof1				= (Yes "end of file encountered inside comment", input)
@@ -536,29 +574,35 @@ ScanComment2 c1 input
 							= ScanComment input
 	| otherwise				= ScanComment input
 
-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
+scan_comment_in_line :: !Int !Int !Int !{#Char} !Int !*InputStream !String !String -> (!Optional String, !Input)
+scan_comment_in_line i fp_col fp_line line tabsize stream inp_path 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
+			= scan_comment_in_line (i+1) (tabsize * (fp_col / tabsize + 1)) fp_line line tabsize stream inp_path 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_path=inp_path,
+						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_path=inp_path,
+								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
+			= scan_comment_in_line (i+1) (fp_col+1) fp_line line tabsize stream inp_path inp_filename
 	= ScanComment {
-				inp_filename=inp_filename,inp_tabsize=tabsize,
+				inp_path=inp_path,
+				inp_filename=inp_filename,
+				inp_tabsize=tabsize,
 				inp_stream = stream
 			,	inp_pos	= {fp_line=fp_line, fp_col = fp_col}
 			}
@@ -1324,13 +1368,15 @@ EndOfInput input=:{inp_stream = InFile file}
 EndOfInput input						= (False, input)
 
 ReadNormalChar :: !*Input -> (!Bool, !Char, !Input)
-ReadNormalChar {inp_stream = OldLine i line stream,inp_pos,inp_tabsize,inp_filename}
+ReadNormalChar {inp_stream = OldLine i line stream,inp_pos,inp_tabsize,inp_filename,inp_path}
 	| i<size line
 		# c=line.[i]
 		| c==LFChar || c==CRChar || c=='\t'
 			=	(	True,	NewLineChar
 				,	{
-						inp_filename=inp_filename,inp_tabsize=inp_tabsize,
+						inp_path=inp_path,
+						inp_filename=inp_filename,
+						inp_tabsize=inp_tabsize,
 						inp_stream = OldLine i line stream,
 						inp_pos	= inp_pos
 					}
@@ -1338,13 +1384,15 @@ ReadNormalChar {inp_stream = OldLine i line stream,inp_pos,inp_tabsize,inp_filen
 			#	pos = {inp_pos & fp_col = inp_pos.fp_col + 1}
 			=	(	False, c
 				,	{
-						inp_filename=inp_filename,inp_tabsize=inp_tabsize,
+						inp_path=inp_path,
+						inp_filename=inp_filename,
+						inp_tabsize=inp_tabsize,
 						inp_stream = OldLine (i+1) line stream,
 						inp_pos	= pos
 					}
 				)
-		= ReadNormalChar {inp_filename=inp_filename,inp_tabsize=inp_tabsize,inp_pos=inp_pos,inp_stream = stream}
-ReadNormalChar {inp_stream = InFile file, inp_pos, inp_tabsize, inp_filename}
+		= ReadNormalChar {inp_filename=inp_filename,inp_path=inp_path,inp_tabsize=inp_tabsize,inp_pos=inp_pos,inp_stream = stream}
+ReadNormalChar {inp_stream = InFile file, inp_pos, inp_tabsize, inp_filename, inp_path}
 	#!	(s, file) = freadline file
 	| size s==0
 		#	c	= NewLineChar
@@ -1353,40 +1401,49 @@ ReadNormalChar {inp_stream = InFile file, inp_pos, inp_tabsize, inp_filename}
 			,	c
 			,	{
 //					input &
-					inp_tabsize=inp_tabsize,inp_filename=inp_filename,
+					inp_path=inp_path,
+					inp_filename=inp_filename,
+					inp_tabsize=inp_tabsize,
 					inp_stream = InFile file
 				,	inp_pos	= inp_pos
 				}
 			) 
 		= ReadNormalChar {
-				inp_tabsize=inp_tabsize,inp_filename=inp_filename,inp_pos=inp_pos,
+				inp_path=inp_path,
+				inp_filename=inp_filename,
+				inp_tabsize=inp_tabsize,
+				inp_pos=inp_pos,
 				inp_stream = OldLine 0 s (InFile file)
 				}
 
 ReadChar :: !*Input -> (!Bool, !Char, !Input) // Bool indicates end of file, we read always newlines in an empty file
-ReadChar {inp_stream = OldLine i line stream,inp_pos,inp_tabsize,inp_filename}
+ReadChar {inp_stream = OldLine i line stream,inp_pos,inp_tabsize,inp_filename,inp_path}
 	| i<size line
 		# c=line.[i]
 		| c==LFChar || c==CRChar || c=='\t'
 			#	pos = NextPos c inp_pos inp_tabsize
 				(c,stream)	= correctNewline_OldLine c i inp_tabsize line stream
 			=	(	False,	c
-				,	{	inp_filename = inp_filename, inp_tabsize = inp_tabsize
+				,	{	inp_path = inp_path
+					,	inp_filename = inp_filename
+					,	inp_tabsize = inp_tabsize
 					,	inp_stream = stream
 					,	inp_pos	= pos
 					}
 				)
 			#	pos = {inp_pos & fp_col = inp_pos.fp_col + 1}
 			=	(	False, c
-				,	{	inp_filename = inp_filename, inp_tabsize = inp_tabsize
+				,	{	inp_path = inp_path
+					,	inp_filename = inp_filename
+					,	inp_tabsize = inp_tabsize
 					,	inp_stream = OldLine (i+1) line stream
 					,	inp_pos	= pos
 					}
 				)
-		= ReadChar {inp_filename=inp_filename,inp_tabsize=inp_tabsize,inp_pos=inp_pos,
+		= ReadChar {inp_path=inp_path,inp_filename=inp_filename,inp_tabsize=inp_tabsize,inp_pos=inp_pos,
 								inp_stream = stream}
 //ReadChar input=:{inp_stream = InFile file, inp_pos, inp_tabsize}
-ReadChar {inp_stream = InFile file, inp_pos, inp_tabsize, inp_filename}
+ReadChar {inp_stream = InFile file, inp_pos, inp_tabsize, inp_filename, inp_path}
 	#!	(s, file) = freadline file
 	| size s==0
 		#	c	= NewLineChar
@@ -1395,13 +1452,13 @@ ReadChar {inp_stream = InFile file, inp_pos, inp_tabsize, inp_filename}
 			,	c
 			,	{
 //					input &
-					inp_tabsize=inp_tabsize,inp_filename=inp_filename,
+					inp_tabsize=inp_tabsize,inp_filename=inp_filename,inp_path=inp_path,
 					inp_stream = InFile file
 				,	inp_pos	= pos
 				}
 			) 
 		= ReadChar {
-				inp_tabsize=inp_tabsize,inp_filename=inp_filename,inp_pos=inp_pos,
+				inp_tabsize=inp_tabsize,inp_filename=inp_filename,inp_path=inp_path,inp_pos=inp_pos,
 				inp_stream = OldLine 0 s (InFile file)
 				}
 
@@ -1440,11 +1497,11 @@ correctNewline_OldLine c i tab_size line input
 			_		-> (c,OldLine (i+1) line input)
 
 charBack :: !Input -> Input
-charBack {inp_stream=OldLine i line stream,inp_pos,inp_tabsize,inp_filename}
+charBack {inp_stream=OldLine i line stream,inp_pos,inp_tabsize,inp_filename,inp_path}
 	=	{	
 			inp_stream		= OldLine (i-1) line stream,
 			inp_pos = {inp_pos & fp_col = inp_pos.fp_col - 1},
-			inp_tabsize=inp_tabsize,inp_filename=inp_filename
+			inp_tabsize=inp_tabsize,inp_filename=inp_filename,inp_path=inp_path
 		}
 
 GetPreviousChar :: !Input -> (!Char,!Input)
@@ -1631,11 +1688,12 @@ where
 	toString RightAssoc = "infixr "
 	toString NoAssoc	= "infix "
 
-openScanner :: !*File !String -> ScanState
-openScanner file file_name
+openScanner :: !*File !String !String -> ScanState
+openScanner file path file_name
 	= ScanState {	ss_input 		= Input
 										{ inp_stream		= InFile file
 										, inp_filename		= file_name
+										, inp_path			= path
 										, inp_pos			= {fp_line = 1, fp_col = 0}
 										, inp_tabsize		= 4
 										}