refactor, remove some unused functions and record, use =: instead of == to...

refactor, remove some unused functions and record, use =: instead of == to compare annotations and attributes in the parser

frontend/checktypes.icl

@@ -1504,7 +1504,7 @@ where
 				-> case opt_type of
 					Yes dyn_type
 						# (dyn_type, loc_type_vars, type_defs, class_defs, modules, type_heaps, cs)
-							= check_dynamic_type_in_pattern mod_index scope dyn_type type_defs class_defs modules type_heaps cs
+							= check_dynamic_type mod_index scope dyn_type type_defs class_defs modules type_heaps cs
 						| isEmpty loc_type_vars
 							# expr_heap =  expr_heap <:= (dyn_info_ptr, EI_UnmarkedDynamic (Yes dyn_type) loc_dynamics)
 				  		  	-> check_local_dynamics mod_index scope loc_dynamics type_defs class_defs modules type_heaps expr_heap cs
@@ -1516,7 +1516,7 @@ where
 				  		 -> check_local_dynamics mod_index scope loc_dynamics type_defs class_defs modules type_heaps expr_heap cs
 			EI_DynamicType dyn_type loc_dynamics
 				# (dyn_type, loc_type_vars, type_defs, class_defs, modules, type_heaps, cs)
-					= check_dynamic_type_in_pattern mod_index scope dyn_type type_defs class_defs modules type_heaps cs
+					= check_dynamic_type mod_index scope dyn_type type_defs class_defs modules type_heaps cs
 				  (type_defs, class_defs, modules, type_heaps, expr_heap, cs)
 				  	= check_local_dynamics mod_index scope loc_dynamics type_defs class_defs modules type_heaps expr_heap cs
 				  cs_symbol_table = removeVariablesFromSymbolTable scope loc_type_vars cs.cs_symbol_table
@@ -1526,21 +1526,7 @@ where
 	check_local_dynamics mod_index scope local_dynamics type_defs class_defs modules type_heaps expr_heap cs
 		= foldSt (check_dynamic mod_index (inc scope)) local_dynamics (type_defs, class_defs, modules, type_heaps, expr_heap, cs)
 
-	check_dynamic_type_in_expression mod_index scope dt=:{dt_uni_vars,dt_type,dt_contexts} type_defs class_defs modules type_heaps=:{th_vars} cs
-		# (dt_uni_vars, (th_vars, cs)) = add_type_variables_to_symbol_table scope dt_uni_vars th_vars cs
-		  ots = { ots_type_defs = type_defs, ots_modules = modules }
-		  oti = { oti_heaps = { type_heaps & th_vars = th_vars }, oti_all_vars = [], oti_all_attrs = [], oti_global_vars = [] }
-
-		  (contexts, type_defs, class_defs, modules, heaps, cs)
-		  	= checkTypeContexts dt_contexts mod_index class_defs ots {oti & oti_all_vars=[],oti_all_attrs=[],oti_global_vars=[]} cs
-		  oti = {oti & oti_heaps=heaps}
-		  ots = {ots_modules = modules, ots_type_defs = type_defs}
-
-		  (dt_type, ({ots_type_defs, ots_modules}, oti, cs))
-		  		= checkOpenAType mod_index scope DAK_None dt_type (ots, oti, { cs & cs_x = {cs.cs_x & x_check_dynamic_types = True} })
-		= check_dynamic_type_uniqueness dt_type dt_uni_vars contexts oti ots_type_defs ots_modules class_defs cs
-
-	check_dynamic_type_in_pattern mod_index scope dt=:{dt_uni_vars,dt_type,dt_contexts} type_defs class_defs modules type_heaps=:{th_vars} cs
+	check_dynamic_type mod_index scope dt=:{dt_uni_vars,dt_type,dt_contexts} type_defs class_defs modules type_heaps=:{th_vars} cs
 		# (dt_uni_vars, (th_vars, cs)) = add_type_variables_to_symbol_table scope dt_uni_vars th_vars cs
 		  ots = { ots_type_defs = type_defs, ots_modules = modules }
 		  oti = { oti_heaps = { type_heaps & th_vars = th_vars }, oti_all_vars = [], oti_all_attrs = [], oti_global_vars = [] }

