reduce memory allocation

frontend/checksupport.dcl

@@ -129,7 +129,7 @@ retrieveAndRemoveImportsOfModuleFromSymbolTable :: ![.Declaration] ![.Declaratio
 addLocalFunctionDefsToSymbolTable :: !Level !Index !Index !u:{#FunDef} !*SymbolTable !*ErrorAdmin -> (!u:{# FunDef}, !*SymbolTable, !*ErrorAdmin)
 addDefToSymbolTable :: !Level !Index !Ident !STE_Kind !*SymbolTable !*ErrorAdmin -> (!* SymbolTable, !*ErrorAdmin)
 addDeclaredSymbolsToSymbolTable :: .Bool .Int ![.Declaration] ![.Declaration] !*CheckState -> .CheckState;
-addLocalSymbolsToSymbolTable :: ![.Declaration] Int !*CheckState -> .CheckState;
+//addLocalSymbolsToSymbolTable :: ![.Declaration] Int !*CheckState -> .CheckState;
 addFieldToSelectorDefinition :: !Ident (Global .Int) !*CheckState -> .CheckState;
 addGlobalDefinitionsToSymbolTable :: ![.Declaration] !*CheckState -> .CheckState;
 retrieveImportsFromSymbolTable :: ![Import ImportDeclaration] ![Declaration] !*{#DclModule} !*(Heap SymbolTableEntry) -> *(![Declaration],!*{#DclModule},!*Heap SymbolTableEntry);

frontend/checksupport.icl

@@ -155,6 +155,7 @@ checkWarning id mess error=:{ea_file,ea_loc=[]}
 checkWarning id mess error=:{ea_file,ea_loc}
 	= { error & ea_file = ea_file <<< "Check Warning " <<< hd ea_loc <<< ":\"" <<< id  <<< "\" " <<< mess <<< '\n' }
 
+
 checkErrorWithIdentPos :: !IdentPos !a !*ErrorAdmin -> .ErrorAdmin | <<< a;
 checkErrorWithIdentPos ident_pos mess error=:{ea_file}
 	= { error & ea_file = ea_file <<< "Check Error " <<< ident_pos <<< ":" <<< mess <<< '\n', ea_ok = False }
@@ -202,24 +203,73 @@ retrieveAndRemoveImportsOfModuleFromSymbolTable imports locals all_decls symbol_
 	# (all_decls, symbol_table) = retrieve_declared_symbols imports all_decls symbol_table
 	= retrieve_declared_symbols locals all_decls symbol_table
 where
+	retrieve_declared_symbols :: ![Declaration] ![Declaration] !*SymbolTable -> (![Declaration], !*SymbolTable)
+	retrieve_declared_symbols [symbol=:{dcl_ident=ident=:{id_info},dcl_kind,dcl_index}:symbols] decls symbol_table
+		#! entry = sreadPtr id_info symbol_table
+		# {ste_kind,ste_def_level} = entry
+		| ste_kind == STE_Empty || ste_def_level > cModuleScope
+			= retrieve_declared_symbols symbols decls symbol_table
+			# symbol_table = symbol_table <:= (id_info, entry.ste_previous)
+			= case ste_kind of
+				STE_Field selector_id
+					| case dcl_kind of
+							STE_Field f -> f==selector_id
+							_ -> False
+						-> retrieve_declared_symbols symbols [symbol : decls ] (removeFieldFromSelectorDefinition selector_id NoIndex dcl_index symbol_table)
+						#! symbol = { symbol & dcl_kind = ste_kind }
+						-> retrieve_declared_symbols symbols [symbol : decls ] (removeFieldFromSelectorDefinition selector_id NoIndex dcl_index symbol_table)
+				STE_Imported (STE_Field selector_id) def_mod
+					| case dcl_kind of
+							STE_Imported (STE_Field f) d -> d==def_mod && f==selector_id
+							_ -> False
+						-> retrieve_declared_symbols symbols [symbol : decls ] (removeFieldFromSelectorDefinition selector_id def_mod dcl_index symbol_table)
+						#! symbol = { symbol & dcl_kind = ste_kind }
+						-> retrieve_declared_symbols symbols [symbol : decls ] (removeFieldFromSelectorDefinition selector_id def_mod dcl_index symbol_table)
+				_
+					| same_STE_Kind ste_kind dcl_kind
+						-> retrieve_declared_symbols symbols [symbol : decls ] symbol_table					
+						#! symbol = { symbol & dcl_kind = ste_kind }
+						-> retrieve_declared_symbols symbols [symbol : decls ] symbol_table
+	retrieve_declared_symbols [] decls symbol_table
+		= (decls, symbol_table)
+/*
 	retrieve_declared_symbols :: ![Declaration] ![Declaration] !*SymbolTable -> (![Declaration], !*SymbolTable)
 	retrieve_declared_symbols decls collected_decls symbol_table
 		= foldSt retrieve_declared_symbol decls (collected_decls, symbol_table)
 
 	retrieve_declared_symbol symbol=:{dcl_ident=ident=:{id_info},dcl_kind,dcl_index} (decls, symbol_table)
 		#! entry = sreadPtr id_info symbol_table
-		# {ste_kind,ste_def_level,ste_previous} = entry
+//		# {ste_kind,ste_def_level,ste_previous} = entry
+		# {ste_kind,ste_def_level} = entry
 		| ste_kind == STE_Empty || ste_def_level > cModuleScope
 			= (decls, symbol_table)
 			= case ste_kind of
 				STE_Field selector_id
-					-> ([{ symbol & dcl_kind = ste_kind } : decls ], 
-							removeFieldFromSelectorDefinition selector_id NoIndex dcl_index (symbol_table <:= (id_info, ste_previous)))
+//					-> ([{ symbol & dcl_kind = ste_kind } : decls ], 
+//							removeFieldFromSelectorDefinition selector_id NoIndex dcl_index (symbol_table <:= (id_info, ste_previous)))
+					#! symbol = { symbol & dcl_kind = ste_kind }
+					-> ([symbol : decls ], 
+							removeFieldFromSelectorDefinition selector_id NoIndex dcl_index (symbol_table <:= (id_info, entry.ste_previous)))
 				STE_Imported (STE_Field selector_id) def_mod
-					-> ([{ symbol & dcl_kind = ste_kind } : decls ], 
-							removeFieldFromSelectorDefinition selector_id def_mod dcl_index (symbol_table <:= (id_info, ste_previous)))
+//					-> ([{ symbol & dcl_kind = ste_kind } : decls ], 
+//							removeFieldFromSelectorDefinition selector_id def_mod dcl_index (symbol_table <:= (id_info, ste_previous)))
+					#! symbol = { symbol & dcl_kind = ste_kind }
+					-> ([symbol : decls ], 
+							removeFieldFromSelectorDefinition selector_id def_mod dcl_index (symbol_table <:= (id_info, entry.ste_previous)))
 				_
-					-> ([{ symbol & dcl_kind = ste_kind } : decls ], symbol_table <:= (id_info, ste_previous))
+//					-> ([{ symbol & dcl_kind = ste_kind } : decls ], symbol_table <:= (id_info, ste_previous))
+						#! symbol = { symbol & dcl_kind = ste_kind }
+						-> ([symbol : decls ], symbol_table <:= (id_info, entry.ste_previous))
+*/
+
+same_STE_Kind (STE_Imported s1 i1) (STE_Imported s2 i2) = i1==i2 && same_STE_Kind s1 s2
+same_STE_Kind STE_DclFunction STE_DclFunction = True
+same_STE_Kind STE_Type STE_Type = True
+same_STE_Kind STE_Instance STE_Instance = True
+same_STE_Kind STE_Member STE_Member = True
+same_STE_Kind STE_Class STE_Class = True
+same_STE_Kind (STE_Field f1) (STE_Field f2) = f1==f2
+same_STE_Kind _ _ = False
 
 addLocalFunctionDefsToSymbolTable :: !Level !Index !Index !u:{#FunDef} !*SymbolTable !*ErrorAdmin -> (!u:{# FunDef}, !*SymbolTable, !*ErrorAdmin)
 addLocalFunctionDefsToSymbolTable level from_index to_index fun_defs symbol_table error
@@ -249,7 +299,8 @@ where
 		= case dcl_kind of
 			STE_Imported def_kind def_mod
 				| is_dcl_mod || def_mod <> cIclModIndex
-					-> add_imports_to_symbol_table is_dcl_mod symbols (addImportedSymbol dcl_ident dcl_pos def_kind dcl_index def_mod cs)
+//					-> add_imports_to_symbol_table is_dcl_mod symbols (addImportedSymbol dcl_ident dcl_pos def_kind dcl_index def_mod cs)
+					-> add_imports_to_symbol_table is_dcl_mod symbols (addIndirectlyImportedSymbol dcl_ident dcl_pos dcl_kind def_kind dcl_index def_mod cs)
 					-> add_imports_to_symbol_table is_dcl_mod symbols cs
 			STE_FunctionOrMacro _
 				-> add_imports_to_symbol_table is_dcl_mod symbols (addImportedFunctionOrMacro dcl_ident dcl_index cs)
@@ -292,19 +343,42 @@ addImportedSymbol :: !Ident !Position !STE_Kind !.Int !.Int !*CheckState -> .Che
 addImportedSymbol ident pos def_kind def_index def_mod cs=:{cs_symbol_table}
 	# (entry, cs_symbol_table) = readPtr ident.id_info cs_symbol_table 
 	= add_imported_symbol entry ident pos def_kind def_index def_mod { cs & cs_symbol_table = cs_symbol_table }
-where	
-	add_imported_symbol entry=:{ste_kind = STE_Empty} {id_name,id_info} _ def_kind def_index def_mod cs=:{cs_symbol_table}
-		# cs = { cs & cs_symbol_table = NewEntry cs_symbol_table id_info (STE_Imported def_kind def_mod) def_index cModuleScope entry}
-		= case def_kind of
-			STE_Field selector_id
-				-> addFieldToSelectorDefinition selector_id	{ glob_module = def_mod, glob_object = def_index } cs
-			_
-				-> cs
-	add_imported_symbol	entry=:{ste_kind = STE_Imported kind mod_index, ste_index} ident=:{id_info} _ def_kind def_index def_mod cs
-		| kind == def_kind && mod_index == def_mod && ste_index == def_index
-			= cs
-	add_imported_symbol	entry ident pos def_kind def_index def_mod cs=:{cs_error}
-		= { cs & cs_error = checkErrorWithIdentPos (newPosition ident pos) " multiply imported" cs_error}
+	where
+		add_imported_symbol /*entry=:*/{ste_kind = STE_Empty} {id_name,id_info} _ def_kind def_index def_mod cs=:{cs_symbol_table}
+			// JVG: read the entry again, because it is boxed
+			# (entry, cs_symbol_table) = readPtr id_info cs_symbol_table
+			# cs = { cs & cs_symbol_table = NewEntry cs_symbol_table id_info (STE_Imported def_kind def_mod) def_index cModuleScope entry}
+			= case def_kind of
+				STE_Field selector_id
+					-> addFieldToSelectorDefinition selector_id	{ glob_module = def_mod, glob_object = def_index } cs
+				_
+					-> cs
+		add_imported_symbol	/*entry=:*/{ste_kind = STE_Imported kind mod_index, ste_index} ident=:{id_info} _ def_kind def_index def_mod cs
+			| kind == def_kind && mod_index == def_mod && ste_index == def_index
+				= cs
+		add_imported_symbol	entry ident pos def_kind def_index def_mod cs=:{cs_error}
+			= { cs & cs_error = checkErrorWithIdentPos (newPosition ident pos) " multiply imported" cs_error}
+
+// same as addImportedSymbol but does not create a new STE_Imported
+addIndirectlyImportedSymbol :: !Ident !Position !STE_Kind !STE_Kind !.Int !.Int !*CheckState -> .CheckState;
+addIndirectlyImportedSymbol ident pos dcl_kind def_kind def_index def_mod cs=:{cs_symbol_table}
+	# (entry, cs_symbol_table) = readPtr ident.id_info cs_symbol_table
+	= add_indirectly_imported_symbol entry ident pos def_kind def_index def_mod { cs & cs_symbol_table = cs_symbol_table }
+	where
+		add_indirectly_imported_symbol /*entry=:*/{ste_kind = STE_Empty} {id_name,id_info} _ def_kind def_index def_mod cs=:{cs_symbol_table}
+			// JVG: read the entry again, because it is boxed
+			# (entry, cs_symbol_table) = readPtr id_info cs_symbol_table
+			# cs = { cs & cs_symbol_table = NewEntry cs_symbol_table id_info dcl_kind def_index cModuleScope entry}
+			= case def_kind of
+				STE_Field selector_id
+					-> addFieldToSelectorDefinition selector_id	{ glob_module = def_mod, glob_object = def_index } cs
+				_
+					-> cs
+		add_indirectly_imported_symbol	/*entry=:*/{ste_kind = STE_Imported kind mod_index, ste_index} ident=:{id_info} _ def_kind def_index def_mod cs
+			| kind == def_kind && mod_index == def_mod && ste_index == def_index
+				= cs
+		add_indirectly_imported_symbol	entry ident pos def_kind def_index def_mod cs=:{cs_error}
+			= { cs & cs_error = checkErrorWithIdentPos (newPosition ident pos) " multiply imported" cs_error}
 
 addGlobalDefinitionsToSymbolTable :: ![.Declaration] !*CheckState -> .CheckState;
 addGlobalDefinitionsToSymbolTable decls cs

frontend/checktypes.icl

@@ -459,6 +459,8 @@ determineAttributeVariable attr_var=:{av_name=attr_name=:{id_info}} oti=:{oti_he
 
 ::	DemandedAttributeKind = DAK_Ignore | DAK_Unique | DAK_None
 
+// JVG: added type:
+newAttribute :: !.DemandedAttributeKind .{#Char} TypeAttribute !*OpenTypeInfo !*CheckState -> (!TypeAttribute,!.OpenTypeInfo,!.CheckState);
 newAttribute DAK_Ignore var_name _ oti cs
 	= (TA_Multi, oti, cs)
 newAttribute DAK_Unique var_name new_attr  oti cs
@@ -574,7 +576,8 @@ where
 	check_attribute var_name dem_attr _ this_attr oti cs
 		= (TA_Multi, oti, cs)
 
-
+//JVG: added type
+checkOpenAType :: Int Int DemandedAttributeKind AType *(u:OpenTypeSymbols,*OpenTypeInfo,*CheckState) -> *(!AType,!*(!u:OpenTypeSymbols,!*OpenTypeInfo,!*CheckState));
 checkOpenAType mod_index scope dem_attr type=:{at_type = TV tv, at_attribute} (ots, oti, cs)
 	# (tv, at_attribute, (oti, cs)) = checkTypeVar scope dem_attr tv at_attribute (oti, cs)
 	= ({ type & at_type = TV tv, at_attribute = at_attribute }, (ots, oti, cs))
@@ -627,6 +630,8 @@ where
 		  (arg_types, cot_state) = check_args_of_type_cons mod_index scope dem_attr arg_types td_args cot_state
 		= ([arg_type : arg_types], cot_state)
 */
+	// JVG: added type:
+	check_args_of_type_cons :: Int Int [AType] [ATypeVar] !*(!u:OpenTypeSymbols,!*OpenTypeInfo,!*CheckState) -> *(!.[AType],!*(!u:OpenTypeSymbols,!*OpenTypeInfo,!*CheckState));
 	check_args_of_type_cons mod_index scope [] _ cot_state
 		= ([], cot_state)
 	check_args_of_type_cons mod_index scope [arg_type : arg_types] [ {atv_attribute} : td_args ] cot_state

frontend/explicitimports.icl

@@ -4,7 +4,6 @@ import StdEnv
 
 import syntax, typesupport, parse, checksupport, utilities, checktypes, transform, predef, RWSDebug
 
-
 temporary_import_solution_XXX yes no :== yes
 // to switch between importing modes.
 // iff this is yes, then explicit imports happen in the old Clean 1.3 fashion.
@@ -253,6 +252,8 @@ instance == ConsequenceKind
 
 NoPosition :== -1
 
+//JVG: added type
+filter_decl :: [.Declaration] ([(Ident,AtomType)],[(Ident,StructureInfo,StructureType,Optional Int)]) Int *{#DclModule} *CheckState -> (!(!.[Declaration],!([(Ident,AtomType)],![(Ident,StructureInfo,StructureType,Optional Int)])),!.{#DclModule},!.CheckState);
 filter_decl [] unimported _ modules cs
 	= (([], unimported), modules, cs)
 filter_decl [decl:decls] unimported index modules cs
@@ -317,7 +318,7 @@ atomAppears dcl_ident dcl_index (atomicImports, structureImports) index modules
 			= atom_appears dcl_ident dcl_index atomicImports atomicImports 0 index modules cs
 	= ((result, (atomicImports, structureImports)), modules, cs)
 
-
+atom_appears :: Ident .Int [(Ident,.AtomType)] w:[y:(Ident,u1:AtomType)] !Int .Int !u:{#u3:DclModule} !*CheckState -> (!(.Bool,x:[z:(Ident,u2:AtomType)]),!v:{#DclModule},!.CheckState) , [u <= v, u1 <= u2, y <= z, w <= x, u <= u3];
 atom_appears _ _ [] atomic_imports _ _ modules cs
   	= ((False, atomic_imports), modules, cs)
 atom_appears ident dcl_index [h=:(import_ident, atomType):t] atomic_imports unimp_index index modules cs
@@ -357,6 +358,7 @@ instance == StructureType
 	(==) ST_Class		ST_Class		= True
 	(==) _ _							= False
 
+element_appears :: StructureType Ident Int [(Ident,.StructureInfo,u2:StructureType,z:Optional .Int)] u:[w:(Ident,u5:StructureInfo,u3:StructureType,y:Optional Int)] !Int Int !*{#DclModule} !*CheckState -> (!(Bool,v:[x:(Ident,u6:StructureInfo,u4:StructureType,u1:Optional Int)]),!.{#DclModule},!.CheckState), [y z <= u1, u3 <= u4, u5 <= u6, w <= x, u <= v, u2 <= u3];
 element_appears _ _ _ [] atomic_imports _ _ modules cs
 	= ((False, atomic_imports), modules, cs)
 // MW2 remove this later ..
@@ -442,6 +444,8 @@ lookup_type dcl_index index modules cs
 		#	com_type_def	= dcl_module.dcl_common.com_type_defs.[dcl_index]
 		= (com_type_def.td_rhs, modules, cs)
 
+//JVG: added type:
+element_appears_in_stomm_struct :: .StructureType Ident .Int .Int .String *{#DclModule} *CheckState -> (!Bool,!.{#DclModule},!.CheckState)
 // MW remove this later CCC
 element_appears_in_stomm_struct imported_st element_ident dcl_index index type_name_string modules cs
 	| not do_temporary_import_solution_XXX
@@ -449,8 +453,45 @@ element_appears_in_stomm_struct imported_st element_ident dcl_index index type_n
 	#	(dcl_module=:{dcl_name=dcl_name=:{id_info}}, modules)		= modules ! [index]
 		(module_entry, cs_symbol_table)				= readPtr id_info cs.cs_symbol_table
 	#!	cs	= { cs & cs_symbol_table=cs_symbol_table }
-	= continuation imported_st module_entry.ste_kind dcl_module modules cs
+//	= continuation imported_st module_entry.ste_kind dcl_module modules cs
+	= (appears imported_st module_entry.ste_kind dcl_module.dcl_common,modules,cs);
   where
+	appears ST_RecordType (STE_OpenModule _ modul) _
+		//	lookup the constructors/fields for the algebraic type/record
+		#	allTypes	= modul.mod_defs.def_types
+			search		= dropWhile (\{td_name} -> td_name.id_name<>type_name_string) allTypes
+		|	isEmpty search
+			= False
+		#	{td_rhs}	= hd search
+		|	not (isRecordType td_rhs)
+			= False
+		#	element_idents	= getElements td_rhs
+		= isMember element_ident element_idents
+	appears ST_RecordType STE_ClosedModule dcl_common
+		// lookup the type of the constructor and compare
+		#	type_index		= dcl_common.com_selector_defs.[dcl_index].sd_type_index
+			com_type_def	= dcl_common.com_type_defs.[type_index]
+			appears	= com_type_def.td_name.id_name==type_name_string
+		= appears
+	appears ST_Class (STE_OpenModule _ modul) _
+		//	lookup the members for the class
+		#	allClasses	= modul.mod_defs.def_classes
+			search		= dropWhile (\{class_name} -> class_name.id_name<>type_name_string) allClasses
+		|	isEmpty search
+			= False
+		#	{class_members}	= hd search
+			element_idents	= [ ds_ident \\ {ds_ident} <-:class_members ]
+		= isMember element_ident element_idents
+	appears ST_Class STE_ClosedModule dcl_common
+		// lookup the class and compare
+		#	com_member_def	= dcl_common.com_member_defs.[dcl_index]
+			{glob_object}	= com_member_def.me_class
+			com_class_def	= dcl_common.com_class_defs.[glob_object]
+			appears	= com_class_def.class_name.id_name==type_name_string
+		= appears
+	appears _ _ _
+		= False
+/*
 	continuation ST_RecordType (STE_OpenModule _ modul) _ modules cs
 		//	lookup the constructors/fields for the algebraic type/record
 		#	allTypes	= modul.mod_defs.def_types
@@ -486,6 +527,7 @@ element_appears_in_stomm_struct imported_st element_ident dcl_index index type_n
 		= (appears, modules, cs)
 	continuation _ _ _ modules cs
 		= (False, modules, cs)
+*/
 	getElements (RecordType {rt_fields})
 		= [ fs_name \\ {fs_name}<-:rt_fields ]
 	getElements _
@@ -555,19 +597,19 @@ element_appears_in_struct imported_st element_ident dcl_index struct_ident index
 
 check_completeness_of_module :: .Index [(.Declaration,.Int)] .String *(*{!.FunctionConsequence},*{#.DclModule},*{#FunDef},*ExpressionHeap,*CheckState) -> (.{!FunctionConsequence},.{#DclModule},.{#FunDef},.ExpressionHeap,.CheckState);
 check_completeness_of_module mod_index dcls_explicit file_name (f_consequences, modules, icl_functions, expr_heap, cs)
-	#	dcls_imp	= [((dcl_ident, kind), (dcl_index, mod_index), (file_name, line_nr))
-						\\ ({dcl_ident, dcl_index, dcl_kind=STE_Imported kind mod_index}, line_nr) <- dcls_explicit]
-		(conseqs, (f_consequences, modules, icl_functions, expr_heap))
-				= mapSt (consequences_of mod_index) dcls_imp (f_consequences, modules, icl_functions, expr_heap)
+//	#	dcls_imp	= [((dcl_ident, kind), (dcl_index, mod_index), (file_name, line_nr))
+//						\\ ({dcl_ident, dcl_index, dcl_kind=STE_Imported kind mod_index}, line_nr) <- dcls_explicit]
+	#	(conseqs, (f_consequences, modules, icl_functions, expr_heap))
+				= mapSt (consequences_of file_name mod_index) dcls_explicit (f_consequences, modules, icl_functions, expr_heap)
 		conseqs	= flatten conseqs
 	#!	(modules, cs)	= foldr checkConsequenceError (modules, cs) conseqs
 	= (f_consequences, modules, icl_functions, expr_heap, cs)
 
-consequences_of ::	!Index
-					(!IdentWithKind, !(!Index,!Index), !(!String, !Int)) !(!*{!FunctionConsequence}, !*{#DclModule}, !*{#FunDef}, !*ExpressionHeap)
+consequences_of :: String !Index
+					!(!.Declaration,Int) !(!*{!FunctionConsequence}, !*{#DclModule}, !*{#FunDef}, !*ExpressionHeap)
  				->	(![(!IdentWithKind, !IdentWithCKind, !(!String, !Int))], !(*{!FunctionConsequence}, !*{#DclModule}, !*{#FunDef}, !*ExpressionHeap))
-consequences_of count (expl_imp_ident_kind=:(_,expl_imp_kind), (dcl_index, mod_index), errMsgInfo) 
-				(f_consequences, modules, icl_functions, expr_heap)
+
+consequences_of file_name count ({dcl_ident, dcl_index, dcl_kind=STE_Imported expl_imp_kind mod_index}, line_nr) (f_consequences, modules, icl_functions, expr_heap)
 	= case expl_imp_kind of
 			STE_FunctionOrMacro _
 				# (consequences, (f_consequences, icl_functions, expr_heap)) = consequences_of_macro count dcl_index f_consequences icl_functions expr_heap
@@ -576,6 +618,9 @@ consequences_of count (expl_imp_ident_kind=:(_,expl_imp_kind), (dcl_index, mod_i
 				# (modul, modules)	= modules![mod_index]
 				-> (add_kind_and_error_info_to_consequences (consequences_of_simple_symbol expl_imp_kind modul dcl_index), (f_consequences, modules, icl_functions, expr_heap))
 	where
+		expl_imp_ident_kind=(dcl_ident,expl_imp_kind)
+		errMsgInfo = (file_name, line_nr)
+
 		add_kind_and_error_info_to_consequences consequences
 			= [(expl_imp_ident_kind, conseq, errMsgInfo) \\ conseq<-removeDup consequences]
 	

frontend/parse.icl

@@ -48,16 +48,29 @@ Conventions:
 	,	ps_hash_table		:: !*HashTable
 	,	ps_pre_def_symbols	:: !*PredefinedSymbols
 	}
-
+/*
 appScanState :: (ScanState -> ScanState) !ParseState -> ParseState
 appScanState f pState=:{ps_scanState}
 	#	ps_scanState = f ps_scanState
 	=	{	pState & ps_scanState = ps_scanState }
+*/
+appScanState f pState:==appScanState pState
+	where
+	appScanState pState=:{ps_scanState}
+		#	ps_scanState = f ps_scanState
+		=	{	pState & ps_scanState = ps_scanState }
 
+/*
 accScanState :: (ScanState -> (.t,ScanState)) !ParseState -> (.t,ParseState)
 accScanState f pState=:{ps_scanState}
 	#	( x, ps_scanState) = f ps_scanState
 	=	( x, {pState & ps_scanState = ps_scanState })
+*/
+accScanState f pState:== accScanState pState
+	where
+		accScanState pState=:{ps_scanState}
+			#	( x, ps_scanState) = f ps_scanState
+			=	( x, {pState & ps_scanState = ps_scanState })
 
 makeStringTypeSymbol pState=:{ps_pre_def_symbols}
 	#! string_id = ps_pre_def_symbols.[PD_StringType]
@@ -2362,6 +2375,7 @@ where
 					// transform one group of nested updates with the same first field
 					//  for example: f.g1 = e1, f.g2 = e2 -> f = {id.f & g1 = e1, g2 = e2},
 					//  (id is ident to shared expression that's being updated)
+
 					transform_update :: !Int [NestedUpdate] (Optional Ident,Optional Ident,ParseState) -> (FieldAssignment, !(!Optional Ident,!Optional Ident,ParseState))
 					transform_update _ [{nu_selectors=[PS_Record fieldIdent field_record_type], nu_update_expr}] (shareIdent,record_type,pState)
 						# (record_type,pState) = check_field_and_record_types field_record_type record_type pState;
@@ -2396,7 +2410,7 @@ where
 					build_update record_type (Yes ident) expr assignments
 						=	PE_Let False (LocalParsedDefs [buildNodeDef (PE_Ident ident) expr])
 									(PE_Record (PE_Ident ident) record_type assignments)
-
+					
 					check_field_and_record_types :: (Optional Ident) (Optional Ident) ParseState -> (!Optional Ident,!ParseState);
 					check_field_and_record_types No record_type pState
 						= (record_type,pState);

frontend/scanner.dcl

@@ -6,11 +6,6 @@ import StdEnv, general
 
 ::	* ScanState
 
-//::	*Input
-//::	* InputStream
-//::	LongToken
-//::	Buffer x
-
 ::	FilePosition = {fp_line :: !Int, fp_col :: !Int}
 
 instance <<< FilePosition

frontend/scanner.icl

@@ -16,7 +16,45 @@ functions names starting with '->' require a ';' after the type. Solutions:
 */
 ::	SearchPaths	:== [String]
 
-::	* ScanState =
+::	*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
+	nextToken context (ScanState scan_state)
+		# (token,scan_state) = nextToken context scan_state
+		= (token,ScanState scan_state) 
+
+instance currentToken ScanState
+where
+	currentToken (ScanState scan_state)
+		# (token,scan_state) = currentToken scan_state
+		= (token,ScanState scan_state) 
+
+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)
+
+instance getPosition ScanState
+where
+	getPosition (ScanState scan_state)
+		# (position,scan_state) = getPosition scan_state
+		= (position,ScanState scan_state) 
+
+::	* RScanState =
 	{	ss_input		::	ScanInput