From 19fdc6be18ff9706d59d1e1e87698832eec52442 Mon Sep 17 00:00:00 2001 From: "johnvg@science.ru.nl" Date: Fri, 3 May 2019 16:36:23 +0200 Subject: [PATCH] remove struct flat_type, replace fields type_lhs by type_symbol and type_attribute, remove BEFlatType, adjust BEAbstractType, replace BEAlgebraicType, BEExtendableAlgebraicType and BERecordType by BEDefineAlgebraicType, BEDefineExtensibleAlgebraicType and BEDefineRecordType, add constructor index argument to BEDefineRecordType and pass TypeArgP instead of TypeNodeP to remove hack in this function and BEConstructorSymbol --- .../Mac/Clean System Files/backend_library | 7 +- .../Clean System Files/backend_library | 9 +- backend/backend.dcl | 19 ++-- backend/backend.icl | 39 ++++---- backend/backendconvert.icl | 56 ++++++------ backendC/CleanCompilerLib.mcp.exp | 7 +- backendC/CleanCompilerSources/backend.c | 88 +++++++------------ backendC/CleanCompilerSources/backend.h | 22 ++--- backendC/CleanCompilerSources/codegen1.c | 4 +- backendC/CleanCompilerSources/codegen2.c | 26 +++--- backendC/CleanCompilerSources/codegen3.c | 4 +- backendC/CleanCompilerSources/instructions.c | 8 +- backendC/CleanCompilerSources/optimisations.c | 6 +- backendC/CleanCompilerSources/statesgen.c | 22 +++-- .../CleanCompilerSources/syntax_tree_types.h | 10 +-- backendC/backend.def | 9 +- backendC/backend.link | 9 +- backendC/backend.link64 | 9 +- 18 files changed, 148 insertions(+), 206 deletions(-) diff --git a/backend/Mac/Clean System Files/backend_library b/backend/Mac/Clean System Files/backend_library index d1e98107..0d462dab 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 f69c82fb..49796414 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 eb4a2f4a..faf40527 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 4d78a9a0..d7023a3f 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 24829f83..e8d6fa6d 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 45a05116..562c3020 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 d7724761..0458dfe5 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 03f56b50..39a58336 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 5bbf24f6..5dfa903f 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 9290b89d..30b22a9d 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 67ac3323..31d77317 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 151ddf14..92399600 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 5254be9b..a9192cc8 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 ec52d253..f81e3936 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 3c3545ad..16936f0c 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 49debf8d..e2979638 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 b8fd4bdf..fdd4bb23 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 f56c6fba..b7e0dfa8 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 -- GitLab