optimize is constructor functions

backendC/CleanCompilerSources/codegen.c

 
-
 #define for_l(v,l,n) for(v=(l);v!=NULL;v=v->n)
 
 #define SHARE_UPDATE_CODE 0 /* also in codegen1.c */
@@ -667,7 +666,8 @@ static void CodeRule (ImpRuleP rule)
 
 	if (rule_sdef->sdef_exported){
 		GenExportStrictAndEaEntry (rule_sdef);
-	} else if (!(rule_sdef->sdef_mark & (SDEF_USED_CURRIED_MASK | SDEF_USED_LAZILY_MASK | SDEF_USED_STRICTLY_MASK)))
+	} else if (!(rule_sdef->sdef_mark & (SDEF_USED_CURRIED_MASK | SDEF_USED_LAZILY_MASK) ||
+				 (rule_sdef->sdef_mark & SDEF_USED_STRICTLY_MASK && !(rule_sdef->sdef_mark & SDEF_INLINE_IS_CONSTRUCTOR))))
 		return;
 
 	GenFunctionDescriptorAndExportNodeAndDescriptor (rule_sdef);
@@ -882,7 +882,12 @@ static void CodeRule (ImpRuleP rule)
 	}
 #endif
 
-	rule_may_fail=CodeRuleAlt (rule->rule_alts,init_a_stack_top,init_b_stack_top,CurrentAltLabel.lab_post,resultstate);
+	if ((rule_sdef->sdef_mark & SDEF_INLINE_IS_CONSTRUCTOR)!=0){
+		generate_is_constructor (rule);
+		GenRtn (0, 1, BasicSymbolStates[bool_type]);
+		rule_may_fail = False;
+	} else
+		rule_may_fail = CodeRuleAlt (rule->rule_alts,init_a_stack_top,init_b_stack_top,CurrentAltLabel.lab_post,resultstate);
 
 	if (function_called_only_curried_or_lazy_with_one_return){
 		StateS *function_state_p;

backendC/CleanCompilerSources/codegen1.c

@@ -1340,7 +1340,7 @@ void GenerateCodeForConstructorsAndRecords (Symbol symbols)
 
 					for_l (fields,constructor->cl_fields,fl_next)
 						GenLazyFieldSelectorEntry (fields->fl_symbol->symb_def,def->sdef_record_state, asize, bsize);
-				}	
+				}
 			}
 		}
 	}
@@ -3025,6 +3025,42 @@ static void jump_false_to_next_alternative (LabDef *esclabel,int remove_a,int re
 	}
 }
 
