print forall typevars in backend

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

3 files changed, 42 insertions, 23 deletions

diff --git a/backend/backend.dcl b/backend/backend.dcl
index 0cb88e6..f151e64 100644
--- a/backend/backend.dcl
+++ b/backend/backend.dcl
@@ -67,22 +67,20 @@ BEBoolSymbol :: !Bool !BackEnd -> (!BESymbolP,!BackEnd);
 // BESymbolP BEBoolSymbol (int value);
 BELiteralSymbol :: !BESymbKind !String !BackEnd -> (!BESymbolP,!BackEnd);
 // BESymbolP BELiteralSymbol (BESymbKind kind,CleanString value);
-
 BEPredefineListConstructorSymbol :: !Int !Int !BESymbKind !Int !Int !BackEnd -> BackEnd;
-// void BEPredefineListConstructorSymbol(int constructorIndex,int moduleIndex,BESymbKind symbolKind,int head_strictnes,int tail_stricness);
+// void BEPredefineListConstructorSymbol (int constructorIndex,int moduleIndex,BESymbKind symbolKind,int head_strictness,int tail_strictness);
 BEPredefineListTypeSymbol :: !Int !Int !BESymbKind !Int !Int !BackEnd -> BackEnd;
-// void BEPredefineListTypeSymbol(int typeIndex,int moduleIndex,BESymbKind symbolKind,int head_strictnes,int tail_stricness);
+// void BEPredefineListTypeSymbol (int typeIndex,int moduleIndex,BESymbKind symbolKind,int head_strictness,int tail_strictness);
 BEAdjustStrictListConsInstance :: !Int !Int !BackEnd -> BackEnd;
-// void BEAdjustStrictListConsInstance(int functionIndex,int moduleIndex);
+// void BEAdjustStrictListConsInstance (int functionIndex,int moduleIndex);
 BEAdjustUnboxedListDeconsInstance :: !Int !Int !BackEnd -> BackEnd;
-// void BEAdjustUnboxedListDeconsInstance(int functionIndex,int moduleIndex);
+// void BEAdjustUnboxedListDeconsInstance (int functionIndex,int moduleIndex);
 BEAdjustOverloadedNilFunction :: !Int !Int !BackEnd -> BackEnd;
-// void BEAdjustOverloadedNilFunction(int functionIndex,int moduleIndex);
+// void BEAdjustOverloadedNilFunction (int functionIndex,int moduleIndex);
 BEOverloadedConsSymbol :: !Int !Int !Int !Int !BackEnd -> (!BESymbolP,!BackEnd);
 // BESymbolP BEOverloadedConsSymbol (int constructorIndex,int moduleIndex,int deconsIndex,int deconsModuleIndex);
 BEOverloadedPushNode :: !Int !BESymbolP !BEArgP !BENodeIdListP !BENodeP !BackEnd -> (!BENodeP,!BackEnd);
 // BENodeP BEOverloadedPushNode (int arity,BESymbolP symbol,BEArgP arguments,BENodeIdListP nodeIds,BENodeP decons_node);
-
 BEPredefineConstructorSymbol :: !Int !Int !Int !BESymbKind !BackEnd -> BackEnd;
 // void BEPredefineConstructorSymbol (int arity,int constructorIndex,int moduleIndex,BESymbKind symbolKind);
 BEPredefineTypeSymbol :: !Int !Int !Int !BESymbKind !BackEnd -> BackEnd;
@@ -91,14 +89,18 @@ BEBasicSymbol :: !Int !BackEnd -> (!BESymbolP,!BackEnd);
 // BESymbolP BEBasicSymbol (BESymbKind kind);
 BEVarTypeNode :: !String !BackEnd -> (!BETypeNodeP,!BackEnd);
 // BETypeNodeP BEVarTypeNode (CleanString name);
