aboutsummaryrefslogtreecommitdiff
path: root/backendC
diff options
context:
space:
mode:
Diffstat (limited to 'backendC')
-rw-r--r--backendC/CleanCompilerSources/sa.c54
-rw-r--r--backendC/CleanCompilerSources/settings.c1
-rw-r--r--backendC/CleanCompilerSources/settings.h1
3 files changed, 50 insertions, 6 deletions
diff --git a/backendC/CleanCompilerSources/sa.c b/backendC/CleanCompilerSources/sa.c
index d253898..bb9f3a0 100644
--- a/backendC/CleanCompilerSources/sa.c
+++ b/backendC/CleanCompilerSources/sa.c
@@ -3105,6 +3105,43 @@ static void UpdateStateInfosWithStrictInfos (TypeAlts rule, unsigned arity, Stri
/* the result has no sense at the moment */
}
+static void update_exported_function_state_info_with_strict_info (TypeNode node, StrictInfo *s)
+{
+ Bool is_strict_annotated, is_strict, is_tuple;
+
+ is_strict_annotated = node->type_node_annotation==StrictAnnot;
+ is_tuple = IsTupleInfo (s);
+ is_strict = (is_tuple ? GetTupleStrictKind (s) : GetStrictKind (s, 0)) != NotStrict;
+
+ if (!is_strict_annotated && is_strict)
+ node->type_node_annotation=StrictAnnot;
+
+ if (is_tuple && (is_strict || is_strict_annotated)){
+ unsigned arity,i;
+ TypeArgs args;
+
+ arity = s->strict_arity;
+ args = node->type_node_arguments;
+
+ for (i = 0; i < arity; i++, args = args->type_arg_next)
+ update_exported_function_state_info_with_strict_info (args->type_arg_node,&GetTupleInfo (s,i));
+ }
+}
+
+static void update_exported_function_type_state_infos_with_strict_infos (TypeAlts rule, unsigned arity, StrictInfo *strict_args)
+{
+ unsigned i;
+ TypeArgs args;
+
+ if (! rule)
+ return;
+
+ args = rule->type_alt_lhs->type_node_arguments;
+
+ for (i = 0; i < arity; i++, args = args->type_arg_next)
+ update_exported_function_state_info_with_strict_info (args->type_arg_node,&strict_args[i]);
+}
+
Bool IsListArg (Fun *f, unsigned n)
{
TypeArgs args;
@@ -3574,12 +3611,17 @@ static void update_function_strictness (SymbDef sdef)
strict_added = False;
warning = False;
UpdateStateInfosWithStrictInfos (rule, arity, f->fun_strictargs, &f->fun_strictresult,&strict_added, &warning);
-
- if (strict_added && sdef->sdef_exported){
- if (DoListStrictTypes && ! DoListAllTypes)
- PrintType (sdef, rule);
- else
- export_warning = True;
+
+ if (sdef->sdef_exported){
+ if (strict_added){
+ if (DoListStrictTypes && ! DoListAllTypes)
+ PrintType (sdef, rule);
+ else
+ export_warning = True;
+ }
+
+ if (AddStrictnessToExportedFunctionTypes && sdef->sdef_dcl_icl!=NULL)
+ update_exported_function_type_state_infos_with_strict_infos (sdef->sdef_dcl_icl->sdef_rule_type->rule_type_rule, arity, f->fun_strictargs);
}
if (warning && (StrictAllWarning || StrictChecks))
diff --git a/backendC/CleanCompilerSources/settings.c b/backendC/CleanCompilerSources/settings.c
index 105ffd0..7fb3273 100644
--- a/backendC/CleanCompilerSources/settings.c
+++ b/backendC/CleanCompilerSources/settings.c
@@ -23,6 +23,7 @@ Bool ListOptimizations = False;
Bool DoDescriptors = False;
Bool ExportLocalLabels = False;
+Bool AddStrictnessToExportedFunctionTypes = False;
Bool DoProfiling=False; /* no longer used by memory profiler */
Bool DoTimeProfiling=False;
diff --git a/backendC/CleanCompilerSources/settings.h b/backendC/CleanCompilerSources/settings.h
index a8234a2..0ae5751 100644
--- a/backendC/CleanCompilerSources/settings.h
+++ b/backendC/CleanCompilerSources/settings.h
@@ -22,6 +22,7 @@ extern Bool DoDescriptors; /* not generated in abc file */
extern Bool ListOptimizations;
extern Bool ExportLocalLabels;
+extern Bool AddStrictnessToExportedFunctionTypes;
extern Bool DoProfiling;
extern Bool DoTimeProfiling;