+void generate_is_constructor (ImpRuleP rule)
+{
+	NodeP case_node;
+	LabDef symbol_label;
+
+	case_node = rule->rule_alts->alt_rhs_root->node_arguments->arg_node;
+
+	if (case_node->node_symbol->symb_kind==nil_symb)
+		GenEqDesc (&nil_lab,case_node->node_arity,0);
+	else if (case_node->node_symbol->symb_kind==cons_symb){
+		struct symbol *symbol;
+		
+		symbol=case_node->node_symbol;
+		if (symbol->symb_head_strictness==1 || symbol->symb_head_strictness>=3){
+			GenEqDesc (&nil_lab,0,0);
+			GenNotB();
+		} else
+			GenEqDesc (&cons_lab,case_node->node_arity,0);
+	} else {
+		SymbDef sdef;
+		sdef=case_node->node_symbol->symb_def;
+
+		if (sdef->sdef_kind==CONSTRUCTOR && sdef->sdef_strict_constructor
+			&& sdef->sdef_arity==case_node->node_arity)
+		{
+			ConvertSymbolToKLabel (&symbol_label,sdef);
+			GenEqDesc (&symbol_label,0,0);
+		} else {
+			ConvertSymbolToConstructorDLabel (&symbol_label,sdef);
+			GenEqDesc (&symbol_label,case_node->node_arity,0);
+		}
+	}
+	
+	GenPopA (1);
+}
+
 static void CheckSymbol (Label symblab,int arity,int stackpos,int remove_a,int remove_b,Label esclabel)
 {
 	GenEqDesc (symblab, arity, stackpos);
@@ -3431,7 +3467,7 @@ static int generate_code_for_switch_node (NodeP node,int asp,int bsp,struct esc
 								
 								GenJmp (&case_label);
 								matches_always=1;
-							} else {	
+							} else {
 								if (sdef->sdef_kind==CONSTRUCTOR && sdef->sdef_strict_constructor
 									&& sdef->sdef_arity==case_node->node_arity)
 								{

backendC/CleanCompilerSources/codegen1.h

@@ -131,3 +131,4 @@ extern ImpRuleS *create_simple_imp_rule (struct node *lhs_root,struct node *rhs_
 #define unused_node_id(node_id) ((node_id)->nid_refcount!=-1 ? (node_id)->nid_refcount==0 : unused_node_id_ (node_id))
 extern int unused_node_id_ (NodeId node_id);
 
+extern void generate_is_constructor (ImpRuleP rule);

backendC/CleanCompilerSources/instructions.c

@@ -1217,7 +1217,7 @@ static void CallFunction2 (Label label, SymbDef def, Bool isjsr, StateS root_sta
 				CurrentModule = def->sdef_module;
 				CurrentExt    = GetFileExtension (abcFile);
 				
-				StaticMessage (False, "%D", "no inline code for this rule", def);
+				StaticMessage (False, "%D", "no inline code for this function", def);
 
 				CurrentModule = previous_module;
 				CurrentExt = previous_ext;
@@ -1231,31 +1231,41 @@ static void CallFunction2 (Label label, SymbDef def, Bool isjsr, StateS root_sta
 			} else
 				GenJmp (label);
 		}
-	} else if (def->sdef_kind==IMPRULE && IsInlineFromCurrentModule (def)){
-		Instructions instruction, last, first, next;
+		return;
+	}
+	if (def->sdef_kind==IMPRULE){
+		if ((def->sdef_mark & SDEF_INLINE_IS_CONSTRUCTOR)!=0){
+			generate_is_constructor (def->sdef_rule);
+			if (!isjsr)
+				GenRtn (aout, bout, root_state);
+			return;
+		} else if (IsInlineFromCurrentModule (def)){
+			Instructions instruction, last, first, next;
 
-		instruction=def->sdef_rule->rule_alts->alt_rhs_code->co_instr;
-		instruction=instruction->instr_next;
-		first=instruction;
+			instruction=def->sdef_rule->rule_alts->alt_rhs_code->co_instr;
+			instruction=instruction->instr_next;
+			first=instruction;
 
-		last=NULL;
-		for (;(next=instruction->instr_next)!=NULL;instruction=next)
-			last=instruction;
+			last=NULL;
+			for (;(next=instruction->instr_next)!=NULL;instruction=next)
+				last=instruction;
 
-		last->instr_next=NULL;
-		GenInstructions (first);
-		last->instr_next=instruction;
+			last->instr_next=NULL;
+			GenInstructions (first);
+			last->instr_next=instruction;
 
-		if (!isjsr)
-			GenRtn (aout, bout, root_state);
-	} else {
-		GenDStackLayout (ain, bin, fun_args);
-		if (isjsr){
-			GenJsr (label);
-			GenOStackLayoutOfState (aout, bout, root_state);
-		} else
-			GenJmp (label);
-	}	
+			if (!isjsr)
+				GenRtn (aout, bout, root_state);
+			return;
+		}
+	}
+
+	GenDStackLayout (ain, bin, fun_args);
+	if (isjsr){
+		GenJsr (label);
+		GenOStackLayoutOfState (aout, bout, root_state);
+	} else
+		GenJmp (label);
 }
 
 void CallFunction (Label label, SymbDef def, Bool isjsr, Node root)

backendC/CleanCompilerSources/statesgen.c

@@ -2945,6 +2945,62 @@ static void set_states_in_lhs (ArgP arguments,StateP states)
 }
 #endif
 
