From 51ce630aec91fa5227c1e334fa35a71d9d193cc2 Mon Sep 17 00:00:00 2001
From: johnvg
Date: Mon, 21 Oct 2002 11:38:48 +0000
Subject: add BEFlatTypeX and BERecordTypeX for boxed records and types with
 lhs uniqueness attribute

git-svn-id: https://svn.cs.ru.nl/repos/clean-compiler/trunk@1248 1f8540f1-abd5-4d5b-9d24-4c5ce8603e2d
---
 backendC/CleanCompilerSources/backend.c | 33 +++++++++++++++++++++++++++++----
 backendC/CleanCompilerSources/backend.h |  6 ++++++
 2 files changed, 35 insertions(+), 4 deletions(-)

(limited to 'backendC')

diff --git a/backendC/CleanCompilerSources/backend.c b/backendC/CleanCompilerSources/backend.c
index e73de65..c3202ac 100644
--- a/backendC/CleanCompilerSources/backend.c
+++ b/backendC/CleanCompilerSources/backend.c
@@ -2729,7 +2729,7 @@ BENoTypeVars (void)
 } /* BENoTypeVars */
 
 BEFlatTypeP
-BEFlatType (BESymbolP symbol, BETypeVarListP arguments)
+BEFlatTypeX (BESymbolP symbol, BEAttribution attribution, BETypeVarListP arguments)
 {
 	FlatType	flatType;
 	int			i;
@@ -2745,7 +2745,15 @@ BEFlatType (BESymbolP symbol, BETypeVarListP arguments)
 
 	flatType->ft_cons_vars	= NULL;	/* used in PrintType */
 
+	flatType->ft_attribute = (AttributeKind) attribution;;
+
 	return (flatType);
+} /* BEFlatTypeX */
+
+BEFlatTypeP
+BEFlatType (BESymbolP symbol, BETypeVarListP arguments)
+{
+	return BEFlatTypeX (symbol,NoUniAttr,arguments);
 } /* BEFlatType */
 
 void
@@ -2790,7 +2798,7 @@ BEAlgebraicType (BEFlatTypeP lhs, BEConstructorListP constructors)
 } /* BEAlgebraicType */
 
 void
-BERecordType (int moduleIndex, BEFlatTypeP lhs, BETypeNodeP constructorType, BEFieldListP fields)
+BERecordTypeX (int moduleIndex, BEFlatTypeP lhs, BETypeNodeP constructorType, int is_boxed_record, BEFieldListP fields)
 {
 	int					nFields;
 	Types				type;
@@ -2837,6 +2845,8 @@ BERecordType (int moduleIndex, BEFlatTypeP lhs, BETypeNodeP constructorType, BEF
 	sdef->sdef_type			= type;
 	sdef->sdef_arity		= constructorType->type_node_arity;
 
+	sdef->sdef_boxed_record	= is_boxed_record;
+	
 	// +++ change this
 	{
 		int	i;
@@ -2853,6 +2863,12 @@ BERecordType (int moduleIndex, BEFlatTypeP lhs, BETypeNodeP constructorType, BEF
 	}
 } /* BERecordType */
 
+void
+BERecordType (int moduleIndex, BEFlatTypeP lhs, BETypeNodeP constructorType, BEFieldListP fields)
+{
+	BERecordTypeX (moduleIndex,lhs,constructorType,0,fields);
+}
+
 void
 BEAbsType (BEFlatTypeP lhs)
 {
@@ -3218,7 +3234,9 @@ AddExtension (char *name)
 /* ... copied from compiler.c */
 
 
- 
+#if 0
+File rules_file;
+#endif
 
 int
 BEGenerateCode (CleanString outputFile)
@@ -3263,10 +3281,18 @@ BEGenerateCode (CleanString outputFile)
 	}
 #endif
 
+#if 0
+	rules_file=fopen ("Rules","w");
+#endif
+
 	CodeGeneration (gBEState.be_icl.beicl_module, outputFileName);
 	if (hadExtension)
 		AddExtension (outputFileName);
 
+#if 0
+	fclose (rules_file);
+#endif
+
 	return (!CompilerError);
 } /* BEGenerateCode */
 
@@ -3302,7 +3328,6 @@ BEExportType (int dclTypeIndex, int iclTypeIndex)
 
 	iclDef->sdef_dcl_icl	= dclDef;
 	dclDef->sdef_dcl_icl	= iclDef;
-
 	iclDef->sdef_exported = True;
 	dclDef->sdef_exported = True;
 } /* BEExportType */
diff --git a/backendC/CleanCompilerSources/backend.h b/backendC/CleanCompilerSources/backend.h
index b66f099..6971c7d 100644
--- a/backendC/CleanCompilerSources/backend.h
+++ b/backendC/CleanCompilerSources/backend.h
@@ -430,12 +430,18 @@ Clean (BENoTypes :: BackEnd -> (BETypeP, BackEnd))
 BEFlatTypeP BEFlatType (BESymbolP symbol, BETypeVarListP arguments);
 Clean (BEFlatType :: BESymbolP BETypeVarListP BackEnd -> (BEFlatTypeP, BackEnd))
 
+BEFlatTypeP BEFlatTypeX (BESymbolP symbol, BEAttribution attribution, BETypeVarListP arguments);
+Clean (BEFlatTypeX :: BESymbolP BEAttribution BETypeVarListP BackEnd -> (BEFlatTypeP, BackEnd))
+
 void BEAlgebraicType (BEFlatTypeP lhs, BEConstructorListP constructors);
 Clean (BEAlgebraicType:: BEFlatTypeP BEConstructorListP BackEnd -> BackEnd)
 
 void BERecordType (int moduleIndex, BEFlatTypeP lhs, BETypeNodeP constructorType, BEFieldListP fields);
 Clean (BERecordType :: Int BEFlatTypeP BETypeNodeP BEFieldListP BackEnd -> BackEnd)
 
+void BERecordTypeX (int moduleIndex, BEFlatTypeP lhs, BETypeNodeP constructorType, int is_boxed_record, BEFieldListP fields);
+Clean (BERecordTypeX :: Int BEFlatTypeP BETypeNodeP Int BEFieldListP BackEnd -> BackEnd)
+
 void BEAbsType (BEFlatTypeP lhs);
 Clean (BEAbsType :: BEFlatTypeP BackEnd -> BackEnd)
 
-- 
cgit v1.2.3