frontend/parse.icl

@@ -2507,7 +2507,7 @@ where
 			_
 				# (condefs, extensible_algebraic_type, pState) = want_constructor_list exi_vars token pState
 				# td & td_rhs = if extensible_algebraic_type (ExtensibleConses condefs) (ConsList condefs)
-				| annot == AN_None
+				| annot =: AN_None
 	 		  		->	(PD_Type td, pState)
 					->	(PD_Type td, parseError "Algebraic type" No ("No lhs strictness annotation for the algebraic type "+name) pState)
 	where
@@ -2522,7 +2522,7 @@ where
 		  pState			= verify_annot_attr annot td_attribute name pState
 		  (atype, pState)	= want pState // Atype
 		  td				= {td & td_rhs = TypeSpec atype}
-		| annot == AN_None
+		| annot =: AN_None
 			= (PD_Type td, pState)
 			= (PD_Type td, parseError "Type synonym" No ("No lhs strictness annotation for the type synonym "+name) pState)
 
@@ -2533,7 +2533,7 @@ where
 		  (token, pState)		= nextToken GeneralContext pState
 		  (condef, pState)		= want_newtype_constructor exi_vars token pState
 		  td					= { td & td_rhs = NewTypeCons condef }
-		| annot == AN_None
+		| annot =: AN_None
 	 		= (PD_Type td, pState)
 	 		= (PD_Type td, parseError "New type" No ("No lhs strictness annotation for the new type "+name) pState)
 
@@ -2570,14 +2570,14 @@ where
 		  module_name = file_name % (0,size file_name-4)
 		  (type_ext_ident, pState) = stringToIdent name (IC_TypeExtension module_name) pState
 		  td & td_rhs			= MoreConses type_ext_ident condefs
-		| annot == AN_None
+		| annot =: AN_None
 	 		= (PD_Type td, pState)
 	 		= (PD_Type td, parseError "Algebraic type" No ("No lhs strictness annotation for the algebraic type "+name) pState)
 
 	want_type_rhs token parseContext td=:{td_attribute} annot pState
 		| isIclContext parseContext
 			= (PD_Erroneous, parseError "type RHS" (Yes token) "type definition" pState)
-			| td_attribute == TA_Anonymous || td_attribute == TA_Unique || td_attribute == TA_None
+			| td_attribute =: TA_Anonymous || td_attribute =: TA_Unique || td_attribute =: TA_None
 				# (td_attribute, properties) = determine_properties annot td_attribute
 				# td = { td & td_attribute = td_attribute, td_rhs = EmptyRhs properties}
 				= (PD_Type td, tokenBack pState)
@@ -2586,19 +2586,19 @@ where
 
 	verify_annot_attr :: !Annotation !TypeAttribute !String !ParseState -> ParseState
 	verify_annot_attr annot attr name pState
-		| annot <> AN_None
+		| not annot =: AN_None
 			= parseError "type definition" No ("No annotation, "+toString annot+", in the lhs of type "+name) pState
-		| attr == TA_None || attr == TA_Unique
+		| attr =: TA_None || attr =: TA_Unique
 			= pState
 			= parseError "type definition" No ("No attribute, "+toString attr+", in the lhs of type "+name) pState
 
 	determine_properties :: !Annotation !TypeAttribute -> (!TypeAttribute, !BITVECT)
 	determine_properties annot attr
-		| annot == AN_Strict
-			| attr == TA_Anonymous
+		| annot =: AN_Strict
+			| attr =: TA_Anonymous
 				= (TA_None, cIsHyperStrict)
 				= (attr, cIsHyperStrict bitor cIsNonCoercible)