+static void mark_is_constructor_function (ImpRuleP rule)
+{
+	RuleAltP alt;
+
+	alt=rule->rule_alts;
+	if (alt->alt_kind==Contractum && alt->alt_next==NULL && alt->alt_rhs_defs==NULL && alt->alt_lhs_defs==NULL){
+		NodeP node_p;
+		ArgP arg_p;
+		
+		arg_p=alt->alt_lhs_root->node_arguments;
+		if (arg_p!=NULL && arg_p->arg_next==NULL && arg_p->arg_node->node_kind==NodeIdNode){
+			node_p=alt->alt_rhs_root;
+			if (node_p->node_kind==SwitchNode){
+				NodeP case_node;
+
+				arg_p=node_p->node_arguments;
+				case_node=arg_p->arg_node;
+				if (case_node->node_kind==CaseNode){
+					struct symbol *symbol;
+					NodeP case_rhs_node;
+
+					case_rhs_node = case_node->node_arguments->arg_node;
+					if (case_rhs_node->node_kind==PushNode)
+						case_rhs_node = case_rhs_node->node_arguments->arg_next->arg_node;
+
+					symbol=case_node->node_symbol;
+					if (((symbol->symb_kind==definition && symbol->symb_def->sdef_kind==CONSTRUCTOR) ||
+						 symbol->symb_kind==nil_symb || symbol->symb_kind==cons_symb) &&
+						case_node->node_node_defs==NULL &&
+						case_rhs_node->node_kind==NormalNode && case_rhs_node->node_symbol->symb_kind==bool_denot &&
+						case_rhs_node->node_symbol->symb_bool==True)
+					{
+						arg_p=arg_p->arg_next;
+						if (arg_p!=NULL){
+							NodeP default_node;
+
+							default_node=arg_p->arg_node;
+							if (arg_p->arg_node->node_kind==DefaultNode){
+								NodeP default_rhs_node;
+								
+								default_rhs_node=default_node->node_arguments->arg_node;
+								if (default_node->node_node_defs==NULL &&
+									default_rhs_node->node_kind==NormalNode && default_rhs_node->node_symbol->symb_kind==bool_denot &&
+									default_rhs_node->node_symbol->symb_bool==False)
+								{
+									rule->rule_root->node_symbol->symb_def->sdef_mark |= SDEF_INLINE_IS_CONSTRUCTOR;
+								}
+							}
+						}
+					}
+				}
+			}
+		}
+	}
+}
+
 void GenerateStatesForRule (ImpRuleS *rule)
 {
 	SymbDef rule_sdef;
@@ -2975,10 +3031,15 @@ void GenerateStatesForRule (ImpRuleS *rule)
 
 #ifdef OBSERVE_ARRAY_SELECTS_IN_PATTERN
 			set_states_of_array_selects_in_pattern (alt);
-#endif				
+#endif
 		} else if (rule->rule_type==NULL)
 			StaticMessage (True, "%S", ECodeBlock, CurrentSymbol);
 	}
+
+	if (rule_sdef->sdef_arity==1 &&
+			function_state_p[-1].state_type==SimpleState && function_state_p[-1].state_kind==OnB && function_state_p[-1].state_object==BoolObj &&
+			function_state_p[0].state_type==SimpleState && function_state_p[0].state_kind==StrictOnA)
+		mark_is_constructor_function (rule);
 }
 
 void GenerateStates (ImpRules rules)
@@ -4014,7 +4075,7 @@ static void DetermineSharedAndAnnotatedNodesOfRule (ImpRuleP rule)
 	CurrentSymbol=rule->rule_root->node_symbol;
 	
 	rule_sdef=CurrentSymbol->symb_def;
-	
+
 	for_l (alt,rule->rule_alts,alt_next)
 		if (alt->alt_kind==Contractum){
 			CurrentLine = alt->alt_line;

backendC/CleanCompilerSources/syntaxtr.t

@@ -278,9 +278,7 @@ STRUCT (node_id,NodeId){
 #define SHARED_NODES_COLLECTED_MASK				1
 #define NID_ALIAS_MASK 							2
 #define NID_ALIAS_MARK_MASK						4
-#define NID_COUNTED_AND_USED_IN_INNER_SCOPE		8
 #define NID_EXTRA_REFCOUNT_MASK					16
-#define COPY_NODE_MASK							64
 #define ON_A_CYCLE_MASK							128
 #define NID_VERIFY_MASK							256		/* macros */
 #define NID_THEN_ELSE_NON_LOCAL_NODE_ID			512		/* pattern_match */
@@ -298,7 +296,6 @@ STRUCT (node_id,NodeId){
 #endif
 #define NID_FIELD_NAME_MASK					32			/* typechecker */
 
-#define NID_COMPONENT_DETERMINED_MASK		256				/* optimise_lambda */
 #define NID_LHS_PUSHED						4096			/* codegen1 */
 
 #define NID_HAS_LAZY_SELECTOR_COUNTER		8192			/* statesgen */
@@ -659,6 +656,7 @@ STRUCT (symbol_def,SymbDef){
 #define SDEF_NEXT_IMP_RULE_VERSION_MASK 32
 #define	SDEF_HAS_IMP_RULE_VERSIONS_MASK 64
 #define	SDEF_OPTIMISED_FUNCTION_MASK 128
+#define SDEF_INLINE_IS_CONSTRUCTOR 4096
 
 /* some macros to reuse bit fields */