bug fix parse_bug_forbidden_symbols

idents that start with an underscore are only allowed in modules for which
the module name starts with an underscore
Because of this bug fix StdEnv has to be updated (_createArray in the Array class)


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

4 files changed, 46 insertions, 11 deletions

diff --git a/frontend/parse.icl b/frontend/parse.icl
index 0c40360..6204ffc 100644
--- a/frontend/parse.icl
+++ b/frontend/parse.icl
@@ -217,13 +217,13 @@ where
 		  (y, pState) = want pState
 		= ((x,y), pState)
 */
-wantIdents :: !Context !IdentClass !ParseState -> (![Ident], !ParseState)
-wantIdents context ident_class pState
-	# (first_name, pState) = want pState
+wantModuleIdents :: !Context !IdentClass !ParseState -> (![Ident], !ParseState)
+wantModuleIdents context ident_class pState
+	# (first_name, pState) = wantModuleName pState
 	  (first_ident, pState) = stringToIdent first_name ident_class pState
 	  (token, pState) = nextToken context pState
 	| token == CommaToken
-		# (rest, pState) = wantIdents context ident_class pState
+		# (rest, pState) = wantModuleIdents context ident_class pState
 		= ([first_ident : rest], pState)
 	= ([first_ident], tokenBack pState)
 
@@ -390,6 +390,8 @@ where
 
 	try_module_name (IdentToken name) mod_type scanState
 		= (True, mod_type, name, scanState) //-->> ("module",name)
+	try_module_name (UnderscoreIdentToken name) mod_type scanState
+		= (True, mod_type, name, setUseUnderscoreIdents True scanState) //-->> ("module",name)
 	try_module_name token mod_type scanState
 		= (False, mod_type, "", tokenBack scanState)
 	
@@ -900,14 +902,14 @@ wantLocals pState
 
 wantImports :: !ParseState -> (![ParsedImport], !ParseState)
 wantImports pState
-	# (names, pState) = wantIdents FunctionContext IC_Module pState
+	# (names, pState) = wantModuleIdents FunctionContext IC_Module pState
 	  (file_name, line_nr, pState)	= getFileAndLineNr pState
 	  pState = wantEndOfDefinition "imports" pState
 	= (map (\name -> { import_module = name, import_symbols = [], import_file_position = LinePos file_name line_nr}) names, pState)
 
 wantFromImports :: !ParseState -> (!ParsedImport, !ParseState)
 wantFromImports pState
-	# (mod_name, pState) = want pState
+	# (mod_name, pState) = wantModuleName pState
 	  (mod_ident, pState) = stringToIdent mod_name IC_Module pState
 	  pState = wantToken GeneralContext "from imports" ImportToken pState
 	  (file_name, line_nr, pState)	= getFileAndLineNr pState
@@ -3251,6 +3253,14 @@ where
 			IdentToken name -> (name, pState)
 			_				-> ("", parseError "String" (Yes token) "identifier" pState)
 
