add extra attribute argument to BEFlatType and

the is_boxed_record argument to BERecordType


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

2 files changed, 11 insertions, 17 deletions

diff --git a/backend/backendconvert.icl b/backend/backendconvert.icl
index 2883c58..41ac150 100644
--- a/backend/backendconvert.icl
+++ b/backend/backendconvert.icl
@@ -308,7 +308,7 @@ beDeclareNodeId number lhsOrRhs name
 beAdjustArrayFunction backendId functionIndex moduleIndex
 	:==	beApFunction0 (BEAdjustArrayFunction backendId functionIndex moduleIndex)
 beFlatType
-	:==	beFunction2 BEFlatType
+	:==	beFunction3 BEFlatType
 beNoTypeVars
 	:==	beFunction0 BENoTypeVars
 beTypeVars
@@ -783,7 +783,7 @@ defineTypes moduleIndex constructors selectors types
 
 convertTypeLhs :: ModuleIndex Index TypeAttribute [ATypeVar] -> BEMonad BEFlatTypeP
 convertTypeLhs moduleIndex typeIndex attribute args
-	=	beFlatType (beTypeSymbol typeIndex moduleIndex) (convertTypeVars args)
+	=	beFlatType (beTypeSymbol typeIndex moduleIndex) (convertAttribution attribute) (convertTypeVars args)
 
 convertTypeVars :: [ATypeVar] -> BEMonad BETypeVarListP
 convertTypeVars typeVars
@@ -812,7 +812,7 @@ defineType moduleIndex constructors selectors typeIndex {td_attribute, td_args,
 				(beConstructorSymbol moduleIndex constructorIndex)
 				(convertSymbolTypeArgs constructorType)
 				be
-	=	appBackEnd (BERecordType moduleIndex flatType constructorTypeNode fields) be
+	=	appBackEnd (BERecordType moduleIndex flatType constructorTypeNode (if rt_is_boxed_record 1 0) fields) be
 	where
 		constructorIndex
 			=	rt_constructor.ds_index
@@ -1358,20 +1358,14 @@ convertAttribution attr
 convertAnnotTypeNode :: AType -> BEMonad BETypeNodeP
 convertAnnotTypeNode {at_type, at_attribute}
 	=	convertTypeNode at_type
-	:-	beAnnotateTypeNode c_annot
-	:-	beAttributeTypeNode c_attrib
-	where
-		c_annot = convertAnnotation AN_None
-		c_attrib = convertAttribution at_attribute
+	:-	beAnnotateTypeNode (convertAnnotation AN_None)
+	:-	beAttributeTypeNode (convertAttribution at_attribute)
 
 convertAnnotAndTypeNode :: Annotation AType -> BEMonad BETypeNodeP
 convertAnnotAndTypeNode at_annotation {at_type, at_attribute}
 	= convertTypeNode at_type
-	:-	beAnnotateTypeNode c_annot
-	:-	beAttributeTypeNode c_attrib
-	where
-		c_annot = convertAnnotation at_annotation
-		c_attrib = convertAttribution at_attribute
+	:-	beAnnotateTypeNode (convertAnnotation at_annotation)
+	:-	beAttributeTypeNode (convertAttribution at_attribute)
 
 convertTypeNode :: Type -> BEMonad BETypeNodeP
 convertTypeNode (TB (BT_String type))
diff --git a/backendC/CleanCompilerSources/backend.c b/backendC/CleanCompilerSources/backend.c
index 2dc81f3..6308b8d 100644
--- a/backendC/CleanCompilerSources/backend.c
+++ b/backendC/CleanCompilerSources/backend.c
@@ -2733,7 +2733,7 @@ BENoTypeVars (void)
 } /* BENoTypeVars */
 
 BEFlatTypeP
-BEFlatType (BESymbolP symbol, BETypeVarListP arguments)
+BEFlatType (BESymbolP symbol, BEAttribution attribution, BETypeVarListP arguments)
 {
 	FlatType	flatType;
 	int			i;
@@ -2749,7 +2749,7 @@ BEFlatType (BESymbolP symbol, BETypeVarListP arguments)
 
 	flatType->ft_cons_vars	= NULL;	/* used in PrintType */
 
-	flatType->ft_attribute = NoUniAttr;
+	flatType->ft_attribute = (AttributeKind) attribution;;
 
 	return (flatType);
 } /* BEFlatType */
@@ -2796,7 +2796,7 @@ BEAlgebraicType (BEFlatTypeP lhs, BEConstructorListP constructors)
 } /* BEAlgebraicType */
 
 void
-BERecordType (int moduleIndex, BEFlatTypeP lhs, BETypeNodeP constructorType, BEFieldListP fields)
+BERecordType (int moduleIndex, BEFlatTypeP lhs, BETypeNodeP constructorType, int is_boxed_record, BEFieldListP fields)
 {
 	int					nFields;
 	Types				type;
@@ -2843,7 +2843,7 @@ BERecordType (int moduleIndex, BEFlatTypeP lhs, BETypeNodeP constructorType, BEF
 	sdef->sdef_type			= type;
 	sdef->sdef_arity		= constructorType->type_node_arity;
 
-	sdef->sdef_boxed_record	= False;
+	sdef->sdef_boxed_record	= is_boxed_record;
 	
 	// +++ change this
 	{