diff: purity bug-fix and new module post_typecheck.m
Fergus Henderson
fjh at cs.mu.OZ.AU
Thu Jun 4 22:55:15 AEST 1998
Estimated hours taken: 1.5
Improve the modularity of the code in purity.m by splitting it into two
modules and fix a purity-related bug by moving some code from typecheck.m
into the new module.
compiler/post_typecheck.m:
New module. Handles the typechecking stuff that happens
after typecheck.m.
compiler/purity.m:
Move the typechecking related code in purity.m into post_typecheck.m.
compiler/typecheck.m:
Move the code for copying clauses to the proc_infos, etc. into
new predicates in post_typecheck.m. This code is now called
from purity.m rather than from typecheck.m.
(I think the fact that it was being done in typecheck.m was a
bug -- it meant that the goal_info flags computed by purity.m
were not being copied across to the proc_infos.)
compiler/mercury_compile.m: compiler/typecheck.m:
Don't pass the ModeError parameter down to typecheck_pred,
since with the above change it isn't needed anymore.
compiler/notes/compiler_design.html:
Document these changes.
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.93
diff -u -r1.93 mercury_compile.m
--- mercury_compile.m 1998/05/29 08:50:41 1.93
+++ mercury_compile.m 1998/06/04 11:46:05
@@ -579,7 +579,7 @@
%
% Next typecheck the clauses.
%
- typecheck(HLDS2, HLDS3, FoundUndefModeError, FoundTypeError), !,
+ typecheck(HLDS2, HLDS3, FoundTypeError), !,
( { FoundTypeError = yes } ->
maybe_write_string(Verbose,
"% Program contains type error(s).\n"),
Index: compiler/post_typecheck.m
===================================================================
RCS file: post_typecheck.m
diff -N post_typecheck.m
--- /dev/null Thu Jun 4 22:08:21 1998
+++ post_typecheck.m Thu Jun 4 22:44:15 1998
@@ -0,0 +1,330 @@
+%-----------------------------------------------------------------------------%
+% Copyright (C) 1997-1998 The University of Melbourne.
+% This file may only be copied under the terms of the GNU General
+% Public License - see the file COPYING in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+%
+% File : post_typecheck.m
+% Author : fjh
+% Purpose : finish off type checking.
+%
+% This module does the final parts of type analysis:
+%
+% - it resolves predicate overloading
+% (perhaps it ought to also resolve function overloading,
+% converting unifications that are function calls into
+% HLDS call instructions, but currently that is still done
+% in modecheck_unify.m)
+%
+% - it checks for unbound type variables and if there are any,
+% it reports an error (or a warning, binding them to the type `void').
+%
+% These actions cannot be done until after type inference is complete,
+% so they need to be a separate "post-typecheck pass". For efficiency
+% reasons, this is in fact done at the same time as purity analysis --
+% the routines here are called from purity.m rather than mercury_compile.m.
+%
+% This module also copies the clause_info structure
+% to the proc_info structures. This is done in the post_typecheck pass
+% and not at the start of modecheck because modecheck may be
+% reinvoked after HLDS transformations. Any transformation that
+% needs typechecking should work with the clause_info structure.
+% Type information is also propagated into the modes of procedures
+% by this pass if the ModeError parameter is no.
+% ModeError should be yes if any undefined modes
+% were found by previous passes.
+%
+
+:- module post_typecheck.
+:- interface.
+:- import_module hlds_module, hlds_pred, io.
+:- import_module list, term, prog_data.
+
+ % Check that the all of the types which have been inferred
+ % for the variables in the clause do not contain any unbound type
+ % variables other than those that occur in the types of head
+ % variables.
+ %
+:- pred post_typecheck__check_type_bindings(pred_id, pred_info, pred_info,
+ module_info, int, io__state, io__state).
+:- mode post_typecheck__check_type_bindings(in, in, out, in, out, di, uo)
+ is det.
+
+ % Handle any unresolved overloading for a predicate call.
+ %
+:- pred post_typecheck__resolve_pred_overloading(pred_id, list(var),
+ pred_info, module_info, sym_name, sym_name, pred_id).
+:- mode post_typecheck__resolve_pred_overloading(in, in, in, in, in,
+ out, out) is det.
+
+ % Do the stuff needed to initialize the proc_infos so that
+ % a pred is ready for mode checking (copy clauses from the
+ % clause_info to the proc_info, etc.)
+ %
+:- pred post_typecheck__finish_pred(module_info, pred_id, pred_info, pred_info,
+ io__state, io__state).
+:- mode post_typecheck__finish_pred(in, in, in, out, di, uo) is det.
+
+:- pred post_typecheck__finish_imported_pred(module_info, pred_id,
+ pred_info, pred_info, io__state, io__state).
+:- mode post_typecheck__finish_imported_pred(in, in, in, out, di, uo) is det.
+
+%-----------------------------------------------------------------------------%
+:- implementation.
+
+:- import_module typecheck, clause_to_proc, mode_util, inst_match.
+:- import_module mercury_to_mercury, prog_out, hlds_out.
+:- import_module globals, options.
+
+:- import_module map, set, assoc_list, varset, bool, std_util.
+
+%-----------------------------------------------------------------------------%
+% Check for unbound type variables
+%
+% Check that the all of the types which have been inferred
+% for the variables in the clause do not contain any unbound type
+% variables other than those that occur in the types of head
+% variables.
+
+post_typecheck__check_type_bindings(PredId, PredInfo0, PredInfo, ModuleInfo,
+ NumErrors, IOState0, IOState) :-
+ pred_info_clauses_info(PredInfo0, ClausesInfo0),
+ ClausesInfo0 = clauses_info(VarSet, B, VarTypesMap0, HeadVars, E),
+ map__apply_to_list(HeadVars, VarTypesMap0, HeadVarTypes),
+ term__vars_list(HeadVarTypes, HeadVarTypeParams),
+ map__to_assoc_list(VarTypesMap0, VarTypesList),
+ set__init(Set0),
+ check_type_bindings_2(VarTypesList, HeadVarTypeParams,
+ [], Errs, Set0, Set),
+ ( Errs = [] ->
+ PredInfo = PredInfo0,
+ IOState = IOState0,
+ NumErrors = 0
+ ;
+ %
+ % report the warning
+ %
+ report_unresolved_type_warning(Errs, PredId, PredInfo0,
+ ModuleInfo, VarSet, IOState0, IOState),
+ NumErrors = 0,
+
+ %
+ % bind all the type variables in `Set' to `void' ...
+ %
+ pred_info_context(PredInfo0, Context),
+ bind_type_vars_to_void(Set, Context, VarTypesMap0, VarTypesMap),
+ ClausesInfo = clauses_info(VarSet, B, VarTypesMap, HeadVars, E),
+ pred_info_set_clauses_info(PredInfo0, ClausesInfo, PredInfo)
+ ).
+
+:- pred check_type_bindings_2(assoc_list(var, (type)), list(var),
+ assoc_list(var, (type)), assoc_list(var, (type)),
+ set(tvar), set(tvar)).
+:- mode check_type_bindings_2(in, in, in, out, in, out) is det.
+
+check_type_bindings_2([], _, Errs, Errs, Set, Set).
+check_type_bindings_2([Var - Type | VarTypes], HeadTypeParams,
+ Errs0, Errs, Set0, Set) :-
+ term__vars(Type, TVars),
+ set__list_to_set(TVars, TVarsSet0),
+ set__delete_list(TVarsSet0, HeadTypeParams, TVarsSet1),
+ ( \+ set__empty(TVarsSet1) ->
+ Errs1 = [Var - Type | Errs0],
+ set__union(Set0, TVarsSet1, Set1)
+ ;
+ Errs1 = Errs0,
+ Set0 = Set1
+ ),
+ check_type_bindings_2(VarTypes, HeadTypeParams,
+ Errs1, Errs, Set1, Set).
+
+%
+% bind all the type variables in `UnboundTypeVarsSet' to the type `void' ...
+%
+:- pred bind_type_vars_to_void(set(var), term__context,
+ map(var, type), map(var, type)).
+:- mode bind_type_vars_to_void(in, in, in, out) is det.
+
+bind_type_vars_to_void(UnboundTypeVarsSet, Context,
+ VarTypesMap0, VarTypesMap) :-
+ %
+ % first create a pair of corresponding lists (UnboundTypeVars, Voids)
+ % that map the unbound type variables to void
+ %
+ set__to_sorted_list(UnboundTypeVarsSet, UnboundTypeVars),
+ list__length(UnboundTypeVars, Length),
+ Void = term__functor(term__atom("void"), [], Context),
+ list__duplicate(Length, Void, Voids),
+
+ %
+ % then apply the substitution we just created to the variable types
+ %
+ map__keys(VarTypesMap0, Vars),
+ map__values(VarTypesMap0, Types0),
+ term__substitute_corresponding_list(UnboundTypeVars, Voids,
+ Types0, Types),
+ map__from_corresponding_lists(Vars, Types, VarTypesMap).
+
+%
+% report an error: uninstantiated type parameter
+%
+:- pred report_unresolved_type_warning(assoc_list(var, (type)), pred_id,
+ pred_info, module_info, varset, io__state, io__state).
+:- mode report_unresolved_type_warning(in, in, in, in, in, di, uo) is det.
+
+report_unresolved_type_warning(Errs, PredId, PredInfo, ModuleInfo, VarSet) -->
+ globals__io_lookup_bool_option(halt_at_warn, HaltAtWarn),
+ ( { HaltAtWarn = yes } ->
+ io__set_exit_status(1)
+ ;
+ []
+ ),
+
+ { pred_info_typevarset(PredInfo, TypeVarSet) },
+ { pred_info_context(PredInfo, Context) },
+
+ prog_out__write_context(Context),
+ io__write_string("In "),
+ hlds_out__write_pred_id(ModuleInfo, PredId),
+ io__write_string(":\n"),
+
+ prog_out__write_context(Context),
+ io__write_string(" warning: unresolved polymorphism.\n"),
+ prog_out__write_context(Context),
+ ( { Errs = [_] } ->
+ io__write_string(" The variable with an unbound type was:\n")
+ ;
+ io__write_string(" The variables with unbound types were:\n")
+ ),
+ write_type_var_list(Errs, Context, VarSet, TypeVarSet),
+ prog_out__write_context(Context),
+ io__write_string(" The unbound type variable(s) will be implicitly\n"),
+ prog_out__write_context(Context),
+ io__write_string(" bound to the builtin type `void'.\n"),
+ globals__io_lookup_bool_option(verbose_errors, VerboseErrors),
+ ( { VerboseErrors = yes } ->
+ io__write_strings([
+"\tThe body of the clause contains a call to a polymorphic predicate,\n",
+"\tbut I can't determine which version should be called,\n",
+"\tbecause the type variables listed above didn't get bound.\n",
+% "\tYou may need to use an explicit type qualifier.\n",
+% XXX improve error message
+"\t(I ought to tell you which call caused the problem, but I'm afraid\n",
+"\tyou'll have to work it out yourself. My apologies.)\n"
+ ])
+ ;
+ []
+ ).
+
+:- pred write_type_var_list(assoc_list(var, (type)), term__context,
+ varset, tvarset, io__state, io__state).
+:- mode write_type_var_list(in, in, in, in, di, uo) is det.
+
+write_type_var_list([], _, _, _) --> [].
+write_type_var_list([Var - Type | Rest], Context, VarSet, TVarSet) -->
+ prog_out__write_context(Context),
+ io__write_string(" "),
+ mercury_output_var(Var, VarSet, no),
+ io__write_string(" :: "),
+ mercury_output_term(Type, TVarSet, no),
+ io__write_string("\n"),
+ write_type_var_list(Rest, Context, VarSet, TVarSet).
+
+%-----------------------------------------------------------------------------%
+% resolve predicate overloading
+
+% In the case of a call to an overloaded predicate, typecheck.m
+% does not figure out the correct pred_id. We must do that here.
+
+post_typecheck__resolve_pred_overloading(PredId0, Args0, CallerPredInfo,
+ ModuleInfo, PredName0, PredName, PredId) :-
+ ( invalid_pred_id(PredId0) ->
+ %
+ % Find the set of candidate pred_ids for predicates which
+ % have the specified name and arity
+ %
+ pred_info_typevarset(CallerPredInfo, TVarSet),
+ pred_info_clauses_info(CallerPredInfo, ClausesInfo),
+ ClausesInfo = clauses_info(_, _, VarTypes, _, _),
+ typecheck__resolve_pred_overloading(ModuleInfo, Args0,
+ VarTypes, TVarSet, PredName0, PredName, PredId)
+ ;
+ PredId = PredId0,
+ PredName = PredName0
+ ).
+
+%-----------------------------------------------------------------------------%
+
+ %
+ % Copy clauses to procs, then ensure that all
+ % constructors occurring in predicate mode
+ % declarations are module qualified.
+ %
+post_typecheck__finish_pred(ModuleInfo, PredId, PredInfo1, PredInfo) -->
+ { maybe_add_default_mode(ModuleInfo, PredInfo1, PredInfo2, _) },
+ { copy_clauses_to_procs(PredInfo2, PredInfo3) },
+ post_typecheck__finish_imported_pred(ModuleInfo, PredId,
+ PredInfo3, PredInfo).
+
+ %
+ % Ensure that all constructors occurring in predicate mode
+ % declarations are module qualified.
+ %
+post_typecheck__finish_imported_pred(ModuleInfo, PredId, PredInfo0, PredInfo)
+ -->
+ { pred_info_arg_types(PredInfo0, _, ArgTypes) },
+ { pred_info_procedures(PredInfo0, Procs0) },
+ { pred_info_procids(PredInfo0, ProcIds) },
+ propagate_types_into_proc_modes(ModuleInfo, PredId, ProcIds, ArgTypes,
+ Procs0, Procs),
+ { pred_info_set_procedures(PredInfo0, Procs, PredInfo) }.
+
+%-----------------------------------------------------------------------------%
+
+:- pred propagate_types_into_proc_modes(module_info,
+ pred_id, list(proc_id), list(type), proc_table, proc_table,
+ io__state, io__state).
+:- mode propagate_types_into_proc_modes(in,
+ in, in, in, in, out, di, uo) is det.
+
+propagate_types_into_proc_modes(_, _, [], _, Procs, Procs) --> [].
+propagate_types_into_proc_modes(ModuleInfo, PredId,
+ [ProcId | ProcIds], ArgTypes, Procs0, Procs) -->
+ { map__lookup(Procs0, ProcId, ProcInfo0) },
+ { proc_info_argmodes(ProcInfo0, ArgModes0) },
+ { propagate_types_into_mode_list(ArgTypes, ModuleInfo,
+ ArgModes0, ArgModes) },
+ %
+ % check for unbound inst vars
+ % (this needs to be done after propagate_types_into_mode_list,
+ % because we need the insts to be module-qualified; and it
+ % needs to be done before mode analysis, to avoid internal errors)
+ %
+ ( { mode_list_contains_inst_var(ArgModes, ModuleInfo, _InstVar) } ->
+ unbound_inst_var_error(PredId, ProcInfo0, ModuleInfo),
+ % delete this mode, to avoid internal errors
+ { map__det_remove(Procs0, ProcId, _, Procs1) }
+ ;
+ { proc_info_set_argmodes(ProcInfo0, ArgModes, ProcInfo) },
+ { map__det_update(Procs0, ProcId, ProcInfo, Procs1) }
+ ),
+ propagate_types_into_proc_modes(ModuleInfo, PredId, ProcIds,
+ ArgTypes, Procs1, Procs).
+
+:- pred unbound_inst_var_error(pred_id, proc_info, module_info,
+ io__state, io__state).
+:- mode unbound_inst_var_error(in, in, in, di, uo) is det.
+
+unbound_inst_var_error(PredId, ProcInfo, ModuleInfo) -->
+ { proc_info_context(ProcInfo, Context) },
+ io__set_exit_status(1),
+ prog_out__write_context(Context),
+ io__write_string("In mode declaration for "),
+ hlds_out__write_pred_id(ModuleInfo, PredId),
+ io__write_string(":\n"),
+ prog_out__write_context(Context),
+ io__write_string(" error: unbound inst variable(s).\n"),
+ prog_out__write_context(Context),
+ io__write_string(" (Sorry, polymorphic modes are not supported.)\n").
+
+%-----------------------------------------------------------------------------%
Index: compiler/purity.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/purity.m,v
retrieving revision 1.9
diff -u -r1.9 purity.m
--- purity.m 1998/03/03 17:35:55 1.9
+++ purity.m 1998/06/04 12:43:10
@@ -137,6 +137,8 @@
:- import_module globals, options, mercury_to_mercury, hlds_out.
:- import_module passes_aux, typecheck, module_qual, clause_to_proc.
:- import_module modecheck_unify, modecheck_call, inst_util, prog_out.
+:- import_module post_typecheck.
+
:- import_module list, map, varset, term, string, require, std_util.
:- import_module assoc_list, bool, int, set.
@@ -256,185 +258,32 @@
{ pred_info_is_imported(PredInfo0)
; pred_info_is_pseudo_imported(PredInfo0) }
->
- { ModuleInfo1 = ModuleInfo0 },
+ post_typecheck__finish_imported_pred(ModuleInfo0, PredId,
+ PredInfo0, PredInfo),
{ NumErrors1 = NumErrors0 }
;
write_pred_progress_message("% Purity-checking ", PredId,
ModuleInfo0),
- check_type_bindings(PredId, PredInfo0, PredInfo1, ModuleInfo0,
+ post_typecheck__check_type_bindings(PredId, PredInfo0,
+ PredInfo1, ModuleInfo0,
UnboundTypeErrsInThisPred),
puritycheck_pred(PredId, PredInfo1, PredInfo2, ModuleInfo0,
PurityErrsInThisPred),
- { map__det_update(Preds0, PredId, PredInfo2, Preds) },
- { module_info_get_predicate_table(ModuleInfo0, PredTable0) },
- { predicate_table_set_preds(PredTable0, Preds, PredTable) },
- { module_info_set_predicate_table(ModuleInfo0, PredTable,
- ModuleInfo1) },
+ post_typecheck__finish_pred(ModuleInfo0, PredId, PredInfo2,
+ PredInfo),
{ NumErrors1 is NumErrors0 + UnboundTypeErrsInThisPred
+ PurityErrsInThisPred }
),
+ { map__det_update(Preds0, PredId, PredInfo, Preds) },
+ { module_info_get_predicate_table(ModuleInfo0, PredTable0) },
+ { predicate_table_set_preds(PredTable0, Preds, PredTable) },
+ { module_info_set_predicate_table(ModuleInfo0, PredTable,
+ ModuleInfo1) },
check_preds_purity_2(PredIds, ModuleInfo1, ModuleInfo,
NumErrors1, NumErrors).
% Purity-check the code for single predicate, reporting any errors.
-
-%-----------------------------------------------------------------------------%
-% Check for unbound type variables
-%
-% Check that the all of the types which have been inferred
-% for the variables in the clause do not contain any unbound type
-% variables other than those that occur in the types of head
-% variables.
-
-:- pred check_type_bindings(pred_id, pred_info, pred_info,
- module_info, int, io__state, io__state).
-:- mode check_type_bindings(in, in, out, in, out, di, uo) is det.
-
-check_type_bindings(PredId, PredInfo0, PredInfo, ModuleInfo, NumErrors,
- IOState0, IOState) :-
- pred_info_clauses_info(PredInfo0, ClausesInfo0),
- ClausesInfo0 = clauses_info(VarSet, B, VarTypesMap0, HeadVars, E),
- map__apply_to_list(HeadVars, VarTypesMap0, HeadVarTypes),
- term__vars_list(HeadVarTypes, HeadVarTypeParams),
- map__to_assoc_list(VarTypesMap0, VarTypesList),
- set__init(Set0),
- check_type_bindings_2(VarTypesList, HeadVarTypeParams,
- [], Errs, Set0, Set),
- ( Errs = [] ->
- PredInfo = PredInfo0,
- IOState = IOState0,
- NumErrors = 0
- ;
- %
- % report the warning
- %
- report_unresolved_type_warning(Errs, PredId, PredInfo0,
- ModuleInfo, VarSet, IOState0, IOState),
- NumErrors = 0,
-
- %
- % bind all the type variables in `Set' to `void' ...
- %
- pred_info_context(PredInfo0, Context),
- bind_type_vars_to_void(Set, Context, VarTypesMap0, VarTypesMap),
- ClausesInfo = clauses_info(VarSet, B, VarTypesMap, HeadVars, E),
- pred_info_set_clauses_info(PredInfo0, ClausesInfo, PredInfo)
- ).
-
-:- pred check_type_bindings_2(assoc_list(var, (type)), list(var),
- assoc_list(var, (type)), assoc_list(var, (type)),
- set(tvar), set(tvar)).
-:- mode check_type_bindings_2(in, in, in, out, in, out) is det.
-
-check_type_bindings_2([], _, Errs, Errs, Set, Set).
-check_type_bindings_2([Var - Type | VarTypes], HeadTypeParams,
- Errs0, Errs, Set0, Set) :-
- term__vars(Type, TVars),
- set__list_to_set(TVars, TVarsSet0),
- set__delete_list(TVarsSet0, HeadTypeParams, TVarsSet1),
- ( \+ set__empty(TVarsSet1) ->
- Errs1 = [Var - Type | Errs0],
- set__union(Set0, TVarsSet1, Set1)
- ;
- Errs1 = Errs0,
- Set0 = Set1
- ),
- check_type_bindings_2(VarTypes, HeadTypeParams,
- Errs1, Errs, Set1, Set).
-
-%
-% bind all the type variables in `UnboundTypeVarsSet' to the type `void' ...
-%
-:- pred bind_type_vars_to_void(set(var), term__context,
- map(var, type), map(var, type)).
-:- mode bind_type_vars_to_void(in, in, in, out) is det.
-
-bind_type_vars_to_void(UnboundTypeVarsSet, Context,
- VarTypesMap0, VarTypesMap) :-
- %
- % first create a pair of corresponding lists (UnboundTypeVars, Voids)
- % that map the unbound type variables to void
- %
- set__to_sorted_list(UnboundTypeVarsSet, UnboundTypeVars),
- list__length(UnboundTypeVars, Length),
- Void = term__functor(term__atom("void"), [], Context),
- list__duplicate(Length, Void, Voids),
-
- %
- % then apply the substitution we just created to the variable types
- %
- map__keys(VarTypesMap0, Vars),
- map__values(VarTypesMap0, Types0),
- term__substitute_corresponding_list(UnboundTypeVars, Voids,
- Types0, Types),
- map__from_corresponding_lists(Vars, Types, VarTypesMap).
-
-%
-% report an error: uninstantiated type parameter
-%
-:- pred report_unresolved_type_warning(assoc_list(var, (type)), pred_id,
- pred_info, module_info, varset, io__state, io__state).
-:- mode report_unresolved_type_warning(in, in, in, in, in, di, uo) is det.
-
-report_unresolved_type_warning(Errs, PredId, PredInfo, ModuleInfo, VarSet) -->
- globals__io_lookup_bool_option(halt_at_warn, HaltAtWarn),
- ( { HaltAtWarn = yes } ->
- io__set_exit_status(1)
- ;
- []
- ),
-
- { pred_info_typevarset(PredInfo, TypeVarSet) },
- { pred_info_context(PredInfo, Context) },
-
- prog_out__write_context(Context),
- io__write_string("In "),
- hlds_out__write_pred_id(ModuleInfo, PredId),
- io__write_string(":\n"),
-
- prog_out__write_context(Context),
- io__write_string(" warning: unresolved polymorphism.\n"),
- prog_out__write_context(Context),
- ( { Errs = [_] } ->
- io__write_string(" The variable with an unbound type was:\n")
- ;
- io__write_string(" The variables with unbound types were:\n")
- ),
- write_type_var_list(Errs, Context, VarSet, TypeVarSet),
- prog_out__write_context(Context),
- io__write_string(" The unbound type variable(s) will be implicitly\n"),
- prog_out__write_context(Context),
- io__write_string(" bound to the builtin type `void'.\n"),
- globals__io_lookup_bool_option(verbose_errors, VerboseErrors),
- ( { VerboseErrors = yes } ->
- io__write_strings([
-"\tThe body of the clause contains a call to a polymorphic predicate,\n",
-"\tbut I can't determine which version should be called,\n",
-"\tbecause the type variables listed above didn't get bound.\n",
-% "\tYou may need to use an explicit type qualifier.\n",
-% XXX improve error message
-"\t(I ought to tell you which call caused the problem, but I'm afraid\n",
-"\tyou'll have to work it out yourself. My apologies.)\n"
- ])
- ;
- []
- ).
-
-:- pred write_type_var_list(assoc_list(var, (type)), term__context,
- varset, tvarset, io__state, io__state).
-:- mode write_type_var_list(in, in, in, in, di, uo) is det.
-
-write_type_var_list([], _, _, _) --> [].
-write_type_var_list([Var - Type | Rest], Context, VarSet, TVarSet) -->
- prog_out__write_context(Context),
- io__write_string(" "),
- mercury_output_var(Var, VarSet, no),
- io__write_string(" :: "),
- mercury_output_term(Type, TVarSet, no),
- io__write_string("\n"),
- write_type_var_list(Rest, Context, VarSet, TVarSet).
-
%-----------------------------------------------------------------------------%
% Check purity of a single predicate
%
@@ -527,8 +376,8 @@
call(PredId,ProcId,Vars,BIState,UContext,Name), GoalInfo,
PredInfo, ModuleInfo, InClosure, ActualPurity,
NumErrors0, NumErrors) -->
- { resolve_pred_overloading(PredId0, Vars, PredInfo, ModuleInfo,
- Name0, Name, PredId) },
+ { post_typecheck__resolve_pred_overloading(PredId0, Vars, PredInfo,
+ ModuleInfo, Name0, Name, PredId) },
{ module_info_preds(ModuleInfo, Preds) },
{ map__lookup(Preds, PredId, CalleePredInfo) },
{ pred_info_get_purity(CalleePredInfo, ActualPurity) },
@@ -835,35 +684,6 @@
io__write_string("In "),
hlds_out__write_pred_id(ModuleInfo, PredId),
io__write_string(":\n").
-
-
%-----------------------------------------------------------------------------%
-% resolve predicate overloading
-
-:- pred resolve_pred_overloading(pred_id, list(var), pred_info, module_info,
- sym_name, sym_name, pred_id).
-:- mode resolve_pred_overloading(in, in, in, in, in, out, out)
- is det.
-
-% In the case of a call to an overloaded predicate, typecheck.m
-% does not figure out the correct pred_id. We must do that here.
-
-resolve_pred_overloading(PredId0, Args0, CallerPredInfo, ModuleInfo,
- PredName0, PredName, PredId) :-
- ( invalid_pred_id(PredId0) ->
- %
- % Find the set of candidate pred_ids for predicates which
- % have the specified name and arity
- %
- pred_info_typevarset(CallerPredInfo, TVarSet),
- pred_info_clauses_info(CallerPredInfo, ClausesInfo),
- ClausesInfo = clauses_info(_, _, VarTypes, _, _),
- typecheck__resolve_pred_overloading(ModuleInfo, Args0,
- VarTypes, TVarSet, PredName0, PredName, PredId)
- ;
- PredId = PredId0,
- PredName = PredName0
- ).
-
Index: compiler/typecheck.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/typecheck.m,v
retrieving revision 1.239
diff -u -r1.239 typecheck.m
--- typecheck.m 1998/05/27 14:36:55 1.239
+++ typecheck.m 1998/06/04 12:39:49
@@ -108,32 +108,23 @@
:- import_module hlds_module, hlds_pred, hlds_data, prog_data.
:- import_module bool, io, list, map, term.
-:- pred typecheck(module_info, module_info, bool, bool, io__state, io__state).
-:- mode typecheck(in, out, in, out, di, uo) is det.
+:- pred typecheck(module_info, module_info, bool, io__state, io__state).
+:- mode typecheck(in, out, out, di, uo) is det.
/*
- Formally, typecheck(Module0, Module, ModeError, FoundError, IO0, IO) is
+ Formally, typecheck(Module0, Module, FoundError, IO0, IO) is
intended to be true iff Module is Module0 annotated with the
variable typings that result from the process of type-checking,
FoundError is `yes' if Module0 contains any type errors and `no'
otherwise, and IO is the io__state that results from IO0 after
printing out appropriate error messages for the type errors in
- Module0, if any. ModeError should be true if any undefined modes
- were found by previous passes.
+ Module0, if any.
- Informally, typecheck(Module0, Module, ModeError, FoundError, IO0, IO)
+ Informally, typecheck(Module0, Module, FoundError, IO0, IO)
type-checks Module0 and annotates it with variable typings
(returning the result in Module), prints out appropriate error
messages, and sets FoundError to `yes' if it finds any errors
and `no' otherwise.
-
- Typecheck also copies the clause_info structure it annotates
- to the proc structures. This is done at the end of typecheck
- and not at the start of modecheck because modecheck may be
- reinvoked after HLDS transformations. Any transformation that
- needs typechecking should work with the clause_info structure.
- Type information is also propagated into the modes of procedures
- by this pass if the ModeError parameter is no.
*/
@@ -183,14 +174,14 @@
% XXX need to pass FoundError to all steps
-typecheck(Module0, Module, ModeError, FoundError) -->
+typecheck(Module0, Module, FoundError) -->
globals__io_lookup_bool_option(statistics, Statistics),
globals__io_lookup_bool_option(verbose, Verbose),
io__stderr_stream(StdErr),
io__set_output_stream(StdErr, OldStream),
maybe_write_string(Verbose, "% Type-checking clauses...\n"),
- check_pred_types(Module0, Module, ModeError, FoundError),
+ check_pred_types(Module0, Module, FoundError),
maybe_report_stats(Statistics),
io__set_output_stream(OldStream, _).
@@ -199,29 +190,29 @@
% Type-check the code for all the predicates in a module.
-:- pred check_pred_types(module_info, module_info, bool, bool,
+:- pred check_pred_types(module_info, module_info, bool,
io__state, io__state).
-:- mode check_pred_types(in, out, in, out, di, uo) is det.
+:- mode check_pred_types(in, out, out, di, uo) is det.
-check_pred_types(Module0, Module, ModeError, FoundError) -->
+check_pred_types(Module0, Module, FoundError) -->
{ module_info_predids(Module0, PredIds) },
globals__io_lookup_int_option(type_inference_iteration_limit,
MaxIterations),
typecheck_to_fixpoint(MaxIterations, PredIds, Module0,
- Module, ModeError, FoundError),
+ Module, FoundError),
write_inference_messages(PredIds, Module).
% Repeatedly typecheck the code for a group of predicates
% until a fixpoint is reached, or until some errors are detected.
:- pred typecheck_to_fixpoint(int, list(pred_id), module_info, module_info,
- bool, bool, io__state, io__state).
-:- mode typecheck_to_fixpoint(in, in, in, out, in, out, di, uo) is det.
+ bool, io__state, io__state).
+:- mode typecheck_to_fixpoint(in, in, in, out, out, di, uo) is det.
-typecheck_to_fixpoint(NumIterations, PredIds, Module0, Module, ModeError,
+typecheck_to_fixpoint(NumIterations, PredIds, Module0, Module,
FoundError) -->
typecheck_pred_types_2(PredIds, Module0, Module1,
- ModeError, no, FoundError1, no, Changed),
+ no, FoundError1, no, Changed),
( { Changed = no ; FoundError1 = yes } ->
{ Module = Module1 },
{ FoundError = FoundError1 }
@@ -235,7 +226,7 @@
{ NumIterations1 = NumIterations - 1 },
( { NumIterations1 > 0 } ->
typecheck_to_fixpoint(NumIterations1, PredIds, Module1,
- Module, ModeError, FoundError)
+ Module, FoundError)
;
typecheck_report_max_iterations_exceeded,
{ Module = Module1 },
@@ -264,37 +255,25 @@
% Iterate over the list of pred_ids in a module.
:- pred typecheck_pred_types_2(list(pred_id), module_info, module_info,
- bool, bool, bool, bool, bool, io__state, io__state).
+ bool, bool, bool, bool, io__state, io__state).
:- mode typecheck_pred_types_2(in, in, out,
- in, in, out, in, out, di, uo) is det.
+ in, out, in, out, di, uo) is det.
typecheck_pred_types_2([], ModuleInfo, ModuleInfo,
- _, Error, Error, Changed, Changed) --> [].
+ Error, Error, Changed, Changed) --> [].
typecheck_pred_types_2([PredId | PredIds], ModuleInfo0, ModuleInfo,
- ModeError, Error0, Error, Changed0, Changed) -->
+ Error0, Error, Changed0, Changed) -->
{ module_info_preds(ModuleInfo0, Preds0) },
{ map__lookup(Preds0, PredId, PredInfo0) },
- { pred_info_procids(PredInfo0, ProcIds) },
(
{ pred_info_is_imported(PredInfo0) }
->
{ Error1 = Error0 },
-
- %
- % Ensure that all constructors occurring in predicate mode
- % declarations are module qualified.
- %
- { pred_info_arg_types(PredInfo0, _, ArgTypes) },
- { pred_info_procedures(PredInfo0, Procs0) },
- typecheck_propagate_types_into_proc_modes(
- ModuleInfo0, PredId, ProcIds, ArgTypes, Procs0, Procs),
- { pred_info_set_procedures(PredInfo0, Procs, PredInfo) },
- { map__set(Preds0, PredId, PredInfo, Preds) },
- { module_info_set_preds(ModuleInfo0, Preds, ModuleInfo1) },
+ { ModuleInfo1 = ModuleInfo0 },
{ Changed2 = Changed0 }
;
typecheck_pred_type(PredId, PredInfo0, ModuleInfo0,
- ModeError, MaybePredInfo, Changed1),
+ MaybePredInfo, Changed1),
{
MaybePredInfo = yes(PredInfo),
Error1 = Error0,
@@ -309,99 +288,13 @@
{ bool__or(Changed0, Changed1, Changed2) }
),
typecheck_pred_types_2(PredIds, ModuleInfo1, ModuleInfo,
- ModeError, Error1, Error, Changed2, Changed).
-
-:- pred typecheck_pred_type(pred_id, pred_info, module_info, bool,
- maybe(pred_info), bool, io__state, io__state).
-:- mode typecheck_pred_type(in, in, in, in, out, out, di, uo) is det.
-
-typecheck_pred_type(PredId, PredInfo0, ModuleInfo, ModeError,
- MaybePredInfo, Changed, IOState0, IOState) :-
- typecheck_pred_type_2(PredId, PredInfo0, ModuleInfo, MaybePredInfo0,
- Changed, IOState0, IOState1),
- (
- MaybePredInfo0 = no,
- MaybePredInfo = no,
- IOState = IOState1
- ;
- MaybePredInfo0 = yes(PredInfo1),
-
- ( ModeError = no ->
- %
- % Copy clauses to procs, then ensure that all
- % constructors occurring in predicate mode
- % declarations are module qualified, unless undefined
- % modes were found by an earlier pass.
- %
- maybe_add_default_mode(ModuleInfo,
- PredInfo1, PredInfo2, _),
- copy_clauses_to_procs(PredInfo2, PredInfo3),
- pred_info_arg_types(PredInfo3, _, ArgTypes),
- pred_info_procedures(PredInfo3, Procs1),
- pred_info_procids(PredInfo3, ProcIds),
- typecheck_propagate_types_into_proc_modes(
- ModuleInfo, PredId, ProcIds, ArgTypes,
- Procs1, Procs,
- IOState1, IOState),
- pred_info_set_procedures(PredInfo3, Procs, PredInfo)
- ;
- PredInfo = PredInfo1,
- IOState = IOState1
- ),
- MaybePredInfo = yes(PredInfo)
- ).
-
-:- pred typecheck_propagate_types_into_proc_modes(module_info,
- pred_id, list(proc_id), list(type), proc_table, proc_table,
- io__state, io__state).
-:- mode typecheck_propagate_types_into_proc_modes(in,
- in, in, in, in, out, di, uo) is det.
-
-typecheck_propagate_types_into_proc_modes(_, _, [], _, Procs, Procs) --> [].
-typecheck_propagate_types_into_proc_modes(ModuleInfo, PredId,
- [ProcId | ProcIds], ArgTypes, Procs0, Procs) -->
- { map__lookup(Procs0, ProcId, ProcInfo0) },
- { proc_info_argmodes(ProcInfo0, ArgModes0) },
- { propagate_types_into_mode_list(ArgTypes, ModuleInfo,
- ArgModes0, ArgModes) },
- %
- % check for unbound inst vars
- % (this needs to be done after propagate_types_into_mode_list,
- % because we need the insts to be module-qualified; and it
- % needs to be done before mode analysis, to avoid internal errors)
- %
- ( { mode_list_contains_inst_var(ArgModes, ModuleInfo, _InstVar) } ->
- unbound_inst_var_error(PredId, ProcInfo0, ModuleInfo),
- % delete this mode, to avoid internal errors
- { map__det_remove(Procs0, ProcId, _, Procs1) }
- ;
- { proc_info_set_argmodes(ProcInfo0, ArgModes, ProcInfo) },
- { map__det_update(Procs0, ProcId, ProcInfo, Procs1) }
- ),
- typecheck_propagate_types_into_proc_modes(ModuleInfo, PredId, ProcIds,
- ArgTypes, Procs1, Procs).
-
-:- pred unbound_inst_var_error(pred_id, proc_info, module_info,
- io__state, io__state).
-:- mode unbound_inst_var_error(in, in, in, di, uo) is det.
-
-unbound_inst_var_error(PredId, ProcInfo, ModuleInfo) -->
- { proc_info_context(ProcInfo, Context) },
- io__set_exit_status(1),
- prog_out__write_context(Context),
- io__write_string("In mode declaration for "),
- hlds_out__write_pred_id(ModuleInfo, PredId),
- io__write_string(":\n"),
- prog_out__write_context(Context),
- io__write_string(" error: unbound inst variable(s).\n"),
- prog_out__write_context(Context),
- io__write_string(" (Sorry, polymorphic modes are not supported.)\n").
+ Error1, Error, Changed2, Changed).
-:- pred typecheck_pred_type_2(pred_id, pred_info, module_info,
+:- pred typecheck_pred_type(pred_id, pred_info, module_info,
maybe(pred_info), bool, io__state, io__state).
-:- mode typecheck_pred_type_2(in, in, in, out, out, di, uo) is det.
+:- mode typecheck_pred_type(in, in, in, out, out, di, uo) is det.
-typecheck_pred_type_2(PredId, PredInfo0, ModuleInfo, MaybePredInfo, Changed,
+typecheck_pred_type(PredId, PredInfo0, ModuleInfo, MaybePredInfo, Changed,
IOState0, IOState) :-
(
% Compiler-generated predicates are created already type-correct,
Index: compiler/notes/compiler_design.html
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/notes/compiler_design.html,v
retrieving revision 1.19
diff -u -r1.19 compiler_design.html
--- compiler_design.html 1998/05/15 07:08:30 1.19
+++ compiler_design.html 1998/06/04 12:14:29
@@ -216,7 +216,9 @@
pred_info. However, typecheck.m doesn't figure out the pred_id
for function calls or calls to overloaded predicates; that can't
be done in a single pass of typechecking, and so it is done
- later on in modes.m. Typeclass constraints are checked here, and
+ later on (in post_typecheck.m, for preds, and in
+ modecheck_unify.m, for function calls).
+ Typeclass constraints are checked here, and
any redundant constraints that are eliminated are recorded (as
constraint_proofs) in the pred_info for future reference. When it has
finished, typecheck.m calls clause_to_proc.m to make duplicate copies
@@ -224,6 +226,10 @@
stages work on procedures, not predicates.
<li> type_util.m contains utility predicates dealing with types
that are used in a variety of different places within the compiler
+ <li> post_typecheck.m may also be considered to logically be a part
+ of typechecking, but it is actually called from purity
+ analysis (see below). It contains the stuff related to
+ type checking that can't be done in the main type checking pass.
</ul>
<dt> purity analysis
@@ -231,9 +237,12 @@
<dd>
purity.m is responsible for purity checking, as well as
defining the <CODE>purity</CODE> type and a few public
- operations on it. It also completes the handling of predicate
+ operations on it. It also calls post_typecheck.m to
+ complete the handling of predicate
overloading for cases which typecheck.m is unable to handle,
- and checks for unbound type variables.
+ to check for unbound type variables,
+ and to copy the clauses to the proc_infos in
+ preparation for mode analysis.
<dt> mode analysis
--
Fergus Henderson <fjh at cs.mu.oz.au> | "I have always known that the pursuit
WWW: <http://www.cs.mu.oz.au/~fjh> | of excellence is a lethal habit"
PGP: finger fjh at 128.250.37.3 | -- the last words of T. S. Garp.
More information about the developers
mailing list