-BETypeVars :: !BETypeVarP !BETypeVarListP !BackEnd -> (!BETypeVarListP,!BackEnd);
-// BETypeVarListP BETypeVars (BETypeVarP typeVar,BETypeVarListP typeVarList);
+BETypeVarListElem :: !BETypeVarP !BEAttribution !BackEnd -> (!BETypeVarListP,!BackEnd);
+// BETypeVarListP BETypeVarListElem (BETypeVarP typeVar,BEAttribution attribute);
+BETypeVars :: !BETypeVarListP !BETypeVarListP !BackEnd -> (!BETypeVarListP,!BackEnd);
+// BETypeVarListP BETypeVars (BETypeVarListP typeVarListElem,BETypeVarListP typeVarList);
 BENoTypeVars :: !BackEnd -> (!BETypeVarListP,!BackEnd);
 // BETypeVarListP BENoTypeVars ();
 BENormalTypeNode :: !BESymbolP !BETypeArgP !BackEnd -> (!BETypeNodeP,!BackEnd);
 // BETypeNodeP BENormalTypeNode (BESymbolP symbol,BETypeArgP args);
 BEAnnotateTypeNode :: !BEAnnotation !BETypeNodeP !BackEnd -> (!BETypeNodeP,!BackEnd);
 // BETypeNodeP BEAnnotateTypeNode (BEAnnotation annotation,BETypeNodeP typeNode);
+BEAddForAllTypeVariables :: !BETypeVarListP !BETypeNodeP !BackEnd -> (!BETypeNodeP,!BackEnd);
+// BETypeNodeP BEAddForAllTypeVariables (BETypeVarListP vars,BETypeNodeP type);
 BEAttributeTypeNode :: !BEAttribution !BETypeNodeP !BackEnd -> (!BETypeNodeP,!BackEnd);
 // BETypeNodeP BEAttributeTypeNode (BEAttribution attribution,BETypeNodeP typeNode);
 BEAttributeKind :: !BEAttribution !BackEnd -> (!BEAttributeKindList,!BackEnd);
diff --git a/backend/backend.icl b/backend/backend.icl
index 519acac..d0494c2 100644
--- a/backend/backend.icl
+++ b/backend/backend.icl
@@ -128,36 +128,35 @@ BELiteralSymbol a0 a1 a2 = code {
 };
 // BESymbolP BELiteralSymbol (BESymbKind kind,CleanString value);
 
-
 BEPredefineListConstructorSymbol :: !Int !Int !BESymbKind !Int !Int !BackEnd -> BackEnd;
 BEPredefineListConstructorSymbol a0 a1 a2 a3 a4 a5 = code {
 	ccall BEPredefineListConstructorSymbol "IIIII:V:I"
 };
-// void BEPredefineListConstructorSymbol(int constructorIndex,int moduleIndex,BESymbKind symbolKind,int head_strictnes,int tail_stricness);
+// void BEPredefineListConstructorSymbol (int constructorIndex,int moduleIndex,BESymbKind symbolKind,int head_strictness,int tail_strictness);
 
 BEPredefineListTypeSymbol :: !Int !Int !BESymbKind !Int !Int !BackEnd -> BackEnd;
 BEPredefineListTypeSymbol a0 a1 a2 a3 a4 a5 = code {
 	ccall BEPredefineListTypeSymbol "IIIII:V:I"
 };
-// void BEPredefineListTypeSymbol(int typeIndex,int moduleIndex,BESymbKind symbolKind,int head_strictnes,int tail_stricness);
+// void BEPredefineListTypeSymbol (int typeIndex,int moduleIndex,BESymbKind symbolKind,int head_strictness,int tail_strictness);
 
 BEAdjustStrictListConsInstance :: !Int !Int !BackEnd -> BackEnd;
 BEAdjustStrictListConsInstance a0 a1 a2 = code {
 	ccall BEAdjustStrictListConsInstance "II:V:I"
 };
