add hierarchical modules

git-svn-id: https://svn.cs.ru.nl/repos/clean-compiler/trunk@2177 1f8540f1-abd5-4d5b-9d24-4c5ce8603e2d

4 files changed, 149 insertions, 94 deletions

diff --git a/backendC/CleanCompilerSources/windows_io.c b/backendC/CleanCompilerSources/windows_io.c
index 932dca7..11e1099 100644
--- a/backendC/CleanCompilerSources/windows_io.c
+++ b/backendC/CleanCompilerSources/windows_io.c
@@ -136,6 +136,66 @@ static Bool find_filepath_and_time (char *fname,FileKind kind,char *path,FileTim
 }
 #endif
 
+
+static void append_file_name_and_ext (char *path_p,char *fname_p,char *ext,int in_clean_system_files_folder)
+{
+	int i;
+	char c;
+	
+	if (in_clean_system_files_folder){
+		int last_dot_i;
+
+		last_dot_i = -1;
+
+		i=0;
+		while (c=fname_p[i], c!='\0'){
+			if (c=='.')
+				last_dot_i=i;
+			++i;
+		}
+
+		if (last_dot_i>=0){
+			i=0;
+			while (i<last_dot_i){
+				path_p[i]=fname_p[i];
+				++i;
+			}
+			path_p[i]='\\';
+			
+			path_p+=last_dot_i+1;
+			fname_p+=last_dot_i+1;
+		}
+		
+
+		strcpy (path_p,"Clean System Files\\");
+		path_p += 19;
+
+		i=0;
+		while (c=fname_p[i], c!='\0'){
+			path_p[i] = c;
+			++i;
+		}
+		path_p+=i;
+	} else {
+		int i;
+		char c;
+
+		i=0;
+		while (c=fname_p[i], c!='\0'){
+			path_p[i] = c=='.' ? '\\' : c;
+			++i;
+		}
+		path_p+=i;
+	}
+
+	i=0;
+	do {
+		c=ext[i];
+		path_p[i]=c;
+		++i;
+	} while (c!='\0');
+}
+
 static Bool findfilepath (char *fname,FileKind kind,char *path)
 {
     char *s,*path_elem,c,*pathlist,*ext;
@@ -178,12 +238,8 @@ static Bool findfilepath (char *fname,FileKind kind,char *path)
 					*dest_p++ = *from_p++;
 				*dest_p = '\0';
 
-				if (in_clean_system_files_folder)
-					strcat (path,"\\Clean System Files\\");
-				else
-				    strcat (path,"\\");
-			    strcat (path,fname);
-			    strcat (path,ext);
+				*dest_p++ = '\\';
+				append_file_name_and_ext (dest_p,fname,ext,in_clean_system_files_folder);
 				if (file_exists (path))
 					return True;
 		    
@@ -196,12 +252,7 @@ static Bool findfilepath (char *fname,FileKind kind,char *path)
 		}
 	}
 
-	if (in_clean_system_files_folder){
-		strcpy (path,"Clean System Files\\");
-		strcat (path,fname);
-	} else
-		strcpy (path,fname);
-	strcat (path,ext);
+	append_file_name_and_ext (path,fname,ext,in_clean_system_files_folder);
 
  	return file_exists (path);
 }
@@ -227,6 +278,23 @@ File FOpenWithFileTime (char *file_name,FileKind kind, char *mode,FileTime *file
 }
 #endif
 
+static char *skip_after_last_dot (char *s)
+{
+	int i,after_last_dot_i;
+	char c;
+
+	after_last_dot_i=0;
+
+	i=0;
+	while (c=s[i],c!='\0'){
+		++i;
+		if (c=='.')
+			after_last_dot_i=i;
+	}
+	
+	return &s[after_last_dot_i];
+}
+
 File FOpen (char *fname,FileKind kind,char *mode)
 {
 	char path[MAXPATHLEN];
@@ -275,9 +343,10 @@ File FOpen (char *fname,FileKind kind,char *mode)
 				}
 
 				strcat (after_last_slash,"\\");
-				strcat (after_last_slash,fname);
+				
+				strcat (after_last_slash,skip_after_last_dot (fname));
 			} else
