add seq

backendC/CleanCompilerSources/backend.c

@@ -583,8 +583,13 @@ BEBindSpecialFunction (BESpecialIdentIndex index, int functionIndex, int moduleI
 	Assert ((unsigned int) functionIndex < module->bem_nFunctions);
 	functionSymbol	= &module->bem_functions [functionIndex];
 
-	if (functionSymbol->symb_kind == definition)
+	if (functionSymbol->symb_kind == definition){
 		*gSpecialIdents [index]	= functionSymbol->symb_def->sdef_ident;
+		
+		if (index==BESpecialIdentSeq && moduleIndex!=main_dcl_module_n){
+			functionSymbol->symb_kind=seq_symb;
+		}
+	}
 } /* BEBindSpecialFunction */
 
 extern SymbDefP special_types[]; /* defined in statesgen */
@@ -3630,7 +3635,6 @@ CheckBEEnumTypes (void)
 	Assert (apply_symb					== BEApplySymb);
 	Assert (if_symb						== BEIfSymb);
 	Assert (fail_symb					== BEFailSymb);
-	Assert (all_symb					== BEAllSymb);
 	Assert (select_symb					== BESelectSymb);
 	Assert (Nr_Of_Predef_FunsOrConses	== BENrOfPredefFunsOrConses);
 	Assert (definition					== BEDefinition);
@@ -3787,6 +3791,11 @@ BEInit (int argc)
 	gSpecialIdents [BESpecialIdentAnd]		= &AndId;
 	gSpecialIdents [BESpecialIdentOr]		= &OrId;
 
+	PreludeId = Identifier ("Prelude");
+	seq_id = NULL;
+	gSpecialIdents[BESpecialIdentPrelude] = &PreludeId;
+	gSpecialIdents[BESpecialIdentSeq] = &seq_id;
+
 	UserDefinedArrayFunctions	= NULL;
 #if STRICT_LISTS
 	unboxed_record_cons_list=NULL;

backendC/CleanCompilerSources/backend.h

@@ -166,6 +166,7 @@ Clean (::BESpecialIdentIndex :== Int)
 enum {
 	BESpecialIdentStdMisc, BESpecialIdentAbort, BESpecialIdentUndef,
 	BESpecialIdentStdBool, BESpecialIdentAnd, BESpecialIdentOr,
+	BESpecialIdentPrelude, BESpecialIdentSeq,
 
 	BESpecialIdentCount
 };

backendC/CleanCompilerSources/buildtree.c

@@ -13,7 +13,7 @@ SymbolP	BasicTypeSymbols [Nr_Of_Basic_Types],
 
 		ApplyTypeSymbol, TrueSymbol, FalseSymbol,
 		TupleSymbol, ListSymbol, ConsSymbol, NilSymbol,
-		SelectSymbols [MaxNodeArity], ApplySymbol, IfSymbol, FailSymbol, AllSymbol,
+		SelectSymbols [MaxNodeArity], ApplySymbol, IfSymbol, FailSymbol,
 		EmptyTypeSymbol,
 		TupleTypeSymbols [MaxNodeArity];
 
@@ -452,11 +452,6 @@ NewRuleAlt (void)
 	return (alt);
 } /* NewRuleAlt */
 
