add Expression to CP_SymbArg and rename as CP_SymbArgAndExpression,

print expression in error message in cannot_unify


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

3 files changed, 51 insertions, 43 deletions

diff --git a/frontend/syntax.dcl b/frontend/syntax.dcl
index 066c32d..7d1b086 100644
--- a/frontend/syntax.dcl
+++ b/frontend/syntax.dcl
@@ -1513,7 +1513,7 @@ instance == OverloadedListType
 ::	CoercionPosition
 	=	CP_Expression !Expression
 	|	CP_FunArg !Ident !Int // Function or constructor ident, argument position (>=1)
-	|	CP_SymbArg !SymbIdent !Int // Function or constructor symbol, argument position (>=1)
+	|	CP_SymbArgAndExpression !SymbIdent !Int !Expression // Function or constructor symbol, argument position (>=1)
 	|	CP_LiftedFunArg !Ident !Ident // Function symbol, lifted argument ident
 
 ::	IdentPos =
diff --git a/frontend/syntax.icl b/frontend/syntax.icl
index f0cf4b1..5146852 100644
--- a/frontend/syntax.icl
+++ b/frontend/syntax.icl
@@ -716,7 +716,6 @@ instance <<< ParsedSelector
 where
 	(<<<) file {ps_field_ident,ps_field_type} = file <<< ps_field_ident <<< ps_field_type
 
-
 instance <<< ModuleKind
 where
 	(<<<) file kind 		= file
@@ -772,7 +771,15 @@ where
 
 instance <<< ExprWithLocalDefs
 where
-	(<<<) file {ewl_expr,ewl_locals} = file <<< ewl_expr <<< ewl_locals
+	(<<<) file {ewl_expr,ewl_locals,ewl_nodes=[]} = file <<< ewl_expr <<< ewl_locals
+	(<<<) file {ewl_expr,ewl_locals,ewl_nodes} = file <<< ewl_nodes <<< '\n' <<< ewl_expr <<< ewl_locals
+
+instance <<< NodeDefWithLocals
+where
+	(<<<) file {ndwl_strict,ndwl_def,ndwl_locals}
+		| ndwl_strict
+			= file <<< "\n#! " <<< ndwl_def <<< ndwl_locals;
+			= file <<< "\n# " <<< ndwl_def <<< ndwl_locals;
 
 instance <<< GuardedExpr
 where
@@ -855,43 +862,43 @@ instance <<< CoercionPosition
 where
 	(<<<) file (CP_FunArg fun_name arg_nr)
 		= file <<< "argument " <<< arg_nr <<< " of " <<< readable fun_name
-	(<<<) file (CP_SymbArg fun_name arg_nr)
-		= file <<< "argument " <<< arg_nr <<< " of " <<< readable fun_name.symb_ident
+	(<<<) file (CP_SymbArgAndExpression fun_name arg_nr expression)
+		= show_expression (file <<< "argument " <<< arg_nr <<< " of " <<< readable fun_name.symb_ident <<< " : ") expression 
 	(<<<) file (CP_LiftedFunArg fun_name arg_name)
 		= file <<< "lifted argument " <<< arg_name <<< " of " <<< readable fun_name
 	(<<<) file (CP_Expression expression) = show_expression file expression
-	where
-		show_expression file (Var {var_ident})
-			= file <<< var_ident
-		show_expression file (FreeVar {fv_ident})
-			= file <<< fv_ident
-		show_expression file (App {app_symb={symb_ident}, app_args})
-			| symb_ident.id_name=="_dummyForStrictAlias"
-				= show_expression file (hd app_args)
-			= file <<< readable symb_ident
-		show_expression file (fun @ fun_args)
-			= show_expression file fun
-		show_expression file (Case {case_ident=No})
-			= file <<< "(case ... )"
-		show_expression file (Selection _ expr selectors)
-			= file <<< "selection"
-		show_expression file (Update expr1 selectors expr2)
-			= file <<< "update"
-		show_expression file (TupleSelect {ds_arity} elem_nr expr)
-			= file <<< "argument " <<< (elem_nr + 1) <<< " of " <<< ds_arity <<< "-tuple"
-		show_expression file (BasicExpr bv)
-			= file <<< bv
-		show_expression file (RecordUpdate _ _ _)
-			= file <<< "update of record"
-		show_expression file (MatchExpr _ expr)
-			= file <<< "match expression"
-		show_expression file (IsConstructor _ _ _ _ _ _)
-			= file <<< "is constructor expression"
-		show_expression file (Let _)
-			= file <<< "(let ... ) or #"
-		show_expression file _
-			= file
-		
+
+show_expression file (Var {var_ident})
+	= file <<< var_ident
+show_expression file (FreeVar {fv_ident})
+	= file <<< fv_ident
+show_expression file (App {app_symb={symb_ident}, app_args})
+	| symb_ident.id_name=="_dummyForStrictAlias"
+		= show_expression file (hd app_args)
+	= file <<< readable symb_ident
+show_expression file (fun @ fun_args)
+	= show_expression file fun
+show_expression file (Case {case_ident=No})
+	= file <<< "(case ... )"
+show_expression file (Selection _ expr selectors)
+	= file <<< "selection"
+show_expression file (Update expr1 selectors expr2)
+	= file <<< "update"
+show_expression file (TupleSelect {ds_arity} elem_nr expr)
+	= file <<< "argument " <<< (elem_nr + 1) <<< " of " <<< ds_arity <<< "-tuple"
+show_expression file (BasicExpr bv)
+	= file <<< bv
+show_expression file (RecordUpdate _ _ _)
+	= file <<< "update of record"
+show_expression file (MatchExpr _ expr)
+	= file <<< "match expression"
+show_expression file (IsConstructor _ _ _ _ _ _)
+	= file <<< "is constructor expression"
+show_expression file (Let _)
+	= file <<< "(let ... ) or #"
+show_expression file _
+	= file
+
 instance <<< Declaration
   where
 	(<<<) file (Declaration { decl_ident, decl_kind })