-				strcpy (after_last_slash,fname);
+				strcpy (after_last_slash,skip_after_last_dot (fname));
 			strcat (after_last_slash,GetFileExtension (kind));
 			
 			return fopen (path,mode);
@@ -409,7 +478,7 @@ int CheckInterrupt (void)
 {	
 	return 0;
 }
- 
+
 void *Alloc (long unsigned count, SizeT size)
 {	
 	if (size == 1){
diff --git a/frontend/parse.icl b/frontend/parse.icl
index b013d1e..732859e 100644
--- a/frontend/parse.icl
+++ b/frontend/parse.icl
@@ -270,7 +270,7 @@ cWantDclFile :== False
 wantModule :: !Bool !Ident !Position !Bool !*HashTable !*File !SearchPaths (ModTimeFunction *Files) !*Files
 	-> (!Bool,!Bool,!ParsedModule, !*HashTable, !*File, !*Files)
 wantModule iclmodule file_id=:{id_name} import_file_position support_generics hash_table error searchPaths modtimefunction files
-	= case openScanner file_name searchPaths modtimefunction files of
+	= case openScanner id_name file_name_extension searchPaths modtimefunction files of
 		(Yes (scanState, modification_time), files)
 			# hash_table=set_hte_mark (if iclmodule 1 0) hash_table
 			# (ok,dynamic_type_used,mod,hash_table,file,files) = initModule file_name modification_time scanState hash_table error files
@@ -280,7 +280,8 @@ wantModule iclmodule file_id=:{id_name} import_file_position support_generics ha
 			-> let mod = { mod_ident = file_id,  mod_modification_time = "", mod_type = MK_None, mod_imports = [], mod_imported_objects = [],mod_foreign_exports=[],mod_defs = [] } in
 			   (False, False, mod, hash_table, error <<< "Error " <<< import_file_position <<< ": "  <<< file_name <<< " could not be imported\n", files)
 where
-	file_name = if iclmodule (id_name +++ ".icl") (id_name +++ ".dcl")
+	file_name = id_name +++ file_name_extension
+	file_name_extension = if iclmodule ".icl" ".dcl"
 
 	initModule :: String String ScanState     !*HashTable !*File  *Files
 				-> (!Bool,!Bool,!ParsedModule,!*HashTable,!*File,!*Files)
@@ -332,7 +333,7 @@ where
 	try_module_token mod_type scanState
 		# (token, scanState) = nextToken GeneralContext scanState
 		| token == ModuleToken
-			# (token, scanState) = nextToken GeneralContext scanState
+			# (token, scanState) = nextToken ModuleNameContext scanState
  			= try_module_name token mod_type scanState
 			= (False, mod_type, "", tokenBack scanState)
 
@@ -4640,7 +4641,7 @@ where
 
 wantModuleName :: !*ParseState -> (!{# Char}, !*ParseState)
 wantModuleName pState
-	# (token, pState) = nextToken GeneralContext pState
+	# (token, pState) = nextToken ModuleNameContext pState
 	= case token of
 		IdentToken name -> (name, pState)
 		UnderscoreIdentToken name -> (name, pState)
@@ -4648,10 +4649,10 @@ wantModuleName pState
 
 wantOptionalQualifiedAndModuleName :: !*ParseState -> (!ImportQualified,!{#Char},!*ParseState)
 wantOptionalQualifiedAndModuleName pState
-	# (token, pState) = nextToken GeneralContext pState
+	# (token, pState) = nextToken ModuleNameContext pState
 	= case token of
 		IdentToken name1=:"qualified"
-			# (token, pState) = nextToken GeneralContext pState
+			# (token, pState) = nextToken ModuleNameContext pState
 			-> case token of
 				IdentToken name
 					-> (Qualified, name, pState)
diff --git a/frontend/scanner.dcl b/frontend/scanner.dcl
index 1a5b8da..24e66c0 100644
--- a/frontend/scanner.dcl
+++ b/frontend/scanner.dcl
@@ -120,6 +120,7 @@ instance <<< FilePosition
 	|	FunctionContext
 	|	CodeContext
 	| 	GenericContext
+	|	ModuleNameContext
 
 ::	Assoc	= LeftAssoc | RightAssoc | NoAssoc
 
@@ -147,7 +148,7 @@ instance replaceToken ScanState
 class getPosition state :: !*state -> (!FilePosition,!*state)  // Position of current Token (or Char)
 instance getPosition ScanState
 
-openScanner :: !String !SearchPaths (ModTimeFunction *Files) !*Files -> (!Optional (ScanState, {#Char}), !*Files) // state, file time
+openScanner :: !String !String !SearchPaths (ModTimeFunction *Files) !*Files -> (!Optional (ScanState, {#Char}), !*Files) // state, file time
 closeScanner :: !ScanState !*Files -> *Files
 
 setUseLayout :: !Bool !ScanState -> ScanState
diff --git a/frontend/scanner.icl b/frontend/scanner.icl
index 48f3d17..6b1e550 100644
--- a/frontend/scanner.icl
+++ b/frontend/scanner.icl
@@ -201,13 +201,13 @@ ScanOptionNoNewOffsideForSeqLetBit:==4;
 	|	ExistsToken				//		E.
 	|	ForAllToken				//		A.
 
-
 ::	ScanContext
 	=	GeneralContext
 	|	TypeContext
 	|	FunctionContext
 	|	CodeContext
 	| 	GenericContext
+	|	ModuleNameContext
 
 instance == ScanContext
 where
@@ -766,55 +766,32 @@ new_exp_char '/' = True // to handle end of comment symbol: */
 new_exp_char c	 = isSpace c
 
 ScanIdentFast :: !Int !Input !ScanContext -> (!Token, !Input)
+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)
 ScanIdentFast n input=:{inp_stream=OldLine i line stream,inp_pos} co
-	# (end_i,qualified) = ScanIdentCharsInString i line co
+	# end_i = ScanIdentCharsInString i line co
 		with
-			ScanIdentCharsInString :: !Int !{#Char} !ScanContext -> (!Int,!Bool)
+			ScanIdentCharsInString :: !Int !{#Char} !ScanContext -> Int
 			ScanIdentCharsInString i line co
 				| 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
+					= 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
 
 ScanOperator :: !Int !Input ![Char] !ScanContext -> (!Token, !Input)
 ScanOperator n input token co
@@ -829,6 +806,7 @@ 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
+// not called with ModuleNameContext
 
 CheckReservedOperator :: !String !Input -> (!Token, !Input)
 CheckReservedOperator "!"  input =	(ExclamationToken, input)
@@ -1316,6 +1294,13 @@ IsIdentChar '`'	_					= True
 IsIdentChar '^'	TypeContext			= True
 IsIdentChar  _	_					= False
 
+IsModuleNameChar :: !Char -> Bool
+IsModuleNameChar  c	| isAlphanum c	= True
+IsModuleNameChar '_'				= True
+IsModuleNameChar '`'				= True
+IsModuleNameChar '.'				= True
+IsModuleNameChar _					= False
+
 string_to_list ::!{#Char} -> .[Char]
 string_to_list s = stolacc s (size s - 1) []
 where
@@ -1643,17 +1628,16 @@ where
 	toString LeftAssoc 	= "infixl "
 	toString RightAssoc = "infixr "
 	toString NoAssoc	= "infix "
-	
 
-openScanner :: !String !SearchPaths (ModTimeFunction *Files) !*Files -> (!Optional (ScanState, {#Char}), !*Files) // state, file time
-openScanner file_name searchPaths modtimefunction files
-	= case fopenInSearchPaths file_name searchPaths FReadData modtimefunction files of
+openScanner :: !String !String !SearchPaths (ModTimeFunction *Files) !*Files -> (!Optional (ScanState, {#Char}), !*Files) // state, file time
+openScanner file_name file_name_extension searchPaths modtimefunction files
+	= case fopenInSearchPaths file_name file_name_extension searchPaths FReadData modtimefunction files of
 		(No, files)
 			->	(No, files)
 		(Yes (file, time), files)
 			->  (Yes (ScanState {	ss_input 		= Input
 												{ inp_stream		= InFile file
-									 			, inp_filename		= file_name
+									 			, inp_filename		= file_name +++ file_name_extension
 									 			, inp_pos			= {fp_line = 1, fp_col = 0}
 												, inp_tabsize		= 4
 												}
@@ -1664,38 +1648,38 @@ openScanner file_name searchPaths modtimefunction files
 				, files
 				)
 
-fopenInSearchPaths :: !{#Char} SearchPaths !Int (ModTimeFunction *f) !*f -> (Optional (*File, {#Char}),!*f) | FileSystem f
-fopenInSearchPaths fileName searchPaths mode modtimefunction f
-	# filtered_locations
-		=	filter (\(moduleName,path) -> moduleName == fileName) searchPaths.sp_locations
-	| isEmpty filtered_locations
-		=	fopenAnywhereInSearchPaths fileName searchPaths.sp_paths mode modtimefunction f
-	# (_, path)
-		=	hd filtered_locations
-	# (opened, file, f)
-		=	fopen (path + fileName) mode f
-	| opened
-		=	getModificationTime file path modtimefunction f
-	| otherwise
-		=	(No, f)
+fopenInSearchPaths :: !{#Char} !{#Char} !SearchPaths !Int (ModTimeFunction *f) !*f -> (Optional (*File, {#Char}),!*f) | FileSystem f
+fopenInSearchPaths moduleName fileNameExtension searchPaths mode modtimefunction f
+	# fileName = replace_dots_by_directory_separators moduleName +++ fileNameExtension
+	= case [path \\ (moduleName,path)<-searchPaths.sp_locations | moduleName == fileName] of
+		[path:_]
+			# fullFileName = path +++ fileName
+			# (opened, file, f) = fopen fullFileName mode f
+			| opened
+				-> getModificationTime file fullFileName modtimefunction f
+				-> (No, f)
+		[]
+			-> fopenAnywhereInSearchPaths fileName searchPaths.sp_paths mode modtimefunction f
 	where
 		fopenAnywhereInSearchPaths :: !{#Char} ![{#Char}] !Int (ModTimeFunction *f) *f -> (Optional (*File, {#Char}),!*f) | FileSystem f
-		fopenAnywhereInSearchPaths fileName [] _ _ f
-			=	(No, f)
 		fopenAnywhereInSearchPaths fileName [path : paths] mode modtimefunction f
-			# (opened, file, f)
-				=	fopen (path + fileName) mode f
+			# fullFileName = path +++ fileName
+			# (opened, file, f) = fopen fullFileName mode f
 			| opened
-				=	getModificationTime file path modtimefunction f
-			// otherwise
+				=	getModificationTime file fullFileName modtimefunction f
 				=	fopenAnywhereInSearchPaths fileName paths mode modtimefunction f
+		fopenAnywhereInSearchPaths fileName [] _ _ f
+			=	(No, f)
 
 		getModificationTime :: *File {#Char} (ModTimeFunction *f) *f -> (Optional (*File, {#Char}),!*f) | FileSystem f
-		getModificationTime file path modtimefunction f
-			# (time, f)
-				=	modtimefunction (path + fileName) f
+		getModificationTime file fullFileName modtimefunction f
+			# (time, f) = modtimefunction fullFileName f
 			=	(Yes (file, time), f)
 
+		replace_dots_by_directory_separators :: !{#Char} -> *{#Char}
+		replace_dots_by_directory_separators file_name
+			= {if (c=='.') '\\' c \\ c<-:file_name}
+
 closeScanner :: !ScanState !*Files -> *Files
 closeScanner (ScanState scan_state) files = closeScanner_ scan_state files
 
@@ -1855,7 +1839,7 @@ where
 				, { scanState
 				  & ss_offsides = [ (os, needsNewDefinitionToken token) : ss_offsides ]
 				  }
-				) -->> (token,pos,"New offside defined at ",os_pos,[ (os, token == CaseToken) : ss_offsides ])
+				) // -->> (token,pos,"New offside defined at ",os_pos,[ (os, token == CaseToken) : ss_offsides ])
 	// otherwise // ~ (definesOffside token)
 	= (token, scanState) -->> (token,pos," not offside")