Commit f00ce5ea authored by John van Groningen's avatar John van Groningen
Browse files

added code for strict and unboxed lists

parent d84f1330
...@@ -41,6 +41,9 @@ BEGetVersion (int *current, int *oldestDefinition, int *oldestImplementation) ...@@ -41,6 +41,9 @@ BEGetVersion (int *current, int *oldestDefinition, int *oldestImplementation)
*oldestImplementation = kBEVersionOldestImplementation; *oldestImplementation = kBEVersionOldestImplementation;
} }
#if STRICT_LISTS
PolyList unboxed_record_cons_list,unboxed_record_decons_list;
#endif
extern PolyList UserDefinedArrayFunctions; /* typechecker.c */ extern PolyList UserDefinedArrayFunctions; /* typechecker.c */
extern StdOutReopened, StdErrorReopened; /* cocl.c */ extern StdOutReopened, StdErrorReopened; /* cocl.c */
...@@ -494,10 +497,11 @@ BEFunctionSymbol (int functionIndex, int moduleIndex) ...@@ -494,10 +497,11 @@ BEFunctionSymbol (int functionIndex, int moduleIndex)
Assert ((unsigned int) functionIndex < module->bem_nFunctions); Assert ((unsigned int) functionIndex < module->bem_nFunctions);
functionSymbol = &module->bem_functions [functionIndex]; functionSymbol = &module->bem_functions [functionIndex];
Assert (functionSymbol->symb_kind == definition Assert (functionSymbol->symb_kind == definition || functionSymbol->symb_kind == cons_symb || functionSymbol->symb_kind == nil_symb
|| (moduleIndex == kPredefinedModuleIndex && functionSymbol->symb_kind != erroneous_symb)); || (moduleIndex == kPredefinedModuleIndex && functionSymbol->symb_kind != erroneous_symb));
functionSymbol->symb_def->sdef_isused = True; if (functionSymbol->symb_kind!=cons_symb && functionSymbol->symb_kind!=nil_symb)
functionSymbol->symb_def->sdef_isused = True;
return (functionSymbol); return (functionSymbol);
} /* BEFunctionSymbol */ } /* BEFunctionSymbol */
...@@ -978,10 +982,10 @@ BEConstructorSymbol (int constructorIndex, int moduleIndex) ...@@ -978,10 +982,10 @@ BEConstructorSymbol (int constructorIndex, int moduleIndex)
if (constructorSymbol->symb_kind == erroneous_symb) if (constructorSymbol->symb_kind == erroneous_symb)
return (constructorSymbol); return (constructorSymbol);
Assert (constructorSymbol->symb_kind == definition Assert (constructorSymbol->symb_kind == definition || constructorSymbol->symb_kind == cons_symb
|| (moduleIndex == kPredefinedModuleIndex && constructorSymbol->symb_kind != erroneous_symb)); || (moduleIndex == kPredefinedModuleIndex && constructorSymbol->symb_kind != erroneous_symb));
if (moduleIndex != kPredefinedModuleIndex) if (moduleIndex != kPredefinedModuleIndex && constructorSymbol->symb_kind!=cons_symb)
constructorSymbol->symb_def->sdef_isused = True; constructorSymbol->symb_def->sdef_isused = True;
return (constructorSymbol); return (constructorSymbol);
...@@ -1036,8 +1040,14 @@ BELiteralSymbol (BESymbKind kind, CleanString value) ...@@ -1036,8 +1040,14 @@ BELiteralSymbol (BESymbKind kind, CleanString value)
return (symbol); return (symbol);
} /* BELiteralSymbol */ } /* BELiteralSymbol */
# define nid_ref_count_sign nid_scope
#if STRICT_LISTS #if STRICT_LISTS
void BEPredefineListConstructorSymbol(int arity,int constructorIndex,int moduleIndex,BESymbKind symbolKind,int head_strictness,int tail_strictness) static SymbolS unboxed_list_symbols[Nr_Of_Predef_Types][2];
static SymbolP strict_list_cons_symbols[8];
void BEPredefineListConstructorSymbol (int constructorIndex,int moduleIndex,BESymbKind symbolKind,int head_strictness,int tail_strictness)
{ {
BEModuleP module; BEModuleP module;
SymbolP symbol_p; SymbolP symbol_p;
...@@ -1045,21 +1055,21 @@ void BEPredefineListConstructorSymbol(int arity,int constructorIndex,int moduleI ...@@ -1045,21 +1055,21 @@ void BEPredefineListConstructorSymbol(int arity,int constructorIndex,int moduleI
Assert (moduleIndex == kPredefinedModuleIndex); Assert (moduleIndex == kPredefinedModuleIndex);
Assert ((unsigned int) moduleIndex < gBEState.be_nModules); Assert ((unsigned int) moduleIndex < gBEState.be_nModules);
module = &gBEState.be_modules [moduleIndex]; module = &gBEState.be_modules [moduleIndex];
Assert ((unsigned int) constructorIndex < module->bem_nConstructors); Assert ((unsigned int) constructorIndex < module->bem_nConstructors);
symbol_p=module->bem_constructors [constructorIndex]; symbol_p=module->bem_constructors [constructorIndex];
Assert (symbol_p->symb_kind == erroneous_symb);
symbol_p->symb_kind = symbolKind; symbol_p->symb_kind = symbolKind;
symbol_p->symb_arity = arity;
symbol_p->symb_head_strictness=head_strictness; symbol_p->symb_head_strictness=head_strictness;
symbol_p->symb_tail_strictness=tail_strictness; symbol_p->symb_tail_strictness=tail_strictness;
if (symbolKind==BEConsSymb && head_strictness<4)
strict_list_cons_symbols[(head_strictness<<1)+tail_strictness]=symbol_p;
} }
void BEPredefineListTypeSymbol(int typeIndex,int moduleIndex,BESymbKind symbolKind,int head_strictness,int tail_strictness) void BEPredefineListTypeSymbol (int typeIndex,int moduleIndex,BESymbKind symbolKind,int head_strictness,int tail_strictness)
{ {
BEModuleP module; BEModuleP module;
SymbolP symbol_p; SymbolP symbol_p;
...@@ -1067,19 +1077,207 @@ void BEPredefineListTypeSymbol(int typeIndex,int moduleIndex,BESymbKind symbolKi ...@@ -1067,19 +1077,207 @@ void BEPredefineListTypeSymbol(int typeIndex,int moduleIndex,BESymbKind symbolKi
Assert (moduleIndex == kPredefinedModuleIndex); Assert (moduleIndex == kPredefinedModuleIndex);
Assert ((unsigned int) moduleIndex < gBEState.be_nModules); Assert ((unsigned int) moduleIndex < gBEState.be_nModules);
module = &gBEState.be_modules [moduleIndex]; module = &gBEState.be_modules [moduleIndex];
Assert ((unsigned int) typeIndex < module->bem_nTypes); Assert ((unsigned int) typeIndex < module->bem_nTypes);
symbol_p=module->bem_types [typeIndex]; symbol_p=module->bem_types [typeIndex];
Assert (symbol_p->symb_kind == erroneous_symb); symbol_p->symb_kind = symbolKind;
symbol_p->symb_arity = 1;
symbol_p->symb_kind = symbolKind;
symbol_p->symb_arity = 1;
symbol_p->symb_head_strictness=head_strictness; symbol_p->symb_head_strictness=head_strictness;
symbol_p->symb_tail_strictness=tail_strictness; symbol_p->symb_tail_strictness=tail_strictness;
} }
void BEAdjustStrictListConsInstance (int functionIndex,int moduleIndex)
{
SymbolP symbol_p;
symbol_p=&gBEState.be_modules[moduleIndex].bem_functions[functionIndex];
if (symbol_p->symb_kind==definition){
TypeNode element_type_p,list_type_p;
SymbDef sdef;
TypeArgs type_args_p;
sdef=symbol_p->symb_def;
type_args_p=sdef->sdef_rule_type->rule_type_rule->type_alt_lhs->type_node_arguments;
element_type_p=type_args_p->type_arg_node;
list_type_p=type_args_p->type_arg_next->type_arg_node;
Assert (list_type_p->type_node_is_var==0);
Assert (list_type_p->type_node_symbol->symb_kind==list_type);
symbol_p->symb_head_strictness=list_type_p->type_node_symbol->symb_head_strictness;
symbol_p->symb_tail_strictness=list_type_p->type_node_symbol->symb_tail_strictness;
if (list_type_p->type_node_symbol->symb_head_strictness==3){
int element_symbol_kind;
struct unboxed_cons *unboxed_cons_p;
Assert (element_type_p->type_node_is_var==0);
element_symbol_kind=element_type_p->type_node_symbol->symb_kind;
symbol_p->symb_head_strictness=4;
unboxed_cons_p=ConvertAllocType (struct unboxed_cons);
unboxed_cons_p->unboxed_cons_sdef_p=sdef;
if (element_symbol_kind < Nr_Of_Predef_Types)
unboxed_cons_p->unboxed_cons_state_p = unboxed_list_symbols[element_symbol_kind][symbol_p->symb_tail_strictness].symb_state_p;
else if (element_symbol_kind==definition && element_type_p->type_node_symbol->symb_def->sdef_kind==RECORDTYPE){
PolyList new_unboxed_record_cons_element;
SymbDef record_sdef;
record_sdef=element_type_p->type_node_symbol->symb_def;
record_sdef->sdef_isused=True;
sdef->sdef_isused=True;
unboxed_cons_p->unboxed_cons_state_p = &record_sdef->sdef_record_state;
new_unboxed_record_cons_element=ConvertAllocType (struct poly_list);
new_unboxed_record_cons_element->pl_elem = sdef;
new_unboxed_record_cons_element->pl_next = unboxed_record_cons_list;
unboxed_record_cons_list = new_unboxed_record_cons_element;
sdef->sdef_module=NULL;
} else
unboxed_cons_p->unboxed_cons_state_p = &StrictState;
symbol_p->symb_unboxed_cons_p=unboxed_cons_p;
}
} else {
Assert (symbol_p->symb_kind==definition);
debug_message ("BEAdjustStrictListInstance: !(symbol_p->symb_kind==definition) %d %d %d\n",functionIndex,moduleIndex,symbol_p->symb_kind);
symbol_p->symb_head_strictness=0;
symbol_p->symb_tail_strictness=0;
}
symbol_p->symb_kind = cons_symb;
/* symbol_p->symb_arity = 2; no symb_arity for cons_symb, because symb_state_p is used of this union */
}
void BEAdjustUnboxedListDeconsInstance (int functionIndex,int moduleIndex)
{
SymbolP symbol_p,cons_symbol_p;
SymbDefP sdef_p;
TypeNode element_type_p,list_type_p;
PolyList new_unboxed_record_decons_element;
symbol_p=&gBEState.be_modules[moduleIndex].bem_functions[functionIndex];
Assert (symbol_p->symb_kind==definition);
sdef_p=symbol_p->symb_def;
list_type_p=sdef_p->sdef_rule_type->rule_type_rule->type_alt_lhs->type_node_arguments->type_arg_node;
element_type_p=list_type_p->type_node_arguments->type_arg_node;
Assert (list_type_p->type_node_is_var==0);
Assert (list_type_p->type_node_symbol->symb_kind==list_type);
Assert (list_type_p->type_node_symbol->symb_head_strictness==3);
Assert (element_type_p->type_node_symbol->symb_def->sdef_kind==RECORDTYPE);
cons_symbol_p=ConvertAllocType (SymbolS);
cons_symbol_p->symb_kind = cons_symb;
cons_symbol_p->symb_head_strictness=4;
cons_symbol_p->symb_tail_strictness=list_type_p->type_node_symbol->symb_tail_strictness;
cons_symbol_p->symb_state_p=&element_type_p->type_node_symbol->symb_def->sdef_record_state;
sdef_p->sdef_unboxed_cons_symbol=cons_symbol_p;
new_unboxed_record_decons_element=ConvertAllocType (struct poly_list);
new_unboxed_record_decons_element->pl_elem = sdef_p;
new_unboxed_record_decons_element->pl_next = unboxed_record_decons_list;
unboxed_record_decons_list = new_unboxed_record_decons_element;
}
void BEAdjustOverloadedNilFunction (int functionIndex,int moduleIndex)
{
SymbolP symbol_p;
symbol_p=&gBEState.be_modules[moduleIndex].bem_functions[functionIndex];
symbol_p->symb_head_strictness=1;
symbol_p->symb_tail_strictness=0;
symbol_p->symb_kind = nil_symb;
}
BESymbolP BEOverloadedConsSymbol (int constructorIndex,int moduleIndex,int deconsIndex,int deconsModuleIndex)
{
BEModuleP module,decons_module;
SymbolP constructor_symbol,decons_symbol,list_type_symbol;
TypeNode list_type,element_type;
Assert ((unsigned int) deconsModuleIndex < gBEState.be_nModules);
decons_module = &gBEState.be_modules [deconsModuleIndex];
Assert ((unsigned int) deconsIndex < decons_module->bem_nFunctions);
decons_symbol = &decons_module->bem_functions [deconsIndex];
Assert (decons_symbol->symb_kind==definition);
list_type=decons_symbol->symb_def->sdef_rule_type->rule_type_rule->type_alt_lhs->type_node_arguments->type_arg_node;
element_type=list_type->type_node_arguments->type_arg_node;
Assert ((unsigned int) moduleIndex < gBEState.be_nModules);
module = &gBEState.be_modules [moduleIndex];
Assert ((unsigned int) constructorIndex < module->bem_nConstructors);
constructor_symbol = module->bem_constructors [constructorIndex];
Assert (constructor_symbol->symb_kind==definition
|| (moduleIndex==kPredefinedModuleIndex && constructor_symbol->symb_kind!=erroneous_symb));
if (moduleIndex != kPredefinedModuleIndex)
constructor_symbol->symb_def->sdef_isused = True;
list_type_symbol=list_type->type_node_symbol;
if (constructor_symbol->symb_head_strictness==1 && list_type_symbol->symb_head_strictness<4)
constructor_symbol=strict_list_cons_symbols[(list_type_symbol->symb_head_strictness<<1)+list_type_symbol->symb_tail_strictness];
if (list_type_symbol->symb_head_strictness==3){
int element_symbol_kind;
Assert (element_type->type_node_is_var==0);
element_symbol_kind=element_type->type_node_symbol->symb_kind;
if (element_symbol_kind<Nr_Of_Predef_Types)
constructor_symbol=&unboxed_list_symbols[element_symbol_kind][list_type_symbol->symb_tail_strictness];
else if (element_symbol_kind==definition && element_type->type_node_symbol->symb_def->sdef_kind==RECORDTYPE)
constructor_symbol=decons_symbol->symb_def->sdef_unboxed_cons_symbol;
}
return constructor_symbol;
}
BENodeP BEOverloadedPushNode (int arity,BESymbolP symbol,BEArgP arguments,BENodeIdListP nodeIds,BENodeP decons_node)
{
NodeP push_node;
push_node = ConvertAllocType (NodeS);
push_node->node_kind = PushNode;
push_node->node_arity = arity;
push_node->node_arguments = arguments;
push_node->node_push_symbol = symbol;
push_node->node_decons_node = decons_node;
push_node->node_node_ids = nodeIds;
push_node->node_number = 0;
Assert (arguments->arg_node->node_kind == NodeIdNode);
Assert (arguments->arg_node->node_node_id->nid_ref_count_sign == -1);
arguments->arg_node->node_node_id->nid_refcount++;
return push_node;
}
#endif #endif
void void
...@@ -1460,9 +1658,6 @@ static int gCurrentScope = 0; ...@@ -1460,9 +1658,6 @@ static int gCurrentScope = 0;
static NodeIdRefCountListP gRefCountLists [kMaxScope]; static NodeIdRefCountListP gRefCountLists [kMaxScope];
static NodeIdRefCountListP gRefCountList; static NodeIdRefCountListP gRefCountList;
# define nid_ref_count_sign nid_scope
static void static void
AddRefCount (NodeIdP nodeId) AddRefCount (NodeIdP nodeId)
{ {
...@@ -1731,7 +1926,11 @@ BEPushNode (int arity, BESymbolP symbol, BEArgP arguments, BENodeIdListP nodeIds ...@@ -1731,7 +1926,11 @@ BEPushNode (int arity, BESymbolP symbol, BEArgP arguments, BENodeIdListP nodeIds
pushNode->node_kind = PushNode; pushNode->node_kind = PushNode;
pushNode->node_arity = arity; pushNode->node_arity = arity;
pushNode->node_arguments = arguments; pushNode->node_arguments = arguments;
#if STRICT_LISTS
pushNode->node_push_symbol = symbol;
#else
pushNode->node_record_symbol= symbol; pushNode->node_record_symbol= symbol;
#endif
pushNode->node_node_ids = nodeIds; pushNode->node_node_ids = nodeIds;
pushNode->node_number = 0; pushNode->node_number = 0;
/* /*
...@@ -1748,6 +1947,7 @@ BEPushNode (int arity, BESymbolP symbol, BEArgP arguments, BENodeIdListP nodeIds ...@@ -1748,6 +1947,7 @@ BEPushNode (int arity, BESymbolP symbol, BEArgP arguments, BENodeIdListP nodeIds
*/ */
Assert (arguments->arg_node->node_kind == NodeIdNode); Assert (arguments->arg_node->node_kind == NodeIdNode);
Assert (arguments->arg_node->node_node_id->nid_ref_count_sign == -1); Assert (arguments->arg_node->node_node_id->nid_ref_count_sign == -1);
arguments->arg_node->node_node_id->nid_refcount++; arguments->arg_node->node_node_id->nid_refcount++;
return (pushNode); return (pushNode);
...@@ -3229,6 +3429,62 @@ BEArg (CleanString arg) ...@@ -3229,6 +3429,62 @@ BEArg (CleanString arg)
} }
} /* BEArg */ } /* BEArg */
#if STRICT_LISTS
static void init_unboxed_list_symbols (void)
{
StateP array_state_p,strict_array_state_p,unboxed_array_state_p;
int i;
for (i=0; i<Nr_Of_Predef_Types; ++i){
SymbolP symbol_p;
symbol_p=&unboxed_list_symbols[i][0];
symbol_p->symb_kind=cons_symb;
symbol_p->symb_head_strictness=4;
symbol_p->symb_tail_strictness=0;
symbol_p->symb_state_p=&BasicSymbolStates[i];
symbol_p->symb_next=NULL;
symbol_p=&unboxed_list_symbols[i][1];
symbol_p->symb_kind=cons_symb;
symbol_p->symb_head_strictness=4;
symbol_p->symb_tail_strictness=1;
symbol_p->symb_state_p=&BasicSymbolStates[i];
symbol_p->symb_next=NULL;
}
array_state_p=ConvertAllocType (StateS);
array_state_p->state_type = ArrayState;
array_state_p->state_arity = 1;
array_state_p->state_array_arguments = ConvertAllocType (StateS);
array_state_p->state_mark = 0;
SetUnaryState (&array_state_p->state_array_arguments[0],OnA,UnknownObj);
unboxed_list_symbols[array_type][0].symb_state_p=array_state_p;
unboxed_list_symbols[array_type][1].symb_state_p=array_state_p;
strict_array_state_p=ConvertAllocType (StateS);
strict_array_state_p->state_type = ArrayState;
strict_array_state_p->state_arity = 1;
strict_array_state_p->state_array_arguments = ConvertAllocType (StateS);
strict_array_state_p->state_mark = 0;
strict_array_state_p->state_array_arguments[0] = StrictState;
unboxed_list_symbols[strict_array_type][0].symb_state_p=strict_array_state_p;
unboxed_list_symbols[strict_array_type][1].symb_state_p=strict_array_state_p;
unboxed_array_state_p=ConvertAllocType (StateS);
unboxed_array_state_p->state_type = ArrayState;
unboxed_array_state_p->state_arity = 1;
unboxed_array_state_p->state_array_arguments = ConvertAllocType (StateS);
unboxed_array_state_p->state_mark = STATE_UNBOXED_ARRAY_MASK;
unboxed_array_state_p->state_array_arguments [0] = StrictState;
unboxed_list_symbols[unboxed_array_type][0].symb_state_p=unboxed_array_state_p;
unboxed_list_symbols[unboxed_array_type][1].symb_state_p=unboxed_array_state_p;
}
#endif
BackEnd BackEnd
BEInit (int argc) BEInit (int argc)
{ {
...@@ -3256,6 +3512,10 @@ BEInit (int argc) ...@@ -3256,6 +3512,10 @@ BEInit (int argc)
#endif #endif
UserDefinedArrayFunctions = NULL; UserDefinedArrayFunctions = NULL;
#if STRICT_LISTS
unboxed_record_cons_list=NULL;
unboxed_record_decons_list=NULL;
#endif
InitPredefinedSymbols (); InitPredefinedSymbols ();
...@@ -3266,6 +3526,10 @@ BEInit (int argc) ...@@ -3266,6 +3526,10 @@ BEInit (int argc)
InitCoding (); InitCoding ();
InitInstructions (); InitInstructions ();
#if STRICT_LISTS
init_unboxed_list_symbols();
#endif
CheckBEEnumTypes (); CheckBEEnumTypes ();
gBEState.be_argv = ConvertAlloc ((argc+1) * sizeof (char *)); gBEState.be_argv = ConvertAlloc ((argc+1) * sizeof (char *));
......
...@@ -209,13 +209,28 @@ Clean (BEBoolSymbol :: Bool BackEnd -> (BESymbolP, BackEnd)) ...@@ -209,13 +209,28 @@ Clean (BEBoolSymbol :: Bool BackEnd -> (BESymbolP, BackEnd))
BESymbolP BELiteralSymbol (BESymbKind kind, CleanString value); BESymbolP BELiteralSymbol (BESymbKind kind, CleanString value);
Clean (BELiteralSymbol :: BESymbKind String BackEnd -> (BESymbolP, BackEnd)) Clean (BELiteralSymbol :: BESymbKind String BackEnd -> (BESymbolP, BackEnd))
/*
void BEPredefineListConstructorSymbol (int arity, int constructorIndex, int moduleIndex, BESymbKind symbolKind,int head_strictness,int tail_strictness); void BEPredefineListConstructorSymbol (int constructorIndex, int moduleIndex, BESymbKind symbolKind,int head_strictness,int tail_strictness);
Clean (BEPredefineListConstructorSymbol :: Int Int Int BESymbKind Int Int BackEnd -> BackEnd) Clean (BEPredefineListConstructorSymbol :: Int Int BESymbKind Int Int BackEnd -> BackEnd)
void BEPredefineListTypeSymbol (int typeIndex, int moduleIndex, BESymbKind symbolKind,int head_strictness,int tail_strictness); void BEPredefineListTypeSymbol (int typeIndex, int moduleIndex, BESymbKind symbolKind,int head_strictness,int tail_strictness);
Clean (BEPredefineListTypeSymbol :: Int Int BESymbKind Int Int BackEnd -> BackEnd) Clean (BEPredefineListTypeSymbol :: Int Int BESymbKind Int Int BackEnd -> BackEnd)
*/
void BEAdjustStrictListConsInstance (int functionIndex, int moduleIndex);
Clean (BEAdjustStrictListConsInstance :: Int Int BackEnd -> BackEnd)
void BEAdjustUnboxedListDeconsInstance (int functionIndex, int moduleIndex);
Clean (BEAdjustUnboxedListDeconsInstance :: Int Int BackEnd -> BackEnd)
void BEAdjustOverloadedNilFunction (int functionIndex,int moduleIndex);
Clean (BEAdjustOverloadedNilFunction :: Int Int BackEnd -> BackEnd)
BESymbolP BEOverloadedConsSymbol (int constructorIndex,int moduleIndex,int deconsIndex,int deconsModuleIndex);
Clean (BEOverloadedConsSymbol :: Int Int Int Int BackEnd -> (BESymbolP,BackEnd))
BENodeP BEOverloadedPushNode (int arity,BESymbolP symbol,BEArgP arguments,BENodeIdListP nodeIds,BENodeP decons_node);
Clean (BEOverloadedPushNode :: Int BESymbolP BEArgP BENodeIdListP BENodeP BackEnd -> (BENodeP, BackEnd))
void BEPredefineConstructorSymbol (int arity, int constructorIndex, int moduleIndex, BESymbKind symbolKind); void BEPredefineConstructorSymbol (int arity, int constructorIndex, int moduleIndex, BESymbKind symbolKind);
Clean (BEPredefineConstructorSymbol :: Int Int Int BESymbKind BackEnd -> BackEnd) Clean (BEPredefineConstructorSymbol :: Int Int Int BESymbKind BackEnd -> BackEnd)
......
...@@ -67,6 +67,29 @@ fatal_backend_error (char *s) ...@@ -67,6 +67,29 @@ fatal_backend_error (char *s)
Debugger (); Debugger ();
} }
void debug_message (const char *format,...)
{
va_list ap;
va_start (ap,format);
vfprintf (StdError,format,ap);
va_end (ap);
#ifdef _MAC_
{
FILE *f;
f=fopen ("DebugMessages","a");
if (f!=NULL){
va_start (ap,format);
vfprintf (f,format,ap);
va_end (ap);
fclose (f);
}
}
#endif
}
#if 1 #if 1
/* /*
Memory management Memory management
......
...@@ -13,6 +13,7 @@ extern void AssertionFailed (char *conditionString, char *file, int line); ...@@ -13,6 +13,7 @@ extern void AssertionFailed (char *conditionString, char *file, int line);
# define Assert(condition) {if (!(condition)) AssertionFailed ("!(" #condition ")", __FILE__, __LINE__);} # define Assert(condition) {if (!(condition)) AssertionFailed ("!(" #condition ")", __FILE__, __LINE__);}
extern void fatal_backend_error (char *s); extern void fatal_backend_error (char *s);
extern void debug_message (const char *format,...);
/* /*
Memory management Memory management
......
...@@ -1191,7 +1191,9 @@ void CodeGeneration (ImpMod imod, char *fname) ...@@ -1191,7 +1191,9 @@ void CodeGeneration (ImpMod imod, char *fname)
GenerateCodeForLazyTupleSelectorEntries (LazyTupleSelectors); GenerateCodeForLazyTupleSelectorEntries (LazyTupleSelectors);
GenerateCodeForLazyArrayFunctionEntries(); GenerateCodeForLazyArrayFunctionEntries();
#if STRICT_LISTS
GenerateCodeForLazyUnboxedRecordListFunctions();
#endif
WriteLastNewlineToABCFile(); WriteLastNewlineToABCFile();
CloseABCFile (fname); CloseABCFile (fname);
......
...@@ -93,6 +93,17 @@ LabDef match_error_lab = {NULL, "", False, "_match_error", 0}; ...@@ -93,6 +93,17 @@ LabDef match_error_lab = {NULL, "", False, "_match_error", 0};
LabDef conss_lab = {NULL, "", False, "_Conss", 0}; LabDef conss_lab = {NULL, "", False, "_Conss", 0};
LabDef consts_lab = {NULL, "", False, "_Consts", 0}; LabDef consts_lab = {NULL, "", False, "_Consts", 0};
LabDef conssts_lab = {NULL, "", False, "_Conssts", 0}; LabDef conssts_lab = {NULL, "", False, "_Conssts", 0};
LabDef unboxed_cons_labels[][2] = {
/*IntObj*/ {{NULL, "", False, "_Consi", 0}, {NULL, "", False, "_Consits", 0}},
/*BoolObj*/ {{NULL, "", False, "_Consb", 0}, {NULL, "", False, "_Consbts", 0}},