diff --git a/frontend/type.icl b/frontend/type.icl
index c7d3ec3..4491456 100644
--- a/frontend/type.icl
+++ b/frontend/type.icl
@@ -269,17 +269,18 @@ cannot_unify t1 t2 position common_defs err
 	  ea_file = case position of
 				CP_FunArg _ _
 					-> ea_file <<< "\"" <<< position <<< "\""
-				CP_SymbArg {symb_kind=SK_Constructor {glob_module,glob_object},symb_ident} arg_n
+				CP_SymbArgAndExpression {symb_kind=SK_Constructor {glob_module,glob_object},symb_ident} arg_n expression
 					#! type_index = common_defs.[glob_module].com_cons_defs.[glob_object].cons_type_index
 					-> case common_defs.[glob_module].com_type_defs.[type_index].td_rhs of
 						RecordType {rt_fields}
 							# field_name = rt_fields.[arg_n-1].fs_ident.id_name
 							  record_name = symb_ident.id_name
 							  record_name = if (record_name.[0]=='_') (record_name % (1,size record_name-1)) record_name
-							-> ea_file <<< "\"" <<< "field " <<< field_name <<< " of " <<< record_name <<< "\""
+							-> ea_file <<< "\"" <<< "field " <<< field_name <<< " of " <<< record_name 
+								<<< " : " <<< CP_Expression expression <<< "\""
 						_
 							-> ea_file <<< "\"" <<< position <<< "\""
-				CP_SymbArg _ _
+				CP_SymbArgAndExpression _ _ _
 					-> ea_file <<< "\"" <<< position <<< "\""
 				CP_LiftedFunArg _ _
 					-> ea_file <<< "\"" <<< position <<< "\""
@@ -1630,7 +1631,7 @@ where
 			= reqs_ts
 		requirements_of_args ti fun_ident arg_nr [expr:exprs] [lt:lts] reqs_ts
 			# (e_type, opt_expr_ptr, (reqs, ts)) = requirements ti expr reqs_ts
-			#! type_coercion = {tc_demanded = lt, tc_offered = e_type, tc_position = CP_SymbArg fun_ident arg_nr, tc_coercible = True}
+			#! type_coercion = {tc_demanded = lt, tc_offered = e_type, tc_position = CP_SymbArgAndExpression fun_ident arg_nr expr, tc_coercible = True}
 			# req_type_coercions = [type_coercion : reqs.req_type_coercions]
 			  ts_expr_heap = storeAttribute opt_expr_ptr lt.at_attribute ts.ts_expr_heap
 			= requirements_of_args ti fun_ident (arg_nr+1) exprs lts ({reqs & req_type_coercions = req_type_coercions}, {ts & ts_expr_heap = ts_expr_heap})
@@ -2675,7 +2676,7 @@ where
 		| group_index == size comps
 			= funs_and_state
 			#! comp = comps.[group_index]	
-			# funs_and_state = type_component list_inferred_types comp.group_members  class_instances ti funs_and_state
+			# funs_and_state = type_component list_inferred_types comp.group_members class_instances ti funs_and_state
 			= type_components list_inferred_types (inc group_index) comps class_instances ti funs_and_state
 /*
 	show_component comp fun_defs
@@ -2871,7 +2872,7 @@ where
 					  	case tc_position of
 					  		CP_FunArg _ _
 					  			-> ea_file <<< "\"" <<< tc_position <<< "\" "
-					  		CP_SymbArg _ _
+					  		CP_SymbArgAndExpression _ _ _
 					  			-> ea_file <<< "\"" <<< tc_position <<< "\" "
 					  		CP_LiftedFunArg _ _
 					  			-> ea_file <<< "\"" <<< tc_position <<< "\" "