diff options
Diffstat (limited to 'backendC')
-rw-r--r-- | backendC/CleanCompilerSources/sa.c | 54 | ||||
-rw-r--r-- | backendC/CleanCompilerSources/settings.c | 1 | ||||
-rw-r--r-- | backendC/CleanCompilerSources/settings.h | 1 |
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; |