-TypeNode NewEmptyTypeNode (void)
-{
-	return NewTypeNode (NoAnnot, NoAttr, EmptyTypeSymbol, NIL, 0);
-} /* NewEmptyTypeNode */
-
 struct p_at_node_tree {
 	NodeP					annoted_node;
 	NodeP					at_node;

backendC/CleanCompilerSources/buildtree.h

@@ -78,8 +78,6 @@ extern char *CopyString (char *to, char *from, int *rest_size);
 extern	char BasicTypeIds  [];
 #define ConvertBasicTypeToChar(type_symb) BasicTypeIds [(type_symb) -> symb_kind]
 
-extern TypeNode NewEmptyTypeNode (void);
-
 extern IdentP DetermineNewSymbolId (char *prefix, TypeNode inst_type, TableKind table);
 
 extern	IdentP	gArrayIdents [];
@@ -88,7 +86,7 @@ extern SymbolP	BasicTypeSymbols [],
 				ArraySymbols [],
 				TrueSymbol, FalseSymbol, TupleSymbol, ListSymbol, ConsSymbol, NilSymbol,
 				ApplySymbol, ApplyTypeSymbol, SelectSymbols[],
-				FailSymbol, IfSymbol, AllSymbol, EmptyTypeSymbol;
+				FailSymbol, IfSymbol;
 #if STRICT_LISTS
 extern SymbolP
 	StrictListSymbol, StrictConsSymbol, StrictNilSymbol,

backendC/CleanCompilerSources/checker.h

@@ -16,6 +16,7 @@ extern Ident DynamicId;
 #if SA_RECOGNIZES_ABORT_AND_UNDEF
 extern Ident StdMiscId,abort_id,undef_id;
 #endif
+extern Ident PreludeId,seq_id,system_seq_id;
 
 extern Symbol StartSymbol, UnboxedArrayClassSymbols [], UnboxedArrayFunctionSymbols [];
 extern SymbDef scc_dependency_list,ArrayFunctionDefs[], StdArrayAbortDef;

backendC/CleanCompilerSources/checker_2.c

@@ -110,6 +110,8 @@ Ident AnnotatedId, ListId, TupleId, ConsId, NilId, ApplyId, SelectId,
 Ident StdMiscId,abort_id,undef_id;	
 #endif
 
+Ident PreludeId,seq_id,system_seq_id;
+
 Symbol StartSymbol;
 
 SymbDef ArrayFunctionDefs [NoArrayFun],StdArrayAbortDef;
@@ -203,6 +205,8 @@ void InitChecker (void)
 	StdMiscId = PutStringInHashTable ("StdMisc",ModuleIdTable);
 #endif
 
+	system_seq_id = PutStringInHashTable ("seq", SymbolIdTable);
+
  	/* Predefined Array functions */
 
  	ArrayFunctionIds[CreateArrayFun]	= PutStringInHashTable ("createArray", SymbolIdTable);

backendC/CleanCompilerSources/codegen2.c

@@ -51,7 +51,7 @@ char else_symb[] = "else";
 char then_symb[] = "then";
 char notused_string[] = "notused";
 
-SymbDef ApplyDef,IfDef;
+SymbDef ApplyDef,IfDef,SeqDef;
 
 unsigned NewLabelNr,new_not_eq_z_label_n;
 		
@@ -3266,6 +3266,58 @@ static void FillNormalNode (Node node,int *asp_p,int *bsp_p,NodeId update_node_i
 			}
 			return;
 		}
