Commit 5f0679df authored by John van Groningen's avatar John van Groningen
Browse files

add seq

parent f36dcd61
......@@ -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;
......
......@@ -166,6 +166,7 @@ Clean (::BESpecialIdentIndex :== Int)
enum {
BESpecialIdentStdMisc, BESpecialIdentAbort, BESpecialIdentUndef,
BESpecialIdentStdBool, BESpecialIdentAnd, BESpecialIdentOr,
BESpecialIdentPrelude, BESpecialIdentSeq,
BESpecialIdentCount
};
......
......@@ -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;
......
......@@ -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,
......
......@@ -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;
......
......@@ -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);
......
......@@ -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);
......
......@@ -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,
......
......@@ -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);
......
......@@ -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 */
......@@ -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");
}
}
......
......@@ -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;
}
......
......@@ -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)
......
......@@ -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];
......
......@@ -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,
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment