[m-rev.] for post-commit review: typecheck speedups
Zoltan Somogyi
zs at csse.unimelb.edu.au
Mon Sep 14 13:28:11 AEST 2009
compiler/typecheck.m:
compiler/typeclasses.m:
Checkpoints during typechecking are needed only when debugging the
typechecker; during all other compilations, they are of no use
but do take up time. This diff compiles the checkpoints into the
compiler only if --trace-flag type_checkpoint is specified
when building the compiler.
When typechecking unifications with integer, float and string
constants, use a cut-down version of the usual typechecking algorithm
that does not look for special cases (such as existentially typed
or type-class-constrained arguments) that cannot occur for such
cons_ids.
Optimize away some redundant checks.
These changes speed up the compiler by 1.5% when compiling
training_cars_full.m, and it yields a speedup of 0.4% on
tools/speedtest.
compiler/options.m:
doc/user_guide.texi:
Comment out the documentation of --debug-types, since now it works
only with --trace-flag type_checkpoint, and hence even more for
developers only than before.
compiler/prog_type_subst.m:
Improve programming style without algorithmic changes.
cvs diff: Diffing .
cvs diff: Diffing analysis
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/doc
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing boehm_gc/libatomic_ops-1.2
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/doc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/gcc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/hpc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/ibmc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/icc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/msftc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/sunc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/tests
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing boehm_gc/windows-untested
cvs diff: Diffing boehm_gc/windows-untested/vc60
cvs diff: Diffing boehm_gc/windows-untested/vc70
cvs diff: Diffing boehm_gc/windows-untested/vc71
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/options.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/options.m,v
retrieving revision 1.654
diff -u -b -r1.654 options.m
--- compiler/options.m 8 Sep 2009 08:14:40 -0000 1.654
+++ compiler/options.m 14 Sep 2009 03:01:42 -0000
@@ -3403,9 +3403,12 @@
% is implemented automatically in handle_options, so users shouldn't need to be
% aware of it.
% "--detailed-statistics",
-% "\tOutput more detailed messages about the compiler's time/space usage.",
- "-T, --debug-types",
- "\tOutput detailed debugging traces of the type checking.",
+% "\tOutput more detailed messages about the compiler's",
+% "\ttime/space usage.",
+% --debug-types works only if the compiler was compiled with
+% "--trace-flags type_checkpoint".
+% "-T, --debug-types",
+% "\tOutput detailed debugging traces of the type checking.",
"-N, --debug-modes",
"\tOutput debugging traces of the mode checking.",
"--debug-modes-statistics",
Index: compiler/prog_type_subst.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_type_subst.m,v
retrieving revision 1.6
diff -u -b -r1.6 prog_type_subst.m
--- compiler/prog_type_subst.m 3 Sep 2009 23:07:29 -0000 1.6
+++ compiler/prog_type_subst.m 11 Sep 2009 00:59:48 -0000
@@ -178,16 +178,20 @@
%-----------------------------------------------------------------------------%
-apply_variable_renaming_to_type(Renaming, type_variable(TVar0, Kind),
- type_variable(TVar, Kind)) :-
- apply_variable_renaming_to_tvar(Renaming, TVar0, TVar).
-apply_variable_renaming_to_type(Renaming, defined_type(Name, Args0, Kind),
- defined_type(Name, Args, Kind)) :-
- apply_variable_renaming_to_type_list(Renaming, Args0, Args).
-apply_variable_renaming_to_type(_Renaming, Type @ builtin_type(_), Type).
-apply_variable_renaming_to_type(Renaming,
- higher_order_type(Args0, MaybeReturn0, Purity, EvalMethod),
- higher_order_type(Args, MaybeReturn, Purity, EvalMethod)) :-
+apply_variable_renaming_to_type(Renaming, Type0, Type) :-
+ (
+ Type0 = type_variable(TVar0, Kind),
+ apply_variable_renaming_to_tvar(Renaming, TVar0, TVar),
+ Type = type_variable(TVar, Kind)
+ ;
+ Type0 = defined_type(Name, Args0, Kind),
+ apply_variable_renaming_to_type_list(Renaming, Args0, Args),
+ Type = defined_type(Name, Args, Kind)
+ ;
+ Type0 = builtin_type(_),
+ Type = Type0
+ ;
+ Type0 = higher_order_type(Args0, MaybeReturn0, Purity, EvalMethod),
apply_variable_renaming_to_type_list(Renaming, Args0, Args),
(
MaybeReturn0 = yes(Return0),
@@ -196,31 +200,40 @@
;
MaybeReturn0 = no,
MaybeReturn = no
- ).
-apply_variable_renaming_to_type(Renaming, tuple_type(Args0, Kind),
- tuple_type(Args, Kind)) :-
- apply_variable_renaming_to_type_list(Renaming, Args0, Args).
-apply_variable_renaming_to_type(Renaming, apply_n_type(TVar0, Args0, Kind),
- apply_n_type(TVar, Args, Kind)) :-
+ ),
+ Type = higher_order_type(Args, MaybeReturn, Purity, EvalMethod)
+ ;
+ Type0 = tuple_type(Args0, Kind),
+ apply_variable_renaming_to_type_list(Renaming, Args0, Args),
+ Type = tuple_type(Args, Kind)
+ ;
+ Type0 = apply_n_type(TVar0, Args0, Kind),
apply_variable_renaming_to_type_list(Renaming, Args0, Args),
- apply_variable_renaming_to_tvar(Renaming, TVar0, TVar).
-apply_variable_renaming_to_type(Renaming, kinded_type(Type0, Kind),
- kinded_type(Type, Kind)) :-
- apply_variable_renaming_to_type(Renaming, Type0, Type).
+ apply_variable_renaming_to_tvar(Renaming, TVar0, TVar),
+ Type = apply_n_type(TVar, Args, Kind)
+ ;
+ Type0 = kinded_type(BaseType0, Kind),
+ apply_variable_renaming_to_type(Renaming, BaseType0, BaseType),
+ Type = kinded_type(BaseType, Kind)
+ ).
-apply_subst_to_type(Subst, Type0 @ type_variable(TVar, Kind), Type) :-
+apply_subst_to_type(Subst, Type0, Type) :-
+ (
+ Type0 = type_variable(TVar, Kind),
( map.search(Subst, TVar, Type1) ->
ensure_type_has_kind(Kind, Type1, Type)
;
Type = Type0
- ).
-apply_subst_to_type(Subst, defined_type(Name, Args0, Kind),
- defined_type(Name, Args, Kind)) :-
- apply_subst_to_type_list(Subst, Args0, Args).
-apply_subst_to_type(_Subst, Type @ builtin_type(_), Type).
-apply_subst_to_type(Subst,
- higher_order_type(Args0, MaybeReturn0, Purity, EvalMethod),
- higher_order_type(Args, MaybeReturn, Purity, EvalMethod)) :-
+ )
+ ;
+ Type0 = defined_type(Name, Args0, Kind),
+ apply_subst_to_type_list(Subst, Args0, Args),
+ Type = defined_type(Name, Args, Kind)
+ ;
+ Type0 = builtin_type(_),
+ Type = Type0
+ ;
+ Type0 = higher_order_type(Args0, MaybeReturn0, Purity, EvalMethod),
apply_subst_to_type_list(Subst, Args0, Args),
(
MaybeReturn0 = yes(Return0),
@@ -229,34 +242,44 @@
;
MaybeReturn0 = no,
MaybeReturn = no
- ).
-apply_subst_to_type(Subst, tuple_type(Args0, Kind), tuple_type(Args, Kind)) :-
- apply_subst_to_type_list(Subst, Args0, Args).
-apply_subst_to_type(Subst, apply_n_type(TVar, Args0, Kind), Type) :-
+ ),
+ Type = higher_order_type(Args, MaybeReturn, Purity, EvalMethod)
+ ;
+ Type0 = tuple_type(Args0, Kind),
+ apply_subst_to_type_list(Subst, Args0, Args),
+ Type = tuple_type(Args, Kind)
+ ;
+ Type0 = apply_n_type(TVar, Args0, Kind),
apply_subst_to_type_list(Subst, Args0, Args),
( map.search(Subst, TVar, AppliedType) ->
apply_type_args(AppliedType, Args, Type)
;
Type = apply_n_type(TVar, Args, Kind)
+ )
+ ;
+ Type0 = kinded_type(BaseType0, Kind),
+ apply_subst_to_type(Subst, BaseType0, BaseType),
+ Type = kinded_type(BaseType, Kind)
).
-apply_subst_to_type(Subst, kinded_type(Type0, Kind),
- kinded_type(Type, Kind)) :-
- apply_subst_to_type(Subst, Type0, Type).
-apply_rec_subst_to_type(Subst, Type0 @ type_variable(TVar, Kind), Type) :-
+apply_rec_subst_to_type(Subst, Type0, Type) :-
+ (
+ Type0 = type_variable(TVar, Kind),
( map.search(Subst, TVar, Type1) ->
ensure_type_has_kind(Kind, Type1, Type2),
apply_rec_subst_to_type(Subst, Type2, Type)
;
Type = Type0
- ).
-apply_rec_subst_to_type(Subst, defined_type(Name, Args0, Kind),
- defined_type(Name, Args, Kind)) :-
- apply_rec_subst_to_type_list(Subst, Args0, Args).
-apply_rec_subst_to_type(_Subst, Type @ builtin_type(_), Type).
-apply_rec_subst_to_type(Subst,
- higher_order_type(Args0, MaybeReturn0, Purity, EvalMethod),
- higher_order_type(Args, MaybeReturn, Purity, EvalMethod)) :-
+ )
+ ;
+ Type0 = defined_type(Name, Args0, Kind),
+ apply_rec_subst_to_type_list(Subst, Args0, Args),
+ Type = defined_type(Name, Args, Kind)
+ ;
+ Type0 = builtin_type(_),
+ Type = Type0
+ ;
+ Type0 = higher_order_type(Args0, MaybeReturn0, Purity, EvalMethod),
apply_rec_subst_to_type_list(Subst, Args0, Args),
(
MaybeReturn0 = yes(Return0),
@@ -265,21 +288,26 @@
;
MaybeReturn0 = no,
MaybeReturn = no
- ).
-apply_rec_subst_to_type(Subst, tuple_type(Args0, Kind),
- tuple_type(Args, Kind)) :-
- apply_rec_subst_to_type_list(Subst, Args0, Args).
-apply_rec_subst_to_type(Subst, apply_n_type(TVar, Args0, Kind), Type) :-
+ ),
+ Type = higher_order_type(Args, MaybeReturn, Purity, EvalMethod)
+ ;
+ Type0 = tuple_type(Args0, Kind),
+ apply_rec_subst_to_type_list(Subst, Args0, Args),
+ Type = tuple_type(Args, Kind)
+ ;
+ Type0 = apply_n_type(TVar, Args0, Kind),
apply_rec_subst_to_type_list(Subst, Args0, Args),
( map.search(Subst, TVar, AppliedType0) ->
apply_rec_subst_to_type(Subst, AppliedType0, AppliedType),
apply_type_args(AppliedType, Args, Type)
;
Type = apply_n_type(TVar, Args, Kind)
+ )
+ ;
+ Type0 = kinded_type(BaseType0, Kind),
+ apply_rec_subst_to_type(Subst, BaseType0, BaseType),
+ Type = kinded_type(BaseType, Kind)
).
-apply_rec_subst_to_type(Subst, kinded_type(Type0, Kind),
- kinded_type(Type, Kind)) :-
- apply_rec_subst_to_type(Subst, Type0, Type).
%-----------------------------------------------------------------------------%
@@ -308,29 +336,41 @@
:- pred apply_type_args(mer_type::in, list(mer_type)::in, mer_type::out)
is det.
-apply_type_args(type_variable(TVar, Kind0), Args,
- apply_n_type(TVar, Args, Kind)) :-
- apply_type_args_to_kind(Kind0, Args, Kind).
-apply_type_args(defined_type(Name, Args0, Kind0), Args,
- defined_type(Name, Args0 ++ Args, Kind)) :-
- apply_type_args_to_kind(Kind0, Args, Kind).
-apply_type_args(Type @ builtin_type(_), [], Type).
-apply_type_args(builtin_type(_), [_ | _], _) :-
- unexpected(this_file, "applied type args to builtin").
-apply_type_args(Type @ higher_order_type(_, _, _, _), [], Type).
-apply_type_args(higher_order_type(_, _, _, _), [_ | _], _) :-
- unexpected(this_file, "applied type args to higher_order").
-apply_type_args(tuple_type(Args0, Kind0), Args,
- tuple_type(Args0 ++ Args, Kind)) :-
- apply_type_args_to_kind(Kind0, Args, Kind).
-apply_type_args(apply_n_type(TVar, Args0, Kind0), Args,
- apply_n_type(TVar, Args0 ++ Args, Kind)) :-
- apply_type_args_to_kind(Kind0, Args, Kind).
-apply_type_args(kinded_type(Type0, _), Args, Type) :-
+apply_type_args(Type0, Args, Type) :-
+ (
+ Type0 = type_variable(TVar, Kind0),
+ apply_type_args_to_kind(Kind0, Args, Kind),
+ Type = apply_n_type(TVar, Args, Kind)
+ ;
+ Type0 = defined_type(Name, Args0, Kind0),
+ apply_type_args_to_kind(Kind0, Args, Kind),
+ Type = defined_type(Name, Args0 ++ Args, Kind)
+ ;
+ ( Type0 = builtin_type(_)
+ ; Type0 = higher_order_type(_, _, _, _)
+ ),
+ (
+ Args = []
+ ;
+ Args = [_ | _],
+ unexpected(this_file, "applied type args to builtin")
+ ),
+ Type = Type0
+ ;
+ Type0 = tuple_type(Args0, Kind0),
+ apply_type_args_to_kind(Kind0, Args, Kind),
+ Type = tuple_type(Args0 ++ Args, Kind)
+ ;
+ Type0 = apply_n_type(TVar, Args0, Kind0),
+ apply_type_args_to_kind(Kind0, Args, Kind),
+ Type = apply_n_type(TVar, Args0 ++ Args, Kind)
+ ;
+ Type0 = kinded_type(BaseType0, _),
% We drop the explicit kind annotation, since:
% - it will already have been used by kind inference, and
% - it no longer corresponds to any explicit annotation given.
- apply_type_args(Type0, Args, Type).
+ apply_type_args(BaseType0, Args, Type)
+ ).
:- pred apply_type_args_to_kind(kind::in, list(mer_type)::in, kind::out)
is det.
Index: compiler/typecheck.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/typecheck.m,v
retrieving revision 1.443
diff -u -b -r1.443 typecheck.m
--- compiler/typecheck.m 4 Sep 2009 02:27:56 -0000 1.443
+++ compiler/typecheck.m 11 Sep 2009 09:01:19 -0000
@@ -1027,11 +1027,11 @@
% Typecheck the clause - first the head unification, and then the body.
typecheck_var_has_type_list(HeadVars, ArgTypes, 1, !Info),
typecheck_goal(Body0, Body, !Info),
- trace [io(!IO)] (
+ trace [compiletime(flag("type_checkpoint")), io(!IO)] (
type_checkpoint("end of clause", !.Info, !IO)
),
- !:Clause = !.Clause ^ clause_body := Body,
- !:Info = !.Info ^ tc_info_context := Context,
+ !Clause ^ clause_body := Body,
+ !Info ^ tc_info_context := Context,
typecheck_check_for_ambiguity(clause_only, HeadVars, !Info).
%-----------------------------------------------------------------------------%
@@ -1179,29 +1179,29 @@
typecheck_goal_2(GoalExpr0, GoalExpr, GoalInfo, !Info) :-
(
GoalExpr0 = conj(ConjType, List0),
- trace [io(!IO)] (
+ trace [compiletime(flag("type_checkpoint")), io(!IO)] (
type_checkpoint("conj", !.Info, !IO)
),
typecheck_goal_list(List0, List, !Info),
GoalExpr = conj(ConjType, List)
;
GoalExpr0 = disj(List0),
- trace [io(!IO)] (
+ trace [compiletime(flag("type_checkpoint")), io(!IO)] (
type_checkpoint("disj", !.Info, !IO)
),
typecheck_goal_list(List0, List, !Info),
GoalExpr = disj(List)
;
GoalExpr0 = if_then_else(Vars, Cond0, Then0, Else0),
- trace [io(!IO)] (
+ trace [compiletime(flag("type_checkpoint")), io(!IO)] (
type_checkpoint("if", !.Info, !IO)
),
typecheck_goal(Cond0, Cond, !Info),
- trace [io(!IO)] (
+ trace [compiletime(flag("type_checkpoint")), io(!IO)] (
type_checkpoint("then", !.Info, !IO)
),
typecheck_goal(Then0, Then, !Info),
- trace [io(!IO)] (
+ trace [compiletime(flag("type_checkpoint")), io(!IO)] (
type_checkpoint("else", !.Info, !IO)
),
typecheck_goal(Else0, Else, !Info),
@@ -1209,14 +1209,14 @@
GoalExpr = if_then_else(Vars, Cond, Then, Else)
;
GoalExpr0 = negation(SubGoal0),
- trace [io(!IO)] (
+ trace [compiletime(flag("type_checkpoint")), io(!IO)] (
type_checkpoint("not", !.Info, !IO)
),
typecheck_goal(SubGoal0, SubGoal, !Info),
GoalExpr = negation(SubGoal)
;
GoalExpr0 = scope(Reason, SubGoal0),
- trace [io(!IO)] (
+ trace [compiletime(flag("type_checkpoint")), io(!IO)] (
type_checkpoint("scope", !.Info, !IO)
),
typecheck_goal(SubGoal0, SubGoal, !Info),
@@ -1240,7 +1240,7 @@
GoalExpr = scope(Reason, SubGoal)
;
GoalExpr0 = plain_call(_, ProcId, Args, BI, UC, Name),
- trace [io(!IO)] (
+ trace [compiletime(flag("type_checkpoint")), io(!IO)] (
type_checkpoint("call", !.Info, !IO)
),
list.length(Args, Arity),
@@ -1256,7 +1256,7 @@
(
GenericCall0 = higher_order(PredVar, Purity, _, _),
GenericCall = GenericCall0,
- trace [io(!IO)] (
+ trace [compiletime(flag("type_checkpoint")), io(!IO)] (
type_checkpoint("higher-order call", !.Info, !IO)
),
typecheck_higher_order_call(PredVar, Purity, Args, !Info)
@@ -1267,7 +1267,7 @@
;
GenericCall0 = event_call(EventName),
GenericCall = GenericCall0,
- trace [io(!IO)] (
+ trace [compiletime(flag("type_checkpoint")), io(!IO)] (
type_checkpoint("event call", !.Info, !IO)
),
typecheck_event_call(EventName, Args, !Info)
@@ -1280,7 +1280,7 @@
GoalExpr = generic_call(GenericCall, Args, Modes, Detism)
;
GoalExpr0 = unify(LHS, RHS0, UnifyMode, Unification, UnifyContext),
- trace [io(!IO)] (
+ trace [compiletime(flag("type_checkpoint")), io(!IO)] (
type_checkpoint("unify", !.Info, !IO)
),
!:Info = !.Info ^ tc_info_arg_num := 0,
@@ -1307,7 +1307,7 @@
GoalExpr0 = shorthand(ShortHand0),
(
ShortHand0 = bi_implication(LHS0, RHS0),
- trace [io(!IO)] (
+ trace [compiletime(flag("type_checkpoint")), io(!IO)] (
type_checkpoint("<=>", !.Info, !IO)
),
typecheck_goal(LHS0, LHS, !Info),
@@ -1316,7 +1316,7 @@
;
ShortHand0 = atomic_goal(GoalType, Outer, Inner, MaybeOutputVars,
MainGoal0, OrElseGoals0, OrElseInners),
- trace [io(!IO)] (
+ trace [compiletime(flag("type_checkpoint")), io(!IO)] (
type_checkpoint("atomic_goal", !.Info, !IO)
),
(
@@ -1350,7 +1350,7 @@
MainGoal, OrElseGoals, OrElseInners)
;
ShortHand0 = try_goal(MaybeIO, ResultVar, SubGoal0),
- trace [io(!IO)] (
+ trace [compiletime(flag("type_checkpoint")), io(!IO)] (
type_checkpoint("try_goal", !.Info, !IO)
),
typecheck_goal(SubGoal0, SubGoal, !Info),
@@ -1935,11 +1935,59 @@
!:Info = !.Info ^ tc_info_type_assign_set := TypeAssignSet
).
+:- pred cons_id_must_be_builtin_type(cons_id::in, mer_type::out, string::out)
+ is semidet.
+
+cons_id_must_be_builtin_type(ConsId, ConsType, BuiltinTypeName) :-
+ (
+ ConsId = int_const(_),
+ BuiltinTypeName = "int",
+ BuiltinType = builtin_type_int
+ ;
+ ConsId = float_const(_),
+ BuiltinTypeName = "float",
+ BuiltinType = builtin_type_float
+ ;
+ ConsId = string_const(_),
+ BuiltinTypeName = "string",
+ BuiltinType = builtin_type_string
+ ),
+ ConsType = builtin_type(BuiltinType).
+
:- pred typecheck_unify_var_functor(prog_var::in, cons_id::in,
list(prog_var)::in, goal_path::in,
typecheck_info::in, typecheck_info::out) is det.
typecheck_unify_var_functor(Var, ConsId, Args, GoalPath, !Info) :-
+ ( cons_id_must_be_builtin_type(ConsId, ConsType, BuiltinTypeName) ->
+ TypeAssignSet0 = !.Info ^ tc_info_type_assign_set,
+ list.foldl(
+ type_assign_check_functor_type_builtin(ConsType, Var),
+ TypeAssignSet0, [], TypeAssignSet),
+ (
+ TypeAssignSet = [_ | _],
+ !Info ^ tc_info_type_assign_set := TypeAssignSet
+ ;
+ TypeAssignSet = [],
+ % If we encountered an error, continue checking with the
+ % original type assign set.
+ !Info ^ tc_info_type_assign_set := TypeAssignSet0,
+ (
+ TypeAssignSet0 = []
+ % The error did not originate here, so generating an error
+ % message here would be misleading.
+ ;
+ TypeAssignSet0 = [_ | _],
+ varset.init(ConsTypeVarSet),
+ empty_hlds_constraints(EmptyConstraints),
+ ConsDefn = cons_type_info(ConsTypeVarSet, [], ConsType, [],
+ EmptyConstraints, source_builtin_type(BuiltinTypeName)),
+ ConsIdSpec = report_error_functor_type(!.Info, Var, [ConsDefn],
+ ConsId, 0, TypeAssignSet0),
+ typecheck_info_add_error(ConsIdSpec, !Info)
+ )
+ )
+ ;
% Get the list of possible constructors that match this functor/arity.
% If there aren't any, report an undefined constructor error.
list.length(Args, Arity),
@@ -1977,8 +2025,10 @@
true
),
- % Check that the type of the functor matches the type of the variable.
- typecheck_functor_type(ConsTypeAssignSet, Var, [], ArgsTypeAssignSet),
+ % Check that the type of the functor matches the type of the
+ % variable.
+ typecheck_functor_type(ConsTypeAssignSet, Var,
+ [], ArgsTypeAssignSet),
(
ArgsTypeAssignSet = [],
ConsTypeAssignSet = [_ | _]
@@ -1995,24 +2045,24 @@
typecheck_functor_arg_types(ArgsTypeAssignSet, Args, !.Info,
[], TypeAssignSet),
(
- TypeAssignSet = [],
- ArgsTypeAssignSet = [_ | _]
- ->
- ArgSpec = report_error_functor_arg_types(!.Info, Var, ConsDefns,
- ConsId, Args, ArgsTypeAssignSet),
- typecheck_info_add_error(ArgSpec, !Info)
+ TypeAssignSet = [_ | _],
+ !Info ^ tc_info_type_assign_set := TypeAssignSet
;
- true
- ),
-
+ TypeAssignSet = [],
% If we encountered an error, continue checking with the
% original type assign set.
+ !Info ^ tc_info_type_assign_set := TypeAssignSet0,
(
- TypeAssignSet = [],
- !Info ^ tc_info_type_assign_set := TypeAssignSet0
- ;
- TypeAssignSet = [_ | _],
- !Info ^ tc_info_type_assign_set := TypeAssignSet
+ ArgsTypeAssignSet = []
+ % The error did not originate here, so generating an error
+ % message here would be misleading.
+ ;
+ ArgsTypeAssignSet = [_ | _],
+ ArgSpec = report_error_functor_arg_types(!.Info, Var,
+ ConsDefns, ConsId, Args, ArgsTypeAssignSet),
+ typecheck_info_add_error(ArgSpec, !Info)
+ )
+ )
)
).
@@ -2040,13 +2090,13 @@
% Iterate over the type assign sets.
%
-typecheck_unify_var_functor_get_ctors([], _, _, !TypeAssignSet).
+typecheck_unify_var_functor_get_ctors([], _, _, !ConsTypeAssignSet).
typecheck_unify_var_functor_get_ctors([TypeAssign | TypeAssigns], Info,
- ConsDefns, !TypeAssignSet) :-
+ ConsDefns, !ConsTypeAssignSet) :-
typecheck_unify_var_functor_get_ctors_2(ConsDefns, Info, TypeAssign,
- !TypeAssignSet),
+ !ConsTypeAssignSet),
typecheck_unify_var_functor_get_ctors(TypeAssigns, Info, ConsDefns,
- !TypeAssignSet).
+ !ConsTypeAssignSet).
% Iterate over all the different cons defns.
%
@@ -2170,17 +2220,17 @@
prog_var::in, type_assign::in,
args_type_assign_set::in, args_type_assign_set::out) is det.
-type_assign_check_functor_type(ConsType, ArgTypes, Y, TypeAssign1,
- !TypeAssignSet) :-
+type_assign_check_functor_type(ConsType, ArgTypes, Y, TypeAssign0,
+ !ArgsTypeAssignSet) :-
% Unify the type of Var with the type of the constructor.
- type_assign_get_var_types(TypeAssign1, VarTypes0),
+ type_assign_get_var_types(TypeAssign0, VarTypes0),
( map.search(VarTypes0, Y, TypeY) ->
- ( type_assign_unify_type(TypeAssign1, ConsType, TypeY, TypeAssign2) ->
+ ( type_assign_unify_type(TypeAssign0, ConsType, TypeY, TypeAssign) ->
% The constraints are empty here because none are added by
% unification with a functor.
empty_hlds_constraints(EmptyConstraints),
- ArgsTypeAssign = args(TypeAssign2, ArgTypes, EmptyConstraints),
- !:TypeAssignSet = [ArgsTypeAssign | !.TypeAssignSet]
+ ArgsTypeAssign = args(TypeAssign, ArgTypes, EmptyConstraints),
+ !:ArgsTypeAssignSet = [ArgsTypeAssign | !.ArgsTypeAssignSet]
;
true
)
@@ -2188,10 +2238,34 @@
% The constraints are empty here because none are added by
% unification with a functor.
map.det_insert(VarTypes0, Y, ConsType, VarTypes),
- type_assign_set_var_types(VarTypes, TypeAssign1, TypeAssign3),
+ type_assign_set_var_types(VarTypes, TypeAssign0, TypeAssign),
empty_hlds_constraints(EmptyConstraints),
- ArgsTypeAssign = args(TypeAssign3, ArgTypes, EmptyConstraints),
- !:TypeAssignSet = [ArgsTypeAssign | !.TypeAssignSet]
+ ArgsTypeAssign = args(TypeAssign, ArgTypes, EmptyConstraints),
+ !:ArgsTypeAssignSet = [ArgsTypeAssign | !.ArgsTypeAssignSet]
+ ).
+
+:- pred type_assign_check_functor_type_builtin(mer_type::in,
+ prog_var::in, type_assign::in,
+ type_assign_set::in, type_assign_set::out) is det.
+
+type_assign_check_functor_type_builtin(ConsType, Y, TypeAssign0,
+ !TypeAssignSet) :-
+ % Unify the type of Var with the type of the constructor.
+ type_assign_get_var_types(TypeAssign0, VarTypes0),
+ ( map.search(VarTypes0, Y, TypeY) ->
+ ( type_assign_unify_type(TypeAssign0, ConsType, TypeY, TypeAssign) ->
+ % The constraints are empty here because none are added by
+ % unification with a functor.
+ !:TypeAssignSet = [TypeAssign | !.TypeAssignSet]
+ ;
+ true
+ )
+ ;
+ % The constraints are empty here because none are added by
+ % unification with a functor.
+ map.det_insert(VarTypes0, Y, ConsType, VarTypes),
+ type_assign_set_var_types(VarTypes, TypeAssign0, TypeAssign),
+ !:TypeAssignSet = [TypeAssign | !.TypeAssignSet]
).
%-----------------------------------------------------------------------------%
@@ -2987,22 +3061,23 @@
++ PredConsInfos ++ ApplyConsInfos,
ConsInfos = DataConsInfos ++ OtherConsInfos.
+ % Filter out the errors (they aren't actually reported as errors
+ % unless there was no other matching constructor).
+ %
:- pred split_cons_errors(list(maybe_cons_type_info)::in,
list(cons_type_info)::out, list(cons_error)::out) is det.
-split_cons_errors(MaybeConsInfoList, ConsInfoList, ConsErrors) :-
- % Filter out the errors (they aren't actually reported as errors
- % unless there was no other matching constructor).
- list.filter_map(
- (pred(ok(ConsInfo)::in, ConsInfo::out) is semidet),
- MaybeConsInfoList, ConsInfoList, ConsErrors0),
- (
- list.map((pred(error(ConsError)::in, ConsError::out) is semidet),
- ConsErrors0, ConsErrors1)
- ->
- ConsErrors = ConsErrors1
- ;
- unexpected(this_file, "typecheck_info_get_ctor_list")
+split_cons_errors([], [], []).
+split_cons_errors([MaybeConsInfo | MaybeConsInfos], Infos, Errors) :-
+ split_cons_errors(MaybeConsInfos, InfosTail, ErrorsTail),
+ (
+ MaybeConsInfo = ok(ConsInfo),
+ Infos = [ConsInfo | InfosTail],
+ Errors = ErrorsTail
+ ;
+ MaybeConsInfo = error(ConsError),
+ Infos = InfosTail,
+ Errors = [ConsError | ErrorsTail]
).
%-----------------------------------------------------------------------------%
Index: compiler/typeclasses.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/typeclasses.m,v
retrieving revision 1.25
diff -u -b -r1.25 typeclasses.m
--- compiler/typeclasses.m 26 Aug 2009 16:05:56 -0000 1.25
+++ compiler/typeclasses.m 11 Sep 2009 00:59:49 -0000
@@ -105,7 +105,7 @@
:- import_module io.
perform_context_reduction(!Info) :-
- trace [io(!IO)] (
+ trace [compiletime(flag("type_checkpoint")), io(!IO)] (
type_checkpoint("before context reduction", !.Info, !IO)
),
TypeAssignSet0 = tc_info_type_assign_set(!.Info),
cvs diff: Diffing compiler/notes
cvs diff: Diffing debian
cvs diff: Diffing debian/patches
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
Index: doc/user_guide.texi
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/doc/user_guide.texi,v
retrieving revision 1.593
diff -u -b -r1.593 user_guide.texi
--- doc/user_guide.texi 8 Sep 2009 08:14:41 -0000 1.593
+++ doc/user_guide.texi 14 Sep 2009 03:01:38 -0000
@@ -6395,12 +6395,12 @@
@findex --no-trad-passes
@findex --trad-passes
- at sp 1
- at item -T
- at itemx --debug-types
- at findex -T
- at findex --debug-types
-Output detailed debugging traces of the type checking.
+ at c @sp 1
+ at c @item -T
+ at c @itemx --debug-types
+ at c @findex -T
+ at c @findex --debug-types
+ at c Output detailed debugging traces of the type checking.
@sp 1
@item -N
cvs diff: Diffing extras
cvs diff: Diffing extras/base64
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/concurrency
cvs diff: Diffing extras/curs
cvs diff: Diffing extras/curs/samples
cvs diff: Diffing extras/curses
cvs diff: Diffing extras/curses/sample
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/error
cvs diff: Diffing extras/fixed
cvs diff: Diffing extras/gator
cvs diff: Diffing extras/gator/generations
cvs diff: Diffing extras/gator/generations/1
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/easyx
cvs diff: Diffing extras/graphics/easyx/samples
cvs diff: Diffing extras/graphics/mercury_allegro
cvs diff: Diffing extras/graphics/mercury_allegro/examples
cvs diff: Diffing extras/graphics/mercury_allegro/samples
cvs diff: Diffing extras/graphics/mercury_allegro/samples/demo
cvs diff: Diffing extras/graphics/mercury_allegro/samples/mandel
cvs diff: Diffing extras/graphics/mercury_allegro/samples/pendulum2
cvs diff: Diffing extras/graphics/mercury_allegro/samples/speed
cvs diff: Diffing extras/graphics/mercury_glut
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/gears
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/lex
cvs diff: Diffing extras/lex/samples
cvs diff: Diffing extras/lex/tests
cvs diff: Diffing extras/log4m
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/moose/tests
cvs diff: Diffing extras/mopenssl
cvs diff: Diffing extras/morphine
cvs diff: Diffing extras/morphine/non-regression-tests
cvs diff: Diffing extras/morphine/scripts
cvs diff: Diffing extras/morphine/source
cvs diff: Diffing extras/net
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/posix/samples
cvs diff: Diffing extras/quickcheck
cvs diff: Diffing extras/quickcheck/tutes
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/solver_types
cvs diff: Diffing extras/solver_types/library
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/windows_installer_generator
cvs diff: Diffing extras/windows_installer_generator/sample
cvs diff: Diffing extras/windows_installer_generator/sample/images
cvs diff: Diffing extras/xml
cvs diff: Diffing extras/xml/samples
cvs diff: Diffing extras/xml_stylesheets
cvs diff: Diffing java
cvs diff: Diffing java/runtime
cvs diff: Diffing library
cvs diff: Diffing mdbcomp
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/standalone_c
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/solver_types
cvs diff: Diffing samples/tests
cvs diff: Diffing samples/tests/c_interface
cvs diff: Diffing samples/tests/c_interface/c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/tests/c_interface/mercury_calls_c
cvs diff: Diffing samples/tests/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/tests/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/tests/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/tests/diff
cvs diff: Diffing samples/tests/muz
cvs diff: Diffing samples/tests/rot13
cvs diff: Diffing samples/tests/solutions
cvs diff: Diffing samples/tests/toplevel
cvs diff: Diffing scripts
cvs diff: Diffing slice
cvs diff: Diffing ssdb
cvs diff: Diffing tests
cvs diff: Diffing tests/analysis
cvs diff: Diffing tests/analysis/ctgc
cvs diff: Diffing tests/analysis/excp
cvs diff: Diffing tests/analysis/ext
cvs diff: Diffing tests/analysis/sharing
cvs diff: Diffing tests/analysis/table
cvs diff: Diffing tests/analysis/trail
cvs diff: Diffing tests/analysis/unused_args
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
cvs diff: Diffing tests/debugger/declarative
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/general
cvs diff: Diffing tests/general/accumulator
cvs diff: Diffing tests/general/string_format
cvs diff: Diffing tests/general/structure_reuse
cvs diff: Diffing tests/grade_subdirs
cvs diff: Diffing tests/hard_coded
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/purity
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
cvs diff: Diffing tests/invalid/purity
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/mmc_make
cvs diff: Diffing tests/mmc_make/lib
cvs diff: Diffing tests/par_conj
cvs diff: Diffing tests/recompilation
cvs diff: Diffing tests/stm
cvs diff: Diffing tests/stm/orig
cvs diff: Diffing tests/stm/orig/stm-compiler
cvs diff: Diffing tests/stm/orig/stm-compiler/test1
cvs diff: Diffing tests/stm/orig/stm-compiler/test10
cvs diff: Diffing tests/stm/orig/stm-compiler/test2
cvs diff: Diffing tests/stm/orig/stm-compiler/test3
cvs diff: Diffing tests/stm/orig/stm-compiler/test4
cvs diff: Diffing tests/stm/orig/stm-compiler/test5
cvs diff: Diffing tests/stm/orig/stm-compiler/test6
cvs diff: Diffing tests/stm/orig/stm-compiler/test7
cvs diff: Diffing tests/stm/orig/stm-compiler/test8
cvs diff: Diffing tests/stm/orig/stm-compiler/test9
cvs diff: Diffing tests/stm/orig/stm-compiler-par
cvs diff: Diffing tests/stm/orig/stm-compiler-par/bm1
cvs diff: Diffing tests/stm/orig/stm-compiler-par/bm2
cvs diff: Diffing tests/stm/orig/stm-compiler-par/stmqueue
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test1
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test10
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test11
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test2
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test3
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test4
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test5
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test6
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test7
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test8
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test9
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test1
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test2
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test3
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test4
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test5
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test6
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test7
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test8
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test9
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/trailing
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
cvs diff: Diffing trace
cvs diff: Diffing util
cvs diff: Diffing vim
cvs diff: Diffing vim/after
cvs diff: Diffing vim/ftplugin
cvs diff: Diffing vim/syntax
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list