-// void BEAdjustStrictListConsInstance(int functionIndex,int moduleIndex);
+// void BEAdjustStrictListConsInstance (int functionIndex,int moduleIndex);
 
 BEAdjustUnboxedListDeconsInstance :: !Int !Int !BackEnd -> BackEnd;
 BEAdjustUnboxedListDeconsInstance a0 a1 a2 = code {
 	ccall BEAdjustUnboxedListDeconsInstance "II:V:I"
 };
-// void BEAdjustUnboxedListDeconsInstance(int functionIndex,int moduleIndex);
+// void BEAdjustUnboxedListDeconsInstance (int functionIndex,int moduleIndex);
 
 BEAdjustOverloadedNilFunction :: !Int !Int !BackEnd -> BackEnd;
 BEAdjustOverloadedNilFunction a0 a1 a2 = code {
 	ccall BEAdjustOverloadedNilFunction "II:V:I"
 };
-// void BEAdjustOverloadedNilFunction(int functionIndex,int moduleIndex);
+// void BEAdjustOverloadedNilFunction (int functionIndex,int moduleIndex);
 
 BEOverloadedConsSymbol :: !Int !Int !Int !Int !BackEnd -> (!BESymbolP,!BackEnd);
 BEOverloadedConsSymbol a0 a1 a2 a3 a4 = code {
@@ -171,7 +170,6 @@ BEOverloadedPushNode a0 a1 a2 a3 a4 a5 = code {
 };
 // BENodeP BEOverloadedPushNode (int arity,BESymbolP symbol,BEArgP arguments,BENodeIdListP nodeIds,BENodeP decons_node);
 
-
 BEPredefineConstructorSymbol :: !Int !Int !Int !BESymbKind !BackEnd -> BackEnd;
 BEPredefineConstructorSymbol a0 a1 a2 a3 a4 = code {
 	ccall BEPredefineConstructorSymbol "IIII:V:I"
@@ -196,11 +194,17 @@ BEVarTypeNode a0 a1 = code {
 };
 // BETypeNodeP BEVarTypeNode (CleanString name);
 
-BETypeVars :: !BETypeVarP !BETypeVarListP !BackEnd -> (!BETypeVarListP,!BackEnd);
+BETypeVarListElem :: !BETypeVarP !BEAttribution !BackEnd -> (!BETypeVarListP,!BackEnd);
+BETypeVarListElem a0 a1 a2 = code {
+	ccall BETypeVarListElem "II:I:I"
+};
+// BETypeVarListP BETypeVarListElem (BETypeVarP typeVar,BEAttribution attribute);
+
+BETypeVars :: !BETypeVarListP !BETypeVarListP !BackEnd -> (!BETypeVarListP,!BackEnd);
 BETypeVars a0 a1 a2 = code {
 	ccall BETypeVars "II:I:I"
 };
-// BETypeVarListP BETypeVars (BETypeVarP typeVar,BETypeVarListP typeVarList);
+// BETypeVarListP BETypeVars (BETypeVarListP typeVarListElem,BETypeVarListP typeVarList);
 
 BENoTypeVars :: !BackEnd -> (!BETypeVarListP,!BackEnd);
 BENoTypeVars a0 = code {
@@ -220,6 +224,12 @@ BEAnnotateTypeNode a0 a1 a2 = code {
 };
 // BETypeNodeP BEAnnotateTypeNode (BEAnnotation annotation,BETypeNodeP typeNode);
 
+BEAddForAllTypeVariables :: !BETypeVarListP !BETypeNodeP !BackEnd -> (!BETypeNodeP,!BackEnd);
+BEAddForAllTypeVariables a0 a1 a2 = code {
+	ccall BEAddForAllTypeVariables "II:I:I"
+};
+// BETypeNodeP BEAddForAllTypeVariables (BETypeVarListP vars,BETypeNodeP type);
+
 BEAttributeTypeNode :: !BEAttribution !BETypeNodeP !BackEnd -> (!BETypeNodeP,!BackEnd);
 BEAttributeTypeNode a0 a1 a2 = code {
 	ccall BEAttributeTypeNode "II:I:I"
diff --git a/backend/backendconvert.icl b/backend/backendconvert.icl
index 24c4a4a..51a58f6 100644
--- a/backend/backendconvert.icl
+++ b/backend/backendconvert.icl
@@ -1,6 +1,7 @@
 implementation module backendconvert
 
 import code from library "backend_library"
+import compilerSwitches
 
 import StdEnv
 
@@ -8,7 +9,7 @@ import frontend
 import backend
 import backendsupport, backendpreprocess
 
-//import RWSDebug
+import RWSDebug
 
 // trace macro
 (-*->) infixl
@@ -229,6 +230,8 @@ beUpdateNode
 	:==	beFunction1 BEUpdateNode
 beNormalTypeNode
 	:==	beFunction2 BENormalTypeNode
+beAddForAllTypeVariables
+	:==	beFunction2 BEAddForAllTypeVariables
 beVarTypeNode name
 	:==	beFunction0 (BEVarTypeNode name)
 beRuleAlt lineNumber
@@ -313,6 +316,8 @@ beTypeVars
 	:==	beFunction2 BETypeVars
 beTypeVar name
 	:==	beFunction0 (BETypeVar name)
+beTypeVarListElem
+	:==	beFunction2 BETypeVarListElem
 beExportType dclTypeIndex iclTypeIndex
 	:==	beApFunction0 (BEExportType dclTypeIndex iclTypeIndex)
 beExportConstructor dclConstructorIndex iclConstructorIndex
@@ -895,9 +900,9 @@ convertTypeVars :: [ATypeVar] -> BEMonad BETypeVarListP
 convertTypeVars typeVars
 	=	sfoldr (beTypeVars o convertTypeVar) beNoTypeVars typeVars
 
-convertTypeVar :: ATypeVar -> BEMonad BETypeVarP
+convertTypeVar :: ATypeVar -> BEMonad BETypeVarListP
 convertTypeVar typeVar
-	=	beTypeVar typeVar.atv_variable.tv_name.id_name
+	=	beTypeVarListElem (beTypeVar typeVar.atv_variable.tv_name.id_name) (convertAttribution typeVar.atv_attribute)
 
 defineType :: ModuleIndex {#ConsDef} {#SelectorDef} Index CheckedTypeDef *BackEndState -> *BackEndState
 defineType moduleIndex constructors _ typeIndex {td_name, td_args, td_rhs=AlgType constructorSymbols} be
@@ -1434,7 +1439,7 @@ convertAttribution TA_Anonymous
 convertAttribution (TA_Var attrVar)
 	=	convertAttributeVar attrVar
 convertAttribution (TA_RootVar attrVar)
-	=	convertAttributeVar attrVar
+	=	PA_BUG (return BENoUniAttr) (convertAttributeVar attrVar)
 convertAttribution TA_MultiOfPropagatingConsVar
 	=	return BENoUniAttr
 // FIXME
@@ -1482,8 +1487,10 @@ convertTypeNode (a :@: b)
 	=	beNormalTypeNode (beBasicSymbol BEApplySymb) (convertTypeArgs [{at_attribute=TA_Multi, at_annotation=AN_None, at_type = consVariableToType a} : b])
 convertTypeNode TE
 	=	beNormalTypeNode beDontCareDefinitionSymbol beNoTypeArgs
+convertTypeNode (TFA vars type)
+	=	beAddForAllTypeVariables (convertTypeVars vars) (convertTypeNode type)
 convertTypeNode typeNode
-	=	abort "convertTypeNode" //  <<- ("backendconvert, convertTypeNode: unknown type node", typeNode)
+	=	abort "convertTypeNode"  <<- ("backendconvert, convertTypeNode: unknown type node", typeNode)
 
 consVariableToType :: ConsVariable -> Type
 consVariableToType (CV typeVar)