+		case seq_symb:
+			if (node->node_arity==2){
+				if (IsLazyState (node->node_state)){
+					FillSymbol (node,SeqDef,asp_p,bsp_p,update_node_id,code_gen_node_ids_p);
+				} else {
+					int old_asp,old_bsp;
+
+					old_asp=*asp_p;
+					old_bsp=*bsp_p;
+					BuildArg (node->node_arguments,asp_p,bsp_p,code_gen_node_ids_p);
+					GenPopA (*asp_p-old_asp);
+					GenPopA (*bsp_p-old_bsp);
+					*asp_p=old_asp;
+					*bsp_p=old_bsp;
+
+					if (update_node_id==NULL){
+						ArgP arg2_arg;
+					
+						arg2_arg=node->node_arguments->arg_next;
+						if (arg2_arg->arg_node->node_kind!=NodeIdNode){
+							Build (arg2_arg->arg_node,asp_p,bsp_p,code_gen_node_ids_p);
+						} else {
+							NodeId arg_node_id;
+							
+							arg_node_id=arg2_arg->arg_node->node_node_id;
+#if BOXED_RECORDS
+							arg_node_id->nid_mark2 |= NID_RECORD_USED_BY_NON_SELECTOR_OR_UPDATES;		
+#endif
+							if (CopyNodeIdArgument (arg2_arg->arg_state,arg_node_id,asp_p,bsp_p))
+								ChangeEvalStatusKindToStrictOnA (arg_node_id,code_gen_node_ids_p->saved_nid_state_l);
+							
+							decrement_reference_count_of_node_id (arg_node_id,&code_gen_node_ids_p->free_node_ids);
+						}
+					} else
+						FillNodeOnACycle (node->node_arguments->arg_next->arg_node,asp_p,bsp_p,update_node_id,code_gen_node_ids_p);
+				}
+			} else {
+				LabDef name;
+				
+				ConvertSymbolToConstructorDLabel (&name,SeqDef);
+
+				BuildArgs (node->node_arguments,asp_p,bsp_p,code_gen_node_ids_p);
+						
+				if (update_node_id==NULL){
+					*asp_p+=1-node->node_arity;
+					GenBuildPartialFunctionh (&name,node->node_arity);
+				} else {
+					GenFillh (&name,node->node_arity,*asp_p-update_node_id->nid_a_index,NormalFill);
+					*asp_p-=node->node_arity;
+				}
+			}
+			return;
 		default:
 			if (symb->symb_kind<Nr_Of_Basic_Types){
 				if (update_node_id==NULL){
@@ -6480,6 +6532,9 @@ void InitCoding (void)
 	IfDef=MakeNewSymbolDefinition ("system", IfId, 3, DEFRULE);
 	IfDef->sdef_number=0;
 
+	SeqDef=MakeNewSymbolDefinition ("system", system_seq_id, 2, DEFRULE);
+	SeqDef->sdef_number=0;
+
 	InitBasicDescriptor (UnknownObj, "_", SizeOfAStackElem);
 #if ABSTRACT_OBJECT
 	InitBasicDescriptor (AbstractObj, "_", SizeOfAStackElem);

backendC/CleanCompilerSources/codegen2.h

@@ -102,7 +102,7 @@ void build_and_cleanup (Node node,int *asp_p,int *bsp_p,CodeGenNodeIdsP code_gen
 #define CONSTRUCTOR_R_PREF k_pref
 
 extern char *Co_Wtype,*Co_Wspine,else_symb[],then_symb[],notused_string[];
-extern SymbDef ApplyDef,IfDef;
+extern SymbDef ApplyDef,IfDef,SeqDef;
 extern StateS StrictOnAState;
 
 void FillSelectSymbol (StateKind result_state_kind,int arity,int argnr,Args arg,int *asp_p,int *bsp_p,

backendC/CleanCompilerSources/codegen3.c

@@ -724,6 +724,8 @@ static void CodeRootSelection (Node root, NodeId rootid,int asp,int bsp,CodeGenN
 	}
 }
 
+static int CodeRootNode (Node root,NodeId rootid,int asp,int bsp,CodeGenNodeIdsP code_gen_node_ids_p,StateS resultstate,struct esc *esc_p);
+
 static int CodeRhsNodeDefsAndRestoreNodeIdStates (Node root_node,NodeDefs defs,int asp,int bsp,StateS resultstate,struct esc *esc_p,
 												NodeIdListElementP a_node_ids,NodeIdListElementP b_node_ids,
 												NodeIdListElementP free_node_ids,int doesnt_fail)
@@ -972,6 +974,25 @@ static void CodeNormalRootNode (Node root,NodeId rootid,int asp,int bsp,CodeGenN
 			} else
 				GenRtn (1,1,resultstate);
 			return;
+		case seq_symb:
+			if (root->node_arity==2){
+				int old_asp,old_bsp;
+				
+				old_asp=asp;
+				old_bsp=bsp;
+				BuildArg (root->node_arguments,&asp,&bsp,code_gen_node_ids_p);
+				GenPopA (asp-old_asp);
+				GenPopB (bsp-old_bsp);
+				/* asp=old_asp; bsp=old_bsp; */
+
+				CodeRootNode (root->node_arguments->arg_next->arg_node,rootid,old_asp,old_bsp,code_gen_node_ids_p,resultstate,NULL);
+			} else {
+				LabDef name;
+
+				ConvertSymbolToDLabel (&name,SeqDef);
+				FillRhsRoot (&name, root, asp, bsp,code_gen_node_ids_p);
+			}
+			return;
 		default:
 			if (rootsymb->symb_kind < Nr_Of_Basic_Types)
 				FillRhsRoot (&BasicDescriptors[rootsymb->symb_kind], root, asp, bsp,code_gen_node_ids_p);

backendC/CleanCompilerSources/comparser_2.c

@@ -193,8 +193,6 @@ InitParser (void)
 
 	ApplySymbol		= NewSymbol (apply_symb);
 	FailSymbol		= NewSymbol (fail_symb);
-	AllSymbol		= NewSymbol (all_symb);
-	EmptyTypeSymbol	= NewSymbol (empty_type);
 
 	clear_p_at_node_tree();
 } /* InitParser */

backendC/CleanCompilerSources/instructions.c

@@ -3717,7 +3717,7 @@ void GenSystemImports (void)
 		GenImpDesc ("e_system_dAP");
 		GenImpLab_node_entry ("e_system_nAP","e_system_eaAP");
 		GenImpLab ("e_system_sAP");
-		
+
 		GenImpDesc (nil_lab.lab_name);
 		GenImpDesc (cons_lab.lab_name);
 #if STRICT_LISTS
@@ -3743,6 +3743,12 @@ void GenSystemImports (void)
 			FPrintF (OutFile,N_PREFIX "%s.%d " EA_PREFIX "%s.%d",glob_selr,selnum,glob_selr,selnum);
 		}
 #endif
+
+		if (SeqDef!=NULL && (SeqDef->sdef_mark & (SDEF_USED_LAZILY_MASK | SDEF_USED_CURRIED_MASK))){
+			GenImpDesc ("e_system_dseq");
+			GenImpLab_node_entry ("e_system_nseq","e_system_easeq");	
+		}
+
 		GenImpLab ("_driver");
 	}
 }

