Commit 581859e3 authored by Ronny Wichers Schreur's avatar Ronny Wichers Schreur 🏘
Browse files

print forall typevars in backend

parent 74d8d79e
...@@ -67,22 +67,20 @@ BEBoolSymbol :: !Bool !BackEnd -> (!BESymbolP,!BackEnd); ...@@ -67,22 +67,20 @@ BEBoolSymbol :: !Bool !BackEnd -> (!BESymbolP,!BackEnd);
// BESymbolP BEBoolSymbol (int value); // BESymbolP BEBoolSymbol (int value);
BELiteralSymbol :: !BESymbKind !String !BackEnd -> (!BESymbolP,!BackEnd); BELiteralSymbol :: !BESymbKind !String !BackEnd -> (!BESymbolP,!BackEnd);
// BESymbolP BELiteralSymbol (BESymbKind kind,CleanString value); // BESymbolP BELiteralSymbol (BESymbKind kind,CleanString value);
BEPredefineListConstructorSymbol :: !Int !Int !BESymbKind !Int !Int !BackEnd -> BackEnd; 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; 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; BEAdjustStrictListConsInstance :: !Int !Int !BackEnd -> BackEnd;
// void BEAdjustStrictListConsInstance(int functionIndex,int moduleIndex); // void BEAdjustStrictListConsInstance (int functionIndex,int moduleIndex);
BEAdjustUnboxedListDeconsInstance :: !Int !Int !BackEnd -> BackEnd; BEAdjustUnboxedListDeconsInstance :: !Int !Int !BackEnd -> BackEnd;
// void BEAdjustUnboxedListDeconsInstance(int functionIndex,int moduleIndex); // void BEAdjustUnboxedListDeconsInstance (int functionIndex,int moduleIndex);
BEAdjustOverloadedNilFunction :: !Int !Int !BackEnd -> BackEnd; 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); BEOverloadedConsSymbol :: !Int !Int !Int !Int !BackEnd -> (!BESymbolP,!BackEnd);
// BESymbolP BEOverloadedConsSymbol (int constructorIndex,int moduleIndex,int deconsIndex,int deconsModuleIndex); // BESymbolP BEOverloadedConsSymbol (int constructorIndex,int moduleIndex,int deconsIndex,int deconsModuleIndex);
BEOverloadedPushNode :: !Int !BESymbolP !BEArgP !BENodeIdListP !BENodeP !BackEnd -> (!BENodeP,!BackEnd); BEOverloadedPushNode :: !Int !BESymbolP !BEArgP !BENodeIdListP !BENodeP !BackEnd -> (!BENodeP,!BackEnd);
// BENodeP BEOverloadedPushNode (int arity,BESymbolP symbol,BEArgP arguments,BENodeIdListP nodeIds,BENodeP decons_node); // BENodeP BEOverloadedPushNode (int arity,BESymbolP symbol,BEArgP arguments,BENodeIdListP nodeIds,BENodeP decons_node);
BEPredefineConstructorSymbol :: !Int !Int !Int !BESymbKind !BackEnd -> BackEnd; BEPredefineConstructorSymbol :: !Int !Int !Int !BESymbKind !BackEnd -> BackEnd;
// void BEPredefineConstructorSymbol (int arity,int constructorIndex,int moduleIndex,BESymbKind symbolKind); // void BEPredefineConstructorSymbol (int arity,int constructorIndex,int moduleIndex,BESymbKind symbolKind);
BEPredefineTypeSymbol :: !Int !Int !Int !BESymbKind !BackEnd -> BackEnd; BEPredefineTypeSymbol :: !Int !Int !Int !BESymbKind !BackEnd -> BackEnd;
...@@ -91,14 +89,18 @@ BEBasicSymbol :: !Int !BackEnd -> (!BESymbolP,!BackEnd); ...@@ -91,14 +89,18 @@ BEBasicSymbol :: !Int !BackEnd -> (!BESymbolP,!BackEnd);
// BESymbolP BEBasicSymbol (BESymbKind kind); // BESymbolP BEBasicSymbol (BESymbKind kind);
BEVarTypeNode :: !String !BackEnd -> (!BETypeNodeP,!BackEnd); BEVarTypeNode :: !String !BackEnd -> (!BETypeNodeP,!BackEnd);
// BETypeNodeP BEVarTypeNode (CleanString name); // BETypeNodeP BEVarTypeNode (CleanString name);
BETypeVars :: !BETypeVarP !BETypeVarListP !BackEnd -> (!BETypeVarListP,!BackEnd); BETypeVarListElem :: !BETypeVarP !BEAttribution !BackEnd -> (!BETypeVarListP,!BackEnd);
// BETypeVarListP BETypeVars (BETypeVarP typeVar,BETypeVarListP typeVarList); // BETypeVarListP BETypeVarListElem (BETypeVarP typeVar,BEAttribution attribute);
BETypeVars :: !BETypeVarListP !BETypeVarListP !BackEnd -> (!BETypeVarListP,!BackEnd);
// BETypeVarListP BETypeVars (BETypeVarListP typeVarListElem,BETypeVarListP typeVarList);
BENoTypeVars :: !BackEnd -> (!BETypeVarListP,!BackEnd); BENoTypeVars :: !BackEnd -> (!BETypeVarListP,!BackEnd);
// BETypeVarListP BENoTypeVars (); // BETypeVarListP BENoTypeVars ();
BENormalTypeNode :: !BESymbolP !BETypeArgP !BackEnd -> (!BETypeNodeP,!BackEnd); BENormalTypeNode :: !BESymbolP !BETypeArgP !BackEnd -> (!BETypeNodeP,!BackEnd);
// BETypeNodeP BENormalTypeNode (BESymbolP symbol,BETypeArgP args); // BETypeNodeP BENormalTypeNode (BESymbolP symbol,BETypeArgP args);
BEAnnotateTypeNode :: !BEAnnotation !BETypeNodeP !BackEnd -> (!BETypeNodeP,!BackEnd); BEAnnotateTypeNode :: !BEAnnotation !BETypeNodeP !BackEnd -> (!BETypeNodeP,!BackEnd);
// BETypeNodeP BEAnnotateTypeNode (BEAnnotation annotation,BETypeNodeP typeNode); // BETypeNodeP BEAnnotateTypeNode (BEAnnotation annotation,BETypeNodeP typeNode);
BEAddForAllTypeVariables :: !BETypeVarListP !BETypeNodeP !BackEnd -> (!BETypeNodeP,!BackEnd);
// BETypeNodeP BEAddForAllTypeVariables (BETypeVarListP vars,BETypeNodeP type);
BEAttributeTypeNode :: !BEAttribution !BETypeNodeP !BackEnd -> (!BETypeNodeP,!BackEnd); BEAttributeTypeNode :: !BEAttribution !BETypeNodeP !BackEnd -> (!BETypeNodeP,!BackEnd);
// BETypeNodeP BEAttributeTypeNode (BEAttribution attribution,BETypeNodeP typeNode); // BETypeNodeP BEAttributeTypeNode (BEAttribution attribution,BETypeNodeP typeNode);
BEAttributeKind :: !BEAttribution !BackEnd -> (!BEAttributeKindList,!BackEnd); BEAttributeKind :: !BEAttribution !BackEnd -> (!BEAttributeKindList,!BackEnd);
......
...@@ -128,36 +128,35 @@ BELiteralSymbol a0 a1 a2 = code { ...@@ -128,36 +128,35 @@ BELiteralSymbol a0 a1 a2 = code {
}; };
// BESymbolP BELiteralSymbol (BESymbKind kind,CleanString value); // BESymbolP BELiteralSymbol (BESymbKind kind,CleanString value);
BEPredefineListConstructorSymbol :: !Int !Int !BESymbKind !Int !Int !BackEnd -> BackEnd; BEPredefineListConstructorSymbol :: !Int !Int !BESymbKind !Int !Int !BackEnd -> BackEnd;
BEPredefineListConstructorSymbol a0 a1 a2 a3 a4 a5 = code { BEPredefineListConstructorSymbol a0 a1 a2 a3 a4 a5 = code {
ccall BEPredefineListConstructorSymbol "IIIII:V:I" 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 :: !Int !Int !BESymbKind !Int !Int !BackEnd -> BackEnd;
BEPredefineListTypeSymbol a0 a1 a2 a3 a4 a5 = code { BEPredefineListTypeSymbol a0 a1 a2 a3 a4 a5 = code {
ccall BEPredefineListTypeSymbol "IIIII:V:I" 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 :: !Int !Int !BackEnd -> BackEnd;
BEAdjustStrictListConsInstance a0 a1 a2 = code { BEAdjustStrictListConsInstance a0 a1 a2 = code {
ccall BEAdjustStrictListConsInstance "II:V:I" ccall BEAdjustStrictListConsInstance "II:V:I"
}; };
// void BEAdjustStrictListConsInstance(int functionIndex,int moduleIndex); // void BEAdjustStrictListConsInstance (int functionIndex,int moduleIndex);
BEAdjustUnboxedListDeconsInstance :: !Int !Int !BackEnd -> BackEnd; BEAdjustUnboxedListDeconsInstance :: !Int !Int !BackEnd -> BackEnd;
BEAdjustUnboxedListDeconsInstance a0 a1 a2 = code { BEAdjustUnboxedListDeconsInstance a0 a1 a2 = code {
ccall BEAdjustUnboxedListDeconsInstance "II:V:I" ccall BEAdjustUnboxedListDeconsInstance "II:V:I"
}; };
// void BEAdjustUnboxedListDeconsInstance(int functionIndex,int moduleIndex); // void BEAdjustUnboxedListDeconsInstance (int functionIndex,int moduleIndex);
BEAdjustOverloadedNilFunction :: !Int !Int !BackEnd -> BackEnd; BEAdjustOverloadedNilFunction :: !Int !Int !BackEnd -> BackEnd;
BEAdjustOverloadedNilFunction a0 a1 a2 = code { BEAdjustOverloadedNilFunction a0 a1 a2 = code {
ccall BEAdjustOverloadedNilFunction "II:V:I" 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 :: !Int !Int !Int !Int !BackEnd -> (!BESymbolP,!BackEnd);
BEOverloadedConsSymbol a0 a1 a2 a3 a4 = code { BEOverloadedConsSymbol a0 a1 a2 a3 a4 = code {
...@@ -171,7 +170,6 @@ BEOverloadedPushNode a0 a1 a2 a3 a4 a5 = 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); // BENodeP BEOverloadedPushNode (int arity,BESymbolP symbol,BEArgP arguments,BENodeIdListP nodeIds,BENodeP decons_node);
BEPredefineConstructorSymbol :: !Int !Int !Int !BESymbKind !BackEnd -> BackEnd; BEPredefineConstructorSymbol :: !Int !Int !Int !BESymbKind !BackEnd -> BackEnd;
BEPredefineConstructorSymbol a0 a1 a2 a3 a4 = code { BEPredefineConstructorSymbol a0 a1 a2 a3 a4 = code {
ccall BEPredefineConstructorSymbol "IIII:V:I" ccall BEPredefineConstructorSymbol "IIII:V:I"
...@@ -196,11 +194,17 @@ BEVarTypeNode a0 a1 = code { ...@@ -196,11 +194,17 @@ BEVarTypeNode a0 a1 = code {
}; };
// BETypeNodeP BEVarTypeNode (CleanString name); // 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 { BETypeVars a0 a1 a2 = code {
ccall BETypeVars "II:I:I" ccall BETypeVars "II:I:I"
}; };
// BETypeVarListP BETypeVars (BETypeVarP typeVar,BETypeVarListP typeVarList); // BETypeVarListP BETypeVars (BETypeVarListP typeVarListElem,BETypeVarListP typeVarList);
BENoTypeVars :: !BackEnd -> (!BETypeVarListP,!BackEnd); BENoTypeVars :: !BackEnd -> (!BETypeVarListP,!BackEnd);
BENoTypeVars a0 = code { BENoTypeVars a0 = code {
...@@ -220,6 +224,12 @@ BEAnnotateTypeNode a0 a1 a2 = code { ...@@ -220,6 +224,12 @@ BEAnnotateTypeNode a0 a1 a2 = code {
}; };
// BETypeNodeP BEAnnotateTypeNode (BEAnnotation annotation,BETypeNodeP typeNode); // 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 :: !BEAttribution !BETypeNodeP !BackEnd -> (!BETypeNodeP,!BackEnd);
BEAttributeTypeNode a0 a1 a2 = code { BEAttributeTypeNode a0 a1 a2 = code {
ccall BEAttributeTypeNode "II:I:I" ccall BEAttributeTypeNode "II:I:I"
......
implementation module backendconvert implementation module backendconvert
import code from library "backend_library" import code from library "backend_library"
import compilerSwitches
import StdEnv import StdEnv
...@@ -8,7 +9,7 @@ import frontend ...@@ -8,7 +9,7 @@ import frontend
import backend import backend
import backendsupport, backendpreprocess import backendsupport, backendpreprocess
//import RWSDebug import RWSDebug
// trace macro // trace macro
(-*->) infixl (-*->) infixl
...@@ -229,6 +230,8 @@ beUpdateNode ...@@ -229,6 +230,8 @@ beUpdateNode
:== beFunction1 BEUpdateNode :== beFunction1 BEUpdateNode
beNormalTypeNode beNormalTypeNode
:== beFunction2 BENormalTypeNode :== beFunction2 BENormalTypeNode
beAddForAllTypeVariables
:== beFunction2 BEAddForAllTypeVariables
beVarTypeNode name beVarTypeNode name
:== beFunction0 (BEVarTypeNode name) :== beFunction0 (BEVarTypeNode name)
beRuleAlt lineNumber beRuleAlt lineNumber
...@@ -313,6 +316,8 @@ beTypeVars ...@@ -313,6 +316,8 @@ beTypeVars
:== beFunction2 BETypeVars :== beFunction2 BETypeVars
beTypeVar name beTypeVar name
:== beFunction0 (BETypeVar name) :== beFunction0 (BETypeVar name)
beTypeVarListElem
:== beFunction2 BETypeVarListElem
beExportType dclTypeIndex iclTypeIndex beExportType dclTypeIndex iclTypeIndex
:== beApFunction0 (BEExportType dclTypeIndex iclTypeIndex) :== beApFunction0 (BEExportType dclTypeIndex iclTypeIndex)
beExportConstructor dclConstructorIndex iclConstructorIndex beExportConstructor dclConstructorIndex iclConstructorIndex
...@@ -895,9 +900,9 @@ convertTypeVars :: [ATypeVar] -> BEMonad BETypeVarListP ...@@ -895,9 +900,9 @@ convertTypeVars :: [ATypeVar] -> BEMonad BETypeVarListP
convertTypeVars typeVars convertTypeVars typeVars
= sfoldr (beTypeVars o convertTypeVar) beNoTypeVars typeVars = sfoldr (beTypeVars o convertTypeVar) beNoTypeVars typeVars
convertTypeVar :: ATypeVar -> BEMonad BETypeVarP convertTypeVar :: ATypeVar -> BEMonad BETypeVarListP
convertTypeVar typeVar 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 {#ConsDef} {#SelectorDef} Index CheckedTypeDef *BackEndState -> *BackEndState
defineType moduleIndex constructors _ typeIndex {td_name, td_args, td_rhs=AlgType constructorSymbols} be defineType moduleIndex constructors _ typeIndex {td_name, td_args, td_rhs=AlgType constructorSymbols} be
...@@ -1434,7 +1439,7 @@ convertAttribution TA_Anonymous ...@@ -1434,7 +1439,7 @@ convertAttribution TA_Anonymous
convertAttribution (TA_Var attrVar) convertAttribution (TA_Var attrVar)
= convertAttributeVar attrVar = convertAttributeVar attrVar
convertAttribution (TA_RootVar attrVar) convertAttribution (TA_RootVar attrVar)
= convertAttributeVar attrVar = PA_BUG (return BENoUniAttr) (convertAttributeVar attrVar)
convertAttribution TA_MultiOfPropagatingConsVar convertAttribution TA_MultiOfPropagatingConsVar
= return BENoUniAttr = return BENoUniAttr
// FIXME // FIXME
...@@ -1482,8 +1487,10 @@ convertTypeNode (a :@: b) ...@@ -1482,8 +1487,10 @@ convertTypeNode (a :@: b)
= beNormalTypeNode (beBasicSymbol BEApplySymb) (convertTypeArgs [{at_attribute=TA_Multi, at_annotation=AN_None, at_type = consVariableToType a} : b]) = beNormalTypeNode (beBasicSymbol BEApplySymb) (convertTypeArgs [{at_attribute=TA_Multi, at_annotation=AN_None, at_type = consVariableToType a} : b])
convertTypeNode TE convertTypeNode TE
= beNormalTypeNode beDontCareDefinitionSymbol beNoTypeArgs = beNormalTypeNode beDontCareDefinitionSymbol beNoTypeArgs
convertTypeNode (TFA vars type)
= beAddForAllTypeVariables (convertTypeVars vars) (convertTypeNode type)
convertTypeNode typeNode convertTypeNode typeNode
= abort "convertTypeNode" // <<- ("backendconvert, convertTypeNode: unknown type node", typeNode) = abort "convertTypeNode" <<- ("backendconvert, convertTypeNode: unknown type node", typeNode)
consVariableToType :: ConsVariable -> Type consVariableToType :: ConsVariable -> Type
consVariableToType (CV typeVar) consVariableToType (CV typeVar)
......
...@@ -1334,6 +1334,7 @@ BEVarTypeNode (CleanString name) ...@@ -1334,6 +1334,7 @@ BEVarTypeNode (CleanString name)
node->type_node_arity = 0; node->type_node_arity = 0;
node->type_node_annotation = NoAnnot; node->type_node_annotation = NoAnnot;
node->type_node_attribute = NoUniAttr; node->type_node_attribute = NoUniAttr;
node->type_for_all_vars = NULL;
return (node); return (node);
} /* BEVarTypeNode */ } /* BEVarTypeNode */
...@@ -1351,6 +1352,7 @@ BENormalTypeNode (BESymbolP symbol, BETypeArgP args) ...@@ -1351,6 +1352,7 @@ BENormalTypeNode (BESymbolP symbol, BETypeArgP args)
node->type_node_attribute = NoUniAttr; node->type_node_attribute = NoUniAttr;
node->type_node_symbol = symbol; node->type_node_symbol = symbol;
node->type_node_arguments = args; node->type_node_arguments = args;
node->type_for_all_vars = NULL;
return (node); return (node);
} /* BENormalTypeNode */ } /* BENormalTypeNode */
...@@ -1431,6 +1433,15 @@ BEAnnotateTypeNode (BEAnnotation annotation, BETypeNodeP typeNode) ...@@ -1431,6 +1433,15 @@ BEAnnotateTypeNode (BEAnnotation annotation, BETypeNodeP typeNode)
return (typeNode); return (typeNode);
} /* BEAnnotateTypeNode */ } /* BEAnnotateTypeNode */
BETypeNodeP
BEAddForAllTypeVariables (BETypeVarListP vars, BETypeNodeP type)
{
Assert (type->type_for_all_vars == NULL);
type->type_for_all_vars = vars;
return (type);
} /* BEAddForAllTypeVariables */
BETypeArgP BETypeArgP
BENoTypeArgs (void) BENoTypeArgs (void)
{ {
...@@ -2647,12 +2658,23 @@ BETypeVar (CleanString name) ...@@ -2647,12 +2658,23 @@ BETypeVar (CleanString name)
} /* BETypeVar */ } /* BETypeVar */
BETypeVarListP BETypeVarListP
BETypeVars (BETypeVarP typeVar, BETypeVarListP typeVarList) BETypeVarListElem (BETypeVarP typeVar, BEAttribution attribute)
{ {
TypeVarList typeVarListElement; TypeVarList typeVarListElement;
typeVarListElement = ConvertAllocType (struct type_var_list); 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; typeVarListElement->tvl_next = typeVarList;
return (typeVarListElement); return (typeVarListElement);
......
...@@ -244,8 +244,11 @@ Clean (BEBasicSymbol :: Int BackEnd -> (BESymbolP, BackEnd)) ...@@ -244,8 +244,11 @@ Clean (BEBasicSymbol :: Int BackEnd -> (BESymbolP, BackEnd))
BETypeNodeP BEVarTypeNode (CleanString name); BETypeNodeP BEVarTypeNode (CleanString name);
Clean (BEVarTypeNode :: String BackEnd -> (BETypeNodeP, BackEnd)) Clean (BEVarTypeNode :: String BackEnd -> (BETypeNodeP, BackEnd))
BETypeVarListP BETypeVars (BETypeVarP typeVar, BETypeVarListP typeVarList); BETypeVarListP BETypeVarListElem (BETypeVarP typeVar, BEAttribution attribute);
Clean (BETypeVars :: BETypeVarP BETypeVarListP BackEnd -> (BETypeVarListP, BackEnd)) Clean (BETypeVarListElem :: BETypeVarP BEAttribution BackEnd -> (BETypeVarListP, BackEnd))
BETypeVarListP BETypeVars (BETypeVarListP typeVarListElem, BETypeVarListP typeVarList);
Clean (BETypeVars :: BETypeVarListP BETypeVarListP BackEnd -> (BETypeVarListP, BackEnd))
BETypeVarListP BENoTypeVars (void); BETypeVarListP BENoTypeVars (void);
Clean (BENoTypeVars :: BackEnd -> (BETypeVarListP, BackEnd)) Clean (BENoTypeVars :: BackEnd -> (BETypeVarListP, BackEnd))
...@@ -256,6 +259,9 @@ Clean (BENormalTypeNode :: BESymbolP BETypeArgP BackEnd -> (BETypeNodeP, BackEnd ...@@ -256,6 +259,9 @@ Clean (BENormalTypeNode :: BESymbolP BETypeArgP BackEnd -> (BETypeNodeP, BackEnd
BETypeNodeP BEAnnotateTypeNode (BEAnnotation annotation, BETypeNodeP typeNode); BETypeNodeP BEAnnotateTypeNode (BEAnnotation annotation, BETypeNodeP typeNode);
Clean (BEAnnotateTypeNode :: BEAnnotation BETypeNodeP BackEnd -> (BETypeNodeP, BackEnd)) 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); BETypeNodeP BEAttributeTypeNode (BEAttribution attribution, BETypeNodeP typeNode);
Clean (BEAttributeTypeNode :: BEAttribution BETypeNodeP BackEnd -> (BETypeNodeP, BackEnd)) Clean (BEAttributeTypeNode :: BEAttribution BETypeNodeP BackEnd -> (BETypeNodeP, BackEnd))
......
...@@ -401,6 +401,9 @@ struct type_node ...@@ -401,6 +401,9 @@ struct type_node
short type_node_arity; short type_node_arity;
Annotation type_node_annotation; Annotation type_node_annotation;
unsigned char type_node_is_var:1; unsigned char type_node_is_var:1;
# ifdef CLEAN2
TypeVarList type_for_all_vars;
# endif
}; };
#define type_node_symbol type_node_contents.contents_symbol #define type_node_symbol type_node_contents.contents_symbol
......
...@@ -429,6 +429,28 @@ static void PrintArguments (TypeArgs args, char separator, Bool brackets, Bool s ...@@ -429,6 +429,28 @@ static void PrintArguments (TypeArgs args, char separator, Bool brackets, Bool s
} /* PrintArguments */ } /* 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) 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 ...@@ -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)) (node -> type_node_symbol -> symb_kind == fun_type || node -> type_node_symbol -> symb_kind == apply_symb))
brackets = True; 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) switch (node -> type_node_symbol -> symb_kind)
{ {
case tuple_type: case tuple_type:
...@@ -546,6 +576,10 @@ static void PrintNode (TypeNode node, Bool brackets, Bool strict_context, Bool p ...@@ -546,6 +576,10 @@ static void PrintNode (TypeNode node, Bool brackets, Bool strict_context, Bool p
break; break;
} }
#ifdef CLEAN2
if (node -> type_for_all_vars != NULL)
FPutC (')', StdListTypes);
#endif
} /* PrintNode */ } /* PrintNode */
static void PrintAttributeEquations (UniVarEquations attr_equas) static void PrintAttributeEquations (UniVarEquations attr_equas)
......
...@@ -13,14 +13,23 @@ ...@@ -13,14 +13,23 @@
/EXPORT: BEDontCareDefinitionSymbol /EXPORT: BEDontCareDefinitionSymbol
/EXPORT: BEBoolSymbol /EXPORT: BEBoolSymbol
/EXPORT: BELiteralSymbol /EXPORT: BELiteralSymbol
/EXPORT: BEPredefineListConstructorSymbol
/EXPORT: BEPredefineListTypeSymbol
/EXPORT: BEAdjustStrictListConsInstance
/EXPORT: BEAdjustUnboxedListDeconsInstance
/EXPORT: BEAdjustOverloadedNilFunction
/EXPORT: BEOverloadedConsSymbol
/EXPORT: BEOverloadedPushNode
/EXPORT: BEPredefineConstructorSymbol /EXPORT: BEPredefineConstructorSymbol
/EXPORT: BEPredefineTypeSymbol /EXPORT: BEPredefineTypeSymbol
/EXPORT: BEBasicSymbol /EXPORT: BEBasicSymbol
/EXPORT: BEVarTypeNode /EXPORT: BEVarTypeNode
/EXPORT: BETypeVarListElem
/EXPORT: BETypeVars /EXPORT: BETypeVars
/EXPORT: BENoTypeVars /EXPORT: BENoTypeVars
/EXPORT: BENormalTypeNode /EXPORT: BENormalTypeNode
/EXPORT: BEAnnotateTypeNode /EXPORT: BEAnnotateTypeNode
/EXPORT: BEAddForAllTypeVariables
/EXPORT: BEAttributeTypeNode /EXPORT: BEAttributeTypeNode
/EXPORT: BEAttributeKind /EXPORT: BEAttributeKind
/EXPORT: BENoAttributeKinds /EXPORT: BENoAttributeKinds
...@@ -110,10 +119,3 @@ ...@@ -110,10 +119,3 @@
/EXPORT: BESetMainDclModuleN /EXPORT: BESetMainDclModuleN
/EXPORT: BEDeclareDynamicTypeSymbol /EXPORT: BEDeclareDynamicTypeSymbol
/EXPORT: BEDynamicTempTypeSymbol /EXPORT: BEDynamicTempTypeSymbol
/EXPORT: BEPredefineListTypeSymbol
/EXPORT: BEPredefineListConstructorSymbol
/EXPORT: BEAdjustStrictListConsInstance
/EXPORT: BEAdjustUnboxedListDeconsInstance
/EXPORT: BEAdjustOverloadedNilFunction
/EXPORT: BEOverloadedConsSymbol
/EXPORT: BEOverloadedPushNode
...@@ -14,7 +14,7 @@ ...@@ -14,7 +14,7 @@
# define kFileFlags VS_FF_DEBUG | VS_FF_PRERELEASE # define kFileFlags VS_FF_DEBUG | VS_FF_PRERELEASE
# define kFileFlagsMask 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 VS_VERSION_INFO VERSIONINFO
FILEVERSION kFileVersion FILEVERSION kFileVersion
...@@ -37,7 +37,7 @@ BEGIN ...@@ -37,7 +37,7 @@ BEGIN
VALUE "LegalTrademarks", "\0" VALUE "LegalTrademarks", "\0"
VALUE "OriginalFilename","backend.dll\0" VALUE "OriginalFilename","backend.dll\0"
VALUE "ProductName", "Clean System" VALUE "ProductName", "Clean System"
VALUE "ProductVersion", "2.0.d.8" VALUE "ProductVersion", "2.0.d.9"
VALUE "OLESelfRegister", "\0" VALUE "OLESelfRegister", "\0"
END END
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment