aboutsummaryrefslogtreecommitdiff
path: root/backendC
diff options
context:
space:
mode:
Diffstat (limited to 'backendC')
-rw-r--r--backendC/CleanCompilerSources/backend.c26
-rw-r--r--backendC/CleanCompilerSources/backend.h10
-rw-r--r--backendC/CleanCompilerSources/syntax_tree_types.h3
-rw-r--r--backendC/CleanCompilerSources/typeconv_2.c34
-rw-r--r--backendC/backend.link16
-rw-r--r--backendC/backend.rc4
6 files changed, 80 insertions, 13 deletions
diff --git a/backendC/CleanCompilerSources/backend.c b/backendC/CleanCompilerSources/backend.c
index 8a77f8f..bb09c6f 100644
--- a/backendC/CleanCompilerSources/backend.c
+++ b/backendC/CleanCompilerSources/backend.c
@@ -1334,6 +1334,7 @@ BEVarTypeNode (CleanString name)
node->type_node_arity = 0;
node->type_node_annotation = NoAnnot;
node->type_node_attribute = NoUniAttr;
+ node->type_for_all_vars = NULL;
return (node);
} /* BEVarTypeNode */
@@ -1351,6 +1352,7 @@ BENormalTypeNode (BESymbolP symbol, BETypeArgP args)
node->type_node_attribute = NoUniAttr;
node->type_node_symbol = symbol;
node->type_node_arguments = args;
+ node->type_for_all_vars = NULL;
return (node);
} /* BENormalTypeNode */
@@ -1431,6 +1433,15 @@ BEAnnotateTypeNode (BEAnnotation annotation, BETypeNodeP typeNode)
return (typeNode);
} /* BEAnnotateTypeNode */
+BETypeNodeP
+BEAddForAllTypeVariables (BETypeVarListP vars, BETypeNodeP type)
+{
+ Assert (type->type_for_all_vars == NULL);
+ type->type_for_all_vars = vars;
+
+ return (type);
+} /* BEAddForAllTypeVariables */
+
BETypeArgP
BENoTypeArgs (void)
{
@@ -2647,12 +2658,23 @@ BETypeVar (CleanString name)
} /* BETypeVar */
BETypeVarListP
-BETypeVars (BETypeVarP typeVar, BETypeVarListP typeVarList)
+BETypeVarListElem (BETypeVarP typeVar, BEAttribution attribute)
{
TypeVarList typeVarListElement;
typeVarListElement = ConvertAllocType (struct type_var_list);
- typeVarListElement->tvl_elem = typeVar;
+ typeVarListElement->tvl_elem = typeVar;
+ typeVarListElement->tvl_attribute = attribute;
+ typeVarListElement->tvl_next = NULL;
+
+ return (typeVarListElement);
+} /* BETypeVarListElem */
+
+BETypeVarListP
+BETypeVars (BETypeVarListP typeVarListElement, BETypeVarListP typeVarList)
+{
+ Assert (typeVarListElement->tvl_next == NULL);
+
typeVarListElement->tvl_next = typeVarList;
return (typeVarListElement);
diff --git a/backendC/CleanCompilerSources/backend.h b/backendC/CleanCompilerSources/backend.h
index 0da892e..de0e54c 100644
--- a/backendC/CleanCompilerSources/backend.h
+++ b/backendC/CleanCompilerSources/backend.h
@@ -244,8 +244,11 @@ Clean (BEBasicSymbol :: Int BackEnd -> (BESymbolP, BackEnd))
BETypeNodeP BEVarTypeNode (CleanString name);
Clean (BEVarTypeNode :: String BackEnd -> (BETypeNodeP, BackEnd))
-BETypeVarListP BETypeVars (BETypeVarP typeVar, BETypeVarListP typeVarList);
-Clean (BETypeVars :: BETypeVarP BETypeVarListP BackEnd -> (BETypeVarListP, BackEnd))
+BETypeVarListP BETypeVarListElem (BETypeVarP typeVar, BEAttribution attribute);
+Clean (BETypeVarListElem :: BETypeVarP BEAttribution BackEnd -> (BETypeVarListP, BackEnd))
+
+BETypeVarListP BETypeVars (BETypeVarListP typeVarListElem, BETypeVarListP typeVarList);
+Clean (BETypeVars :: BETypeVarListP BETypeVarListP BackEnd -> (BETypeVarListP, BackEnd))
BETypeVarListP BENoTypeVars (void);
Clean (BENoTypeVars :: BackEnd -> (BETypeVarListP, BackEnd))
@@ -256,6 +259,9 @@ Clean (BENormalTypeNode :: BESymbolP BETypeArgP BackEnd -> (BETypeNodeP, BackEnd
BETypeNodeP BEAnnotateTypeNode (BEAnnotation annotation, BETypeNodeP typeNode);
Clean (BEAnnotateTypeNode :: BEAnnotation BETypeNodeP BackEnd -> (BETypeNodeP, BackEnd))
+BETypeNodeP BEAddForAllTypeVariables (BETypeVarListP vars, BETypeNodeP type);
+Clean (BEAddForAllTypeVariables :: BETypeVarListP BETypeNodeP BackEnd -> (BETypeNodeP, BackEnd))
+
BETypeNodeP BEAttributeTypeNode (BEAttribution attribution, BETypeNodeP typeNode);
Clean (BEAttributeTypeNode :: BEAttribution BETypeNodeP BackEnd -> (BETypeNodeP, BackEnd))
diff --git a/backendC/CleanCompilerSources/syntax_tree_types.h b/backendC/CleanCompilerSources/syntax_tree_types.h
index ded1bf9..ad6cebc 100644
--- a/backendC/CleanCompilerSources/syntax_tree_types.h
+++ b/backendC/CleanCompilerSources/syntax_tree_types.h
@@ -401,6 +401,9 @@ struct type_node
short type_node_arity;
Annotation type_node_annotation;
unsigned char type_node_is_var:1;
+# ifdef CLEAN2
+ TypeVarList type_for_all_vars;
+# endif
};
#define type_node_symbol type_node_contents.contents_symbol
diff --git a/backendC/CleanCompilerSources/typeconv_2.c b/backendC/CleanCompilerSources/typeconv_2.c
index 63f4090..88d0bc8 100644
--- a/backendC/CleanCompilerSources/typeconv_2.c
+++ b/backendC/CleanCompilerSources/typeconv_2.c
@@ -429,6 +429,28 @@ static void PrintArguments (TypeArgs args, char separator, Bool brackets, Bool s
} /* PrintArguments */
+#ifdef CLEAN2
+static void PrintTypeVarList (TypeVarList type_vars)
+{
+ for (; type_vars != NULL; type_vars = type_vars -> tvl_next)
+ {
+ /* RWS:
+ Printing the attributes currently works because the attributes for
+ universally quantified type variables can only be none, '*' or '.'.
+ For attribute variables something should probably done with the
+ CurrentARC_Info administration, but I don't understand how this works.
+ */
+ if (type_vars -> tvl_attribute != NoUniAttr)
+ PrintAttribute (type_vars -> tvl_attribute, cDoPrintColon);
+
+ FPutS (type_vars -> tvl_elem -> tv_ident -> ident_name, StdListTypes);
+
+ if (type_vars -> tvl_next != NULL)
+ FPutC (' ', StdListTypes);
+ }
+}
+#endif
+
static void PrintNode (TypeNode node, Bool brackets, Bool strict_context, Bool print_annot)
{
@@ -449,6 +471,14 @@ static void PrintNode (TypeNode node, Bool brackets, Bool strict_context, Bool p
(node -> type_node_symbol -> symb_kind == fun_type || node -> type_node_symbol -> symb_kind == apply_symb))
brackets = True;
}
+#ifdef CLEAN2
+ if (node -> type_for_all_vars != NULL)
+ { FPutS ("(A.", StdListTypes);
+ PrintTypeVarList (node -> type_for_all_vars);
+ FPutC (':', StdListTypes);
+ brackets = False;
+ }
+#endif
switch (node -> type_node_symbol -> symb_kind)
{
case tuple_type:
@@ -546,6 +576,10 @@ static void PrintNode (TypeNode node, Bool brackets, Bool strict_context, Bool p
break;
}
+#ifdef CLEAN2
+ if (node -> type_for_all_vars != NULL)
+ FPutC (')', StdListTypes);
+#endif
} /* PrintNode */
static void PrintAttributeEquations (UniVarEquations attr_equas)
diff --git a/backendC/backend.link b/backendC/backend.link
index 91099d5..4b7095a 100644
--- a/backendC/backend.link
+++ b/backendC/backend.link
@@ -13,14 +13,23 @@
/EXPORT: BEDontCareDefinitionSymbol
/EXPORT: BEBoolSymbol
/EXPORT: BELiteralSymbol
+/EXPORT: BEPredefineListConstructorSymbol
+/EXPORT: BEPredefineListTypeSymbol
+/EXPORT: BEAdjustStrictListConsInstance
+/EXPORT: BEAdjustUnboxedListDeconsInstance
+/EXPORT: BEAdjustOverloadedNilFunction
+/EXPORT: BEOverloadedConsSymbol
+/EXPORT: BEOverloadedPushNode
/EXPORT: BEPredefineConstructorSymbol
/EXPORT: BEPredefineTypeSymbol
/EXPORT: BEBasicSymbol
/EXPORT: BEVarTypeNode
+/EXPORT: BETypeVarListElem
/EXPORT: BETypeVars
/EXPORT: BENoTypeVars
/EXPORT: BENormalTypeNode
/EXPORT: BEAnnotateTypeNode
+/EXPORT: BEAddForAllTypeVariables
/EXPORT: BEAttributeTypeNode
/EXPORT: BEAttributeKind
/EXPORT: BENoAttributeKinds
@@ -110,10 +119,3 @@
/EXPORT: BESetMainDclModuleN
/EXPORT: BEDeclareDynamicTypeSymbol
/EXPORT: BEDynamicTempTypeSymbol
-/EXPORT: BEPredefineListTypeSymbol
-/EXPORT: BEPredefineListConstructorSymbol
-/EXPORT: BEAdjustStrictListConsInstance
-/EXPORT: BEAdjustUnboxedListDeconsInstance
-/EXPORT: BEAdjustOverloadedNilFunction
-/EXPORT: BEOverloadedConsSymbol
-/EXPORT: BEOverloadedPushNode
diff --git a/backendC/backend.rc b/backendC/backend.rc
index 78fff0a..f65427f 100644
--- a/backendC/backend.rc
+++ b/backendC/backend.rc
@@ -14,7 +14,7 @@
# define kFileFlags VS_FF_DEBUG | VS_FF_PRERELEASE
# define kFileFlagsMask VS_FF_DEBUG | VS_FF_PRERELEASE
-# define kFileVersionString "2.0.d.8"
+# define kFileVersionString "2.0.d.9"
VS_VERSION_INFO VERSIONINFO
FILEVERSION kFileVersion
@@ -37,7 +37,7 @@ BEGIN
VALUE "LegalTrademarks", "\0"
VALUE "OriginalFilename","backend.dll\0"
VALUE "ProductName", "Clean System"
- VALUE "ProductVersion", "2.0.d.8"
+ VALUE "ProductVersion", "2.0.d.9"
VALUE "OLESelfRegister", "\0"
END
generated by cgit v1.2.3 (git 2.39.1) at 2025-04-28 12:14:09 +0000