diff --git a/backend/Mac/Clean System Files/backend_library b/backend/Mac/Clean System Files/backend_library index d1e9810781455f30755af2ca753ea422406db147..0d462dabfe055c43ad856b7672950eccca2e8e6c 100644 --- a/backend/Mac/Clean System Files/backend_library +++ b/backend/Mac/Clean System Files/backend_library @@ -68,10 +68,9 @@ BEDefineRuleType BEAdjustArrayFunction BENoRules BERules -BEFlatType -BEAlgebraicType -BERecordType -BEAbsType +BEDefineAlgebraicType +BEDefineRecordType +BEAbstractType BEConstructorList BENoConstructors BEDeclareField diff --git a/backend/Windows/Clean System Files/backend_library b/backend/Windows/Clean System Files/backend_library index f69c82fbf0f4b0deb11568f9e075aacca133b4f9..49796414eba674a3846c6a47ed28f7e5bda9b933 100644 --- a/backend/Windows/Clean System Files/backend_library +++ b/backend/Windows/Clean System Files/backend_library @@ -68,11 +68,10 @@ BEDefineRuleType BEAdjustArrayFunction BENoRules BERules -BEFlatType -BEAlgebraicType -BEExtendableAlgebraicType -BERecordType -BEAbsType +BEDefineAlgebraicType +BEDefineExtensibleAlgebraicType +BEDefineRecordType +BEAbstractType BEConstructorList BENoConstructors BEDeclareField diff --git a/backend/backend.dcl b/backend/backend.dcl index eb4a2f4a979ecb98696db75bb444d051e79d341a..faf405276662a6d59a087a7222f57afecd852c3f 100644 --- a/backend/backend.dcl +++ b/backend/backend.dcl @@ -11,7 +11,6 @@ definition module backend; :: BEArgP (:== CPtr); :: BERuleAltP (:== CPtr); :: BEImpRuleP (:== CPtr); -:: BEFlatTypeP (:== CPtr); :: BEConstructorListP (:== CPtr); :: BEFieldListP (:== CPtr); :: BENodeIdP (:== CPtr); @@ -170,16 +169,14 @@ BENoRules :: !BackEnd -> (!BEImpRuleP,!BackEnd); // BEImpRuleP BENoRules (); BERules :: !BEImpRuleP !BEImpRuleP !BackEnd -> (!BEImpRuleP,!BackEnd); // BEImpRuleP BERules (BEImpRuleP rule,BEImpRuleP rules); -BEFlatType :: !BESymbolP !BEAttribution !BackEnd -> (!BEFlatTypeP,!BackEnd); -// BEFlatTypeP BEFlatType (BESymbolP symbol,BEAttribution attribution); -BEAlgebraicType :: !BEFlatTypeP !BEConstructorListP !BackEnd -> BackEnd; -// void BEAlgebraicType (BEFlatTypeP lhs,BEConstructorListP constructors); -BEExtendableAlgebraicType :: !BEFlatTypeP !BEConstructorListP !BackEnd -> BackEnd; -// void BEExtendableAlgebraicType (BEFlatTypeP lhs,BEConstructorListP constructors); -BERecordType :: !Int !BEFlatTypeP !BETypeNodeP !Int !BEFieldListP !BackEnd -> BackEnd; -// void BERecordType (int moduleIndex,BEFlatTypeP lhs,BETypeNodeP constructorType,int is_boxed_record,BEFieldListP fields); -BEAbsType :: !BEFlatTypeP !BackEnd -> BackEnd; -// void BEAbsType (BEFlatTypeP lhs); +BEDefineAlgebraicType :: !BESymbolP !BEAttribution !BEConstructorListP !BackEnd -> BackEnd; +// void BEDefineAlgebraicType (BESymbolP symbol,BEAttribution attribution,BEConstructorListP constructors); +BEDefineExtensibleAlgebraicType :: !BESymbolP !BEAttribution !BEConstructorListP !BackEnd -> BackEnd; +// void BEDefineExtensibleAlgebraicType (BESymbolP symbol,BEAttribution attribution,BEConstructorListP constructors); +BEDefineRecordType :: !BESymbolP !BEAttribution !Int !Int !BETypeArgP !Int !BEFieldListP !BackEnd -> BackEnd; +// void BEDefineRecordType (BESymbolP symbol,BEAttribution attribution,int moduleIndex,int constructorIndex,BETypeArgP constructorArgs,int is_boxed_record,BEFieldListP fields); +BEAbstractType :: !BESymbolP !BackEnd -> BackEnd; +// void BEAbstractType (BESymbolP symbol); BEConstructorList :: !BETypeNodeP !BEConstructorListP !BackEnd -> (!BEConstructorListP,!BackEnd); // BEConstructorListP BEConstructorList (BETypeNodeP type,BEConstructorListP constructors); BENoConstructors :: !BackEnd -> (!BEConstructorListP,!BackEnd); diff --git a/backend/backend.icl b/backend/backend.icl index 4d78a9a08c676f4ffc6f322413a18289050486e8..d7023a3ffa88ea67b4bb786265a12adeec7749e5 100644 --- a/backend/backend.icl +++ b/backend/backend.icl @@ -11,7 +11,6 @@ implementation module backend; :: BEArgP :== CPtr; :: BERuleAltP :== CPtr; :: BEImpRuleP :== CPtr; -:: BEFlatTypeP :== CPtr; :: BEConstructorListP :== CPtr; :: BEFieldListP :== CPtr; :: BENodeIdP :== CPtr; @@ -455,35 +454,29 @@ BERules a0 a1 a2 = code { } // BEImpRuleP BERules (BEImpRuleP rule,BEImpRuleP rules); -BEFlatType :: !BESymbolP !BEAttribution !BackEnd -> (!BEFlatTypeP,!BackEnd); -BEFlatType a0 a1 a2 = code { - ccall BEFlatType "pI:p:p" +BEDefineAlgebraicType :: !BESymbolP !BEAttribution !BEConstructorListP !BackEnd -> BackEnd; +BEDefineAlgebraicType a0 a1 a2 a3 = code { + ccall BEDefineAlgebraicType "pIp:V:p" } -// BEFlatTypeP BEFlatType (BESymbolP symbol,BEAttribution attribution); +// void BEDefineAlgebraicType (BESymbolP symbol,BEAttribution attribution,BEConstructorListP constructors); -BEAlgebraicType :: !BEFlatTypeP !BEConstructorListP !BackEnd -> BackEnd; -BEAlgebraicType a0 a1 a2 = code { - ccall BEAlgebraicType "pp:V:p" +BEDefineExtensibleAlgebraicType :: !BESymbolP !BEAttribution !BEConstructorListP !BackEnd -> BackEnd; +BEDefineExtensibleAlgebraicType a0 a1 a2 a3 = code { + ccall BEDefineExtensibleAlgebraicType "pIp:V:p" } -// void BEAlgebraicType (BEFlatTypeP lhs,BEConstructorListP constructors); +// void BEDefineExtensibleAlgebraicType (BESymbolP symbol,BEAttribution attribution,BEConstructorListP constructors); -BEExtendableAlgebraicType :: !BEFlatTypeP !BEConstructorListP !BackEnd -> BackEnd; -BEExtendableAlgebraicType a0 a1 a2 = code { - ccall BEExtendableAlgebraicType "pp:V:p" +BEDefineRecordType :: !BESymbolP !BEAttribution !Int !Int !BETypeArgP !Int !BEFieldListP !BackEnd -> BackEnd; +BEDefineRecordType a0 a1 a2 a3 a4 a5 a6 a7 = code { + ccall BEDefineRecordType "pIIIpIp:V:p" } -// void BEExtendableAlgebraicType (BEFlatTypeP lhs,BEConstructorListP constructors); +// void BEDefineRecordType (BESymbolP symbol,BEAttribution attribution,int moduleIndex,int constructorIndex,BETypeArgP constructor_args,int is_boxed_record,BEFieldListP fields); -BERecordType :: !Int !BEFlatTypeP !BETypeNodeP !Int !BEFieldListP !BackEnd -> BackEnd; -BERecordType a0 a1 a2 a3 a4 a5 = code { - ccall BERecordType "IppIp:V:p" +BEAbstractType :: !BESymbolP !BackEnd -> BackEnd; +BEAbstractType a0 a1 = code { + ccall BEAbstractType "p:V:p" } -// void BERecordType (int moduleIndex,BEFlatTypeP lhs,BETypeNodeP constructorType,int is_boxed_record,BEFieldListP fields); - -BEAbsType :: !BEFlatTypeP !BackEnd -> BackEnd; -BEAbsType a0 a1 = code { - ccall BEAbsType "p:V:p" -} -// void BEAbsType (BEFlatTypeP lhs); +// void BEAbstractType (BESymbolP symbol); BEConstructorList :: !BETypeNodeP !BEConstructorListP !BackEnd -> (!BEConstructorListP,!BackEnd); BEConstructorList a0 a1 a2 = code { diff --git a/backend/backendconvert.icl b/backend/backendconvert.icl index 24829f8353663b4a00e3dc50dd6598c9ef1fd82d..e8d6fa6db25e1c5cd6ef845ec1c2e15c3a3a9e62 100644 --- a/backend/backendconvert.icl +++ b/backend/backendconvert.icl @@ -725,17 +725,18 @@ define_dictionary_types type_i class_i type_i_stop moduleIndex constructors sele = define_dictionary_types (type_i+1) (class_i+1) type_i_stop moduleIndex constructors selectors types class_defs member_defs type_var_heap bes = (type_var_heap,bes) -convertTypeLhs :: ModuleIndex Index TypeAttribute [ATypeVar] !*TypeVarHeap !*BackEndState -> (!BEFlatTypeP, !*TypeVarHeap,!*BackEndState) +convertTypeLhs :: ModuleIndex Index TypeAttribute [ATypeVar] !*TypeVarHeap !*BackEndState + -> (!BESymbolP,!BEAttribution, !*TypeVarHeap,!*BackEndState) convertTypeLhs moduleIndex typeIndex attribute args type_var_heap bes = convertTypeDefToFlatType (beTypeSymbol typeIndex moduleIndex) attribute args type_var_heap bes -convertTypeDefToFlatType :: (BEMonad BESymbolP) TypeAttribute [ATypeVar] !*TypeVarHeap !*BackEndState -> (!BEFlatTypeP, !*TypeVarHeap,!*BackEndState) +convertTypeDefToFlatType :: (BEMonad BESymbolP) TypeAttribute [ATypeVar] !*TypeVarHeap !*BackEndState + -> (!BESymbolP,!BEAttribution,!*TypeVarHeap,!*BackEndState) convertTypeDefToFlatType type_symbol_m attribute args type_var_heap bes # (a1,bes) = type_symbol_m bes (a2,bes) = convertAttribution attribute bes type_var_heap = numberLhsTypeVars args 0 type_var_heap - (flat_type_p,bes) = accBackEnd (BEFlatType a1 a2) bes - = (flat_type_p,type_var_heap,bes) + = (a1,a2,type_var_heap,bes) numberLhsTypeVars :: [ATypeVar] Int !*TypeVarHeap -> *TypeVarHeap numberLhsTypeVars [{atv_variable={tv_info_ptr}}:x] arg_n type_var_heap @@ -753,16 +754,16 @@ remove_TVI_TypeVarArgN_in_args [] type_var_heap defineType :: ModuleIndex {#ConsDef} {#SelectorDef} Index CheckedTypeDef !*TypeVarHeap !*BackEndState -> (!*TypeVarHeap,!*BackEndState) defineType moduleIndex constructors _ typeIndex {td_ident, td_attribute, td_args, td_rhs=AlgType constructorSymbols} type_var_heap be - # (flatType,type_var_heap,be) = convertTypeLhs moduleIndex typeIndex td_attribute td_args type_var_heap be + # (symbol_p,type_attribute,type_var_heap,be) = convertTypeLhs moduleIndex typeIndex td_attribute td_args type_var_heap be (constructors,type_var_heap,be) = convertConstructors typeIndex td_ident.id_name moduleIndex constructors constructorSymbols type_var_heap be - be = appBackEnd (BEAlgebraicType flatType constructors) be + be = appBackEnd (BEDefineAlgebraicType symbol_p type_attribute constructors) be type_var_heap = remove_TVI_TypeVarArgN_in_args td_args type_var_heap = (type_var_heap,be) defineType moduleIndex constructors selectors typeIndex {td_attribute, td_args, td_rhs=RecordType {rt_constructor, rt_fields, rt_is_boxed_record}, td_fun_index} type_var_heap be # constructorIndex = rt_constructor.ds_index constructorDef = constructors.[constructorIndex] - (flatType,type_var_heap,be) + (symbol_p,type_attribute,type_var_heap,be) = if (td_fun_index<>NoIndex) (convertTypeLhs moduleIndex typeIndex td_attribute td_args type_var_heap be) // define the record without marking, to prevent code generation for many unused generic dictionaries @@ -771,9 +772,7 @@ defineType moduleIndex constructors selectors typeIndex {td_attribute, td_args, = convertSelectors moduleIndex selectors rt_fields constructorDef.cons_type.st_args_strictness type_var_heap be (constructorType,be) = constructorTypeFunction constructorDef be (type_arg_p,type_var_heap,be) = convertTypeDefAnnotatedTypeArgs constructorType.st_args constructorType.st_args_strictness type_var_heap be - (symbol_p,be) = beConstructorSymbol moduleIndex constructorIndex be - (constructorTypeNode,be) = accBackEnd (BENormalTypeNode symbol_p type_arg_p) be - be = appBackEnd (BERecordType moduleIndex flatType constructorTypeNode (if rt_is_boxed_record 1 0) fields) be + be = appBackEnd (BEDefineRecordType symbol_p type_attribute moduleIndex constructorIndex type_arg_p (if rt_is_boxed_record 1 0) fields) be type_var_heap = remove_TVI_TypeVarArgN_in_args td_args type_var_heap = (type_var_heap,be) where @@ -784,28 +783,26 @@ defineType moduleIndex constructors selectors typeIndex {td_attribute, td_args, -> (expandedType,bes) _ -> (constructorDef.cons_type,bes) -defineType moduleIndex _ _ typeIndex {td_attribute, td_args, td_rhs=AbstractType _} type_var_heap be - # (flatType,type_var_heap,be) = convertTypeLhs moduleIndex typeIndex td_attribute td_args type_var_heap be - be = appBackEnd (BEAbsType flatType) be - type_var_heap = remove_TVI_TypeVarArgN_in_args td_args type_var_heap +defineType moduleIndex _ _ typeIndex {td_rhs=AbstractType _} type_var_heap be + # (symbol,be) = beTypeSymbol typeIndex moduleIndex be + be = appBackEnd (BEAbstractType symbol) be = (type_var_heap,be) -defineType moduleIndex _ _ typeIndex {td_attribute, td_args, td_rhs=AbstractSynType _ _} type_var_heap be - # (flatType,type_var_heap,be) = convertTypeLhs moduleIndex typeIndex td_attribute td_args type_var_heap be - be = appBackEnd (BEAbsType flatType) be - type_var_heap = remove_TVI_TypeVarArgN_in_args td_args type_var_heap +defineType moduleIndex _ _ typeIndex {td_rhs=AbstractSynType _ _} type_var_heap be + # (symbol,be) = beTypeSymbol typeIndex moduleIndex be + be = appBackEnd (BEAbstractType symbol) be = (type_var_heap,be) defineType moduleIndex constructors _ typeIndex {td_ident, td_attribute, td_args, td_rhs=ExtensibleAlgType constructorSymbols} type_var_heap be - # (flatType,type_var_heap,be) = convertTypeLhs moduleIndex typeIndex td_attribute td_args type_var_heap be + # (symbol_p,type_attribute,type_var_heap,be) = convertTypeLhs moduleIndex typeIndex td_attribute td_args type_var_heap be (constructors,type_var_heap,be) = convertConstructors typeIndex td_ident.id_name moduleIndex constructors constructorSymbols type_var_heap be - be = appBackEnd (BEExtendableAlgebraicType flatType constructors) be + be = appBackEnd (BEDefineExtensibleAlgebraicType symbol_p type_attribute constructors) be type_var_heap = remove_TVI_TypeVarArgN_in_args td_args type_var_heap = (type_var_heap,be) defineType moduleIndex constructors _ typeIndex {td_ident, td_attribute, td_args, td_rhs=AlgConses constructorSymbols _} type_var_heap be - # (flatType,type_var_heap,be) = convertTypeLhs moduleIndex typeIndex td_attribute td_args type_var_heap be + # (symbol_p,type_attribute,type_var_heap,be) = convertTypeLhs moduleIndex typeIndex td_attribute td_args type_var_heap be (constructors,type_var_heap,be) = convertConstructors typeIndex td_ident.id_name moduleIndex constructors constructorSymbols type_var_heap be - be = appBackEnd (BEExtendableAlgebraicType flatType constructors) be + be = appBackEnd (BEDefineExtensibleAlgebraicType symbol_p type_attribute constructors) be type_var_heap = remove_TVI_TypeVarArgN_in_args td_args type_var_heap = (type_var_heap,be) defineType _ _ _ _ _ type_var_heap be @@ -818,7 +815,7 @@ define_dictionary_type moduleIndex constructors selectors typeIndex {class_members} member_defs type_var_heap bes # constructorIndex = rt_constructor.ds_index constructorDef = constructors.[constructorIndex] - (flatType,type_var_heap,bes) + (symbol_p,type_attribute,type_var_heap,bes) = if (td_fun_index<>NoIndex) (convertTypeLhs moduleIndex typeIndex td_attribute td_args type_var_heap bes) // define the record without marking, to prevent code generation for many unused generic dictionaries @@ -827,9 +824,7 @@ define_dictionary_type moduleIndex constructors selectors typeIndex = convert_dictionary_selectors moduleIndex selectors rt_fields (size class_members) constructorDef.cons_type.st_args_strictness member_defs type_var_heap bes (constructorType,bes) = constructorTypeFunction constructorDef bes (type_arg_p,type_var_heap,bes) = convertTypeDefAnnotatedTypeArgs constructorType.st_args constructorType.st_args_strictness type_var_heap bes - (symbol_p,bes) = beConstructorSymbol moduleIndex constructorIndex bes - (constructorTypeNode,bes) = accBackEnd (BENormalTypeNode symbol_p type_arg_p) bes - bes = appBackEnd (BERecordType moduleIndex flatType constructorTypeNode (if rt_is_boxed_record 1 0) fields) bes + bes = appBackEnd (BEDefineRecordType symbol_p type_attribute moduleIndex constructorIndex type_arg_p (if rt_is_boxed_record 1 0) fields) bes type_var_heap = remove_TVI_TypeVarArgN_in_args td_args type_var_heap = (type_var_heap,bes) where @@ -965,6 +960,11 @@ declareDynamicTemp predefs (v2,be) = f2 be :== f v1 v2 be +@^&^ f f1 v2 f3 be + # (v1,be) = f1 be + (v3,be) = f3 be + :== f v1 v2 v3 be + predefineSymbols :: DclModule PredefinedSymbols -> BackEnder predefineSymbols {dcl_common} predefs = appBackEnd (BEDeclarePredefinedModule (size dcl_common.com_type_defs) (size dcl_common.com_cons_defs)) @@ -1037,7 +1037,6 @@ predefineSymbols {dcl_common} predefs constructors :: [(Int, Int, BESymbKind)] constructors = [(index, index-PD_Arity2TupleSymbol+2, BETupleSymb) \\ index <- [PD_Arity2TupleSymbol..PD_Arity32TupleSymbol]] - predefineConstructor (index, arity, symbolKind) // sanity check ... @@ -1051,11 +1050,10 @@ predefineSymbols {dcl_common} predefs type_be_f = @^^ BENormalTypeNode constructor_symbol_be_f BENoTypeArgs constructors_be_f = @^^ BEConstructorList type_be_f BENoConstructors type_symbol_be_f = BETypeSymbol predefs.[PD_UnitType].pds_def cPredefinedModuleIndex - flat_type_be_f = @^^ BEFlatType type_symbol_be_f (^= BENoUniAttr) = appBackEnd ( BEDeclareConstructor predefs.[PD_UnitConsSymbol].pds_def cPredefinedModuleIndex "_Unit" o` BEDeclareType predefs.[PD_UnitType].pds_def cPredefinedModuleIndex "_Unit" - o` @^^ BEAlgebraicType flat_type_be_f constructors_be_f) + o` @^&^ BEDefineAlgebraicType type_symbol_be_f BENoUniAttr constructors_be_f) bindSpecialIdents :: PredefinedSymbols NumberSet -> BackEnder bindSpecialIdents predefs usedModules diff --git a/backendC/CleanCompilerLib.mcp.exp b/backendC/CleanCompilerLib.mcp.exp index 45a05116e4a3b010fc6ae7a29889a9b3fdd38e0d..562c3020c200a351522fb69e044eb7d3b2f5f251 100644 --- a/backendC/CleanCompilerLib.mcp.exp +++ b/backendC/CleanCompilerLib.mcp.exp @@ -67,10 +67,9 @@ BEDefineRuleType BEAdjustArrayFunction BENoRules BERules -BEFlatType -BEAlgebraicType -BERecordType -BEAbsType +BEDefineAlgebraicType +BEDefineRecordType +BEAbstractType BEConstructorList BENoConstructors BEDeclareField diff --git a/backendC/CleanCompilerSources/backend.c b/backendC/CleanCompilerSources/backend.c index d7724761e5061ae9acd4fa4e4d645325b6e27a17..0458dfe575dad34950ff000ac984e1dbbdb808b9 100644 --- a/backendC/CleanCompilerSources/backend.c +++ b/backendC/CleanCompilerSources/backend.c @@ -984,13 +984,6 @@ BEConstructorSymbol (int constructorIndex, int moduleIndex) Assert ((unsigned int) constructorIndex < module->bem_nConstructors); constructorSymbol = module->bem_constructors [constructorIndex]; - /* RWS +++ hack for record constructors, remove this */ - if (constructorSymbol->symb_kind == erroneous_symb){ - /* store index in symb_arity until BERecordType is called, should be passed directly to BERecordType */ - constructorSymbol->symb_arity = constructorIndex; - return constructorSymbol; - } - Assert (constructorSymbol->symb_kind == definition || constructorSymbol->symb_kind == cons_symb || (moduleIndex == kPredefinedModuleIndex && constructorSymbol->symb_kind != erroneous_symb)); @@ -1952,7 +1945,7 @@ BEUpdateNode (BEArgP args) Assert (args->arg_next->arg_node->node_kind == SelectorNode); Assert (args->arg_next->arg_node->node_arity == BESelector); - recordSymbol = args->arg_next->arg_node->node_symbol->symb_def->sdef_type->type_lhs->ft_symbol; + recordSymbol = args->arg_next->arg_node->node_symbol->symb_def->sdef_type->type_symbol; node = ConvertAllocType (NodeS); @@ -2552,21 +2545,8 @@ BEDeclareType (int typeIndex, int moduleIndex, CleanString name) types [typeIndex]->symb_def = newSymbDef; } /* BEDeclareType */ -BEFlatTypeP -BEFlatType (BESymbolP symbol, BEAttribution attribution) -{ - FlatType flatType; - - flatType = ConvertAllocType (struct flat_type); - - flatType->ft_symbol = symbol; - flatType->ft_attribute = (AttributeKind) attribution;; - - return (flatType); -} /* BEFlatType */ - void -BEAlgebraicType (BEFlatTypeP lhs, BEConstructorListP constructors) +BEDefineAlgebraicType (BESymbolP symbol, BEAttribution attribution, BEConstructorListP constructors) { Types type; SymbDefP sdef; @@ -2574,7 +2554,8 @@ BEAlgebraicType (BEFlatTypeP lhs, BEConstructorListP constructors) type = ConvertAllocType (struct type); - type->type_lhs = lhs; + type->type_symbol = symbol; + type->type_attribute = attribution; type->type_constructors = constructors; nConstructors = 0; @@ -2594,47 +2575,53 @@ BEAlgebraicType (BEFlatTypeP lhs, BEConstructorListP constructors) type->type_nr_of_constructors = nConstructors; - Assert (type->type_lhs->ft_symbol->symb_kind == definition); - sdef = type->type_lhs->ft_symbol->symb_def; + Assert (symbol->symb_kind == definition); + sdef = symbol->symb_def; Assert (sdef->sdef_kind == NEWDEFINITION); sdef->sdef_kind = TYPE; sdef->sdef_type = type; -} /* BEAlgebraicType */ +} -void BEExtendableAlgebraicType (BEFlatTypeP lhs, BEConstructorListP constructors) +void BEDefineExtensibleAlgebraicType (BESymbolP symbol, BEAttribution attribution, BEConstructorListP constructors) { Types type; SymbDefP sdef; type = ConvertAllocType (struct type); - type->type_lhs = lhs; + type->type_symbol = symbol; + type->type_attribute = attribution; type->type_constructors = constructors; type->type_nr_of_constructors = 0; for (; constructors!=NULL; constructors=constructors->cl_next) constructors->cl_constructor->type_node_symbol->symb_def->sdef_type = type; - sdef = type->type_lhs->ft_symbol->symb_def; + sdef = symbol->symb_def; sdef->sdef_kind = TYPE; sdef->sdef_type = type; } -void -BERecordType (int moduleIndex, BEFlatTypeP lhs, BETypeNodeP constructorType, int is_boxed_record, BEFieldListP fields) +void BEDefineRecordType + (BESymbolP symbol, BEAttribution attribution, int moduleIndex, int constructorIndex, BETypeArgP constructor_args, int is_boxed_record, BEFieldListP fields) { + struct symbol *constructor_symbol_p; + BETypeNodeP constructorType; int nFields; Types type; SymbDefP sdef; BEConstructorListP constructor; - type = ConvertAllocType (struct type); + constructor_symbol_p = gBEState.be_modules [moduleIndex].bem_constructors [constructorIndex]; - constructor = ConvertAllocType (struct constructor_list); + constructorType = BENormalTypeNode (constructor_symbol_p,constructor_args); + constructor = ConvertAllocType (struct constructor_list); constructor->cl_next = NULL; constructor->cl_constructor = constructorType; - type->type_lhs = lhs; + type = ConvertAllocType (struct type); + type->type_symbol = symbol; + type->type_attribute = attribution; type->type_constructors = constructor; type->type_fields = fields; @@ -2653,8 +2640,8 @@ BERecordType (int moduleIndex, BEFlatTypeP lhs, BETypeNodeP constructorType, int type->type_nr_of_constructors = 0; - Assert (type->type_lhs->ft_symbol->symb_kind == definition); - sdef = type->type_lhs->ft_symbol->symb_def; + Assert (symbol->symb_kind == definition); + sdef = symbol->symb_def; Assert (sdef->sdef_kind == NEWDEFINITION); sdef->sdef_checkstatus = TypeChecked; sdef->sdef_kind = RECORDTYPE; @@ -2663,35 +2650,22 @@ BERecordType (int moduleIndex, BEFlatTypeP lhs, BETypeNodeP constructorType, int sdef->sdef_boxed_record = is_boxed_record; - { - int constructor_index; - struct symbol *constructor_symbol_p; - BEModuleP module; - - constructor_symbol_p = constructorType->type_node_symbol; - /* BEConstructorSymbol has stored the index in symb_arity, should be passed directly to BERecordType */ - constructor_index = constructor_symbol_p->symb_arity; - constructor_symbol_p->symb_arity = 0; + constructor_symbol_p->symb_arity = 0; - module = &gBEState.be_modules [moduleIndex]; - - Assert (module->bem_constructors[constructor_index]==constructor_symbol_p); - module->bem_constructors[constructor_index] = type->type_lhs->ft_symbol; - } -} /* BERecordType */ + gBEState.be_modules [moduleIndex].bem_constructors [constructorIndex] = symbol; +} void -BEAbsType (BEFlatTypeP lhs) +BEAbstractType (BESymbolP symbol_p) { - SymbDefP sdef; + SymbDefP sdef; - Assert (lhs->ft_symbol->symb_kind == definition); - sdef = lhs->ft_symbol->symb_def; + Assert (symbol_p->symb_kind == definition); + sdef = symbol_p->symb_def; Assert (sdef->sdef_kind == NEWDEFINITION); sdef->sdef_checkstatus = TypeChecked; sdef->sdef_kind = ABSTYPE; - -} /* BEAbsType */ +} BEConstructorListP BENoConstructors (void) diff --git a/backendC/CleanCompilerSources/backend.h b/backendC/CleanCompilerSources/backend.h index 03f56b501854b48add3dd3e216eae508dceb4f56..39a5833600c37892428664b6fc72ca142388fb3b 100644 --- a/backendC/CleanCompilerSources/backend.h +++ b/backendC/CleanCompilerSources/backend.h @@ -54,9 +54,6 @@ Clean (:: BERuleAltP (:== CPtr)) typedef struct imp_rule *BEImpRuleP; Clean (:: BEImpRuleP (:== CPtr)) -typedef struct flat_type *BEFlatTypeP; -Clean (:: BEFlatTypeP (:== CPtr)) - typedef struct constructor_list *BEConstructorListP; Clean (:: BEConstructorListP (:== CPtr)) @@ -376,20 +373,17 @@ Clean (BENoRules :: BackEnd -> (BEImpRuleP, BackEnd)) BEImpRuleP BERules (BEImpRuleP rule, BEImpRuleP rules); Clean (BERules :: BEImpRuleP BEImpRuleP BackEnd -> (BEImpRuleP, BackEnd)) -BEFlatTypeP BEFlatType (BESymbolP symbol, BEAttribution attribution); -Clean (BEFlatType :: BESymbolP BEAttribution BackEnd -> (BEFlatTypeP, BackEnd)) - -void BEAlgebraicType (BEFlatTypeP lhs, BEConstructorListP constructors); -Clean (BEAlgebraicType:: BEFlatTypeP BEConstructorListP BackEnd -> BackEnd) +void BEDefineAlgebraicType (BESymbolP symbol, BEAttribution attribution, BEConstructorListP constructors); +Clean (BEDefineAlgebraicType:: BESymbolP BEAttribution BEConstructorListP BackEnd -> BackEnd) -void BEExtendableAlgebraicType (BEFlatTypeP lhs, BEConstructorListP constructors); -Clean (BEExtendableAlgebraicType:: BEFlatTypeP BEConstructorListP BackEnd -> BackEnd) +void BEDefineExtensibleAlgebraicType (BESymbolP symbol, BEAttribution attribution, BEConstructorListP constructors); +Clean (BEDefineExtensibleAlgebraicType:: BESymbolP BEAttribution BEConstructorListP BackEnd -> BackEnd) -void BERecordType (int moduleIndex, BEFlatTypeP lhs, BETypeNodeP constructorType, int is_boxed_record, BEFieldListP fields); -Clean (BERecordType :: Int BEFlatTypeP BETypeNodeP Int BEFieldListP BackEnd -> BackEnd) +void BEDefineRecordType (BESymbolP symbol, BEAttribution attribution, int moduleIndex, int constructorIndex, BETypeArgP constructor_args, int is_boxed_record, BEFieldListP fields); +Clean (BEDefineRecordType :: BESymbolP BEAttribution Int Int BETypeArgP Int BEFieldListP BackEnd -> BackEnd) -void BEAbsType (BEFlatTypeP lhs); -Clean (BEAbsType :: BEFlatTypeP BackEnd -> BackEnd) +void BEAbstractType (BESymbolP symbol); +Clean (BEAbstractType :: BESymbolP BackEnd -> BackEnd) BEConstructorListP BENoConstructors (void); Clean (BENoConstructors:: BackEnd -> (BEConstructorListP, BackEnd)) diff --git a/backendC/CleanCompilerSources/codegen1.c b/backendC/CleanCompilerSources/codegen1.c index 5bbf24f66543627228ccee6fe5dc98eb6cdf34ed..5dfa903f01b412800f94862c5234fbb6655a8201 100644 --- a/backendC/CleanCompilerSources/codegen1.c +++ b/backendC/CleanCompilerSources/codegen1.c @@ -996,7 +996,7 @@ static void GenLazyFieldSelectorEntry (SymbDef field_def,StateS recstate,int tot update_root_node = ! ExpectsResultNode (offfieldstate); - record_name=field_def->sdef_type->type_lhs->ft_symbol->symb_def->sdef_ident->ident_name; + record_name=field_def->sdef_type->type_symbol->symb_def->sdef_ident->ident_name; if (field_def->sdef_calledwithrootnode){ ealab = CurrentAltLabel; @@ -2782,7 +2782,7 @@ SymbDef create_select_function (Symbol selector_symbol,int selector_kind) select_function_symbol=NewSymbol (definition); select_function_symbol->symb_def=select_function_sdef; - record_state_p=&selector_sdef->sdef_type->type_lhs->ft_symbol->symb_def->sdef_record_state; + record_state_p=&selector_sdef->sdef_type->type_symbol->symb_def->sdef_record_state; fieldnr = selector_sdef->sdef_sel_field_number; record_node_id=NewNodeId (NULL); diff --git a/backendC/CleanCompilerSources/codegen2.c b/backendC/CleanCompilerSources/codegen2.c index 9290b89d574e79c4e24efdfd37c8ef505e4c2512..30b22a9d418a5d92b74d212248aa27f90497328c 100644 --- a/backendC/CleanCompilerSources/codegen2.c +++ b/backendC/CleanCompilerSources/codegen2.c @@ -977,7 +977,7 @@ void BuildOrFillLazyFieldSelector (SymbDef selector_sdef,StateKind result_state_ ConvertSymbolToDandNLabel (&dsellab,&nsellab,selector_sdef); - record_sdef=selector_sdef->sdef_type->type_lhs->ft_symbol->symb_def; + record_sdef=selector_sdef->sdef_type->type_symbol->symb_def; record_name=record_sdef->sdef_ident->ident_name; field_result_state_p=&record_sdef->sdef_record_state.state_record_arguments [selector_sdef->sdef_sel_field_number]; @@ -1251,7 +1251,7 @@ static struct state *FillOrReduceFieldSelection_of_selection_in_single_field_unb SymbDef record_sdef; StateP record_state_p; - record_sdef=seldef->sdef_type->type_lhs->ft_symbol->symb_def; + record_sdef=seldef->sdef_type->type_symbol->symb_def; record_state_p=&record_sdef->sdef_record_state; if (record_state_p->state_type==RecordState && record_state_p->state_arity==1 && !record_sdef->sdef_boxed_record){ int asize,bsize; @@ -1283,7 +1283,7 @@ static struct state *FillOrReduceFieldSelection_of_selection_in_single_field_unb int asize,bsize,apos,bpos,tot_asize,tot_bsize; StateP record_state_p; - record_state_p=&seldef->sdef_type->type_lhs->ft_symbol->symb_def->sdef_record_state; + record_state_p=&seldef->sdef_type->type_symbol->symb_def->sdef_record_state; if (record_state_p->state_type!=RecordState) error_in_function ("FillOrReduceFieldSelection_of_selection_in_single_field_unboxable_record"); @@ -1303,7 +1303,7 @@ static struct state *FillOrReduceFieldSelection_of_selection_in_single_field_unb int asize,bsize,apos,bpos,tot_asize,tot_bsize; StateP record_state_p; - record_state_p=&seldef->sdef_type->type_lhs->ft_symbol->symb_def->sdef_record_state; + record_state_p=&seldef->sdef_type->type_symbol->symb_def->sdef_record_state; Build (arg_node,asp_p,bsp_p,code_gen_node_ids_p); @@ -1353,7 +1353,7 @@ static struct state *FillOrReduceFieldSelection_of_selection_in_single_field_unb StateP record_state_p; recindex = arg_node_id->nid_a_index; - record_sdef=seldef->sdef_type->type_lhs->ft_symbol->symb_def; + record_sdef=seldef->sdef_type->type_symbol->symb_def; record_state_p=&record_sdef->sdef_record_state; if (record_state_p->state_type!=RecordState) @@ -1412,7 +1412,7 @@ static struct state *FillOrReduceFieldSelection_of_selection_in_single_field_unb recstate.state_kind = StrictOnA; } - record_sdef=seldef->sdef_type->type_lhs->ft_symbol->symb_def; + record_sdef=seldef->sdef_type->type_symbol->symb_def; DetermineFieldSizeAndPositionAndRecordSize (fieldnr,&a_size,&b_size,&apos, &bpos,&tot_asize,&tot_bsize,&record_sdef->sdef_record_state); # if BOXED_RECORDS if (record_sdef->sdef_boxed_record && (arg_node_id->nid_mark2 & (NID_RECORD_USED_BY_UPDATE | NID_RECORD_USED_BY_NON_SELECTOR_OR_UPDATES))==NID_RECORD_USED_BY_UPDATE @@ -1486,7 +1486,7 @@ static void FillOrReduceFieldSelection (Node node,SymbDef seldef,int *asp_p,int BuildArg (arg,asp_p,bsp_p,code_gen_node_ids_p); - record_state_p=&seldef->sdef_type->type_lhs->ft_symbol->symb_def->sdef_record_state; + record_state_p=&seldef->sdef_type->type_symbol->symb_def->sdef_record_state; #if BOXED_RECORDS if (node->node_arityarg_state.state_type==SimpleState : @@ -1526,7 +1526,7 @@ static void FillOrReduceFieldSelection (Node node,SymbDef seldef,int *asp_p,int arg_node_id=arg_node->node_node_id; - record_state_p=&seldef->sdef_type->type_lhs->ft_symbol->symb_def->sdef_record_state; + record_state_p=&seldef->sdef_type->type_symbol->symb_def->sdef_record_state; tuple_state.state_type=TupleState; tuple_state.state_arity=2; @@ -1575,7 +1575,7 @@ static void FillOrReduceFieldSelection (Node node,SymbDef seldef,int *asp_p,int SymbDef record_sdef; StateP record_state_p; - record_sdef=seldef->sdef_type->type_lhs->ft_symbol->symb_def; + record_sdef=seldef->sdef_type->type_symbol->symb_def; record_state_p=&record_sdef->sdef_record_state; if (record_state_p->state_type==RecordState && record_state_p->state_arity==1 && !record_sdef->sdef_boxed_record){ int asize,bsize; @@ -1613,7 +1613,7 @@ static void FillOrReduceFieldSelection (Node node,SymbDef seldef,int *asp_p,int int asize,bsize,apos,bpos,tot_asize,tot_bsize; StateP record_state_p,field_state_p; - record_state_p=&seldef->sdef_type->type_lhs->ft_symbol->symb_def->sdef_record_state; + record_state_p=&seldef->sdef_type->type_symbol->symb_def->sdef_record_state; if (record_state_p->state_type!=RecordState) error_in_function ("FillOrReduceFieldSelection"); @@ -1638,7 +1638,7 @@ static void FillOrReduceFieldSelection (Node node,SymbDef seldef,int *asp_p,int int asize,bsize,apos,bpos,tot_asize,tot_bsize; StateP record_state_p; #if 1 - record_state_p=&seldef->sdef_type->type_lhs->ft_symbol->symb_def->sdef_record_state; + record_state_p=&seldef->sdef_type->type_symbol->symb_def->sdef_record_state; #else record_state_p=&arg->arg_state; #endif @@ -1706,7 +1706,7 @@ static void FillOrReduceFieldSelection (Node node,SymbDef seldef,int *asp_p,int StateP record_state_p,field_state_p; recindex = arg_node_id->nid_a_index; - record_sdef=seldef->sdef_type->type_lhs->ft_symbol->symb_def; + record_sdef=seldef->sdef_type->type_symbol->symb_def; record_state_p=&record_sdef->sdef_record_state; if (record_state_p->state_type!=RecordState) @@ -1770,7 +1770,7 @@ static void FillOrReduceFieldSelection (Node node,SymbDef seldef,int *asp_p,int recstate.state_kind = StrictOnA; } - record_sdef=seldef->sdef_type->type_lhs->ft_symbol->symb_def; + record_sdef=seldef->sdef_type->type_symbol->symb_def; DetermineFieldSizeAndPositionAndRecordSize (fieldnr,&a_size,&b_size,&apos, &bpos,&tot_asize,&tot_bsize,&record_sdef->sdef_record_state); # if BOXED_RECORDS if (record_sdef->sdef_boxed_record && (arg_node_id->nid_mark2 & (NID_RECORD_USED_BY_UPDATE | NID_RECORD_USED_BY_NON_SELECTOR_OR_UPDATES))==NID_RECORD_USED_BY_UPDATE diff --git a/backendC/CleanCompilerSources/codegen3.c b/backendC/CleanCompilerSources/codegen3.c index 67ac33238494700b9564f375b8c35f594f46669f..31d77317030245af382bcb9504d1f66b9ac2ee05 100644 --- a/backendC/CleanCompilerSources/codegen3.c +++ b/backendC/CleanCompilerSources/codegen3.c @@ -1167,7 +1167,7 @@ static void CodeRootFieldSelector (Node root,NodeId rootid,int asp,int bsp,CodeG offstate = arg_node->node_state; Build (arg_node,&asp,&bsp,code_gen_node_ids_p); - record_state_p=&seldef->sdef_type->type_lhs->ft_symbol->symb_def->sdef_record_state; + record_state_p=&seldef->sdef_type->type_symbol->symb_def->sdef_record_state; if (root->node_arity>=SELECTOR_U){ int record_a_size,record_b_size,asize,bsize,aindex,bindex,offstate_a_size,offstate_b_size; @@ -1288,7 +1288,7 @@ static void CodeRootFieldSelector (Node root,NodeId rootid,int asp,int bsp,CodeG int a_size,b_size; StateP record_state_p; - record_state_p=&seldef->sdef_type->type_lhs->ft_symbol->symb_def->sdef_record_state; + record_state_p=&seldef->sdef_type->type_symbol->symb_def->sdef_record_state; if (root->node_arity>=SELECTOR_U){ int asize,bsize,aindex,bindex,offered_a_size,offered_b_size; diff --git a/backendC/CleanCompilerSources/instructions.c b/backendC/CleanCompilerSources/instructions.c index 151ddf14bf0ba0fca2ef678824441eb8adf55ab1..9239960007cc604faa288c8dfa96e27a5585de12 100644 --- a/backendC/CleanCompilerSources/instructions.c +++ b/backendC/CleanCompilerSources/instructions.c @@ -2451,7 +2451,7 @@ void GenImport (SymbDef sdef) if (sdef->sdef_mark & SDEF_USED_LAZILY_MASK){ char *record_name; - record_name = sdef->sdef_type->type_lhs->ft_symbol->symb_def->sdef_ident->ident_name; + record_name = sdef->sdef_type->type_symbol->symb_def->sdef_ident->ident_name; put_directive_b (impdesc); FPrintF (OutFile, "e_%s_" D_PREFIX "%s.%s",sdef->sdef_module,record_name,name); @@ -2544,7 +2544,7 @@ void GenExportFieldSelector (SymbDef sdef) name = sdef->sdef_ident->ident_name; - record_name=sdef->sdef_type->type_lhs->ft_symbol->symb_def->sdef_ident->ident_name; + record_name=sdef->sdef_type->type_symbol->symb_def->sdef_ident->ident_name; put_directive_ (Dexport); FPrintF (OutFile,"e_%s_" D_PREFIX "%s.%s",CurrentModule,record_name,name); @@ -3335,7 +3335,7 @@ void GenFieldSelectorDescriptor (SymbDef sdef,StateS field_state,int a_pos,int b gc_updates_selector=IsSimpleState (field_state); name = sdef->sdef_ident->ident_name; - record_name=sdef->sdef_type->type_lhs->ft_symbol->symb_def->sdef_ident->ident_name; + record_name=sdef->sdef_type->type_symbol->symb_def->sdef_ident->ident_name; put_directive_ (gc_updates_selector ? Ddescs : Ddesc); if (sdef->sdef_exported){ @@ -3387,7 +3387,7 @@ void GenFieldSelectorDescriptor (SymbDef sdef,int has_gc_apply_entry) name = sdef->sdef_ident->ident_name; arity = (sdef->sdef_kind == RECORDTYPE) ? sdef->sdef_cons_arity : sdef->sdef_arity; - record_name=sdef->sdef_type->type_lhs->ft_symbol->symb_def->sdef_ident->ident_name; + record_name=sdef->sdef_type->type_symbol->symb_def->sdef_ident->ident_name; put_directive_ (Ddesc); if (sdef->sdef_exported){ diff --git a/backendC/CleanCompilerSources/optimisations.c b/backendC/CleanCompilerSources/optimisations.c index 5254be9bdc6b440f1bc86beb03dd4b11251dd3db..a9192cc850d3d95701101eb13a651dce4c49cbd9 100644 --- a/backendC/CleanCompilerSources/optimisations.c +++ b/backendC/CleanCompilerSources/optimisations.c @@ -1559,7 +1559,7 @@ static char *create_arguments_for_local_function (NodeP node_p,ArgS ***arg_h,Arg *rhs_arg_p=new_arg; rhs_arg_p=&new_arg->arg_next; - selector_arg_state_p=&arg_node->node_symbol->symb_def->sdef_type->type_lhs->ft_symbol->symb_def->sdef_record_state; + selector_arg_state_p=&arg_node->node_symbol->symb_def->sdef_type->type_symbol->symb_def->sdef_record_state; if (arg_node->node_arity>=SELECTOR_L) selector_arg_state_p=selector_l_or_n_state_p (&tuple_state,tuple_arg_states,selector_arg_state_p); @@ -2919,7 +2919,7 @@ static void optimise_node_in_then_or_else (NodeP node,FreeUniqueNodeIdsS **f_nod StateP selector_arg_state_p; StateS tuple_state,tuple_arg_states[2]; - selector_arg_state_p=&node->node_symbol->symb_def->sdef_type->type_lhs->ft_symbol->symb_def->sdef_record_state; + selector_arg_state_p=&node->node_symbol->symb_def->sdef_type->type_symbol->symb_def->sdef_record_state; if (node->node_arity>=SELECTOR_L) selector_arg_state_p=selector_l_or_n_state_p (&tuple_state,tuple_arg_states,selector_arg_state_p); @@ -3194,7 +3194,7 @@ static void optimise_node (NodeP node,FreeUniqueNodeIdsS **f_node_ids_l) StateP selector_arg_state_p; StateS tuple_state,tuple_arg_states[2]; - selector_arg_state_p=&node->node_symbol->symb_def->sdef_type->type_lhs->ft_symbol->symb_def->sdef_record_state; + selector_arg_state_p=&node->node_symbol->symb_def->sdef_type->type_symbol->symb_def->sdef_record_state; if (node->node_arity>=SELECTOR_L) selector_arg_state_p=selector_l_or_n_state_p (&tuple_state,tuple_arg_states,selector_arg_state_p); diff --git a/backendC/CleanCompilerSources/statesgen.c b/backendC/CleanCompilerSources/statesgen.c index ec52d2535e3e336d6ebad42fe76e1e5422efed3e..f81e39361836c550eb3b657ebca1eee8ba0217b4 100644 --- a/backendC/CleanCompilerSources/statesgen.c +++ b/backendC/CleanCompilerSources/statesgen.c @@ -247,7 +247,7 @@ void ConvertTypeToState (TypeNode type,StateS *state_p,StateKind kind) #ifdef REUSE_UNIQUE_NODES if (type->type_node_attribute==UniqueAttr || (symbol->symb_kind==definition && (symbol->symb_def->sdef_kind==TYPE || symbol->symb_def->sdef_kind==RECORDTYPE) && - symbol->symb_def->sdef_type->type_lhs->ft_attribute==UniqueAttr)) + symbol->symb_def->sdef_type->type_attribute==UniqueAttr)) { state_p->state_mark |= STATE_UNIQUE_MASK; } @@ -333,16 +333,14 @@ static void GenRecordState (SymbDef sdef) States fieldstates; int i,oldline; Symbol oldsymbol; - FlatType lhs; int strict_record; rectype = sdef->sdef_type; - lhs = rectype->type_lhs; oldline = CurrentLine; oldsymbol = CurrentSymbol; - CurrentSymbol = lhs->ft_symbol; + CurrentSymbol = rectype->type_symbol; CurrentLine = 0 /*rectype->type_line*/; sdef->sdef_checkstatus = ConvertingToState; /* to detect cyclic strict field dependencies */ @@ -412,7 +410,7 @@ static void GenResultStatesOfLazyFields (SymbDef sdef) rectype = sdef->sdef_type; - CurrentSymbol = rectype->type_lhs->ft_symbol; + CurrentSymbol = rectype->type_symbol; CurrentLine = 0 /*rectype->type_line*/; for (i=0, fields = rectype->type_fields; fields; i++, fields = fields->fl_next){ @@ -435,7 +433,7 @@ static void ChangeFieldRecordStateForStrictAbsTypeFields (SymbDef icl_sdef,SymbD icl_type = icl_sdef->sdef_type; - CurrentSymbol = icl_type->type_lhs->ft_symbol; + CurrentSymbol = icl_type->type_symbol; CurrentLine = 0 /*icl_type->type_line*/; icl_fieldstate_p=icl_sdef->sdef_record_state.state_record_arguments; @@ -843,7 +841,7 @@ static void GenStatesInLhsNode (Node node,StateP arg_state_p) # ifdef REUSE_UNIQUE_NODES AttributeKind lhs_type_attribute; - lhs_type_attribute=sdef->sdef_type->type_lhs->ft_attribute; + lhs_type_attribute=sdef->sdef_type->type_attribute; if (lhs_type_attribute==UniqueAttr) arg_state_p->state_mark |= STATE_UNIQUE_MASK; @@ -909,7 +907,7 @@ static void GenStatesInLhsNode (Node node,StateP arg_state_p) # ifdef REUSE_UNIQUE_NODES AttributeKind lhs_type_attribute; - lhs_type_attribute=sdef->sdef_type->type_lhs->ft_attribute; + lhs_type_attribute=sdef->sdef_type->type_attribute; if (lhs_type_attribute==UniqueAttr) arg_state_p->state_mark |= STATE_UNIQUE_MASK; @@ -2368,9 +2366,9 @@ static Bool NodeInAStrictContext (Node node,StateS demanded_state,int local_scop #endif ssymb = node->node_symbol->symb_def; - unboxed_record_state_p=&ssymb->sdef_type->type_lhs->ft_symbol->symb_def->sdef_record_state; + unboxed_record_state_p=&ssymb->sdef_type->type_symbol->symb_def->sdef_record_state; #if BOXED_RECORDS - if (ssymb->sdef_type->type_lhs->ft_symbol->symb_def->sdef_boxed_record){ + if (ssymb->sdef_type->type_symbol->symb_def->sdef_boxed_record){ SetUnaryState (&boxed_record_state,StrictOnA,RecordObj); record_state_p = &boxed_record_state; } else @@ -2847,7 +2845,7 @@ static void DetermineStatesOfNodeAndDefs (Node root_node,NodeDefs node_defs,Stat # ifdef REUSE_UNIQUE_NODES AttributeKind lhs_type_attribute; - lhs_type_attribute=sdef->sdef_type->type_lhs->ft_attribute; + lhs_type_attribute=sdef->sdef_type->type_attribute; if (lhs_type_attribute==UniqueAttr && (node_id_state_p->state_mark & STATE_UNIQUE_MASK)==0){ StateP unique_state_p; @@ -2902,7 +2900,7 @@ static void DetermineStatesOfNodeAndDefs (Node root_node,NodeDefs node_defs,Stat # ifdef REUSE_UNIQUE_NODES AttributeKind lhs_type_attribute; - lhs_type_attribute=sdef->sdef_type->type_lhs->ft_attribute; + lhs_type_attribute=sdef->sdef_type->type_attribute; if (lhs_type_attribute==UniqueAttr && (node_id_state_p->state_mark & STATE_UNIQUE_MASK)==0){ StateP unique_state_p; diff --git a/backendC/CleanCompilerSources/syntax_tree_types.h b/backendC/CleanCompilerSources/syntax_tree_types.h index 3c3545ad763a3563866a4192cecd1e3edcd6c5d6..16936f0c960fa1057db50b5f4b36b9195e54d1c8 100644 --- a/backendC/CleanCompilerSources/syntax_tree_types.h +++ b/backendC/CleanCompilerSources/syntax_tree_types.h @@ -16,12 +16,6 @@ typedef struct type_alt * TypeAlts; typedef struct type_var *TypeVar; -typedef struct flat_type -{ - Symbol ft_symbol; - AttributeKind ft_attribute; -} * FlatType; - typedef struct field_list { Symbol fl_symbol; @@ -40,13 +34,13 @@ typedef struct constructor_list typedef struct type { - FlatType type_lhs; + Symbol type_symbol; + AttributeKind type_attribute; ConstructorList type_constructors; int type_nr_of_constructors; /* 0 for records */ } * Types; #define type_fields type_constructors -> cl_fields -#define type_symbol type_lhs -> ft_symbol struct rule_type { TypeAlts rule_type_rule; diff --git a/backendC/backend.def b/backendC/backend.def index 49debf8d32ad727b9eae1c204b9540ddc5129f73..e2979638b18e6295fe3628aa0996f93d62304295 100644 --- a/backendC/backend.def +++ b/backendC/backend.def @@ -70,11 +70,10 @@ EXPORTS BEAdjustArrayFunction BENoRules BERules - BEFlatType - BEAlgebraicType - BEExtendableAlgebraicType - BERecordType - BEAbsType + BEDefineAlgebraicType + BEDefineExtensibleAlgebraicType + BEDefineRecordType + BEAbstractType BEConstructorList BENoConstructors BEDeclareField diff --git a/backendC/backend.link b/backendC/backend.link index b8fd4bdfc511fea1e6f68b88775d53b28b8d612a..fdd4bb23a441d59bbaec5881b73cbd53406c3e38 100644 --- a/backendC/backend.link +++ b/backendC/backend.link @@ -69,11 +69,10 @@ /EXPORT: BEAdjustArrayFunction /EXPORT: BENoRules /EXPORT: BERules -/EXPORT: BEFlatType -/EXPORT: BEAlgebraicType -/EXPORT: BEExtendableAlgebraicType -/EXPORT: BERecordType -/EXPORT: BEAbsType +/EXPORT: BEDefineAlgebraicType +/EXPORT: BEDefineExtensibleAlgebraicType +/EXPORT: BEDefineRecordType +/EXPORT: BEAbstractType /EXPORT: BEConstructorList /EXPORT: BENoConstructors /EXPORT: BEDeclareField diff --git a/backendC/backend.link64 b/backendC/backend.link64 index f56c6fbae7e6475d00ea28c797820833e54917cb..b7e0dfa8ce0b5c83d734a26223a9eaffdf9cf5f8 100644 --- a/backendC/backend.link64 +++ b/backendC/backend.link64 @@ -67,11 +67,10 @@ /EXPORT:BEAdjustArrayFunction /EXPORT:BENoRules /EXPORT:BERules -/EXPORT:BEFlatType -/EXPORT:BEAlgebraicType -/EXPORT:BEExtendableAlgebraicType -/EXPORT:BERecordType -/EXPORT:BEAbsType +/EXPORT:BEDefineAlgebraicType +/EXPORT:BEDefineExtensibleAlgebraicType +/EXPORT:BEDefineRecordType +/EXPORT:BEAbstractType /EXPORT:BEConstructorList /EXPORT:BENoConstructors /EXPORT:BEDeclareField