Commit 3e5d471b authored by johnvg@science.ru.nl's avatar johnvg@science.ru.nl
Browse files

store type symbols of definition modules in struct module_type_symbols instead of a list of symbols

parent d7a0ac39
...@@ -123,7 +123,6 @@ STRUCT (be_state, BEState) ...@@ -123,7 +123,6 @@ STRUCT (be_state, BEState)
unsigned int be_nModules; unsigned int be_nModules;
SymbolP be_function_symbols; SymbolP be_function_symbols;
SymbolP be_type_symbols;
SymbolP be_dontCareSymbol; SymbolP be_dontCareSymbol;
SymbolP be_dictionarySelectFunSymbol; SymbolP be_dictionarySelectFunSymbol;
SymbolP be_dictionaryUpdateFunSymbol; SymbolP be_dictionaryUpdateFunSymbol;
...@@ -181,13 +180,11 @@ PredefinedSymbol (SymbKind symbolKind, int arity) ...@@ -181,13 +180,11 @@ PredefinedSymbol (SymbKind symbolKind, int arity)
} /* PredefinedSymbol */ } /* PredefinedSymbol */
static SymbolP static SymbolP
AllocateSymbols (int nFunctions, int nTypes, int nConstructorsAndFields, SymbolP *function_symbols_h, SymbolP *type_symbols_h) AllocateSymbols (int nFunctions, int nTypesConstructorsAndFields, SymbolP *function_symbols_h)
{ {
int nFunctionsAndTypes,nSymbols; int nSymbols;
nFunctionsAndTypes = nFunctions+nTypes; nSymbols = nFunctions+nTypesConstructorsAndFields;
nSymbols = nFunctionsAndTypes+nConstructorsAndFields;
if (nSymbols!=0){ if (nSymbols!=0){
SymbolP symbols; SymbolP symbols;
int i; int i;
...@@ -204,16 +201,6 @@ AllocateSymbols (int nFunctions, int nTypes, int nConstructorsAndFields, SymbolP ...@@ -204,16 +201,6 @@ AllocateSymbols (int nFunctions, int nTypes, int nConstructorsAndFields, SymbolP
symbols [nFunctions-1].symb_next = *function_symbols_h; symbols [nFunctions-1].symb_next = *function_symbols_h;
*function_symbols_h = symbols; *function_symbols_h = symbols;
} }
if (nTypes>0){
for (; i < nFunctionsAndTypes; ++i){
symbols [i].symb_kind = erroneous_symb;
symbols [i].symb_next = &symbols [i+1];
}
symbols [nFunctionsAndTypes-1].symb_next = *type_symbols_h;
*type_symbols_h = &symbols[nFunctions];
}
for (; i < nSymbols; i++){ for (; i < nSymbols; i++){
symbols [i].symb_kind = erroneous_symb; symbols [i].symb_kind = erroneous_symb;
...@@ -300,7 +287,7 @@ DeclareModule (int moduleIndex, char *name, Bool isSystemModule, int nFunctions, ...@@ -300,7 +287,7 @@ DeclareModule (int moduleIndex, char *name, Bool isSystemModule, int nFunctions,
BEModuleP module; BEModuleP module;
SymbolP symbols; SymbolP symbols;
symbols = AllocateSymbols (nFunctions, nTypes, nConstructors + nFields, &gBEState.be_function_symbols, &gBEState.be_type_symbols); symbols = AllocateSymbols (nFunctions, nTypes + nConstructors + nFields, &gBEState.be_function_symbols);
Assert ((unsigned int) moduleIndex < gBEState.be_nModules); Assert ((unsigned int) moduleIndex < gBEState.be_nModules);
module = &gBEState.be_modules [moduleIndex]; module = &gBEState.be_modules [moduleIndex];
...@@ -375,6 +362,35 @@ BEDeclareIclModule (CleanString name, CleanString modificationTime, int nFunctio ...@@ -375,6 +362,35 @@ BEDeclareIclModule (CleanString name, CleanString modificationTime, int nFunctio
scc_dependency_list = NULL; scc_dependency_list = NULL;
icl->beicl_depsP = &scc_dependency_list; icl->beicl_depsP = &scc_dependency_list;
{
struct module_type_symbols *dcl_type_symbols_a;
int n_dcl_type_symbols;
struct def_list *def_mod;
dcl_type_symbols_a = (struct module_type_symbols*) ConvertAlloc (gBEState.be_nModules * sizeof (struct module_type_symbols));
n_dcl_type_symbols=0;
for (def_mod=OpenDefinitionModules; def_mod!=NULL; def_mod=def_mod->mod_next){
int module_n;
module_n = def_mod->mod_body->dm_module_n;
if (module_n!=main_dcl_module_n){
dcl_type_symbols_a[n_dcl_type_symbols].mts_n_types = gBEState.be_modules [module_n].bem_nTypes;
dcl_type_symbols_a[n_dcl_type_symbols].mts_type_symbol_a = gBEState.be_modules [module_n].bem_types;
++n_dcl_type_symbols;
}
}
dcl_type_symbols_a[n_dcl_type_symbols].mts_n_types = gBEState.be_modules [kPredefinedModuleIndex].bem_nTypes;
dcl_type_symbols_a[n_dcl_type_symbols].mts_type_symbol_a = gBEState.be_modules [kPredefinedModuleIndex].bem_types;
++n_dcl_type_symbols;
Assert (n_dcl_type_symbols<=gBEState.be_nModules);
icl->beicl_module->im_dcl_type_symbols_a = dcl_type_symbols_a;
icl->beicl_module->im_size_dcl_type_symbols_a = n_dcl_type_symbols;
}
nFunctions += ArraySize (gLocallyGeneratedFunctions); nFunctions += ArraySize (gLocallyGeneratedFunctions);
DeclareModule (main_dcl_module_n, cName, False, nFunctions, nTypes, nConstructors, nFields); DeclareModule (main_dcl_module_n, cName, False, nFunctions, nTypes, nConstructors, nFields);
...@@ -384,8 +400,9 @@ BEDeclareIclModule (CleanString name, CleanString modificationTime, int nFunctio ...@@ -384,8 +400,9 @@ BEDeclareIclModule (CleanString name, CleanString modificationTime, int nFunctio
iclModule->im_def_module = im_def_module; iclModule->im_def_module = im_def_module;
iclModule->im_rules = NULL; iclModule->im_rules = NULL;
iclModule->im_start = NULL; iclModule->im_start = NULL;
iclModule->im_type_symbols.mts_n_types = nTypes;
iclModule->im_type_symbols.mts_type_symbol_a = gBEState.be_modules [main_dcl_module_n].bem_types;
iclModule->im_function_symbols = gBEState.be_function_symbols; iclModule->im_function_symbols = gBEState.be_function_symbols;
iclModule->im_type_symbols = gBEState.be_type_symbols;
# if IMPORT_OBJ_AND_LIB # if IMPORT_OBJ_AND_LIB
iclModule->im_imported_objs = NULL; iclModule->im_imported_objs = NULL;
iclModule->im_imported_libs = NULL; iclModule->im_imported_libs = NULL;
...@@ -416,7 +433,7 @@ BEDeclareDclModule (int moduleIndex, CleanString name, CleanString modificationT ...@@ -416,7 +433,7 @@ BEDeclareDclModule (int moduleIndex, CleanString name, CleanString modificationT
char *cName; char *cName;
SymbolP moduleNameSymbol; SymbolP moduleNameSymbol;
DefMod dclModule; DefMod dclModule;
SymbolP saved_function_symbols,saved_type_symbols,previous_all_symbols; SymbolP saved_function_symbols,previous_all_symbols;
cName = ConvertCleanString (name); cName = ConvertCleanString (name);
...@@ -425,9 +442,7 @@ BEDeclareDclModule (int moduleIndex, CleanString name, CleanString modificationT ...@@ -425,9 +442,7 @@ BEDeclareDclModule (int moduleIndex, CleanString name, CleanString modificationT
if (moduleIndex == main_dcl_module_n){ if (moduleIndex == main_dcl_module_n){
saved_function_symbols = gBEState.be_function_symbols; saved_function_symbols = gBEState.be_function_symbols;
saved_type_symbols = gBEState.be_type_symbols;
gBEState.be_function_symbols = NULL; gBEState.be_function_symbols = NULL;
gBEState.be_type_symbols = NULL;
} }
previous_all_symbols = gBEState.be_function_symbols; previous_all_symbols = gBEState.be_function_symbols;
...@@ -436,10 +451,10 @@ BEDeclareDclModule (int moduleIndex, CleanString name, CleanString modificationT ...@@ -436,10 +451,10 @@ BEDeclareDclModule (int moduleIndex, CleanString name, CleanString modificationT
dclModule = ConvertAllocType (DefRepr); dclModule = ConvertAllocType (DefRepr);
dclModule->dm_name = cName; dclModule->dm_name = cName;
dclModule->dm_module_n = moduleIndex;
dclModule->dm_modification_time = ConvertCleanString (modificationTime); dclModule->dm_modification_time = ConvertCleanString (modificationTime);
dclModule->dm_system_module = isSystemModule; dclModule->dm_system_module = isSystemModule;
dclModule->dm_function_symbols = gBEState.be_function_symbols; dclModule->dm_function_symbols = gBEState.be_function_symbols;
dclModule->dm_type_symbols = gBEState.be_type_symbols;
dclModule->dm_symbols_end = previous_all_symbols; dclModule->dm_symbols_end = previous_all_symbols;
dclModule->dm_system_module_table_kind = FirstSystemModuleTable + moduleIndex; dclModule->dm_system_module_table_kind = FirstSystemModuleTable + moduleIndex;
...@@ -447,7 +462,6 @@ BEDeclareDclModule (int moduleIndex, CleanString name, CleanString modificationT ...@@ -447,7 +462,6 @@ BEDeclareDclModule (int moduleIndex, CleanString name, CleanString modificationT
if (moduleIndex == main_dcl_module_n){ if (moduleIndex == main_dcl_module_n){
gBEState.be_function_symbols = saved_function_symbols; gBEState.be_function_symbols = saved_function_symbols;
gBEState.be_type_symbols = saved_type_symbols;
im_def_module=dclModule; im_def_module=dclModule;
} }
} /* BEDeclareDclModule */ } /* BEDeclareDclModule */
...@@ -3389,7 +3403,6 @@ BEInit (int argc) ...@@ -3389,7 +3403,6 @@ BEInit (int argc)
gBEState.be_modules = NULL; gBEState.be_modules = NULL;
gBEState.be_function_symbols = NULL; gBEState.be_function_symbols = NULL;
gBEState.be_type_symbols = NULL;
gBEState.be_dontCareSymbol = NULL; gBEState.be_dontCareSymbol = NULL;
gBEState.be_dictionarySelectFunSymbol = NULL; gBEState.be_dictionarySelectFunSymbol = NULL;
gBEState.be_dictionaryUpdateFunSymbol = NULL; gBEState.be_dictionaryUpdateFunSymbol = NULL;
......
...@@ -22,7 +22,14 @@ void InitChecker (void); ...@@ -22,7 +22,14 @@ void InitChecker (void);
void GenDependencyList (void); void GenDependencyList (void);
NodeDefs NewNodeDef (NodeId nid, Node node); NodeDefs NewNodeDef (NodeId nid, Node node);
#ifdef CLEAN2 struct def_list {
Symbol mod_name;
Bool mod_undereval;
DefMod mod_body;
struct def_list * mod_next;
};
extern struct def_list *OpenDefinitionModules;
void ClearOpenDefinitionModules (void); void ClearOpenDefinitionModules (void);
void AddOpenDefinitionModule (SymbolP moduleNameSymbol, DefMod definitionModule); void AddOpenDefinitionModule (SymbolP moduleNameSymbol, DefMod definitionModule);
#endif
...@@ -3,13 +3,6 @@ ...@@ -3,13 +3,6 @@
Version: 1.2 Version: 1.2
*/ */
#define COMPLEX_ABSTYPES
#define MOVE_LIFTED_CONSTANTS
#define OPTIMIZE_APPLIES
#define MOVE_MORE_LIFTED_CONSTANTS
#define MOVE_CURRIED_APPLICATIONS
#define MOVE_FUNCTIONS_IN_LAMBDAS
#include "compiledefines.h" #include "compiledefines.h"
#include "types.t" #include "types.t"
#include "system.h" #include "system.h"
...@@ -24,38 +17,18 @@ ...@@ -24,38 +17,18 @@
#include "codegen1.h" #include "codegen1.h"
#include "codegen2.h" #include "codegen2.h"
#include "instructions.h" #include "instructions.h"
#include "transform.h"
#include "checksupport.h" #include "checksupport.h"
#include "settings.h" #include "settings.h"
#include "checker.h" #include "checker.h"
#ifdef MOVE_FUNCTIONS_IN_LAMBDAS
# include "optimise_lambda.h"
#endif
#ifdef applec #ifdef applec
# include <types.h> # include <types.h>
#endif #endif
#undef DEBUG_REF_COUNT
#ifdef DEBUG_REF_COUNT
# define IF_DEBUG_REF_COUNT(a) a
# include "dbprint.h"
#else
# define IF_DEBUG_REF_COUNT(a)
#endif
#define for_l(v,l,n) for(v=(l);v!=NULL;v=v->n) #define for_l(v,l,n) for(v=(l);v!=NULL;v=v->n)
struct def_list {
Symbol mod_name;
Bool mod_undereval;
DefMod mod_body;
struct def_list * mod_next;
};
typedef struct def_list *DefModList,DefModElem; typedef struct def_list *DefModList,DefModElem;
static DefModList OpenDefinitionModules; struct def_list *OpenDefinitionModules;
void GenDependencyList (void) void GenDependencyList (void)
{ {
......
...@@ -1143,7 +1143,7 @@ void CodeGeneration (ImpMod imod, char *fname) ...@@ -1143,7 +1143,7 @@ void CodeGeneration (ImpMod imod, char *fname)
PrintRules (imod->im_rules,rules_file); PrintRules (imod->im_rules,rules_file);
#endif #endif
GenerateStatesForRecords (imod->im_type_symbols); GenerateStatesForRecords (imod->im_type_symbols,imod->im_size_dcl_type_symbols_a,imod->im_dcl_type_symbols_a);
DoStrictnessAnalysis_and_init_ok = DoStrictnessAnalysis && init_strictness_analysis (imod); DoStrictnessAnalysis_and_init_ok = DoStrictnessAnalysis && init_strictness_analysis (imod);
...@@ -1152,7 +1152,7 @@ void CodeGeneration (ImpMod imod, char *fname) ...@@ -1152,7 +1152,7 @@ void CodeGeneration (ImpMod imod, char *fname)
ExitOnInterrupt(); ExitOnInterrupt();
} }
ExamineTypesAndLhsOfSymbols (imod->im_function_symbols,imod->im_type_symbols); ExamineTypesAndLhsOfSymbols (imod->im_function_symbols,imod->im_type_symbols,imod->im_size_dcl_type_symbols_a,imod->im_dcl_type_symbols_a);
#ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS #ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS
{ {
...@@ -1234,7 +1234,7 @@ void CodeGeneration (ImpMod imod, char *fname) ...@@ -1234,7 +1234,7 @@ void CodeGeneration (ImpMod imod, char *fname)
CreateStackFrames(); CreateStackFrames();
ImportSymbols (imod->im_function_symbols,imod->im_type_symbols); ImportSymbols (imod->im_function_symbols,imod->im_size_dcl_type_symbols_a,imod->im_dcl_type_symbols_a);
GenerateCodeForConstructorsAndRecords (imod->im_type_symbols); GenerateCodeForConstructorsAndRecords (imod->im_type_symbols);
...@@ -1285,7 +1285,7 @@ void CodeGeneration (ImpMod imod, char *fname) ...@@ -1285,7 +1285,7 @@ void CodeGeneration (ImpMod imod, char *fname)
GenerateCodeForLazyUnboxedRecordListFunctions(); GenerateCodeForLazyUnboxedRecordListFunctions();
#endif #endif
import_not_yet_imported_record_r_labels (imod->im_type_symbols); import_not_yet_imported_record_r_labels (imod->im_size_dcl_type_symbols_a,imod->im_dcl_type_symbols_a);
import_not_yet_imported_system_labels(); import_not_yet_imported_system_labels();
WriteLastNewlineToABCFile(); WriteLastNewlineToABCFile();
......
...@@ -1603,18 +1603,21 @@ void GenerateCodeForLazyArrayFunctionEntries (void) ...@@ -1603,18 +1603,21 @@ void GenerateCodeForLazyArrayFunctionEntries (void)
} }
} }
void GenerateCodeForConstructorsAndRecords (Symbol symbols) void GenerateCodeForConstructorsAndRecords (struct module_type_symbols mts)
{ {
Symbol symbol_p; int n_types,i;
SymbolP type_symbol_a;
#if STRICT_LISTS #if STRICT_LISTS
PolyList unboxed_record_cons_element; PolyList unboxed_record_cons_element;
#endif #endif
for_l (symbol_p,symbols,symb_next){ n_types = mts.mts_n_types;
if (symbol_p->symb_kind==definition){ type_symbol_a = mts.mts_type_symbol_a;
for (i=0; i<n_types; ++i){
if (type_symbol_a[i].symb_kind==definition){
SymbDef def; SymbDef def;
def = symbol_p->symb_def; def = type_symbol_a[i].symb_def;
if (def->sdef_module==CurrentModule){ if (def->sdef_module==CurrentModule){
if (def->sdef_kind==TYPE){ if (def->sdef_kind==TYPE){
...@@ -3071,7 +3074,7 @@ SymbDef create_select_and_match_function (SymbolP constructor_symbol,int n_dicti ...@@ -3071,7 +3074,7 @@ SymbDef create_select_and_match_function (SymbolP constructor_symbol,int n_dicti
SymbDef match_function_sdef; SymbDef match_function_sdef;
Symbol match_function_symbol; Symbol match_function_symbol;
ArgP lhs_function_arg; ArgP lhs_function_arg;
NodeP lhs_root,rhs_root,constructor_node; NodeP lhs_root,rhs_root;
NodeIdP node_id; NodeIdP node_id;
ImpRuleS *match_imp_rule; ImpRuleS *match_imp_rule;
struct node *push_node,*case_node,*switch_node; struct node *push_node,*case_node,*switch_node;
...@@ -3237,8 +3240,8 @@ struct update { ...@@ -3237,8 +3240,8 @@ struct update {
}; };
#if BIND_UNBOXED_LHS_TUPLE_AND_RECORD_ARGUMENTS_IN_BIND_ARGUMENTS /* added 9-4-1999 */ #if BIND_UNBOXED_LHS_TUPLE_AND_RECORD_ARGUMENTS_IN_BIND_ARGUMENTS /* added 9-4-1999 */
void bind_tuple_and_record_arguments (ArgP arguments,NodeId tuple_node_id,int a_offset,int b_offset, static void bind_tuple_and_record_arguments (ArgP arguments,NodeId tuple_node_id,int a_offset,int b_offset,
NodeIdListElementS ***a_node_ids_h,NodeIdListElementS ***b_node_ids_h) NodeIdListElementS ***a_node_ids_h,NodeIdListElementS ***b_node_ids_h)
{ {
NodeIdListElementS **a_node_ids_p,**b_node_ids_p; NodeIdListElementS **a_node_ids_p,**b_node_ids_p;
ArgP arg_p; ArgP arg_p;
...@@ -3836,7 +3839,7 @@ static void add_node_id_or_tuple_node_ids_to_list (NodeIdP node_id,NodeIdP push_ ...@@ -3836,7 +3839,7 @@ static void add_node_id_or_tuple_node_ids_to_list (NodeIdP node_id,NodeIdP push_
#endif #endif
#if BUILD_FREE_NODE_ID_LIST_DURING_PATTER_MATCH #if BUILD_FREE_NODE_ID_LIST_DURING_PATTER_MATCH
void set_local_reference_counts_and_add_free_node_ids (NodeP case_node,NodeIdListElementS **free_node_ids_l) static void set_local_reference_counts_and_add_free_node_ids (NodeP case_node,NodeIdListElementS **free_node_ids_l)
{ {
NodeIdRefCountListP node_id_ref_count_elem; NodeIdRefCountListP node_id_ref_count_elem;
NodeIdP push_node_id_p; NodeIdP push_node_id_p;
......
...@@ -91,8 +91,7 @@ extern void AddStateSizesAndMaxFrameSizes (int arity, States states,int *maxasiz ...@@ -91,8 +91,7 @@ extern void AddStateSizesAndMaxFrameSizes (int arity, States states,int *maxasiz
extern void AddStateSizesAndMaxFrameSizesOfArguments (Args args,int *maxasize, int *asize, int *bsize); extern void AddStateSizesAndMaxFrameSizesOfArguments (Args args,int *maxasize, int *asize, int *bsize);
extern void DetermineFieldSizeAndPosition (int fieldnr, int *asize, int *bsize,int *apos, int *bpos, States argstates); extern void DetermineFieldSizeAndPosition (int fieldnr, int *asize, int *bsize,int *apos, int *bpos, States argstates);
extern void GenerateCodeForConstructorsAndRecords (Symbol symbs); extern void GenerateCodeForConstructorsAndRecords (struct module_type_symbols mts);
extern void GenerateStatesForRecords (Symbol symbs);
extern Bool NodeEntry (StateS *const function_state_p,int arity,Label ealab,SymbDef rootsymb); extern Bool NodeEntry (StateS *const function_state_p,int arity,Label ealab,SymbDef rootsymb);
extern Bool NodeEntryUnboxed (StateS *const function_state_p,NodeP call_node_p,int args_a_size,int args_b_size,Label ealab,SymbDef rootsymb); extern Bool NodeEntryUnboxed (StateS *const function_state_p,NodeP call_node_p,int args_a_size,int args_b_size,Label ealab,SymbDef rootsymb);
......
...@@ -3626,66 +3626,81 @@ static void convert_imp_rule_alts (SymbDef sdef) ...@@ -3626,66 +3626,81 @@ static void convert_imp_rule_alts (SymbDef sdef)
f->fun_alts = NULL; f->fun_alts = NULL;
} }
static void ConvertSyntaxTree (Symbol symbols) static void convert_type (SymbDef sdef)
{ {
unsigned arity; Fun *f;
Symbol sym; unsigned int arity;
if (sdef->sdef_kind==TYPE){
ConstructorList talts;
for_l (talts,sdef->sdef_type->type_constructors,cl_next){
SymbDef cdef;
f=SAllocType (Fun);
cdef = talts->cl_constructor->type_node_symbol->symb_def;
cdef->sdef_sa_fun = f;
f->fun_symbol = cdef;
arity = f->fun_arity = cdef->sdef_arity;
f->fun_single = False;
f->fun_kind = Constructor;
f->fun_single = cdef->sdef_type->type_nr_of_constructors == 1;
cdef->sdef_constructor=talts;
if (cdef->sdef_strict_constructor)
ConvertTypeArgsToStrictInfos (talts->cl_constructor->type_node_arguments,arity,&f->fun_strictargs, True);
else
f->fun_strictargs = NULL;
InitStrictResult (& f->fun_strictresult);
}
} else if (sdef->sdef_kind==RECORDTYPE){
f=SAllocType (Fun);
sdef->sdef_sa_fun = f;
f->fun_symbol = sdef;
arity = f->fun_arity = sdef->sdef_arity;
f->fun_kind = Constructor;
f->fun_single = True;
if (sdef->sdef_strict_constructor)
ConvertTypeArgsToStrictInfos (TypeArgsOfRecord (sdef), arity,&f->fun_strictargs, True);
else
f->fun_strictargs = Null;
InitStrictResult (& f->fun_strictresult);
}
}
static void ConvertSyntaxTree
(struct module_type_symbols mts,int size_dcl_type_symbols_a,struct module_type_symbols dcl_type_symbols_a[])
{
SymbolP type_symbol_a;
Bool annot_warning; Bool annot_warning;
SymbDef sdef; SymbDef sdef;
Fun *f; int i,n_types,dcl_type_symbols_n;
annot_warning = False; annot_warning = False;
init_predefined_symbols(); init_predefined_symbols();
/* initialise the function table with constructors */ /* initialise the function table with constructors */
for_l (sym,symbols,symb_next) n_types = mts.mts_n_types;
if (sym->symb_kind==definition){ type_symbol_a = mts.mts_type_symbol_a;
sdef = sym->symb_def; for (i=0; i<n_types; ++i)
if (type_symbol_a[i].symb_kind==definition)
if (sdef->sdef_kind==TYPE){ convert_type (type_symbol_a[i].symb_def);
ConstructorList talts;
for (dcl_type_symbols_n=0; dcl_type_symbols_n<size_dcl_type_symbols_a; ++dcl_type_symbols_n){
for_l (talts,sdef->sdef_type->type_constructors,cl_next){ n_types = dcl_type_symbols_a[dcl_type_symbols_n].mts_n_types;
SymbDef cdef; type_symbol_a = dcl_type_symbols_a[dcl_type_symbols_n].mts_type_symbol_a;
for (i=0; i<n_types; ++i)
f=SAllocType (Fun); if (type_symbol_a[i].symb_kind==definition)
convert_type (type_symbol_a[i].symb_def);
cdef = talts->cl_constructor->type_node_symbol->symb_def; }
cdef->sdef_sa_fun = f;
f->fun_symbol = cdef;
arity = f->fun_arity = cdef->sdef_arity;
f->fun_single = False;
f->fun_kind = Constructor;
f->fun_single = cdef->sdef_type->type_nr_of_constructors == 1;
cdef->sdef_constructor=talts;
if (cdef->sdef_strict_constructor)
ConvertTypeArgsToStrictInfos (talts->cl_constructor->type_node_arguments,arity,&f->fun_strictargs, True);
else
f->fun_strictargs = NULL;
InitStrictResult (& f->fun_strictresult);
}
} else if (sdef->sdef_kind==RECORDTYPE){
f=SAllocType (Fun);
sdef->sdef_sa_fun = f;
f->fun_symbol = sdef;
arity = f->fun_arity = sdef->sdef_arity;
f->fun_kind = Constructor;
f->fun_single = True;
if (sdef->sdef_strict_constructor)
ConvertTypeArgsToStrictInfos (TypeArgsOfRecord (sdef), arity,&f->fun_strictargs, True);
else
f->fun_strictargs = Null;
InitStrictResult (& f->fun_strictresult);
}
}
/* initialise the function table with symbols with a definition */ /* initialise the function table with symbols with a definition */
for_l (sdef,scc_dependency_list,sdef_next_scc) for_l (sdef,scc_dependency_list,sdef_next_scc)
......
...@@ -569,15 +569,18 @@ static void ChangeElementStateForStrictAbsTypeFields (SymbDef icl_sdef,SymbDef d ...@@ -569,15 +569,18 @@ static void ChangeElementStateForStrictAbsTypeFields (SymbDef icl_sdef,SymbDef d
SymbDefP special_types[2]; SymbDefP special_types[2];
#endif #endif
void GenerateStatesForRecords (Symbol symbols) void GenerateStatesForRecords (struct module_type_symbols mts,int size_dcl_type_symbols_a,struct module_type_symbols dcl_type_symbols_a[])
{ {
Symbol symb; int n_types,i,dcl_type_symbols_n;
SymbolP type_symbol_a;
for_l (symb,symbols,symb_next)
if (symb->symb_kind==definition){ n_types = mts.mts_n_types;
type_symbol_a = mts.mts_type_symbol_a;
for (i=0; i<n_types; ++i)
if (type_symbol_a[i].symb_kind==definition){