aboutsummaryrefslogtreecommitdiff
path: root/backendC/CleanCompilerSources/dumprestore.c
diff options
context:
space:
mode:
Diffstat (limited to 'backendC/CleanCompilerSources/dumprestore.c')
-rw-r--r--backendC/CleanCompilerSources/dumprestore.c888
1 files changed, 888 insertions, 0 deletions
diff --git a/backendC/CleanCompilerSources/dumprestore.c b/backendC/CleanCompilerSources/dumprestore.c
new file mode 100644
index 0000000..d4f201a
--- /dev/null
+++ b/backendC/CleanCompilerSources/dumprestore.c
@@ -0,0 +1,888 @@
+# include "system.h"
+# include "syntaxtr.t"
+# include "buildtree.h"
+
+# include "dumprestore.h"
+
+# ifdef DUMP_AND_RESTORE
+
+# include "comsupport.h"
+# include "checker.h"
+
+# include "backendsupport.h"
+# define Clean(ignore)
+# include "backend.h"
+
+
+Bool gDumpAndRestore = True;
+
+/*
+ Utilities
+ =========
+*/
+# define CopyContents(from, to) { *(to) = *(from);}
+
+/*
+ Memory management
+ =================
+*/
+static CleanString
+ConvertCString (char *string)
+{
+ int length;
+ CleanString cleanString;
+
+ length = strlen (string);
+ cleanString = (CleanString) CompAlloc (sizeof (CleanString) + length);
+ cleanString->length = length;
+ strncpy (cleanString->chars, string, length);
+
+ return (cleanString);
+} /* ConvertCString */
+
+/*
+ Forward declarations
+ ====================
+*/
+static SymbDefP ConvertSymbDef (SymbDefP sdef);
+static TypeNode ConvertTypeNode (TypeNode node);
+static NodeP ConvertNode (NodeP node);
+static NodeDefP ConvertNodeDefs (NodeDefP nodeDefs);
+static int DefineLhsNode (NodeP node, int sequenceNumber);
+
+/*
+ Symbol
+ ======
+*/
+
+static void
+SetSymbolIndices (SymbolP symbol, int symbolIndex, int moduleIndex)
+{
+ unsigned int indices;
+
+ Assert (0 <= moduleIndex && moduleIndex <= 0xFFFF);
+ Assert (0 <= symbolIndex && symbolIndex <= 0xFFFF);
+ Assert (symbol->symb_kind == definition);
+
+ indices = symbolIndex | (moduleIndex << 16);
+
+ symbol->symb_def->sdef_number = indices;
+} /* SetSymbolIndices */
+
+static void
+GetSymbolIndices (SymbolP symbol, int *symbolIndexP, int *moduleIndexP)
+{
+ unsigned int indices;
+
+ Assert (symbol->symb_kind == definition);
+ indices = (unsigned int) symbol->symb_def->sdef_number;
+
+ *symbolIndexP = indices & 0xFFFF;
+ *moduleIndexP = (indices >> 16) & 0xFFFF;
+} /* GetSymbolIndices */
+
+static SymbolP
+ConvertSymbol (SymbolP symbol)
+{
+ SymbolP copy;
+ int symbolIndex, moduleIndex;
+
+ Assert (!IsConverted (symbol));
+ switch (symbol->symb_kind)
+ {
+ case definition:
+ switch (symbol->symb_def->sdef_kind)
+ {
+ case ABSTYPE:
+ copy = BEDontCareDefinitionSymbol ();
+ break;
+ case TYPE:
+ case RECORDTYPE:
+ GetSymbolIndices (symbol, &symbolIndex, &moduleIndex);
+ copy = BETypeSymbol (symbolIndex, moduleIndex);
+ break;
+ case TYPESYN:
+ break;
+ case DEFRULE:
+ case IMPRULE:
+ case SYSRULE: /* +++ */
+ GetSymbolIndices (symbol, &symbolIndex, &moduleIndex);
+ copy = BEFunctionSymbol (symbolIndex, moduleIndex);
+ break;
+ case CONSTRUCTOR:
+ GetSymbolIndices (symbol, &symbolIndex, &moduleIndex);
+ copy = BEConstructorSymbol (symbolIndex, moduleIndex);
+ break;
+ break;
+ case FIELDSELECTOR:
+ GetSymbolIndices (symbol, &symbolIndex, &moduleIndex);
+ copy = BEFieldSymbol (symbolIndex, moduleIndex);
+ break;
+ case MACRORULE:
+ break;
+ case OVERLOADEDRULE:
+ break;
+ case INSTANCE:
+ break;
+ case CLASS:
+ break;
+ case CLASSINSTANCE:
+ break;
+ case CLASSLIST:
+ break;
+ default:
+ Assert (False);
+ break;
+ }
+ break;
+
+ /* literals */
+ case int_denot:
+ case char_denot:
+ case real_denot:
+ case string_denot:
+ copy = BELiteralSymbol ((SymbKind) symbol->symb_kind, ConvertCString (symbol->symb_int));
+ break;
+
+ /* basic symbols +++ some of these should be moved to the predefined module */
+ case int_type:
+ case bool_type:
+ case char_type:
+ case real_type:
+ case file_type:
+ case world_type:
+ case procid_type:
+ case redid_type:
+ case fun_type:
+
+ case array_type:
+ case strict_array_type:
+ case unboxed_array_type:
+
+ case tuple_type:
+ case tuple_symb:
+ copy = BEBasicSymbol ((SymbKind) symbol->symb_kind);
+ break;
+
+ /* symbols from the predefined module */
+ case list_type:
+ copy = BETypeSymbol (0, kPredefinedModuleIndex);
+ break;
+ case nil_symb:
+ copy = BEConstructorSymbol (0, kPredefinedModuleIndex);
+ break;
+ case cons_symb:
+ copy = BEConstructorSymbol (1, kPredefinedModuleIndex);
+ break;
+
+
+ default:
+ Assert (False);
+ break;
+ }
+
+ return (copy);
+} /* ConvertSymbol */
+
+/*
+ TypeArg
+ =======
+*/
+static TypeArgs
+ConvertTypeArgs (TypeArgs args)
+{
+ TypeArgs copy;
+
+ if (args == NULL)
+ copy = BENoTypeArgs ();
+ else
+ copy = BETypeArgs (ConvertTypeNode (args->type_arg_node), ConvertTypeArgs (args->type_arg_next));
+
+ return (copy);
+} /* ConvertTypeArgs */
+
+/*
+ TypeNode
+ ========
+*/
+static TypeNode
+ConvertTypeNode (TypeNode node)
+{
+ TypeNode copy;
+
+ Assert (!IsConverted (node));
+
+ if (node->type_node_is_var)
+ {
+ Assert (node->type_node_arguments== NULL);
+ copy = BEVarTypeNode (ConvertCString (node->type_node_tv->tv_ident->ident_name));
+ }
+ else
+ copy = BENormalTypeNode (ConvertSymbol (node->type_node_symbol), ConvertTypeArgs (node->type_node_arguments));
+
+ Assert (node->type_node_annotation == NoAnnot || node->type_node_annotation == StrictAnnot);
+ copy = BEAnnotateTypeNode (node->type_node_annotation, copy);
+
+ return (copy);
+} /* ConvertTypeNode */
+
+/*
+ TypeAlt
+ =======
+*/
+static TypeAlt *
+ConvertTypeAlt (TypeAlt *typeAlt)
+{
+ TypeAlt *copy;
+
+ Assert (!IsConverted (typeAlt));
+
+ copy = BETypeAlt (ConvertTypeNode (typeAlt->type_alt_lhs), ConvertTypeNode (typeAlt->type_alt_rhs));
+
+ return (copy);
+} /* ConvertTypeAlt */
+
+/*
+ Arg
+ ===
+*/
+static ArgP
+ConvertArgs (ArgP args)
+{
+ ArgP copy;
+
+ if (args == NULL)
+ copy = BENoArgs ();
+ else
+ copy = BEArgs (ConvertNode (args->arg_node), ConvertArgs (args->arg_next));
+
+ return (copy);
+} /* ConvertArgs */
+
+/*
+ NodeIds
+*/
+
+static int
+DefineNodeIds (NodeDefP nodeDef, int lhsOrRhs, int sequenceNumber)
+{
+ for ( ; nodeDef != NULL; nodeDef = nodeDef->def_next)
+ {
+ NodeIdP nodeId;
+
+ nodeId = nodeDef->def_id;
+ nodeId->nid_scope = sequenceNumber;
+
+ /* RWS ??? Assert (nodeId->nid_mark == 0); */
+
+ BEDeclareNodeId (sequenceNumber, lhsOrRhs, ConvertCString (nodeId->nid_ident->ident_name));
+ sequenceNumber++;
+ }
+ return (sequenceNumber);
+} /* DefineNodeIds */
+
+static int
+DefineLhsNodeId (NodeIdP nodeId, int sequenceNumber)
+{
+ Assert (nodeId->nid_refcount < 0);
+ Assert (nodeId->nid_node_def == NULL);
+ /* RWS ??? Assert (nodeId->nid_forward_node_id == NULL); */
+ Assert (nodeId->nid_state.state_arity == 0);
+ Assert (nodeId->nid_state.state_kind == 0);
+ Assert (nodeId->nid_state.state_mark == 0);
+ Assert (nodeId->nid_state.state_object == 0);
+ Assert (nodeId->nid_state.state_type == 0);
+
+ if (nodeId->nid_node == NULL)
+ {
+ nodeId->nid_scope = sequenceNumber;
+ BEDeclareNodeId (sequenceNumber, BELhsNodeId, ConvertCString (nodeId->nid_ident->ident_name));
+ sequenceNumber++;
+ }
+
+ return (sequenceNumber);
+} /* DefineLhsNodeId */
+
+static int
+DefineLhsArgs (ArgP arg, int sequenceNumber)
+{
+ for ( ; arg != NULL; arg = arg->arg_next)
+ sequenceNumber = DefineLhsNode (arg->arg_node, sequenceNumber);
+
+ return (sequenceNumber);
+} /* DefineLhsArgs */
+
+static int
+DefineLhsNode (NodeP node, int sequenceNumber)
+{
+ switch (node->node_kind)
+ {
+ case NodeIdNode:
+ sequenceNumber = DefineLhsNodeId (node->node_node_id, sequenceNumber);
+ break;
+ case NormalNode:
+ break;
+ default:
+ Assert (False);
+ break;
+ }
+
+ sequenceNumber = DefineLhsArgs (node->node_arguments, sequenceNumber);
+
+ return (sequenceNumber);
+} /* DefineLhsNode */
+
+static NodeIdP
+ConvertNodeId (NodeIdP nodeId)
+{
+ Assert (!IsConverted (nodeId));
+
+ return (BENodeId (nodeId->nid_scope));
+} /* ConvertNodeId*/
+
+
+/*
+ RuleAlt
+ =======
+*/
+
+static RuleAlts
+ConvertRuleAlt (RuleAltP alt)
+{
+ RuleAltP copy;
+
+ int sequenceNumber;
+
+ Assert (!IsConverted (alt));
+
+ Assert (alt->alt_kind == Contractum);
+ Assert (alt->alt_strict_node_ids == NULL);
+
+ sequenceNumber = 0;
+ sequenceNumber = DefineNodeIds (alt->alt_lhs_defs, BELhsNodeId, sequenceNumber);
+ sequenceNumber = DefineNodeIds (alt->alt_rhs_defs, BERhsNodeId, sequenceNumber);
+ sequenceNumber = DefineLhsArgs (alt->alt_lhs_root->node_arguments, sequenceNumber);
+
+ copy = BERuleAlt (alt->alt_line, ConvertNodeDefs (alt->alt_lhs_defs), ConvertNode (alt->alt_lhs_root), ConvertNodeDefs (alt->alt_rhs_defs), ConvertNode (alt->alt_rhs_root));
+
+ return (copy);
+} /* ConvertRuleAlt */
+
+static RuleAlts
+ConvertRuleAlts (RuleAltP alts)
+{
+ RuleAltP copy;
+
+ if (alts == NULL)
+ copy = BENoRuleAlts ();
+ else
+ copy = BERuleAlts (ConvertRuleAlt (alts), ConvertRuleAlts (alts->alt_next));
+
+ return (copy);
+} /* ConvertRuleAlts */
+
+/*
+ Node
+ ====
+*/
+static NodeP
+ConvertNode (NodeP node)
+{
+ NodeP copy;
+
+ Assert (node->node_annotation == NoAnnot);
+ switch (node->node_kind)
+ {
+ case NormalNode:
+ copy = BENormalNode (ConvertSymbol (node->node_symbol), ConvertArgs (node->node_arguments));
+ break;
+ case NodeIdNode:
+ copy = BENodeIdNode (ConvertNodeId (node->node_node_id), ConvertArgs (node->node_arguments));
+ break;
+ case SelectorNode:
+ copy = BESelectorNode (ConvertSymbol (node->node_symbol), ConvertArgs (node->node_arguments));
+ break;
+ default:
+ Assert (False);
+ break;
+ }
+
+ return (copy);
+} /* ConvertNode */
+
+/*
+ NodeDef
+ =======
+*/
+static NodeDefP
+ConvertNodeDef (NodeDefP nodeDef)
+{
+ NodeDefP copy;
+
+ Assert (nodeDef->def_mark == 0);
+
+ copy = BENodeDef (nodeDef->def_id->nid_scope, ConvertNode (nodeDef->def_node));
+
+ return (copy);
+} /* ConvertNodeDef */
+
+static NodeDefP
+ConvertNodeDefs (NodeDefP nodeDefs)
+{
+ if (nodeDefs == NULL)
+ return (BENoNodeDefs ());
+ else
+ return (BENodeDefs (ConvertNodeDef (nodeDefs), ConvertNodeDefs (nodeDefs->def_next)));
+} /* ConvertNodeDefs */
+
+/*
+ ImpRule
+ =======
+*/
+static ImpRuleP
+ConvertRule (ImpRuleP rule)
+{
+ ImpRuleP copy;
+ SymbolP functionSymbol;
+ int symbolIndex, moduleIndex;
+
+ Assert (!IsConverted (rule));
+ Assert (rule->rule_mark == RULE_CHECKED_MASK);
+
+ functionSymbol = rule->rule_root->node_symbol;
+
+ GetSymbolIndices (functionSymbol, &symbolIndex, &moduleIndex);
+ Assert (moduleIndex == kIclModuleIndex);
+ copy = BERule (symbolIndex, ConvertTypeAlt (rule->rule_type), ConvertRuleAlts (rule->rule_alts));
+
+ return (copy);
+} /* ConvertRule */
+
+static ImpRuleP
+ConvertRules (ImpRuleP rules)
+{
+ ImpRuleP copy;
+
+ if (rules == NULL)
+ copy = BENoRules ();
+ else
+ copy = BERules (ConvertRule (rules), ConvertRules (rules->rule_next));
+
+ return (copy);
+} /* ConvertRules */
+
+static void
+DefineRuleType (int functionIndex, int moduleIndex, RuleTypes ruleType)
+{
+ SymbolP functionSymbol;
+
+ Assert (!IsConverted (ruleType));
+
+ // +++ move to count
+ functionSymbol = ruleType->rule_type_root->type_node_symbol;
+ SetSymbolIndices (functionSymbol, functionIndex, moduleIndex);
+
+ Assert (functionSymbol->symb_kind == definition);
+
+ BEDeclareRuleType (functionIndex, moduleIndex, ConvertCString (functionSymbol->symb_def->sdef_ident->ident_name));
+ BEDefineRuleType (functionIndex, moduleIndex, ConvertTypeAlt (ruleType->rule_type_rule));
+} /* DefineRuleType */
+
+static void
+DefineRuleTypes (SymbolP allSymbols, char *moduleName)
+{
+ SymbolP symbol;
+
+ for (symbol = allSymbols; symbol != NULL; symbol = symbol->symb_next)
+ {
+ if (symbol->symb_kind == definition)
+ {
+ SymbDef sdef;
+
+ sdef = symbol->symb_def;
+ if ((sdef->sdef_kind == DEFRULE || sdef->sdef_kind == SYSRULE) && sdef->sdef_isused
+ && sdef->sdef_module == moduleName)
+ {
+ int functionIndex, moduleIndex;
+
+ GetSymbolIndices (symbol, &functionIndex, &moduleIndex);
+ DefineRuleType (functionIndex, moduleIndex, sdef->sdef_rule_type);
+ }
+
+ }
+ }
+} /* DefineRuleTypes */
+
+static void
+DeclareFunctions (SymbDefP sdefs)
+{
+ int i;
+ SymbDefP sdef;
+
+ i = 0;
+ for (sdef = sdefs; sdef != NULL; sdef = sdef->sdef_next_scc)
+ {
+ Node root;
+ ImpRuleP rule;
+ Symbol symbol;
+
+ Assert (sdef->sdef_kind == IMPRULE);
+ rule = sdef->sdef_rule;
+
+ root = rule->rule_root;
+ Assert (root->node_kind == NormalNode);
+ symbol = root->node_symbol;
+ Assert (symbol->symb_kind == definition);
+
+ SetSymbolIndices (symbol, i, kIclModuleIndex);
+
+ Assert (sdef->sdef_kind == IMPRULE);
+ Assert (sdef->sdef_mark == 0);
+ Assert (sdef->sdef_over_arity == 0);
+// Assert (!sdef->sdef_exported);
+ Assert (sdef->sdef_arfun == NoArrayFun);
+
+ // +++ hack
+ if (sdef->sdef_exported)
+ sdef->sdef_ancestor = -sdef->sdef_ancestor-1;
+
+ BEDeclareFunction (ConvertCString (sdef->sdef_ident->ident_name), sdef->sdef_arity, i, sdef->sdef_ancestor);
+
+ i++;
+ }
+} /* DeclareFunctions */
+
+static TypeVar
+ConvertTypeVar (TypeVar typeVar)
+{
+ return (BETypeVar (ConvertCString (typeVar->tv_ident->ident_name)));
+} /* ConvertTypeVar */
+
+static TypeVarList
+ConvertTypeVarList (TypeVarList typeVarList)
+{
+ if (typeVarList == NULL)
+ return (BENoTypeVars ());
+ else
+ return (BETypeVars (ConvertTypeVar (typeVarList->tvl_elem), ConvertTypeVarList (typeVarList->tvl_next)));
+} /* ConvertTypeVarList */
+
+static FlatType
+ConvertFlatType (FlatType flatType)
+{
+ BEFlatType (ConvertSymbol (flatType->ft_symbol), ConvertTypeVarList (flatType->ft_arguments));
+} /* ConvertFlatType */
+
+static void
+SequenceTypesAndConstructors (Types types, int moduleIndex, int *nTypesP, int *nConstructorsP, int *nFieldsP)
+{
+ int typeIndex, constructorIndex, fieldIndex;
+
+ typeIndex = 0;
+ constructorIndex = 0;
+ fieldIndex = 0;
+
+ for (; types != NULL; types = types->type_next)
+ {
+ SymbolP typeSymbol;
+ ConstructorList constructor;
+
+ typeSymbol = types->type_lhs->ft_symbol;
+ SetSymbolIndices (typeSymbol, typeIndex++, moduleIndex);
+
+ if (types->type_nr_of_constructors == 0)
+ {
+ SymbolP constructorSymbol;
+ FieldList field;
+
+ constructor = types->type_constructors;
+
+ Assert (!constructor->cl_constructor->type_node_is_var);
+ Assert (constructor->cl_fields != NULL);
+ /* Assert (constructor->cl_next == NULL); ??? unitialised */
+ constructorSymbol = constructor->cl_constructor->type_node_symbol;
+
+ SetSymbolIndices (constructorSymbol, constructorIndex++, moduleIndex);
+
+ for (field = types->type_fields; field != NULL; field = field->fl_next)
+ {
+ SymbolP fieldSymbol;
+
+ fieldSymbol = field->fl_symbol;
+
+ SetSymbolIndices (fieldSymbol, fieldIndex++, moduleIndex);
+ }
+ }
+ else
+ {
+ for (constructor = types->type_constructors; constructor != NULL; constructor = constructor->cl_next)
+ {
+ SymbolP constructorSymbol;
+
+ Assert (!constructor->cl_constructor->type_node_is_var);
+ Assert (constructor->cl_fields == NULL);
+ constructorSymbol = constructor->cl_constructor->type_node_symbol;
+
+ SetSymbolIndices (constructorSymbol, constructorIndex++, moduleIndex);
+ }
+ }
+ }
+ *nTypesP = typeIndex;
+ *nConstructorsP = constructorIndex;
+ *nFieldsP = fieldIndex;
+} /* SequenceTypesAndConstructors */
+
+static int
+SequenceRuleTypes (SymbolP allSymbols, int moduleIndex, char *moduleName)
+{
+ int nRuleTypes;
+ SymbolP symbol;
+
+ nRuleTypes = 0;
+ for (symbol = allSymbols; symbol != NULL; symbol = symbol->symb_next)
+ {
+ if (symbol->symb_kind == definition)
+ {
+ SymbDef sdef;
+
+ sdef = symbol->symb_def;
+ if ((sdef->sdef_kind == DEFRULE || sdef->sdef_kind == SYSRULE) && sdef->sdef_isused
+ && sdef->sdef_module == moduleName)
+ {
+ SetSymbolIndices (symbol, nRuleTypes, moduleIndex);
+ nRuleTypes++;
+ }
+
+ }
+ }
+
+ return (nRuleTypes);
+} /* SequenceRuleTypes */
+
+static ConstructorList
+ConvertConstructor (ConstructorList constructor)
+{
+ SymbolP constructorSymbol;
+ ConstructorList copy;
+ int constructorIndex, moduleIndex;
+
+ Assert (!constructor->cl_constructor->type_node_is_var);
+ constructorSymbol = constructor->cl_constructor->type_node_symbol;
+
+ GetSymbolIndices (constructorSymbol, &constructorIndex, &moduleIndex);
+
+ BEDeclareConstructor (constructorIndex, moduleIndex, ConvertCString (constructorSymbol->symb_def->sdef_ident->ident_name));
+ copy = BEConstructor (ConvertTypeNode (constructor->cl_constructor));
+
+ return (copy);
+} /* ConvertConstructor */
+
+static ConstructorList
+ConvertConstructors (ConstructorList constructors)
+{
+ ConstructorList copy;
+
+ if (constructors == NULL)
+ copy = BENoConstructors ();
+ else
+ copy = BEConstructors (ConvertConstructor (constructors), ConvertConstructors (constructors->cl_next));
+
+ return (copy);
+} /* ConvertConstructors */
+
+static FieldList
+ConvertField (FieldList field)
+{
+ SymbolP fieldSymbol;
+ FieldList copy;
+ int fieldIndex, moduleIndex;
+
+ fieldSymbol = field->fl_symbol;
+
+ GetSymbolIndices (fieldSymbol, &fieldIndex, &moduleIndex);
+
+ BEDeclareField (fieldIndex, moduleIndex, ConvertCString (fieldSymbol->symb_def->sdef_ident->ident_name));
+ copy = BEField (fieldIndex, moduleIndex, ConvertTypeNode (field->fl_type));
+
+ return (copy);
+} /* ConvertField */
+
+static FieldList
+ConvertFields (FieldList fields)
+{
+ FieldList copy;
+
+ if (fields == NULL)
+ copy = BENoFields ();
+ else
+ copy = BEFields (ConvertField (fields), ConvertFields (fields->fl_next));
+
+ return (copy);
+} /* ConvertFields */
+
+static Types
+ConvertType (Types type)
+{
+ SymbolP typeSymbol;
+ Types copy;
+ int typeIndex, moduleIndex;
+
+ typeSymbol = type->type_lhs->ft_symbol;
+ GetSymbolIndices (typeSymbol, &typeIndex, &moduleIndex);
+
+ Assert (typeSymbol->symb_kind == definition);
+
+ BEDeclareType (typeIndex, moduleIndex, ConvertCString (typeSymbol->symb_def->sdef_ident->ident_name));
+
+ if (type->type_nr_of_constructors == 0)
+ copy = BERecordType (BEFlatType (BETypeSymbol (typeIndex, moduleIndex), NULL), ConvertTypeNode (type->type_constructors->cl_constructor), ConvertFields (type->type_fields));
+ else
+ copy = BEAlgebraicType (BEFlatType (BETypeSymbol (typeIndex, moduleIndex), NULL), ConvertConstructors (type->type_constructors));
+
+ return (copy);
+} /* ConvertType */
+
+static Types
+ConvertTypes (Types types)
+{
+ Types copy;
+
+ if (types == NULL)
+ copy = BENoTypes ();
+ else
+ copy = BETypes (ConvertType (types), ConvertTypes (types->type_next));
+
+ return (copy);
+} /* ConvertTypes */
+
+
+/*
+ ImpMod
+ ======
+*/
+
+static void
+ConvertIclModule (ImpMod module)
+{
+ SymbDefP sdef;
+ int nFunctions, nTypes, nConstructors, nFields;
+
+// Assert (module->im_def_module == NULL);
+// Assert (module->im_main);
+
+ nFunctions = 0;
+ for (sdef = scc_dependency_list; sdef != NULL; sdef = sdef->sdef_next_scc)
+ nFunctions++;
+
+ SequenceTypesAndConstructors (module->im_types, kIclModuleIndex, &nTypes, &nConstructors, &nFields);
+
+ BEDeclareIclModule (ConvertCString (module->im_name->symb_ident->ident_name), nFunctions, nTypes, nConstructors, nFields);
+
+ ConvertTypes (module->im_types);
+
+ DeclareFunctions (scc_dependency_list);
+ BEDefineRules (ConvertRules (module->im_rules));
+} /* ConvertIclModule */
+
+/*
+ DefMod
+ ======
+*/
+
+static int
+CountDclModules (DefMod module, int moduleIndex)
+{
+ ImportList import;
+
+ if ((int) module->dm_abs_types == 1)
+ return (moduleIndex);
+
+ module->dm_abs_types = (void *) 1;
+ module->dm_syn_types = (void *) moduleIndex++;
+
+ for (import = module->dm_imports; import != NULL; import = import->ilist_next)
+ moduleIndex = CountDclModules (import->ilist_def, moduleIndex);
+
+ return (moduleIndex);
+} /* CountDclModules */
+
+static void
+ConvertDclModule (DefMod module, SymbolP allSymbols)
+{
+ int moduleIndex, functionIndex, nTypes, nConstructors, nFields;
+ char *moduleName;
+ ImportList import;
+
+ if ((unsigned int) module->dm_abs_types == 2)
+ return;
+
+ Assert ((unsigned int) module->dm_abs_types == 1);
+ module->dm_abs_types = (void *) 2;
+
+ for (import = module->dm_imports; import != NULL; import = import->ilist_next)
+ ConvertDclModule (import->ilist_def, allSymbols);
+
+ moduleName = module->dm_name->symb_ident->ident_name;
+ moduleIndex = (int) module->dm_syn_types;
+
+ functionIndex = SequenceRuleTypes (allSymbols, moduleIndex, moduleName);
+
+ SequenceTypesAndConstructors (module->dm_types, moduleIndex, &nTypes, &nConstructors, &nFields);
+
+ BEDeclareDclModule (moduleIndex, ConvertCString (module->dm_name->symb_ident->ident_name), False,
+ functionIndex, nTypes, nConstructors, nFields);
+
+
+ DefineRuleTypes (allSymbols, moduleName);
+
+# if 0
+ functionIndex = 0;
+ functionIndex = DefineRuleTypes (moduleIndex, module->dm_rules, functionIndex);
+ functionIndex = DefineInstances (moduleIndex, module->dm_instances, functionIndex);
+# endif
+
+ ConvertTypes (module->dm_types);
+} /* ConvertDclModule */
+
+static void
+ConvertModules (ImpMod module)
+{
+ int n;
+ ImportList import;
+
+ n = 2; /* 2: icl + predef */
+ for (import = module->im_imports; import != NULL; import = import->ilist_next)
+ n = CountDclModules (import->ilist_def, n);
+
+ BEDeclareModules (n);
+
+ // +++ temporary test
+ BEDeclarePredefinedModule (1, 2);
+ BEPredefineTypeSymbol (0, kPredefinedModuleIndex, list_type);
+ BEPredefineConstructorSymbol (0, kPredefinedModuleIndex, nil_symb);
+ BEPredefineConstructorSymbol (1, kPredefinedModuleIndex, cons_symb);
+
+ for (import = module->im_imports; import != NULL; import = import->ilist_next)
+ ConvertDclModule (import->ilist_def, module->im_symbols);
+
+ ConvertIclModule (module);
+} /* ConvertModules */
+
+void
+CoclBackEnd (ImpMod module, char *outputFileName)
+{
+ BackEnd backEnd;
+
+ backEnd = BEInit (0);
+
+ ConvertModules (module);
+
+ CompFree ();
+ InitStorage ();
+
+ BEGenerateCode (ConvertCString (outputFileName));
+
+ BEFree (backEnd);
+} /* CoclBackEnd */
+
+# endif /* DUMP_AND_RESTORE */ \ No newline at end of file
generated by cgit v1.2.3 (git 2.39.1) at 2025-03-15 09:51:50 +0000