+wantModuleName :: !*ParseState -> (!{# Char}, !*ParseState)
+wantModuleName pState
+	# (token, pState) = nextToken GeneralContext pState
+	= case token of
+		IdentToken name -> (name, pState)
+		UnderscoreIdentToken name -> (name, pState)
+		_				-> ("", parseError "String" (Yes token) "module name" pState)
+
 tryTypeVar :: !ParseState -> (!Bool, TypeVar, !ParseState)
 tryTypeVar pState
 	# (token, pState) = nextToken TypeContext pState
diff --git a/frontend/predef.icl b/frontend/predef.icl
index 4667975..02b08f7 100644
--- a/frontend/predef.icl
+++ b/frontend/predef.icl
@@ -179,7 +179,7 @@ where
 
 	fill_table_with_hashing tables
 		# (predefs, hash_table) = tables	
-					<<- ("StdArray", IC_Module, PD_StdArray) <<- ("StdEnum", IC_Module, PD_StdEnum) <<- ("StdBool", IC_Module, PD_StdBool)
+					<<- ("_SystemArray", IC_Module, PD_StdArray) <<- ("StdEnum", IC_Module, PD_StdEnum) <<- ("StdBool", IC_Module, PD_StdBool)
 					<<- ("&&", IC_Expression, PD_AndOp) <<- ("||", IC_Expression, PD_OrOp)
 					<<- ("Array", IC_Class, PD_ArrayClass)
 					<<- ("createArray", IC_Expression, PD_CreateArrayFun)
diff --git a/frontend/scanner.dcl b/frontend/scanner.dcl
index d001d0e..6bb418c 100644
--- a/frontend/scanner.dcl
+++ b/frontend/scanner.dcl
@@ -17,6 +17,7 @@ instance <<< FilePosition
 
 ::	Token
 	= 	IdentToken !.String		//		an identifier
+	| 	UnderscoreIdentToken !.String//	an identifier that starts with a '_'
 	|	IntToken !.String		//		an integer
 	|	RealToken !.String		//		a real
 	|	StringToken !.String	//		a string
@@ -144,6 +145,8 @@ setUseLayout :: !Bool !ScanState -> ScanState
 UseLayout :: !ScanState -> (!Bool, !ScanState)
 dropOffsidePosition :: !ScanState -> ScanState
 
+setUseUnderscoreIdents :: !Bool !ScanState -> ScanState
+
 isLhsStartToken :: ! Token -> Bool
 isOffsideToken :: ! Token -> Bool
 isEndGroupToken :: ! Token -> Bool
diff --git a/frontend/scanner.icl b/frontend/scanner.icl
index 505e281..29ea072 100644
--- a/frontend/scanner.icl
+++ b/frontend/scanner.icl
@@ -1,7 +1,6 @@
 implementation module scanner
 
 import	StdEnv, compare_constructor, StdCompare, general, compilerSwitches
-import RWSDebug
 
 from utilities import revCharListToString, isSpecialChar
 
@@ -36,9 +35,17 @@ where
 
 instance nextToken ScanState
 where
-	nextToken context (ScanState scan_state)
+	nextToken context (ScanState scan_state=:{ss_scanOptions})
 		# (token,scan_state) = nextToken context scan_state
-		= (token,ScanState scan_state) 
+		= (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
 
 instance currentToken ScanState
 where
@@ -68,6 +75,7 @@ where
 	}
 
 ScanOptionUseLayoutBit :== 1
+ScanOptionUnderscoreIdentsBit :== 2
 
 ::	* ScanInput
 	=	Input			Input
@@ -104,6 +112,7 @@ ScanOptionUseLayoutBit :== 1
 
 ::	Token
 	= 	IdentToken ! .String	//		an identifier
+	| 	UnderscoreIdentToken !.String//	an identifier that starts with a '_'
 	|	IntToken !.String		//		an integer
 	|	RealToken !.String		//		a real
 	|	StringToken !.String	//		a string
@@ -609,7 +618,13 @@ Scan c0=:'_' input=:{inp_stream=OldLine i line stream,inp_pos} co //PK ..
 					= scan_underscores (i+1) size line
 					= i
 	| end_i<size && IsIdentChar line.[end_i] co
-		= ScanIdentFast (end_i-i+1) {input & inp_stream=OldLine end_i line stream} co
+		= 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
 	| end_i==i
 		= (WildCardToken, input)
 		# pos = {inp_pos & fp_col = inp_pos.fp_col + (end_i-i)}
@@ -1280,6 +1295,7 @@ where
 instance toString Token
 where
 	toString (IdentToken id)		= id // qw id
+	toString (UnderscoreIdentToken id)		= id // qw id
 	toString (IntToken id)			= id
 	toString (RealToken id)			= id
 	toString (StringToken id)		= id
@@ -1528,6 +1544,12 @@ setUseLayout b (ScanState ss) = ScanState  (setUseLayout_ b ss)
 setUseLayout_ :: !Bool !RScanState -> RScanState
 setUseLayout_ b ss=:{ss_scanOptions} = { ss & ss_scanOptions = if b (ss_scanOptions bitor ScanOptionUseLayoutBit) (ss_scanOptions bitand (bitnot ScanOptionUseLayoutBit)) } // -->> ("uselayout set to ",b)
 
+setUseUnderscoreIdents :: !Bool !ScanState -> ScanState
+setUseUnderscoreIdents b (ScanState ss) = ScanState  (setUseUnderscoreIdents_ b ss)
+
+setUseUnderscoreIdents_ :: !Bool !RScanState -> RScanState
+setUseUnderscoreIdents_ b ss=:{ss_scanOptions} = { ss & ss_scanOptions = if b (ss_scanOptions bitor ScanOptionUnderscoreIdentsBit) (ss_scanOptions bitand (bitnot ScanOptionUnderscoreIdentsBit)) } // -->> ("uselayout set to ",b)
+
 checkOffside :: !FilePosition !Int !Token !RScanState -> (Token,RScanState)
 checkOffside pos index token scanState=:{ss_offsides,ss_scanOptions,ss_input}
 	| (ss_scanOptions bitand ScanOptionUseLayoutBit) == 0