-		| attr == TA_Anonymous
+		| attr =: TA_Anonymous
 			= (TA_None, cAllBitsClear)
 			= (attr, cIsNonCoercible)
 
@@ -3661,7 +3661,7 @@ tryATypeToType atype pState
 		  , atype.at_type
 		  , parseError "simple type" No ("type instead of type annotation "+toString atype.at_annotation) pState
 		  )
-*/	| atype.at_attribute <> TA_None
+*/	| not atype.at_attribute =: TA_None
 		= ( False
 		  , atype.at_type
 		  , parseError "simple type" No ("type instead of type attribute "+toString atype.at_attribute) pState

frontend/type.icl

@@ -35,11 +35,6 @@ import check_instances, genericsupport
 	,	tc_coercible	:: !Bool
 	}
 
-::	SharedAttribute = 
-	{	sa_attr_nr	:: !Int
-	,	sa_position	:: !Expression
-	}
-
 ::	Requirements =
 	{	req_overloaded_calls	:: ![ExprInfoPtr]
 	,	req_type_coercions		:: ![TypeCoercion]
@@ -1000,7 +995,7 @@ fresh_overloaded_list_type [{ap_symbol}:patterns] pd_cons_symbol pd_nil_symbol d
 		make_cons_type_from_decons_type stdStrictLists_index decons_u_index common_defs ts
 			# {me_ident,me_type,me_type_ptr} = common_defs.[stdStrictLists_index].com_member_defs.[decons_u_index]
 			  (fun_type_copy,ts) = determineSymbolTypeOfFunction pos me_ident 1 me_type me_type_ptr common_defs ts
-			  {tst_args,tst_lifted,tst_result,tst_context,tst_attr_env}=fun_type_copy
+			  {tst_args,tst_result,tst_context,tst_attr_env}=fun_type_copy
 			# result_type = case tst_args of [t] -> t
 			# argument_types = case tst_result.at_type of
 									TA _ args=:[arg1,arg2] -> args
@@ -1033,7 +1028,7 @@ fresh_overloaded_maybe_type [{ap_symbol}:patterns] pd_just_symbol pd_none_symbol
 		make_just_type_from_from_just_type stdStrictMaybes_index from_just_index common_defs ts
 			# {me_ident,me_type,me_type_ptr} = common_defs.[stdStrictMaybes_index].com_member_defs.[from_just_index]
 			  (fun_type_copy,ts) = determineSymbolTypeOfFunction pos me_ident 1 me_type me_type_ptr common_defs ts
-			  {tst_args,tst_lifted,tst_result,tst_context,tst_attr_env}=fun_type_copy
+			  {tst_args,tst_result,tst_context,tst_attr_env}=fun_type_copy
 			# result_type = case tst_args of [t] -> t
 			# argument_types = [tst_result]
 			= (argument_types,result_type,tst_context,tst_attr_env,ts)
@@ -1636,7 +1631,7 @@ getSymbolType pos ti {symb_kind = SK_Constructor {glob_module,glob_object}} n_ap
 getSymbolType pos ti {symb_kind = SK_NewTypeConstructor {gi_module,gi_index}} n_app_args ts
 	# (fresh_cons_type, ts) = standardRhsConstructorType pos gi_index gi_module n_app_args ti ts
 	= (fresh_cons_type, [], ts) 
-getSymbolType pos ti=:{ti_functions,ti_common_defs,ti_main_dcl_module_n} {symb_kind = SK_LocalMacroFunction glob_object, symb_ident} n_app_args ts
+getSymbolType pos ti=:{ti_common_defs,ti_main_dcl_module_n} {symb_kind = SK_LocalMacroFunction glob_object, symb_ident} n_app_args ts
 	| glob_object>=size ts.ts_fun_env
 		= abort symb_ident.id_name;
 	# (fun_type, ts) = ts!ts_fun_env.[glob_object]
@@ -2442,7 +2437,6 @@ where
 		  (th_vars, ts_expr_heap) = clear_dynamics fi_dynamics (prop_type_heaps.th_vars, ts.ts_expr_heap)
 		  (fresh_fun_type, ts) = freshSymbolType No cWithoutFreshContextVars ft_with_prop common_defs
 									{ts & ts_type_heaps={prop_type_heaps & th_vars=th_vars}, ts_expr_heap=ts_expr_heap, ts_td_infos=prop_td_infos, ts_error=ts_error}
-//		  (lifted_args, ts) = fresh_non_unique_type_variables fun_lifted [] ts
 		  (lifted_args, ts) = fresh_attributed_type_variables fun_lifted [] ts
 
 		  (ts_var_store, ts_type_heaps, ts_var_heap, ts_expr_heap, pre_def_symbols)
@@ -2477,14 +2471,7 @@ where
 			= (vars, ts)
 			# (var, ts) = freshAttributedVariable ts
 			= fresh_attributed_type_variables (dec n) [var : vars] ts
-	/*
-	fresh_non_unique_type_variables :: !Int ![AType] !*TypeState -> (![AType], !*TypeState)
-	fresh_non_unique_type_variables n vars ts
-		| n == 0
-			= (vars, ts)
-			# (var, ts) = freshNonUniqueVariable ts
-			= fresh_non_unique_type_variables (dec n) [var : vars] ts
-	*/
+
 	fresh_dynamics dyn_ptrs state
 		= foldSt fresh_dynamic dyn_ptrs state
 	where
@@ -2601,11 +2588,9 @@ where
 
 specification_error type type1 err
 	# err = errorHeading "Type error" err
-	  format = { form_properties = cAttributed, form_attr_position = No}
 	# err = { err & ea_file = err.ea_file <<< "derived type conflicts with specified type:" <<< '\n' }
 	# format = { form_properties = cAttributed, form_attr_position = No}
 	# err = { err & ea_file = err.ea_file <<< " " <:: (format, type, Yes initialTypeVarBeautifulizer) <<< '\n' }
-	# format = { form_properties = cAttributed, form_attr_position = No}
 	# err = { err & ea_file = err.ea_file <<< " " <:: (format, type1, Yes initialTypeVarBeautifulizer) <<< '\n' }
 	= err
 
@@ -2687,11 +2672,6 @@ where
 			# (printable_type, th_attrs) = beautifulizeAttributes clean_fun_type type_heaps.th_attrs
 			# (printable_type1, th_attrs) = beautifulizeAttributes fun_type th_attrs
 			= (fun_env, attr_var_env, { type_heaps & th_attrs = th_attrs }, expr_heap, specification_error printable_type printable_type1 error)
-	where
-		add_lifted_arg_types arity_diff args1 args2
-			| arity_diff > 0
-				= take arity_diff args2 ++ args1
-				= args1
 
 	check_caf_context fun_ident fun_pos FK_Caf {st_context=[_:_]} error
 		=	checkErrorWithPosition fun_ident fun_pos "CAF cannot be overloaded" error

frontend/typesupport.icl

@@ -303,10 +303,6 @@ errorHeadingWithPositionNameAndLine error_kind pos ident_name line_n err=:{ea_fi
 		= {err & ea_file = ea_file <<< ident_name <<< "]:", ea_ok = False}
 		= {err & ea_file = ea_file <<< line_n <<< ',' <<< ident_name <<< "]:", ea_ok = False}
 
-contextError class_symb err
-	# err = errorHeading "Overloading error" err
-	= {err & ea_file = err.ea_file <<< " unresolved class \"" <<< class_symb <<< "\" not occurring in specified type\n"}
-
 liftedContextError class_symb err
 	# err = errorHeading "Overloading error" err
 	= {err & ea_file = err.ea_file <<< " type variable of type of lifted argument appears in class \"" <<< class_symb <<< "\"\n"}