added code for strict and unboxed lists

backendC/CleanCompilerSources/backend.c

@@ -41,6 +41,9 @@ BEGetVersion (int *current, int *oldestDefinition, int *oldestImplementation)
 	*oldestImplementation	= kBEVersionOldestImplementation;
 }
 
+#if STRICT_LISTS
+ PolyList unboxed_record_cons_list,unboxed_record_decons_list;
+#endif
 
 extern PolyList UserDefinedArrayFunctions;	/* typechecker.c */
 extern StdOutReopened, StdErrorReopened;	/* cocl.c */
@@ -494,10 +497,11 @@ BEFunctionSymbol (int functionIndex, int moduleIndex)
 
 	Assert ((unsigned int) functionIndex < module->bem_nFunctions);
 	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));
 
-	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);
 } /* BEFunctionSymbol */
@@ -978,10 +982,10 @@ BEConstructorSymbol (int constructorIndex, int moduleIndex)
 	if (constructorSymbol->symb_kind == erroneous_symb)
 		return (constructorSymbol);
 
-	Assert (constructorSymbol->symb_kind == definition
+	Assert (constructorSymbol->symb_kind == definition || constructorSymbol->symb_kind == cons_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;
 
 	return (constructorSymbol);
@@ -1036,8 +1040,14 @@ BELiteralSymbol (BESymbKind kind, CleanString value)
 	return (symbol);
 } /* BELiteralSymbol */
 
+# define	nid_ref_count_sign	nid_scope
+
 #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;
 	SymbolP symbol_p;
@@ -1045,21 +1055,21 @@ void BEPredefineListConstructorSymbol(int arity,int constructorIndex,int moduleI
 	Assert (moduleIndex == kPredefinedModuleIndex);
 
 	Assert ((unsigned int) moduleIndex < gBEState.be_nModules);
-	module	= &gBEState.be_modules [moduleIndex];
+	module = &gBEState.be_modules [moduleIndex];
 
 	Assert ((unsigned int) constructorIndex < module->bem_nConstructors);
 	
 	symbol_p=module->bem_constructors [constructorIndex];
-	
-	Assert (symbol_p->symb_kind == erroneous_symb);
 
 	symbol_p->symb_kind	= symbolKind;
-	symbol_p->symb_arity	= arity;
 	symbol_p->symb_head_strictness=head_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;
 	SymbolP symbol_p;
@@ -1067,19 +1077,207 @@ void BEPredefineListTypeSymbol(int typeIndex,int moduleIndex,BESymbKind symbolKi
 	Assert (moduleIndex == kPredefinedModuleIndex);
 
 	Assert ((unsigned int) moduleIndex < gBEState.be_nModules);
-	module	= &gBEState.be_modules [moduleIndex];
+	module = &gBEState.be_modules [moduleIndex];
 
 	Assert ((unsigned int) typeIndex < module->bem_nTypes);
 
 	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_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
 
 void
@@ -1460,9 +1658,6 @@ static int gCurrentScope = 0;
 static	NodeIdRefCountListP	gRefCountLists [kMaxScope];
 static	NodeIdRefCountListP	gRefCountList;
 
-# define	nid_ref_count_sign	nid_scope
-
-
 static void
 AddRefCount (NodeIdP nodeId)
 {
@@ -1731,7 +1926,11 @@ BEPushNode (int arity, BESymbolP symbol, BEArgP arguments, BENodeIdListP nodeIds
 	pushNode->node_kind			= PushNode;
 	pushNode->node_arity		= arity;
 	pushNode->node_arguments	= arguments;
+#if STRICT_LISTS
+	pushNode->node_push_symbol = symbol;
+#else
 	pushNode->node_record_symbol= symbol;
+#endif
 	pushNode->node_node_ids		= nodeIds;
 	pushNode->node_number		= 0;
 /*
@@ -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_node_id->nid_ref_count_sign == -1);
+
 	arguments->arg_node->node_node_id->nid_refcount++;
 	
 	return (pushNode);
@@ -3229,6 +3429,62 @@ BEArg (CleanString arg)
 	}
 } /* 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
 BEInit (int argc)
 {
@@ -3256,6 +3512,10 @@ BEInit (int argc)
 #endif
 
 	UserDefinedArrayFunctions	= NULL;
+#if STRICT_LISTS
+	unboxed_record_cons_list=NULL;
+	unboxed_record_decons_list=NULL;
+#endif
 
 	InitPredefinedSymbols ();
 
@@ -3266,6 +3526,10 @@ BEInit (int argc)
 	InitCoding ();
 	InitInstructions ();
 
+#if STRICT_LISTS
+	init_unboxed_list_symbols();
+#endif
+
 	CheckBEEnumTypes ();
 
 	gBEState.be_argv		= ConvertAlloc ((argc+1) * sizeof (char *));

backendC/CleanCompilerSources/backend.h

@@ -209,13 +209,28 @@ Clean (BEBoolSymbol :: Bool BackEnd -> (BESymbolP, BackEnd))
 BESymbolP BELiteralSymbol (BESymbKind kind, CleanString value);
 Clean (BELiteralSymbol :: BESymbKind String BackEnd -> (BESymbolP, BackEnd))
 
-/*
-void BEPredefineListConstructorSymbol (int arity, int constructorIndex, int moduleIndex, BESymbKind symbolKind,int head_strictness,int tail_strictness);
-Clean (BEPredefineListConstructorSymbol :: Int Int Int BESymbKind Int Int BackEnd -> BackEnd)
+
+void BEPredefineListConstructorSymbol (int constructorIndex, int moduleIndex, BESymbKind symbolKind,int head_strictness,int tail_strictness);
+Clean (BEPredefineListConstructorSymbol :: Int Int BESymbKind Int Int BackEnd -> BackEnd)
 
 void BEPredefineListTypeSymbol (int typeIndex, int moduleIndex, BESymbKind symbolKind,int head_strictness,int tail_strictness);
 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);
 Clean (BEPredefineConstructorSymbol :: Int Int Int BESymbKind BackEnd -> BackEnd)

backendC/CleanCompilerSources/backendsupport.c

@@ -67,6 +67,29 @@ fatal_backend_error (char *s)
 	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
 /*
 	Memory management

backendC/CleanCompilerSources/backendsupport.h

@@ -13,6 +13,7 @@ extern void AssertionFailed (char *conditionString, char *file, int line);
 # define	Assert(condition)	{if (!(condition)) AssertionFailed ("!(" #condition ")", __FILE__, __LINE__);}
 
 extern void fatal_backend_error (char *s);
+extern void debug_message (const char *format,...);
 
 /*
 	Memory management

backendC/CleanCompilerSources/codegen.c

@@ -1191,7 +1191,9 @@ void CodeGeneration (ImpMod imod, char *fname)
 
 			GenerateCodeForLazyTupleSelectorEntries (LazyTupleSelectors);
 			GenerateCodeForLazyArrayFunctionEntries();
-
+#if STRICT_LISTS
+			GenerateCodeForLazyUnboxedRecordListFunctions();
+#endif
 			WriteLastNewlineToABCFile();
 
 			CloseABCFile (fname);

backendC/CleanCompilerSources/codegen1.c

@@ -93,6 +93,17 @@ LabDef match_error_lab		= {NULL, "", False, "_match_error", 0};
 LabDef conss_lab			= {NULL, "", False, "_Conss", 0};
 LabDef consts_lab			= {NULL, "", False, "_Consts", 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}},
+	/*CharObj*/	{{NULL, "", False, "_Consc", 0}, {NULL, "", False, "_Conscts", 0}},
+	/*RealObj*/	{{NULL, "", False, "_Consr", 0}, {NULL, "", False, "_Consrts", 0}},
+	/*FileObj*/	{{NULL, "", False, "_Consf", 0}, {NULL, "", False, "_Consfts", 0}}
+	};
+
+LabDef unboxed_cons_array_label = {NULL, "", False, "_Consa", 0};
+
 #endif
 #ifdef CLEAN2
 LabDef select_with_dictionary_lab	= {NULL, "", False, "_select_with_dictionary", 0};
@@ -688,7 +699,7 @@ static void CopyEntry (int offset, int *sp, int offframe [])
 		GenPushA (*sp-offset); 
 	else
 		GenPushB (*sp-offset); 
-	(*sp)++;
+	++ *sp;
 	UpdateFrame  (offframe, *sp, offframe[offset], offframe);
 }
 
@@ -1107,46 +1118,109 @@ static void GenLazyFieldSelectorEntry (SymbDef field_def,StateS recstate,int tot
 	 }
 }
 
-static void GenLazyArrayFunction (SymbDef arr_fun_def)
+static void GenUnboxedRecordApplyAndNodeEntries (SymbDef fun_def,int n_result_nodes_on_a_stack,int *a_size_p,int *b_size_p)
 {
 	LabDef ealab;
 	int asize,bsize,maxasize;
-	RuleTypes af_type;
+	RuleTypes rule_type;
 	int arity;
 
 	asize = 0;
 	bsize = 0;
 	maxasize = 0;
 
-	af_type	= arr_fun_def->sdef_rule_type;
-	arity = arr_fun_def->sdef_arity;
+	rule_type	= fun_def->sdef_rule_type;
+	arity = fun_def->sdef_arity;
 
-	MakeSymbolLabel (&CurrentAltLabel,NULL,no_pref,arr_fun_def,0);
+	MakeSymbolLabel (&CurrentAltLabel,NULL,no_pref,fun_def,0);
 
 	ealab			= CurrentAltLabel;
 	ealab.lab_pref	= ea_pref;
 	
-	AddStateSizesAndMaxFrameSizes (arity,af_type->rule_type_state_p,&maxasize,&asize,&bsize);
+	AddStateSizesAndMaxFrameSizes (arity,rule_type->rule_type_state_p,&maxasize,&asize,&bsize);
 
-	if ((arr_fun_def->sdef_mark & SDEF_USED_CURRIED_MASK) || DoDescriptors || DoParallel)
-		GenArrayFunctionDescriptor (arr_fun_def,&CurrentAltLabel,arity);
+	if ((fun_def->sdef_mark & SDEF_USED_CURRIED_MASK) || DoDescriptors || DoParallel)
+		GenArrayFunctionDescriptor (fun_def,&CurrentAltLabel,arity);
 
 	if (DoTimeProfiling)
-		GenPB (arr_fun_def->sdef_ident->ident_name);
+		GenPB (fun_def->sdef_ident->ident_name);
 
-	if (arr_fun_def->sdef_mark & SDEF_USED_CURRIED_MASK)
-		ApplyEntry (af_type->rule_type_state_p,arity,&ealab,!(arr_fun_def->sdef_mark & SDEF_USED_LAZILY_MASK));
+	if (fun_def->sdef_mark & SDEF_USED_CURRIED_MASK)
+		ApplyEntry (rule_type->rule_type_state_p,arity,&ealab,!(fun_def->sdef_mark & SDEF_USED_LAZILY_MASK));
 
-	if (arr_fun_def->sdef_mark & SDEF_USED_LAZILY_MASK)
-		NodeEntry (af_type->rule_type_state_p,arity,&ealab,arr_fun_def);
+	if (fun_def->sdef_mark & SDEF_USED_LAZILY_MASK)
+		NodeEntry (rule_type->rule_type_state_p,arity,&ealab,fun_def);
 
-	EvalArgsEntry (af_type->rule_type_state_p,arr_fun_def,maxasize,&ealab,0);
+	EvalArgsEntry (rule_type->rule_type_state_p,fun_def,maxasize,&ealab,n_result_nodes_on_a_stack);
+	
+	*a_size_p=asize;
+	*b_size_p=bsize;
+}
 
-	CallArrayFunction (arr_fun_def,False,&af_type->rule_type_state_p[-1]);
+#if STRICT_LISTS
+extern PolyList unboxed_record_cons_list,unboxed_record_decons_list;
 
-	if (DoTimeProfiling)
-		GenPE();
+void GenerateCodeForLazyUnboxedRecordListFunctions (void)
+{
+	PolyList unboxed_record_cons_elem,unboxed_record_decons_elem;
+	
+	for_l (unboxed_record_cons_elem,unboxed_record_cons_list,pl_next){
+		SymbDef fun_def;
+		
+		fun_def=unboxed_record_cons_elem->pl_elem;
+		if (fun_def->sdef_mark & (SDEF_USED_LAZILY_MASK | SDEF_USED_CURRIED_MASK)){
+			int a_size,b_size;
+			TypeArgs type_node_arguments_p;
+			LabDef unboxed_record_cons_lab;
+			int tail_strict;
+