diff options
Diffstat (limited to 'backendC')
-rw-r--r-- | backendC/CleanCompilerSources/backend.c | 13 | ||||
-rw-r--r-- | backendC/CleanCompilerSources/backend.h | 1 | ||||
-rw-r--r-- | backendC/CleanCompilerSources/buildtree.c | 7 | ||||
-rw-r--r-- | backendC/CleanCompilerSources/buildtree.h | 4 | ||||
-rw-r--r-- | backendC/CleanCompilerSources/checker.h | 1 | ||||
-rw-r--r-- | backendC/CleanCompilerSources/checker_2.c | 4 | ||||
-rw-r--r-- | backendC/CleanCompilerSources/codegen2.c | 57 | ||||
-rw-r--r-- | backendC/CleanCompilerSources/codegen2.h | 2 | ||||
-rw-r--r-- | backendC/CleanCompilerSources/codegen3.c | 21 | ||||
-rw-r--r-- | backendC/CleanCompilerSources/comparser_2.c | 2 | ||||
-rw-r--r-- | backendC/CleanCompilerSources/instructions.c | 8 | ||||
-rw-r--r-- | backendC/CleanCompilerSources/optimisations.c | 9 | ||||
-rw-r--r-- | backendC/CleanCompilerSources/sa.c | 16 | ||||
-rw-r--r-- | backendC/CleanCompilerSources/statesgen.c | 11 | ||||
-rw-r--r-- | backendC/CleanCompilerSources/syntaxtr.t | 2 |
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, |