backendC/CleanCompilerSources/optimisations.c

@@ -3347,6 +3347,15 @@ static void ExamineSymbolApplication (struct node *node)
 				symbol->symb_unboxed_cons_sdef_p->sdef_mark |= SDEF_USED_CURRIED_MASK;
 			else if (IsLazyState (node->node_state))
 				symbol->symb_unboxed_cons_sdef_p->sdef_mark |= SDEF_USED_LAZILY_MASK;
+		} else if (symbol->symb_kind==seq_symb){
+			if (node->node_arity!=2)
+				SeqDef->sdef_mark |= SDEF_USED_CURRIED_MASK;
+			else {
+				if (IsLazyState (node->node_state))
+					SeqDef->sdef_mark |= SDEF_USED_LAZILY_MASK;
+				else
+					SeqDef->sdef_mark |= SDEF_USED_STRICTLY_MASK;
+			}
 		}
 		return;
 	}

backendC/CleanCompilerSources/sa.c

@@ -2164,7 +2164,9 @@ static void InitNode (Node node)
 
 static void InitAlternative (RuleAltS *alt)
 {
+#ifndef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS
 	NodeDefs nds;
+#endif
 
 	InitNode (alt->alt_lhs_root);
 
@@ -2337,6 +2339,20 @@ static Exp ConvertNode (Node node, NodeId nid)
 					}
 					break;
 				}
+				case seq_symb:
+					if (node->node_arity==2){
+						e->e_kind = Dep;
+						e->e_args = NewExpArgs (2);
+						e->e_sym = 2;
+
+						e->e_args[0] = ConvertNode (node->node_arguments->arg_node,NULL);
+						e->e_args[1] = ConvertNode (node->node_arguments->arg_next->arg_node,NULL);
+
+						if (nid)
+							nid->nid_exp_ = e;
+
+						return e;
+					}
 				default:
 					e = & top;
 					if (nid)

backendC/CleanCompilerSources/statesgen.c

@@ -2124,6 +2124,17 @@ static Bool NodeInAStrictContext (Node node,StateS demanded_state,int local_scop
 				}
 				break;
 			}
+			case seq_symb:
+				node->node_state=demanded_state;
+				if (node->node_arity==2){
+					parallel = DetermineStrictArgContext (node->node_arguments,StrictState,local_scope);
+					parallel = DetermineStrictArgContext (node->node_arguments->arg_next,demanded_state,local_scope);
+				} else {
+					if (ShouldDecrRefCount)
+						DecrRefCountCopiesOfArgs (node->node_arguments IF_OPTIMIZE_LAZY_TUPLE_RECURSION(local_scope));
+					node->node_state = StrictState;
+				}
+				break;
 			default:
 				if (rootsymb->symb_kind < Nr_Of_Predef_Types){
 					node->node_state = BasicSymbolStates [rootsymb->symb_kind];

backendC/CleanCompilerSources/syntaxtr.t

@@ -72,7 +72,7 @@ typedef enum {
 #endif
 	Nr_Of_Predef_Types,
 	tuple_symb, cons_symb, nil_symb,
-	apply_symb, if_symb, fail_symb, all_symb,
+	apply_symb, if_symb, fail_symb, seq_symb,
 	select_symb,
 	Nr_Of_Predef_FunsOrConses,
 	definition, newsymbol, instance_symb, empty_symbol, field_symbol_list,