aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--backendC/CleanCompilerSources/backend.c13
-rw-r--r--backendC/CleanCompilerSources/backend.h1
-rw-r--r--backendC/CleanCompilerSources/buildtree.c7
-rw-r--r--backendC/CleanCompilerSources/buildtree.h4
-rw-r--r--backendC/CleanCompilerSources/checker.h1
-rw-r--r--backendC/CleanCompilerSources/checker_2.c4
-rw-r--r--backendC/CleanCompilerSources/codegen2.c57
-rw-r--r--backendC/CleanCompilerSources/codegen2.h2
-rw-r--r--backendC/CleanCompilerSources/codegen3.c21
-rw-r--r--backendC/CleanCompilerSources/comparser_2.c2
-rw-r--r--backendC/CleanCompilerSources/instructions.c8
-rw-r--r--backendC/CleanCompilerSources/optimisations.c9
-rw-r--r--backendC/CleanCompilerSources/sa.c16
-rw-r--r--backendC/CleanCompilerSources/statesgen.c11
-rw-r--r--backendC/CleanCompilerSources/syntaxtr.t2
15 files changed, 141 insertions, 17 deletions
diff --git a/backendC/CleanCompilerSources/backend.c b/backendC/CleanCompilerSources/backend.c
index e8215a2..b309c13 100644
--- a/backendC/CleanCompilerSources/backend.c
+++ b/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;
diff --git a/backendC/CleanCompilerSources/backend.h b/backendC/CleanCompilerSources/backend.h
index 728aea4..0a25481 100644
--- a/backendC/CleanCompilerSources/backend.h
+++ b/backendC/CleanCompilerSources/backend.h
@@ -166,6 +166,7 @@ Clean (::BESpecialIdentIndex :== Int)
enum {
BESpecialIdentStdMisc, BESpecialIdentAbort, BESpecialIdentUndef,
BESpecialIdentStdBool, BESpecialIdentAnd, BESpecialIdentOr,
+ BESpecialIdentPrelude, BESpecialIdentSeq,
BESpecialIdentCount
};
diff --git a/backendC/CleanCompilerSources/buildtree.c b/backendC/CleanCompilerSources/buildtree.c
index bfe0da7..1c84172 100644
--- a/backendC/CleanCompilerSources/buildtree.c
+++ b/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;
diff --git a/backendC/CleanCompilerSources/buildtree.h b/backendC/CleanCompilerSources/buildtree.h
index 45c909c..ce81188 100644
--- a/backendC/CleanCompilerSources/buildtree.h
+++ b/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,
diff --git a/backendC/CleanCompilerSources/checker.h b/backendC/CleanCompilerSources/checker.h
index 929687b..1d7be59 100644
--- a/backendC/CleanCompilerSources/checker.h
+++ b/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;
diff --git a/backendC/CleanCompilerSources/checker_2.c b/backendC/CleanCompilerSources/checker_2.c
index 2671ead..5b36852 100644
--- a/backendC/CleanCompilerSources/checker_2.c
+++ b/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);
diff --git a/backendC/CleanCompilerSources/codegen2.c b/backendC/CleanCompilerSources/codegen2.c
index 8ca3c18..81690b0 100644
--- a/backendC/CleanCompilerSources/codegen2.c
+++ b/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);
diff --git a/backendC/CleanCompilerSources/codegen2.h b/backendC/CleanCompilerSources/codegen2.h
index df2b29f..07a79db 100644
--- a/backendC/CleanCompilerSources/codegen2.h
+++ b/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,
diff --git a/backendC/CleanCompilerSources/codegen3.c b/backendC/CleanCompilerSources/codegen3.c
index 7a48e02..cfe7178 100644
--- a/backendC/CleanCompilerSources/codegen3.c
+++ b/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);
diff --git a/backendC/CleanCompilerSources/comparser_2.c b/backendC/CleanCompilerSources/comparser_2.c
index 4a5394e..9661a60 100644
--- a/backendC/CleanCompilerSources/comparser_2.c
+++ b/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 */
diff --git a/backendC/CleanCompilerSources/instructions.c b/backendC/CleanCompilerSources/instructions.c
index 271e172..7cbe692 100644
--- a/backendC/CleanCompilerSources/instructions.c
+++ b/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");
}
}
diff --git a/backendC/CleanCompilerSources/optimisations.c b/backendC/CleanCompilerSources/optimisations.c
index 3914329..5f97925 100644
--- a/backendC/CleanCompilerSources/optimisations.c
+++ b/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;
}
diff --git a/backendC/CleanCompilerSources/sa.c b/backendC/CleanCompilerSources/sa.c
index fed8c65..3bc5d68 100644
--- a/backendC/CleanCompilerSources/sa.c
+++ b/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)
diff --git a/backendC/CleanCompilerSources/statesgen.c b/backendC/CleanCompilerSources/statesgen.c
index f9d3e8a..c5d8c3a 100644
--- a/backendC/CleanCompilerSources/statesgen.c
+++ b/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];
diff --git a/backendC/CleanCompilerSources/syntaxtr.t b/backendC/CleanCompilerSources/syntaxtr.t
index 0c1d4a9..4c1589c 100644
--- a/backendC/CleanCompilerSources/syntaxtr.t
+++ b/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,
generated by cgit v1.2.3 (git 2.39.1) at 2025-03-15 08:08:36 +0000