diff: typeclasses (final) [3/6]
David Glen JEFFERY
dgj at cs.mu.oz.au
Fri Dec 19 14:00:54 AEDT 1997
- PredInfo0 = predicate(A, B, C, D, E, F, G, H, I, _, K, L, M, N),
- PredInfo = predicate(A, B, C, D, E, F, G, H, I, Status, K, L, M, N).
+ PredInfo0 = predicate(A, B, C, D, E, F, G, H, I, _, K, L, M, N, O, P),
+ PredInfo = predicate(A, B, C, D, E, F, G, H, I, Status, K,
+ L, M, N, O, P).
pred_info_typevarset(PredInfo, TypeVarSet) :-
- PredInfo = predicate(_, _, _, _, _, _, _, _, _, _, TypeVarSet, _, _, _).
+ PredInfo = predicate(_, _, _, _, _, _, _, _, _, _, TypeVarSet, _, _,
+ _, _, _).
pred_info_set_typevarset(PredInfo0, TypeVarSet, PredInfo) :-
- PredInfo0 = predicate(A, B, C, D, E, F, G, H, I, J, _, L, M, N),
+ PredInfo0 = predicate(A, B, C, D, E, F, G, H, I, J, _, L, M, N, O, P),
PredInfo = predicate(A, B, C, D, E, F, G, H, I, J, TypeVarSet, L, M,
- N).
+ N, O, P).
pred_info_get_goal_type(PredInfo, GoalType) :-
- PredInfo = predicate(_, _, _, _, _, _, _, _, _, _, _, GoalType, _, _).
+ PredInfo = predicate(_, _, _, _, _, _, _, _, _, _, _, GoalType, _,
+ _, _, _).
pred_info_set_goal_type(PredInfo0, GoalType, PredInfo) :-
- PredInfo0 = predicate(A, B, C, D, E, F, G, H, I, J, K, _, M, N),
- PredInfo = predicate(A, B, C, D, E, F, G, H, I, J, K, GoalType, M, N).
+ PredInfo0 = predicate(A, B, C, D, E, F, G, H, I, J, K, _, M, N, O, P),
+ PredInfo = predicate(A, B, C, D, E, F, G, H, I, J, K, GoalType, M,
+ N, O, P).
pred_info_requested_inlining(PredInfo0) :-
pred_info_get_markers(PredInfo0, Markers),
@@ -635,16 +696,45 @@
pred_info_get_markers(PredInfo, Markers) :-
- PredInfo = predicate(_, _, _, _, _, _, _, _, _, _, _, _, Markers, _).
+ PredInfo = predicate(_, _, _, _, _, _, _, _, _, _, _, _, Markers,
+ _, _, _).
pred_info_set_markers(PredInfo0, Markers, PredInfo) :-
- PredInfo0 = predicate(A, B, C, D, E, F, G, H, I, J, K, L, _, N),
- PredInfo = predicate(A, B, C, D, E, F, G, H, I, J, K, L, Markers, N).
+ PredInfo0 = predicate(A, B, C, D, E, F, G, H, I, J, K, L, _, N, O, P),
+ PredInfo = predicate(A, B, C, D, E, F, G, H, I, J, K, L, Markers,
+ N, O, P).
pred_info_get_is_pred_or_func(PredInfo, IsPredOrFunc) :-
PredInfo = predicate(_, _, _, _, _, _, _, _, _, _, _, _, _,
- IsPredOrFunc).
+ IsPredOrFunc, _, _).
+
+pred_info_set_class_context(PredInfo0, ClassContext, PredInfo) :-
+ PredInfo0 = predicate(A, B, C, D, E, F, G, H, I, J, K, L, M, N, _, P),
+ PredInfo = predicate(A, B, C, D, E, F, G, H, I, J, K, L, M, N,
+ ClassContext, P).
+
+pred_info_get_class_context(PredInfo, ClassContext) :-
+ PredInfo = predicate(_, _, _, _, _, _, _, _, _, _, _, _, _, _,
+ ClassContext, _).
+
+pred_info_set_constraint_proofs(PredInfo0, Proofs, PredInfo) :-
+ PredInfo0 = predicate(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O, _),
+ PredInfo = predicate(A, B, C, D, E, F, G, H, I, J, K, L, M, N,
+ O, Proofs).
+
+pred_info_get_constraint_proofs(PredInfo, ConstraintProofs) :-
+ PredInfo = predicate(_, _, _, _, _, _, _, _, _, _, _, _, _, _, _,
+ ConstraintProofs).
+
+%-----------------------------------------------------------------------------%
+
+type_info_locn_var(type_info(Var), Var).
+type_info_locn_var(typeclass_info(Var, _), Var).
+
+type_info_locn_set_var(type_info(_), Var, type_info(Var)).
+type_info_locn_set_var(typeclass_info(_, Num), Var, typeclass_info(Var, Num)).
+%-----------------------------------------------------------------------------%
:- type pred_markers == list(marker).
init_markers([]).
@@ -659,7 +749,7 @@
%-----------------------------------------------------------------------------%
hlds_pred__define_new_pred(Goal0, Goal, ArgVars, InstMap0, PredName, TVarSet,
- VarTypes, VarSet, Markers, ModuleInfo0,
+ VarTypes, ClassContext, VarSet, Markers, ModuleInfo0,
ModuleInfo, PredProcId) :-
Goal0 = _GoalExpr - GoalInfo,
goal_info_get_instmap_delta(GoalInfo, InstMapDelta),
@@ -673,10 +763,12 @@
module_info_name(ModuleInfo0, ModuleName),
SymName = qualified(ModuleName, PredName),
map__init(TVarMap), % later, polymorphism.m will fill this in.
+ map__init(TCVarMap), % later, polymorphism.m will fill this in.
proc_info_create(VarSet, VarTypes, ArgVars, ArgModes, Detism,
- Goal0, Context, TVarMap, ProcInfo),
+ Goal0, Context, TVarMap, TCVarMap, ProcInfo),
pred_info_create(ModuleName, SymName, TVarSet, ArgTypes, true,
- Context, local, Markers, predicate, ProcInfo, ProcId, PredInfo),
+ Context, local, Markers, predicate, ClassContext,
+ ProcInfo, ProcId, PredInfo),
module_info_get_predicate_table(ModuleInfo0, PredTable0),
predicate_table_insert(PredTable0, PredInfo, PredId,
@@ -715,13 +807,15 @@
:- pred proc_info_set(maybe(determinism), varset, map(var, type), list(var),
list(mode), maybe(list(is_live)), hlds_goal, term__context,
stack_slots, determinism, bool, list(arg_info), liveness_info,
- map(tvar, var), termination, proc_info).
+ map(tvar, type_info_locn), map(class_constraint, var), termination,
+ proc_info).
:- mode proc_info_set(in, in, in, in, in, in, in, in, in, in, in, in, in, in,
- in, out) is det.
+ in, in, out) is det.
:- pred proc_info_create(varset, map(var, type), list(var), list(mode),
- determinism, hlds_goal, term__context, map(tvar, var), proc_info).
-:- mode proc_info_create(in, in, in, in, in, in, in, in, out) is det.
+ determinism, hlds_goal, term__context, map(tvar, type_info_locn),
+ map(class_constraint, var), proc_info).
+:- mode proc_info_create(in, in, in, in, in, in, in, in, in, out) is det.
:- pred proc_info_set_body(proc_info, varset, map(var, type), list(var),
hlds_goal, proc_info).
@@ -827,12 +921,20 @@
:- pred proc_info_set_can_process(proc_info, bool, proc_info).
:- mode proc_info_set_can_process(in, in, out) is det.
-:- pred proc_info_typeinfo_varmap(proc_info, map(tvar, var)).
+:- pred proc_info_typeinfo_varmap(proc_info, map(tvar, type_info_locn)).
:- mode proc_info_typeinfo_varmap(in, out) is det.
-:- pred proc_info_set_typeinfo_varmap(proc_info, map(tvar, var), proc_info).
+:- pred proc_info_set_typeinfo_varmap(proc_info, map(tvar, type_info_locn),
+ proc_info).
:- mode proc_info_set_typeinfo_varmap(in, in, out) is det.
+:- pred proc_info_typeclass_info_varmap(proc_info, map(class_constraint, var)).
+:- mode proc_info_typeclass_info_varmap(in, out) is det.
+
+:- pred proc_info_set_typeclass_info_varmap(proc_info,
+ map(class_constraint, var), proc_info).
+:- mode proc_info_set_typeclass_info_varmap(in, in, out) is det.
+
:- pred proc_info_maybe_declared_argmodes(proc_info, maybe(list(mode))).
:- mode proc_info_maybe_declared_argmodes(in, out) is det.
@@ -895,8 +997,12 @@
% should be passed.
liveness_info, % the initial liveness,
% for code generation
- map(tvar, var), % typeinfo vars for
+ map(tvar, type_info_locn),
+ % typeinfo vars for
% type parameters
+ map(class_constraint, var),
+ % typeclass_info vars for class
+ % constraints
termination, % The termination properties of the
% procedure. Initially 'not_set'.
% Final value inferred by termination.m
@@ -926,37 +1032,40 @@
ClauseBody = conj([]) - GoalInfo,
CanProcess = yes,
map__init(TVarsMap),
+ map__init(TCVarsMap),
term_util__init(Termination),
NewProc = procedure(
MaybeDet, BodyVarSet, BodyTypes, HeadVars, Modes, MaybeArgLives,
ClauseBody, MContext, StackSlots, InferredDet, CanProcess,
- ArgInfo, InitialLiveness, TVarsMap, Termination, DeclaredModes
+ ArgInfo, InitialLiveness, TVarsMap, TCVarsMap, Termination,
+ DeclaredModes
).
proc_info_set(DeclaredDetism, BodyVarSet, BodyTypes, HeadVars, HeadModes,
HeadLives, Goal,
Context, StackSlots, InferredDetism, CanProcess,
- ArgInfo, Liveness, TVarMap, Termination, ProcInfo) :-
+ ArgInfo, Liveness, TVarMap, TCVarsMap, Termination, ProcInfo) :-
ProcInfo = procedure(
DeclaredDetism, BodyVarSet, BodyTypes, HeadVars, HeadModes,
HeadLives, Goal, Context, StackSlots, InferredDetism,
- CanProcess, ArgInfo, Liveness, TVarMap, Termination, no).
+ CanProcess, ArgInfo, Liveness, TVarMap, TCVarsMap, Termination,
+ no).
proc_info_create(VarSet, VarTypes, HeadVars, HeadModes, Detism, Goal,
- Context, TVarMap, ProcInfo) :-
+ Context, TVarMap, TCVarsMap, ProcInfo) :-
map__init(StackSlots),
set__init(Liveness),
term_util__init(Termination),
MaybeHeadLives = no,
ProcInfo = procedure(yes(Detism), VarSet, VarTypes, HeadVars, HeadModes,
MaybeHeadLives, Goal, Context, StackSlots, Detism, yes, [],
- Liveness, TVarMap, Termination, no).
+ Liveness, TVarMap, TCVarsMap, Termination, no).
proc_info_set_body(ProcInfo0, VarSet, VarTypes, HeadVars, Goal, ProcInfo) :-
ProcInfo0 = procedure(A, _, _, _, E, F, _,
- H, I, J, K, L, M, N, O, P),
+ H, I, J, K, L, M, N, O, P, Q),
ProcInfo = procedure(A, VarSet, VarTypes, HeadVars, E, F, Goal,
- H, I, J, K, L, M, N, O, P).
+ H, I, J, K, L, M, N, O, P, Q).
proc_info_interface_determinism(ProcInfo, Determinism) :-
proc_info_declared_determinism(ProcInfo, MaybeDeterminism),
@@ -1005,45 +1114,55 @@
instmap__from_assoc_list(InstAL, InstMap).
proc_info_declared_determinism(ProcInfo, Detism) :-
- ProcInfo = procedure(Detism, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _).
+ ProcInfo = procedure(Detism, _, _, _, _, _, _, _, _, _, _, _, _, _, _,
+ _, _).
proc_info_variables(ProcInfo, VarSet) :-
- ProcInfo = procedure(_, VarSet, _, _, _, _, _, _, _, _, _, _, _, _, _, _).
+ ProcInfo = procedure(_, VarSet, _, _, _, _, _, _, _, _, _, _, _, _, _,
+ _, _).
proc_info_vartypes(ProcInfo, VarTypes) :-
- ProcInfo = procedure(_, _, VarTypes, _, _, _, _, _,
- _, _, _, _, _, _, _, _).
+ ProcInfo = procedure(_, _, VarTypes, _, _, _, _, _, _,
+ _, _, _, _, _, _, _, _).
proc_info_headvars(ProcInfo, HeadVars) :-
- ProcInfo = procedure(_, _, _, HeadVars, _, _, _, _,
- _, _, _, _, _, _, _, _).
+ ProcInfo = procedure(_, _, _, HeadVars, _, _, _, _, _, _,
+ _, _, _, _, _, _, _).
proc_info_argmodes(ProcInfo, Modes) :-
- ProcInfo = procedure(_, _, _, _, Modes, _, _, _, _, _, _, _, _, _, _, _).
+ ProcInfo = procedure(_, _, _, _, Modes, _, _, _, _, _, _, _, _, _, _,
+ _, _).
proc_info_maybe_arglives(ProcInfo, ArgLives) :-
- ProcInfo = procedure(_, _, _, _, _, ArgLives,
- _, _, _, _, _, _, _, _, _, _).
+ ProcInfo = procedure(_, _, _, _, _, ArgLives, _, _, _,
+ _, _, _, _, _, _, _, _).
proc_info_goal(ProcInfo, Goal) :-
- ProcInfo = procedure(_, _, _, _, _, _, Goal, _, _, _, _, _, _, _, _, _).
+ ProcInfo = procedure(_, _, _, _, _, _, Goal, _, _, _, _, _, _, _, _,
+ _, _).
proc_info_context(ProcInfo, Context) :-
- ProcInfo = procedure(_, _, _, _, _, _, _, Context, _, _, _, _, _, _, _, _).
+ ProcInfo = procedure(_, _, _, _, _, _, _, Context,
+ _, _, _, _, _, _, _, _, _).
proc_info_stack_slots(ProcInfo, StackSlots) :-
- ProcInfo = procedure(_, _, _, _, _, _, _, _, StackSlots,
- _, _, _, _, _, _, _).
+ ProcInfo = procedure(_, _, _, _, _, _, _, _, StackSlots,
+ _, _, _, _, _, _, _, _).
proc_info_inferred_determinism(ProcInfo, Detism) :-
- ProcInfo = procedure(_, _, _, _, _, _, _, _, _, Detism, _, _, _, _, _, _).
+ ProcInfo = procedure(_, _, _, _, _, _, _, _, _, Detism, _, _, _, _, _,
+ _, _).
proc_info_can_process(ProcInfo, CanProcess) :-
- ProcInfo = procedure(_, _, _, _, _, _, _, _, _, _, CanProcess,
- _, _, _, _, _).
-proc_info_arg_info(ProcInfo, ArgInfo) :-
- ProcInfo = procedure(_, _, _, _, _, _, _, _, _, _, _, ArgInfo,
- _, _, _, _).
+ ProcInfo = procedure(_, _, _, _, _, _, _, _, _, _, CanProcess,
+ _, _, _, _, _, _).
+proc_info_arg_info(ProcInfo, ArgInfo) :-
+ ProcInfo = procedure(_, _, _, _, _, _, _, _, _, _, _, ArgInfo,
+ _, _, _, _, _).
proc_info_liveness_info(ProcInfo, Liveness) :-
- ProcInfo = procedure(_, _, _, _, _, _, _, _, _, _, _, _, Liveness,
- _, _, _).
+ ProcInfo = procedure(_, _, _, _, _, _, _, _, _, _, _, _, Liveness,
+ _, _, _, _).
proc_info_typeinfo_varmap(ProcInfo, TVarMap) :-
- ProcInfo = procedure(_, _, _, _, _, _, _, _, _, _, _, _, _, TVarMap, _, _).
+ ProcInfo = procedure(_, _, _, _, _, _, _,
+ _, _, _, _, _, _, TVarMap, _, _, _).
+proc_info_typeclass_info_varmap(ProcInfo, TCVarMap) :-
+ ProcInfo = procedure(_, _, _, _, _, _, _,
+ _, _, _, _, _, _, _, TCVarMap, _, _).
proc_info_termination(ProcInfo, Termination) :-
- ProcInfo = procedure(_, _, _, _, _, _, _, _, _, _, _, _, _, _,
+ ProcInfo = procedure(_, _, _, _, _, _, _, _, _, _, _, _, _, _, _,
Termination, _).
proc_info_maybe_declared_argmodes(ProcInfo, MaybeArgModes) :-
- ProcInfo = procedure(_, _, _, _, _, _, _,
+ ProcInfo = procedure(_, _, _, _, _, _, _, _,
_, _, _, _, _, _, _, _, MaybeArgModes).
proc_info_declared_argmodes(ProcInfo, ArgModes) :-
@@ -1073,74 +1192,76 @@
% % derived from the
% % modes etc
% M liveness_info % the initial liveness
-% N map(tvar, var) % typeinfo vars to
+% N map(tvar, type_info_locn)
+% % typeinfo vars to
+% % locations.
+% O map(class_constraint, var)
+% % constraints to
% % vars.
-% O termination % Termination analys
-% P maybe(list(mode)) % declared modes
+% P termination % Termination analys
+% Q maybe(list(mode)) % declared modes
% % of args
% ).
proc_info_set_varset(ProcInfo0, VarSet, ProcInfo) :-
- ProcInfo0 = procedure(A, _, C, D, E, F, G, H, I, J, K, L, M, N, O, P),
- ProcInfo = procedure(A, VarSet, C, D, E, F, G, H, I, J, K, L, M, N, O, P).
+ ProcInfo0 = procedure(A,_,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q),
+ ProcInfo = procedure(A,VarSet,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q).
proc_info_set_variables(ProcInfo0, Vars, ProcInfo) :-
- ProcInfo0 = procedure(A, _, C, D, E, F, G, H, I, J, K, L, M, N, O, P),
- ProcInfo = procedure(A, Vars, C, D, E, F, G, H, I, J, K, L, M, N, O, P).
+ ProcInfo0 = procedure(A,_,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q),
+ ProcInfo = procedure(A,Vars,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q).
proc_info_set_vartypes(ProcInfo0, Vars, ProcInfo) :-
- ProcInfo0 = procedure(A, B, _, D, E, F, G, H, I, J, K, L, M, N, O, P),
- ProcInfo = procedure(A, B, Vars, D, E, F, G, H, I, J, K, L, M, N, O, P).
+ ProcInfo0 = procedure(A,B,_,D,E,F,G,H,I,J,K,L,M,N,O,P,Q),
+ ProcInfo = procedure(A,B,Vars,D,E,F,G,H,I,J,K,L,M,N,O,P,Q).
-proc_info_set_headvars(ProcInfo0, HdVars, ProcInfo) :-
- ProcInfo0 = procedure(A, B, C, _, E, F, G, H, I, J, K, L, M, N, O, P),
- ProcInfo = procedure(A, B, C, HdVars, E, F, G, H, I, J, K, L, M, N, O, P).
+proc_info_set_headvars(ProcInfo0, HeadVars, ProcInfo) :-
+ ProcInfo0 = procedure(A,B,C,_,E,F,G,H,I,J,K,L,M,N,O,P,Q),
+ ProcInfo = procedure(A,B,C,HeadVars,E,F,G,H,I,J,K,L,M,N,O,P,Q).
proc_info_set_argmodes(ProcInfo0, ArgModes, ProcInfo) :-
- ProcInfo0 = procedure(A, B, C, D, _, F, G, H, I, J, K, L, M, N, O, P),
- ProcInfo = procedure(A, B, C, D, ArgModes, F, G, H, I,
- J, K, L, M, N, O, P).
+ ProcInfo0 = procedure(A,B,C,D,_,F,G,H,I,J,K,L,M,N,O,P,Q),
+ ProcInfo = procedure(A,B,C,D,ArgModes,F,G,H,I,J,K,L,M,N,O,P,Q).
proc_info_set_maybe_arglives(ProcInfo0, ArgLives, ProcInfo) :-
- ProcInfo0 = procedure(A, B, C, D, E, _, G, H, I, J, K, L, M, N, O, P),
- ProcInfo = procedure(A, B, C, D, E, ArgLives, G, H, I,
- J, K, L, M, N, O, P).
+ ProcInfo0 = procedure(A,B,C,D,E,_,G,H,I,J,K,L,M,N,O,P,Q),
+ ProcInfo = procedure(A,B,C,D,E,ArgLives,G,H,I,J,K,L,M,N,O,P,Q).
proc_info_set_inferred_determinism(ProcInfo0, Detism, ProcInfo) :-
- ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I, _, K, L, M, N, O, P),
- ProcInfo = procedure(A, B, C, D, E, F, G, H, I, Detism, K, L, M, N, O, P).
+ ProcInfo0 = procedure(A,B,C,D,E,F,G,H,I,_,K,L,M,N,O,P,Q),
+ ProcInfo = procedure(A,B,C,D,E,F,G,H,I,Detism,K,L,M,N,O,P,Q).
proc_info_set_can_process(ProcInfo0, CanProcess, ProcInfo) :-
- ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I, J, _, L, M, N, O, P),
- ProcInfo = procedure(A, B, C, D, E, F, G, H, I, J, CanProcess,
- L, M, N, O, P).
+ ProcInfo0 = procedure(A,B,C,D,E,F,G,H,I,J,_,L,M,N,O,P,Q),
+ ProcInfo = procedure(A,B,C,D,E,F,G,H,I,J,CanProcess,L,M,N,O,P,Q).
proc_info_set_goal(ProcInfo0, Goal, ProcInfo) :-
- ProcInfo0 = procedure(A, B, C, D, E, F, _, H, I, J, K, L, M, N, O, P),
- ProcInfo = procedure(A, B, C, D, E, F, Goal, H, I, J, K, L, M, N, O, P).
+ ProcInfo0 = procedure(A,B,C,D,E,F,_,H,I,J,K,L,M,N,O,P,Q),
+ ProcInfo = procedure(A,B,C,D,E,F,Goal,H,I,J,K,L,M,N,O,P,Q).
proc_info_set_stack_slots(ProcInfo0, StackSlots, ProcInfo) :-
- ProcInfo0 = procedure(A, B, C, D, E, F, G, H, _, J, K, L, M, N, O, P),
- ProcInfo = procedure(A, B, C, D, E, F, G, H, StackSlots, J, K,
- L, M, N, O, P).
+ ProcInfo0 = procedure(A,B,C,D,E,F,G,H,_,J,K,L,M,N,O,P,Q),
+ ProcInfo = procedure(A,B,C,D,E,F,G,H,StackSlots,J,K,L,M,N,O,P,Q).
proc_info_set_arg_info(ProcInfo0, ArgInfo, ProcInfo) :-
- ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I, J, K, _, M, N, O, P),
- ProcInfo = procedure(A, B, C, D, E, F, G, H, I, J, K, ArgInfo, M, N, O, P).
+ ProcInfo0 = procedure(A,B,C,D,E,F,G,H,I,J,K,_,M,N,O,P,Q),
+ ProcInfo = procedure(A,B,C,D,E,F,G,H,I,J,K,ArgInfo,M,N,O,P,Q).
proc_info_set_liveness_info(ProcInfo0, Liveness, ProcInfo) :-
- ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I, J, K, L, _, N, O, P),
- ProcInfo = procedure(A, B, C, D, E, F, G, H, I, J, K, L, Liveness,
- N, O, P).
+ ProcInfo0 = procedure(A,B,C,D,E,F,G,H,I,J,K,L,_,N,O,P,Q),
+ ProcInfo = procedure(A,B,C,D,E,F,G,H,I,J,K,L,Liveness,N,O,P,Q).
proc_info_set_typeinfo_varmap(ProcInfo0, TVarMap, ProcInfo) :-
- ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I, J, K, L, M, _, O, P),
- ProcInfo = procedure(A, B, C, D, E, F, G, H, I, J, K, L, M, TVarMap, O, P).
+ ProcInfo0 = procedure(A,B,C,D,E,F,G,H,I,J,K,L,M,_,O,P,Q),
+ ProcInfo = procedure(A,B,C,D,E,F,G,H,I,J,K,L,M,TVarMap,O,P,Q).
+
+proc_info_set_typeclass_info_varmap(ProcInfo0, TCVarMap, ProcInfo) :-
+ ProcInfo0 = procedure(A,B,C,D,E,F,G,H,I,J,K,L,M,N,_,P,Q),
+ ProcInfo = procedure(A,B,C,D,E,F,G,H,I,J,K,L,M,N,TCVarMap,P,Q).
proc_info_set_termination(ProcInfo0, Terminat, ProcInfo) :-
- ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I, J, K, L, M, N, _, P),
- ProcInfo = procedure(A, B, C, D, E, F, G, H, I, J, K, L,
- M, N, Terminat, P).
+ ProcInfo0 = procedure(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,_,Q),
+ ProcInfo = procedure(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,Terminat,Q).
proc_info_get_typeinfo_vars_setwise(ProcInfo, Vars, TypeInfoVars) :-
set__to_sorted_list(Vars, VarList),
@@ -1169,7 +1290,18 @@
% higher order pred types here -- if so, maybe
% treat them specially.
proc_info_typeinfo_varmap(ProcInfo, TVarMap),
- map__apply_to_list(TypeVars, TVarMap, TypeInfoVars0),
+
+ % The type_info is either stored in a variable,
+ % or in a typeclass_info. Either get the
+ % type_info variable or the typeclass_info
+ % variable
+ LookupVar = lambda([TVar::in, TVarVar::out] is det,
+ (
+ map__lookup(TVarMap, TVar, Locn),
+ type_info_locn_var(Locn, TVarVar)
+ )),
+ list__map(LookupVar, TypeVars, TypeInfoVars0),
+
proc_info_get_typeinfo_vars_2(ProcInfo, Vars1,
TypeInfoVars1),
list__append(TypeInfoVars0, TypeInfoVars1, TypeInfoVars)
Index: compiler/inlining.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/inlining.m,v
retrieving revision 1.69
diff -u -r1.69 inlining.m
--- inlining.m 1997/09/01 14:02:31 1.69
+++ inlining.m 1997/09/08 04:51:26
@@ -312,7 +312,7 @@
varset, % varset
map(var, type), % variable types
tvarset, % type variables
- map(tvar, var), % type_info varset, a mapping from
+ map(tvar, type_info_locn),% type_info varset, a mapping from
% type variables to variables
% where their type_info is
% stored.
@@ -520,6 +520,9 @@
inlining__inlining_in_goal(higher_order_call(A, B, C, D, E, F) - GoalInfo,
higher_order_call(A, B, C, D, E, F) - GoalInfo) --> [].
+
+inlining__inlining_in_goal(class_method_call(A, B, C, D, E, F) - GoalInfo,
+ class_method_call(A, B, C, D, E, F) - GoalInfo) --> [].
inlining__inlining_in_goal(unify(A, B, C, D, E) - GoalInfo,
unify(A, B, C, D, E) - GoalInfo) --> [].
Index: compiler/intermod.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/intermod.m,v
retrieving revision 1.38
diff -u -r1.38 intermod.m
--- intermod.m 1997/12/11 21:20:47 1.38
+++ intermod.m 1997/12/18 07:37:31
@@ -385,6 +385,9 @@
intermod__traverse_goal(higher_order_call(A,B,C,D,E,F) - Info,
higher_order_call(A,B,C,D,E,F) - Info, yes) --> [].
+intermod__traverse_goal(class_method_call(A,B,C,D,E,F) - Info,
+ class_method_call(A,B,C,D,E,F) - Info, yes) --> [].
+
intermod__traverse_goal(switch(A, B, Cases0, D) - Info,
switch(A, B, Cases, D) - Info, DoWrite) -->
intermod__traverse_cases(Cases0, Cases, DoWrite).
@@ -850,16 +853,18 @@
{ pred_info_context(PredInfo, Context) },
{ pred_info_get_purity(PredInfo, Purity) },
{ pred_info_get_is_pred_or_func(PredInfo, PredOrFunc) },
+ { pred_info_get_class_context(PredInfo, ClassContext) },
(
{ PredOrFunc = predicate },
mercury_output_pred_type(TVarSet, qualified(Module, Name),
- ArgTypes, no, Purity, Context)
+ ArgTypes, no, Purity, ClassContext,
+ Context)
;
{ PredOrFunc = function },
{ pred_args_to_func_args(ArgTypes, FuncArgTypes, FuncRetType) },
mercury_output_func_type(TVarSet,
qualified(Module, Name), FuncArgTypes,
- FuncRetType, no, Purity, Context)
+ FuncRetType, no, Purity, ClassContext, Context)
),
{ pred_info_procedures(PredInfo, Procs) },
{ pred_info_procids(PredInfo, ProcIds) },
Index: compiler/lambda.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/lambda.m,v
retrieving revision 1.33
diff -u -r1.33 lambda.m
--- lambda.m 1997/11/24 07:26:46 1.33
+++ lambda.m 1997/12/02 05:43:17
@@ -28,6 +28,11 @@
%
% :- pred '__LambdaGoal__1'(int::in, int::out) is nondet.
% '__LambdaGoal__1'(X, Y) :- q(Y, X).
+%
+%
+%
+% Note: Support for lambda expressions which involve class constraints
+% is not yet complete.
%-----------------------------------------------------------------------------%
@@ -43,10 +48,11 @@
:- pred lambda__transform_lambda(pred_or_func, string, list(var), list(mode),
determinism, set(var), hlds_goal, unification,
- varset, map(var, type), tvarset, map(tvar, var), module_info,
- unify_rhs, unification, module_info).
+ varset, map(var, type), list(class_constraint), tvarset,
+ map(tvar, type_info_locn), map(class_constraint, var),
+ module_info, unify_rhs, unification, module_info).
:- mode lambda__transform_lambda(in, in, in, in, in, in, in, in, in, in, in, in,
- in, out, out, out) is det.
+ in, in, in, out, out, out) is det.
% Permute the list of variables so that inputs come before outputs.
:- pred lambda__permute_argvars(list(var), list(mode), module_info,
@@ -67,8 +73,14 @@
lambda_info(
varset, % from the proc_info
map(var, type), % from the proc_info
+ list(class_constraint), % from the pred_info
tvarset, % from the proc_info
- map(tvar, var), % from the proc_info (typeinfos)
+ map(tvar, type_info_locn),
+ % from the proc_info
+ % (typeinfos)
+ map(class_constraint, var),
+ % from the proc_info
+ % (typeclass_infos)
pred_or_func,
string, % pred/func name
module_info
@@ -120,26 +132,28 @@
pred_info_name(PredInfo0, PredName),
pred_info_get_is_pred_or_func(PredInfo0, PredOrFunc),
pred_info_typevarset(PredInfo0, TypeVarSet0),
+ pred_info_get_class_context(PredInfo0, Constraints0),
proc_info_variables(ProcInfo0, VarSet0),
proc_info_vartypes(ProcInfo0, VarTypes0),
proc_info_goal(ProcInfo0, Goal0),
proc_info_typeinfo_varmap(ProcInfo0, TVarMap0),
+ proc_info_typeclass_info_varmap(ProcInfo0, TCVarMap0),
% process the goal
- Info0 = lambda_info(VarSet0, VarTypes0, TypeVarSet0, TVarMap0,
- PredOrFunc, PredName,
- ModuleInfo0),
+ Info0 = lambda_info(VarSet0, VarTypes0, Constraints0, TypeVarSet0,
+ TVarMap0, TCVarMap0, PredOrFunc, PredName, ModuleInfo0),
lambda__process_goal(Goal0, Goal, Info0, Info),
- Info = lambda_info(VarSet, VarTypes, TypeVarSet, TVarMap,
- _, _,
- ModuleInfo),
+ Info = lambda_info(VarSet, VarTypes, Constraints, TypeVarSet,
+ TVarMap, TCVarMap, _, _, ModuleInfo),
% set the new values of the fields in proc_info and pred_info
proc_info_set_goal(ProcInfo0, Goal, ProcInfo1),
proc_info_set_variables(ProcInfo1, VarSet, ProcInfo2),
proc_info_set_vartypes(ProcInfo2, VarTypes, ProcInfo3),
- proc_info_set_typeinfo_varmap(ProcInfo3, TVarMap, ProcInfo),
- pred_info_set_typevarset(PredInfo0, TypeVarSet, PredInfo).
+ proc_info_set_typeinfo_varmap(ProcInfo3, TVarMap, ProcInfo4),
+ proc_info_set_typeclass_info_varmap(ProcInfo4, TCVarMap, ProcInfo),
+ pred_info_set_typevarset(PredInfo0, TypeVarSet, PredInfo1),
+ pred_info_set_class_context(PredInfo1, Constraints, PredInfo).
:- pred lambda__process_goal(hlds_goal, hlds_goal,
lambda_info, lambda_info).
@@ -190,6 +204,9 @@
lambda__process_goal_2(higher_order_call(A,B,C,D,E,F), GoalInfo,
higher_order_call(A,B,C,D,E,F) - GoalInfo) -->
[].
+lambda__process_goal_2(class_method_call(A,B,C,D,E,F), GoalInfo,
+ class_method_call(A,B,C,D,E,F) - GoalInfo) -->
+ [].
lambda__process_goal_2(call(A,B,C,D,E,F), GoalInfo,
call(A,B,C,D,E,F) - GoalInfo) -->
[].
@@ -224,18 +241,18 @@
lambda__process_lambda(PredOrFunc, Vars, Modes, Det, OrigNonLocals0, LambdaGoal,
Unification0, Functor, Unification, LambdaInfo0, LambdaInfo) :-
- LambdaInfo0 = lambda_info(VarSet, VarTypes, TVarSet, TVarMap,
- POF, PredName, ModuleInfo0),
+ LambdaInfo0 = lambda_info(VarSet, VarTypes, Constraints, TVarSet,
+ TVarMap, TCVarMap, POF, PredName, ModuleInfo0),
lambda__transform_lambda(PredOrFunc, PredName, Vars, Modes, Det,
OrigNonLocals0, LambdaGoal, Unification0, VarSet, VarTypes,
- TVarSet, TVarMap, ModuleInfo0, Functor,
+ Constraints, TVarSet, TVarMap, TCVarMap, ModuleInfo0, Functor,
Unification, ModuleInfo),
- LambdaInfo = lambda_info(VarSet, VarTypes, TVarSet, TVarMap,
- POF, PredName, ModuleInfo).
+ LambdaInfo = lambda_info(VarSet, VarTypes, Constraints, TVarSet,
+ TVarMap, TCVarMap, POF, PredName, ModuleInfo).
lambda__transform_lambda(PredOrFunc, OrigPredName, Vars, Modes, Detism,
OrigNonLocals0, LambdaGoal, Unification0, VarSet, VarTypes,
- TVarSet, TVarMap, ModuleInfo0, Functor,
+ Constraints, TVarSet, TVarMap, TCVarMap, ModuleInfo0, Functor,
Unification, ModuleInfo) :-
(
Unification0 = construct(Var0, _, _, UniModes0)
@@ -360,12 +377,12 @@
proc_info_create(VarSet, VarTypes, PermutedArgVars,
PermutedArgModes, Detism, LambdaGoal, LambdaContext,
- TVarMap, ProcInfo),
+ TVarMap, TCVarMap, ProcInfo),
init_markers(Markers),
pred_info_create(ModuleName, PredName, TVarSet, ArgTypes,
true, LambdaContext, local, Markers, PredOrFunc,
- ProcInfo, ProcId, PredInfo),
+ Constraints, ProcInfo, ProcId, PredInfo),
% save the new predicate in the predicate table
Index: compiler/lco.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/lco.m,v
retrieving revision 1.7
diff -u -r1.7 lco.m
--- lco.m 1997/09/01 14:02:49 1.7
+++ lco.m 1997/09/08 04:54:11
@@ -83,6 +83,9 @@
lco_in_goal_2(higher_order_call(A,B,C,D,E,F), _ModuleInfo,
higher_order_call(A,B,C,D,E,F)).
+lco_in_goal_2(class_method_call(A,B,C,D,E,F), _ModuleInfo,
+ class_method_call(A,B,C,D,E,F)).
+
lco_in_goal_2(call(A,B,C,D,E,F), _ModuleInfo, call(A,B,C,D,E,F)).
lco_in_goal_2(unify(A,B,C,D,E), _ModuleInfo, unify(A,B,C,D,E)).
Index: compiler/live_vars.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/live_vars.m,v
retrieving revision 1.67
diff -u -r1.67 live_vars.m
--- live_vars.m 1997/09/01 14:02:55 1.67
+++ live_vars.m 1997/09/08 04:55:25
@@ -254,6 +254,44 @@
ResumeVars = ResumeVars0
).
+ % Code duplication. Ulch.
+build_live_sets_in_goal_2(class_method_call(_, _, ArgVars, Types, Modes, Det),
+ Liveness, ResumeVars0, LiveSets0,
+ GoalInfo, ModuleInfo, ProcInfo,
+ Liveness, ResumeVars, LiveSets) :-
+ % The variables which need to be saved onto the stack
+ % before the call are all the variables that are live
+ % after the call, except for the output arguments produced
+ % by the call, plus all the variables that may be needed
+ % at an enclosing resumption point.
+
+ % To figure out which variables are output, we use the arg_info;
+ % but it shouldn't matter which arg convention we're using,
+ % so we can just pass convention `simple' to make_arg_infos.
+
+ determinism_to_code_model(Det, CallModel),
+ make_arg_infos(simple, Types, Modes, CallModel, ModuleInfo, ArgInfos),
+ find_output_vars_from_arg_info(ArgVars, ArgInfos, OutVars),
+ set__difference(Liveness, OutVars, InputLiveness),
+ set__union(InputLiveness, ResumeVars0, StackVars0),
+
+ % Might need to add more live variables with accurate GC.
+
+ maybe_add_accurate_gc_typeinfos(ModuleInfo, ProcInfo,
+ OutVars, StackVars0, StackVars),
+
+ set__insert(LiveSets0, StackVars, LiveSets),
+
+ % If this is a nondet call, then all the stack slots we need
+ % must be protected against reuse in following code.
+
+ goal_info_get_code_model(GoalInfo, CodeModel),
+ ( CodeModel = model_non ->
+ ResumeVars = StackVars % includes ResumeVars0
+ ;
+ ResumeVars = ResumeVars0
+ ).
+
build_live_sets_in_goal_2(call(PredId, ProcId, ArgVars, BuiltinState, _, _),
Liveness, ResumeVars0, LiveSets0,
GoalInfo, ModuleInfo, ProcInfo,
Index: compiler/livemap.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/livemap.m,v
retrieving revision 1.28
diff -u -r1.28 livemap.m
--- livemap.m 1997/12/05 15:47:21 1.28
+++ livemap.m 1997/12/09 06:37:02
@@ -364,6 +364,9 @@
livemap__special_code_addr(do_det_closure, no).
livemap__special_code_addr(do_semidet_closure, no).
livemap__special_code_addr(do_nondet_closure, no).
+livemap__special_code_addr(do_det_class_method, no).
+livemap__special_code_addr(do_semidet_class_method, no).
+livemap__special_code_addr(do_nondet_class_method, no).
livemap__special_code_addr(do_not_reached, no).
%-----------------------------------------------------------------------------%
Index: compiler/liveness.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/liveness.m,v
retrieving revision 1.84
diff -u -r1.84 liveness.m
--- liveness.m 1997/10/20 07:35:22 1.84
+++ liveness.m 1997/11/17 02:38:55
@@ -289,6 +289,9 @@
detect_liveness_in_goal_2(higher_order_call(_,_,_,_,_,_), _, _, _, _, _) :-
error("higher-order-call in detect_liveness_in_goal_2").
+detect_liveness_in_goal_2(class_method_call(_,_,_,_,_,_), _, _, _, _, _) :-
+ error("class method call in detect_liveness_in_goal_2").
+
detect_liveness_in_goal_2(call(_,_,_,_,_,_), _, _, _, _, _) :-
error("call in detect_liveness_in_goal_2").
@@ -465,6 +468,9 @@
detect_deadness_in_goal_2(higher_order_call(_,_,_,_,_,_), _, _, _, _, _) :-
error("higher-order-call in detect_deadness_in_goal_2").
+detect_deadness_in_goal_2(class_method_call(_,_,_,_,_,_), _, _, _, _, _) :-
+ error("class-method-call in detect_deadness_in_goal_2").
+
detect_deadness_in_goal_2(call(_,_,_,_,_,_), _, _, _, _, _) :-
error("call in detect_deadness_in_goal_2").
@@ -659,6 +665,9 @@
detect_resume_points_in_goal_2(higher_order_call(A,B,C,D,E,F), _, Liveness,
_, _, higher_order_call(A,B,C,D,E,F), Liveness).
+
+detect_resume_points_in_goal_2(class_method_call(A,B,C,D,E,F), _, Liveness, _,
+ _, class_method_call(A,B,C,D,E,F), Liveness).
detect_resume_points_in_goal_2(call(A,B,C,D,E,F), _, Liveness, _, _,
call(A,B,C,D,E,F), Liveness).
Index: compiler/llds.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/llds.m,v
retrieving revision 1.214
diff -u -r1.214 llds.m
--- llds.m 1997/12/10 07:15:43 1.214
+++ llds.m 1997/12/18 07:37:32
@@ -16,7 +16,7 @@
:- interface.
-:- import_module hlds_pred, tree, prog_data, (inst).
+:- import_module hlds_pred, hlds_data, tree, prog_data, (inst).
:- import_module assoc_list, bool, list, set, term, std_util.
%-----------------------------------------------------------------------------%
@@ -443,6 +443,9 @@
---> common(int)
; base_type(base_data, string, arity)
% base_data, type name, type arity
+ ; base_typeclass_info(class_id, string)
+ % class name & class arity, names and arities of the
+ % types
; stack_layout(label).
% stack_layout for a given label
@@ -528,6 +531,9 @@
; do_det_closure
; do_semidet_closure
; do_nondet_closure
+ ; do_det_class_method
+ ; do_semidet_class_method
+ ; do_nondet_class_method
; do_not_reached. % we should never jump to this address
% A proc_label is a label used for the entry point to a procedure.
Index: compiler/llds_out.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/llds_out.m,v
retrieving revision 1.65
diff -u -r1.65 llds_out.m
--- llds_out.m 1997/12/10 07:15:45 1.65
+++ llds_out.m 1997/12/18 07:37:35
@@ -17,7 +17,7 @@
:- interface.
-:- import_module llds.
+:- import_module llds, hlds_data.
:- import_module io.
% Given a 'c_file' structure, open the appropriate .c file
@@ -92,6 +92,11 @@
:- pred llds_out__make_base_type_name(base_data, string, arity, string).
:- mode llds_out__make_base_type_name(in, in, in, out) is det.
+ % Create a name for base_typeclass_info
+
+:- pred llds_out__make_base_typeclass_info_name(class_id, string, string).
+:- mode llds_out__make_base_typeclass_info_name(in, in, out) is det.
+
%-----------------------------------------------------------------------------%
:- implementation.
@@ -1826,6 +1831,9 @@
need_code_addr_decls(do_det_closure, yes) --> [].
need_code_addr_decls(do_semidet_closure, yes) --> [].
need_code_addr_decls(do_nondet_closure, yes) --> [].
+need_code_addr_decls(do_det_class_method, yes) --> [].
+need_code_addr_decls(do_semidet_class_method, yes) --> [].
+need_code_addr_decls(do_nondet_class_method, yes) --> [].
need_code_addr_decls(do_not_reached, yes) --> [].
:- pred output_code_addr_decls(code_addr, io__state, io__state).
@@ -1865,6 +1873,12 @@
io__write_string("Declare_entry(do_call_semidet_closure);\n").
output_code_addr_decls(do_nondet_closure) -->
io__write_string("Declare_entry(do_call_nondet_closure);\n").
+output_code_addr_decls(do_det_class_method) -->
+ io__write_string("Declare_entry(do_call_det_class_method);\n").
+output_code_addr_decls(do_semidet_class_method) -->
+ io__write_string("Declare_entry(do_call_semidet_class_method);\n").
+output_code_addr_decls(do_nondet_class_method) -->
+ io__write_string("Declare_entry(do_call_nondet_class_method);\n").
output_code_addr_decls(do_not_reached) -->
io__write_string("Declare_entry(do_not_reached);\n").
@@ -2028,6 +2042,18 @@
io__write_string("tailcall(ENTRY(do_call_nondet_closure),\n\t\t"),
output_label_as_code_addr(CallerLabel),
io__write_string(");\n").
+output_goto(do_det_class_method, CallerLabel) -->
+ io__write_string("tailcall(ENTRY(do_call_det_class_method),\n\t\t"),
+ output_label_as_code_addr(CallerLabel),
+ io__write_string(");\n").
+output_goto(do_semidet_class_method, CallerLabel) -->
+ io__write_string("tailcall(ENTRY(do_call_semidet_class_method),\n\t\t"),
+ output_label_as_code_addr(CallerLabel),
+ io__write_string(");\n").
+output_goto(do_nondet_class_method, CallerLabel) -->
+ io__write_string("tailcall(ENTRY(do_call_nondet_class_method),\n\t\t"),
+ output_label_as_code_addr(CallerLabel),
+ io__write_string(");\n").
output_goto(do_not_reached, CallerLabel) -->
io__write_string("tailcall(ENTRY(do_not_reached),\n\t\t"),
output_label_as_code_addr(CallerLabel),
@@ -2099,6 +2125,12 @@
io__write_string("ENTRY(do_call_semidet_closure)").
output_code_addr(do_nondet_closure) -->
io__write_string("ENTRY(do_call_nondet_closure)").
+output_code_addr(do_det_class_method) -->
+ io__write_string("ENTRY(do_call_det_class_method)").
+output_code_addr(do_semidet_class_method) -->
+ io__write_string("ENTRY(do_call_semidet_class_method)").
+output_code_addr(do_nondet_class_method) -->
+ io__write_string("ENTRY(do_call_nondet_class_method)").
output_code_addr(do_not_reached) -->
io__write_string("ENTRY(do_not_reached)").
@@ -2125,6 +2157,17 @@
io__write_string("__"),
io__write_string(Str)
;
+ % We don't want to include the module name as part
+ % of the name if it is a base_typeclass_info, since
+ % we _want_ to cause a link error for overlapping
+ % instance decls, even if they are in a different
+ % module
+ { VarName = base_typeclass_info(ClassId, TypeNames) },
+ { llds_out__make_base_typeclass_info_name(ClassId, TypeNames,
+ Str) },
+ io__write_string("__"),
+ io__write_string(Str)
+ ;
{ VarName = stack_layout(Label) },
io__write_string("_stack_layout__"),
output_label(Label)
@@ -3038,6 +3081,24 @@
string__append_list(["base_type_", BaseString, "_", TypeName, "_",
A_str], Str).
+
+%-----------------------------------------------------------------------------%
+
+llds_out__make_base_typeclass_info_name(class_id(ClassSym, ClassArity),
+ TypeNames0, Str) :-
+ (
+ ClassSym = unqualified(_),
+ error("llds_out__make_base_typeclass_info_name: unqualified name")
+ ;
+ ClassSym = qualified(ModuleName, ClassName0),
+ % Mangle the class name in case it is an operator
+ llds_out__name_mangle(ClassName0, ClassName),
+ string__append_list([ModuleName, "__", ClassName], ClassString)
+ ),
+ string__int_to_string(ClassArity, A_str),
+ llds_out__name_mangle(TypeNames0, TypeNames),
+ string__append_list(["base_typeclass_info_", ClassString, "_", A_str,
+ "__", TypeNames], Str).
%-----------------------------------------------------------------------------%
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/make_hlds.m,v
retrieving revision 1.246
diff -u -r1.246 make_hlds.m
--- make_hlds.m 1997/12/09 04:00:51 1.246
+++ make_hlds.m 1997/12/19 00:42:27
@@ -133,8 +133,8 @@
% for a predicate to syntactically precede the pred declaration.
%
% Adding default modes for functions needs to come after we have
- % have processed all the mode declarations, since otherwise we
- % can't be sure that there isn't a mode declaration for the function.
+ % processed all the mode declarations, since otherwise we can't be
+ % sure that there isn't a mode declaration for the function.
:- pred add_item_list_decls_pass_2(item_list, item_status,
module_info, module_info, io__state, io__state).
@@ -188,28 +188,32 @@
module_add_mode_defn(Module0, VarSet, ModeDefn, Cond, Context,
Status, Module).
-add_item_decl_pass_1(pred(VarSet, PredName, TypesAndModes, MaybeDet, Cond,
- Purity), Context, Status, Module0, Status, Module) -->
+add_item_decl_pass_1(pred(VarSet, PredName, TypesAndModes,
+ MaybeDet, Cond, Purity, ClassContext),
+ Context, Status, Module0, Status, Module) -->
+ { init_markers(Markers) },
module_add_pred(Module0, VarSet, PredName, TypesAndModes, MaybeDet,
- Cond, Purity, Context, Status, Module).
+ Cond, Purity, ClassContext, Markers, Context, Status, _,
+ Module).
add_item_decl_pass_1(func(VarSet, FuncName, TypesAndModes, RetTypeAndMode,
- MaybeDet, Cond, Purity), Context, Status, Module0, Status,
- Module) -->
+ MaybeDet, Cond, Purity, ClassContext),
+ Context, Status, Module0, Status, Module) -->
+ { init_markers(Markers) },
module_add_func(Module0, VarSet, FuncName, TypesAndModes,
- RetTypeAndMode, MaybeDet, Cond, Purity, Context, Status,
- Module).
+ RetTypeAndMode, MaybeDet, Cond, Purity, ClassContext, Markers,
+ Context, Status, _, Module).
add_item_decl_pass_1(pred_mode(VarSet, PredName, Modes, MaybeDet, Cond),
Context, Status, Module0, Status, Module) -->
module_add_mode(Module0, VarSet, PredName, Modes, MaybeDet, Cond,
- Context, predicate, Module).
+ Context, predicate, _, Module).
add_item_decl_pass_1(func_mode(VarSet, FuncName, Modes, RetMode, MaybeDet,
Cond), Context, Status, Module0, Status, Module) -->
{ list__append(Modes, [RetMode], Modes1) },
module_add_mode(Module0, VarSet, FuncName, Modes1,
- MaybeDet, Cond, Context, function, Module).
+ MaybeDet, Cond, Context, function, _, Module).
add_item_decl_pass_1(pragma(_), _, Status, Module, Status, Module) --> [].
@@ -250,6 +254,16 @@
add_item_decl_pass_1(nothing, _, Status, Module, Status, Module) --> [].
+add_item_decl_pass_1(typeclass(Constraints, Name, Vars, Interface, VarSet),
+ Context, Status, Module0, Status, Module) -->
+ module_add_class_defn(Module0, Constraints, Name, Vars, Interface,
+ VarSet, Context, Status, Module).
+
+ % We add instance declarations on the second pass so that we don't add
+ % an instance declaration before its class declaration.
+add_item_decl_pass_1(instance(_, _, _, _, _), _, Status, Module, Status,
+ Module) --> [].
+
%-----------------------------------------------------------------------------%
% dispatch on the different types of items
@@ -467,8 +481,8 @@
).
add_item_decl_pass_2(func(_VarSet, FuncName, TypesAndModes, _RetTypeAndMode,
- _MaybeDet, _Cond, _Purity), _Context, Status, Module0, Status,
- Module) -->
+ _MaybeDet, _Cond, _Purity, _ClassContext),
+ _Context, Status, Module0, Status, Module) -->
%
% add default modes for function declarations, if necessary
%
@@ -494,13 +508,20 @@
--> [].
add_item_decl_pass_2(mode_defn(_, _, _), _, Status, Module, Status, Module)
--> [].
-add_item_decl_pass_2(pred(_, _, _, _, _, _), _, Status, Module, Status, Module)
- --> [].
+add_item_decl_pass_2(pred(_, _, _, _, _, _, _), _, Status, Module, Status,
+ Module) --> [].
add_item_decl_pass_2(pred_mode(_, _, _, _, _), _, Status, Module, Status,
Module) --> [].
add_item_decl_pass_2(func_mode(_, _, _, _, _, _), _, Status, Module, Status,
Module) --> [].
add_item_decl_pass_2(nothing, _, Status, Module, Status, Module) --> [].
+add_item_decl_pass_2(typeclass(_, _, _, _, _)
+ , _, Status, Module, Status, Module) --> [].
+add_item_decl_pass_2(instance(Constraints, Name, Types, Interface, VarSet),
+ Context, Status, Module0, Status, Module) -->
+ { Status = item_status(ImportStatus, _) },
+ module_add_instance_defn(Module0, Constraints, Name, Types, Interface,
+ VarSet, ImportStatus, Context, Module).
%------------------------------------------------------------------------------
@@ -543,9 +564,9 @@
Module, Module, Info, Info) --> [].
add_item_clause(mode_defn(_, _, _), Status, Status, _,
Module, Module, Info, Info) --> [].
-add_item_clause(pred(_, _, _, _, _, _), Status, Status, _,
+add_item_clause(pred(_, _, _, _, _, _, _), Status, Status, _,
Module, Module, Info, Info) --> [].
-add_item_clause(func(_, _, _, _, _, _, _), Status, Status, _,
+add_item_clause(func(_, _, _, _, _, _, _, _), Status, Status, _,
Module, Module, Info, Info) --> [].
add_item_clause(pred_mode(_, _, _, _, _), Status, Status, _,
Module, Module, Info, Info) --> [].
@@ -592,6 +613,10 @@
{ Info = Info0 }
).
add_item_clause(nothing, Status, Status, _, Module, Module, Info, Info) --> [].
+add_item_clause(typeclass(_, _, _, _, _)
+ , Status, Status, _, Module, Module, Info, Info) --> [].
+add_item_clause(instance(_, _, _, _, _)
+ , Status, Status, _, Module, Module, Info, Info) --> [].
%-----------------------------------------------------------------------------%
@@ -1063,13 +1088,16 @@
%---------------------------------------------------------------------------%
:- pred module_add_pred(module_info, varset, sym_name, list(type_and_mode),
- maybe(determinism), condition, purity, term__context,
- item_status, module_info, io__state, io__state).
-:- mode module_add_pred(in, in, in, in, in, in, in, in, in, out, di, uo)
- is det.
+ maybe(determinism), condition, purity, list(class_constraint),
+ pred_markers, term__context, item_status,
+ maybe(pair(pred_id, proc_id)), module_info,
+ io__state, io__state).
+:- mode module_add_pred(in, in, in, in, in, in, in, in, in, in, in, out, out,
+ di, uo) is det.
module_add_pred(Module0, VarSet, PredName, TypesAndModes, MaybeDet, Cond,
- Purity, Context, item_status(Status, NeedQual), Module) -->
+ Purity, ClassContext, Markers, Context,
+ item_status(Status, NeedQual), MaybePredProcId, Module) -->
% Only preds with opt_imported clauses are tagged as opt_imported, so
% that the compiler doesn't look for clauses for other preds read in
% from optimization interfaces.
@@ -1079,26 +1107,30 @@
DeclStatus = Status
},
{ split_types_and_modes(TypesAndModes, Types, MaybeModes) },
- add_new_pred(Module0, VarSet, PredName, Types, Cond, Purity, Context,
- DeclStatus, NeedQual, predicate, Module1),
+ add_new_pred(Module0, VarSet, PredName, Types, Cond, Purity,
+ ClassContext, Markers, Context, DeclStatus, NeedQual,
+ predicate, Module1),
(
{ MaybeModes = yes(Modes) }
->
module_add_mode(Module1, VarSet, PredName, Modes, MaybeDet,
- Cond, Context, predicate, Module)
+ Cond, Context, predicate, PredProcId, Module),
+ { MaybePredProcId = yes(PredProcId) }
;
- { Module = Module1 }
+ { Module = Module1 },
+ { MaybePredProcId = no }
).
:- pred module_add_func(module_info, varset, sym_name, list(type_and_mode),
type_and_mode, maybe(determinism), condition, purity,
- term__context, item_status, module_info, io__state, io__state).
-:- mode module_add_func(in, in, in, in, in, in, in, in, in, in, out, di, uo)
- is det.
+ list(class_constraint), pred_markers, term__context,
+ item_status, maybe(pair(pred_id, proc_id)),
+ module_info, io__state, io__state).
+:- mode module_add_func(in, in, in, in, in, in, in, in, in, in, in, in, out, out, di, uo) is det.
module_add_func(Module0, VarSet, FuncName, TypesAndModes, RetTypeAndMode,
- MaybeDet, Cond, Purity, Context,
- item_status(Status, NeedQual), Module) -->
+ MaybeDet, Cond, Purity, ClassContext, Markers, Context,
+ item_status(Status, NeedQual), MaybePredProcId, Module) -->
% Only funcs with opt_imported clauses are tagged as opt_imported, so
% that the compiler doesn't look for clauses for other preds.
{ Status = opt_imported ->
@@ -1109,31 +1141,159 @@
{ split_types_and_modes(TypesAndModes, Types, MaybeModes) },
{ split_type_and_mode(RetTypeAndMode, RetType, MaybeRetMode) },
{ list__append(Types, [RetType], Types1) },
- add_new_pred(Module0, VarSet, FuncName, Types1, Cond, Purity, Context,
- DeclStatus, NeedQual, function, Module1),
+ add_new_pred(Module0, VarSet, FuncName, Types1, Cond, Purity,
+ ClassContext, Markers, Context, DeclStatus, NeedQual, function,
+ Module1),
(
{ MaybeModes = yes(Modes) },
{ MaybeRetMode = yes(RetMode) }
->
{ list__append(Modes, [RetMode], Modes1) },
module_add_mode(Module1, VarSet, FuncName, Modes1,
- MaybeDet, Cond, Context, function, Module)
+ MaybeDet, Cond, Context, function, PredProcId, Module),
+ { MaybePredProcId = yes(PredProcId) }
;
- { Module = Module1 }
+ { Module = Module1 },
+ { MaybePredProcId = no}
).
+:- pred module_add_class_defn(module_info, list(class_constraint), sym_name,
+ list(var), class_interface, varset, term__context,
+ item_status, module_info, io__state, io__state).
+:- mode module_add_class_defn(in, in, in, in, in, in, in, in, out,
+ di, uo) is det.
+
+module_add_class_defn(Module0, Constraints, Name, Vars, Interface, VarSet,
+ Context, Status, Module) -->
+ { module_info_classes(Module0, Classes0) },
+ { list__length(Vars, ClassArity) },
+ { Key = class_id(Name, ClassArity) },
+ (
+ { map__search(Classes0, Key, OldValue) }
+ ->
+ { OldValue = hlds_class_defn(_, _, _, _, OldContext) },
+ multiple_def_error(Name, ClassArity, "typeclass",
+ Context, OldContext),
+ io__set_exit_status(1),
+ { Module = Module0 }
+ ;
+ module_add_class_interface(Module0, Name, Vars, Interface,
+ Status, PredProcIds0, Module1),
+ % Get rid of the `no's from the list of maybes
+ { IsYes = lambda([Maybe::in, PredProcId::out] is semidet,
+ (
+ Maybe = yes(Pred - Proc),
+ PredProcId = hlds_class_proc(Pred, Proc)
+ )) },
+ { list__filter_map(IsYes, PredProcIds0, PredProcIds) },
+ { Value = hlds_class_defn(Constraints, Vars, PredProcIds,
+ VarSet, Context) },
+ { map__det_insert(Classes0, Key, Value, Classes) },
+ { module_info_set_classes(Module1, Classes, Module2) },
+ % When we find the class declaration, make an
+ % entry for the instances.
+ { module_info_instances(Module2, Instances0) },
+ { map__det_insert(Instances0, Key, [], Instances) },
+ { module_info_set_instances(Module2, Instances, Module) }
+ ).
+
+:- pred module_add_class_interface(module_info, sym_name, list(var),
+ class_interface, item_status, list(maybe(pair(pred_id, proc_id))),
+ module_info, io__state, io__state).
+:- mode module_add_class_interface(in, in, in, in, in, out, out, di, uo) is det.
+
+module_add_class_interface(Module, _, _, [], _, [], Module) --> [].
+module_add_class_interface(Module0, Name, Vars, [M|Ms], Status, [P|Ps],
+ Module) -->
+ module_add_class_method(M, Name, Vars, Status, P, Module0, Module1),
+ module_add_class_interface(Module1, Name, Vars, Ms, Status, Ps, Module).
+
+:- pred module_add_class_method(class_method, sym_name, list(var),
+ item_status, maybe(pair(pred_id, proc_id)), module_info, module_info,
+ io__state, io__state).
+:- mode module_add_class_method(in, in, in, in, out, in, out, di, uo) is det.
+
+module_add_class_method(Method, Name, Vars, Status, MaybePredIdProcId,
+ Module0, Module) -->
+ (
+ { Method = pred(VarSet, PredName, TypesAndModes,
+ MaybeDet, Cond, ClassContext, Context) },
+ { term__var_list_to_term_list(Vars, VarTerms) },
+ { NewClassContext = [constraint(Name, VarTerms)|ClassContext] },
+ { init_markers(Markers0) },
+ { add_marker(Markers0, class_method, Markers) },
+ module_add_pred(Module0, VarSet, PredName, TypesAndModes,
+ MaybeDet, Cond, pure, NewClassContext, Markers,
+ Context, Status, MaybePredIdProcId, Module)
+ ;
+ { Method = func(VarSet, FuncName, TypesAndModes, RetTypeAndMode,
+ MaybeDet, Cond, ClassContext, Context) },
+ { term__var_list_to_term_list(Vars, VarTerms) },
+ { NewClassContext = [constraint(Name, VarTerms)|ClassContext] },
+ { init_markers(Markers0) },
+ { add_marker(Markers0, class_method, Markers) },
+ module_add_func(Module0, VarSet, FuncName, TypesAndModes,
+ RetTypeAndMode, MaybeDet, Cond, pure, NewClassContext,
+ Markers, Context, Status, MaybePredIdProcId, Module)
+ ;
+ { Method = pred_mode(VarSet, PredName, Modes, MaybeDet,
+ Cond, Context) },
+ module_add_mode(Module0, VarSet, PredName, Modes, MaybeDet,
+ Cond, Context, predicate, PredIdProcId, Module),
+ { MaybePredIdProcId = yes(PredIdProcId) }
+ ;
+ { Method = func_mode(VarSet, FuncName, Modes, RetMode, MaybeDet,
+ Cond, Context) },
+ { list__append(Modes, [RetMode], Modes1) },
+ module_add_mode(Module0, VarSet, FuncName, Modes1,
+ MaybeDet, Cond, Context, function, PredIdProcId,
+ Module),
+ { MaybePredIdProcId = yes(PredIdProcId) }
+ ).
+
+:- pred module_add_instance_defn(module_info, list(class_constraint), sym_name,
+ list(type), instance_interface, varset, import_status, term__context,
+ module_info, io__state, io__state).
+:- mode module_add_instance_defn(in, in, in, in, in, in, in, in, out,
+ di, uo) is det.
+
+module_add_instance_defn(Module0, Constraints, Name, Types, Interface, VarSet,
+ Status, _Context, Module) -->
+ { module_info_classes(Module0, Classes) },
+ { module_info_instances(Module0, Instances0) },
+ { list__length(Types, ClassArity) },
+ { Key = class_id(Name, ClassArity) },
+ (
+ { map__search(Classes, Key, _) }
+ ->
+ { map__init(Empty) },
+ { NewValue = hlds_instance_defn(Status, Constraints, Types,
+ Interface, no, VarSet, Empty) },
+ { map__lookup(Instances0, Key, Values) },
+ { map__det_update(Instances0, Key, [NewValue|Values],
+ Instances) },
+ { module_info_set_instances(Module0, Instances, Module) }
+ ;
+ % XXX give an error since the class has not been
+ % XXX defined
+ { Module = Module0 }
+ ).
+
+%-----------------------------------------------------------------------------%
+
:- pred add_new_pred(module_info, tvarset, sym_name, list(type), condition,
- purity, term__context, import_status, need_qualifier,
- pred_or_func, module_info, io__state, io__state).
-:- mode add_new_pred(in, in, in, in, in, in, in, in, in, in, out, di, uo)
- is det.
+ purity, list(class_constraint), pred_markers, term__context,
+ import_status, need_qualifier, pred_or_func,
+ module_info, io__state, io__state).
+:- mode add_new_pred(in, in, in, in, in, in, in, in, in, in, in, in, out,
+ di, uo) is det.
-% NB. Predicates are also added in polymorphism.m, which converts
+% NB. Predicates are also added in lambda.m, which converts
% lambda expressions into separate predicates, so any changes may need
% to be reflected there too.
-add_new_pred(Module0, TVarSet, PredName, Types, Cond, Purity, Context,
- Status, NeedQual, PredOrFunc, Module) -->
+add_new_pred(Module0, TVarSet, PredName, Types, Cond, Purity, ClassContext,
+ Markers0, Context, Status, NeedQual, PredOrFunc, Module) -->
{ module_info_name(Module0, ModuleName) },
{ list__length(Types, Arity) },
(
@@ -1147,10 +1307,19 @@
{ Module1 = Module0 },
{ module_info_get_predicate_table(Module1, PredicateTable0) },
{ clauses_info_init(Arity, ClausesInfo) },
- { purity_to_markers(Purity, Markers) },
+ { map__init(Proofs) },
+ { purity_to_markers(Purity, PurityMarkers) },
+ { markers_to_marker_list(PurityMarkers, MarkersList) },
+ { AddMarker = lambda(
+ [M::in, TheMarkers0::in, TheMarkers::out] is det,
+ (
+ add_marker(TheMarkers0, M, TheMarkers)
+ )) },
+ { list__foldl(AddMarker, MarkersList, Markers0, Markers) },
{ pred_info_init(ModuleName, PredName, Arity, TVarSet, Types,
Cond, Context, ClausesInfo, Status, Markers,
- none, PredOrFunc, PredInfo0) },
+ none, PredOrFunc, ClassContext, Proofs,
+ PredInfo0) },
(
{ predicate_table_search_pf_m_n_a(PredicateTable0,
PredOrFunc, MNameOfPred, PName, Arity,
@@ -1328,10 +1497,14 @@
Cond = true,
clauses_info_init(Arity, ClausesInfo0),
adjust_special_pred_status(Status0, SpecialPredId, Status),
+ map__init(Proofs),
init_markers(Markers),
+ % XXX If/when we have "comparable" or "unifiable" typeclasses,
+ % XXX this context might not be empty
+ ClassContext = [],
pred_info_init(ModuleName, PredName, Arity, TVarSet, ArgTypes, Cond,
- Context, ClausesInfo0, Status, Markers, none, predicate,
- PredInfo0),
+ Context, ClausesInfo0, Status, Markers, none, predicate,
+ ClassContext, Proofs, PredInfo0),
ArgLives = no,
add_new_proc(PredInfo0, Arity, ArgModes, yes(ArgModes),
ArgLives, yes(Det), Context, PredInfo, _),
@@ -1388,14 +1561,16 @@
:- pred module_add_mode(module_info, varset, sym_name, list(mode),
maybe(determinism), condition, term__context, pred_or_func,
- module_info, io__state, io__state).
-:- mode module_add_mode(in, in, in, in, in, in, in, in, out, di, uo) is det.
+ pair(pred_id, proc_id), module_info,
+ io__state, io__state).
+:- mode module_add_mode(in, in, in, in, in, in, in, in, out, out,
+ di, uo) is det.
% We should store the mode varset and the mode condition
% in the hlds - at the moment we just ignore those two arguments.
module_add_mode(ModuleInfo0, _VarSet, PredName, Modes, MaybeDet, _Cond,
- MContext, PredOrFunc, ModuleInfo) -->
+ MContext, PredOrFunc, PredProcId, ModuleInfo) -->
% Lookup the pred or func declaration in the predicate table.
% If it's not there (or if it is ambiguous), optionally print a
@@ -1452,11 +1627,12 @@
% add the mode declaration to the pred_info for this procedure.
{ ArgLives = no },
{ add_new_proc(PredInfo0, Arity, Modes, yes(Modes), ArgLives,
- MaybeDet, MContext, PredInfo, _NewProcId) },
+ MaybeDet, MContext, PredInfo, ProcId) },
{ map__det_update(Preds0, PredId, PredInfo, Preds) },
{ predicate_table_set_preds(PredicateTable1, Preds, PredicateTable) },
{ module_info_set_predicate_table(ModuleInfo0, PredicateTable,
- ModuleInfo) }.
+ ModuleInfo) },
+ { PredProcId = PredId - ProcId }.
% Whenever there is a clause or mode declaration for an undeclared
% predicate, we add an implicit declaration
@@ -1477,10 +1653,14 @@
term__var_list_to_term_list(TypeVars, Types),
Cond = true,
clauses_info_init(Arity, ClausesInfo),
+ map__init(Proofs),
+ % The class context is empty since this is an implicit
+ % definition. Inference will fill it in.
+ ClassContext = [],
init_markers(Markers0),
pred_info_init(ModuleName, PredName, Arity, TVarSet, Types, Cond,
- Context, ClausesInfo, local, Markers0, none, PredOrFunc,
- PredInfo0),
+ Context, ClausesInfo, local, Markers0, none, PredOrFunc,
+ ClassContext, Proofs, PredInfo0),
add_marker(Markers0, infer_type, Markers),
pred_info_set_markers(PredInfo0, Markers, PredInfo),
(
@@ -2095,6 +2275,14 @@
PredCallId).
warn_singletons_in_goal_2(higher_order_call(_, Args, _, _, _, _),
+ GoalInfo, QuantVars, VarSet, PredCallId) -->
+ { goal_info_get_nonlocals(GoalInfo, NonLocals) },
+ { goal_info_get_context(GoalInfo, Context) },
+ warn_singletons(Args, NonLocals, QuantVars, VarSet, Context,
+ PredCallId).
+
+ % This code should never be called anyway.
+warn_singletons_in_goal_2(class_method_call(_, _, Args, _, _, _),
GoalInfo, QuantVars, VarSet, PredCallId) -->
{ goal_info_get_nonlocals(GoalInfo, NonLocals) },
{ goal_info_get_context(GoalInfo, Context) },
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/mercury_compile.m,v
retrieving revision 1.65
diff -u -r1.65 mercury_compile.m
--- mercury_compile.m 1997/12/10 07:15:46 1.65
+++ mercury_compile.m 1997/12/18 07:37:37
@@ -32,7 +32,8 @@
:- import_module handle_options, prog_io, modules, module_qual, equiv_type.
:- import_module make_hlds, typecheck, purity, modes.
:- import_module switch_detection, cse_detection, det_analysis, unique_modes.
-:- import_module simplify, intermod, trans_opt, bytecode_gen, bytecode.
+:- import_module check_typeclass, simplify, intermod, trans_opt.
+:- import_module bytecode_gen, bytecode.
:- import_module (lambda), polymorphism, termination, higher_order, inlining.
:- import_module dnf, constraint, unused_args, dead_proc_elim, saved_vars.
:- import_module lco, liveness, stratify.
@@ -569,7 +570,7 @@
( { UnsafeToContinue = yes } ->
{ FoundError = yes },
- { HLDS12 = HLDS5 }
+ { HLDS13 = HLDS5 }
;
mercury_compile__detect_switches(HLDS5, Verbose, Stats, HLDS6),
!,
@@ -599,6 +600,11 @@
Verbose, Stats, HLDS11), !,
mercury_compile__maybe_dump_hlds(HLDS11, "11", "simplify"), !,
+ maybe_write_string(Verbose,
+ "% Mode and type checking typeclass instances...\n"),
+ check_typeclass__check_instance_decls(HLDS11, HLDS12,
+ FoundTypeclassError),
+
%
% work out whether we encountered any errors
%
@@ -608,6 +614,7 @@
{ FoundDetError = no },
{ FoundUniqError = no },
{ FoundStratError = no },
+ { FoundTypeclassError = no },
% Strictly speaking, we shouldn't need to check
% the exit status. But the values returned for
% FoundModeError etc. aren't always correct.
@@ -619,18 +626,18 @@
globals__io_lookup_bool_option(
make_optimization_interface, MakeOptInt),
{ Intermod = yes, MakeOptInt = no ->
- intermod__adjust_pred_import_status(HLDS11,
- HLDS12), !
+ intermod__adjust_pred_import_status(HLDS12,
+ HLDS13), !
;
- HLDS12 = HLDS11
+ HLDS13 = HLDS12
}
;
{ FoundError = yes },
- { HLDS12 = HLDS11 }
+ { HLDS13 = HLDS12 }
)
),
- { HLDS20 = HLDS12 },
+ { HLDS20 = HLDS13 },
mercury_compile__maybe_dump_hlds(HLDS20, "20", "front_end").
:- pred mercury_compile__frontend_pass_2_by_preds(module_info, module_info,
Index: compiler/mercury_to_c.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/mercury_to_c.m,v
retrieving revision 1.29
diff -u -r1.29 mercury_to_c.m
--- mercury_to_c.m 1997/12/09 04:00:58 1.29
+++ mercury_to_c.m 1997/12/09 08:10:50
@@ -165,6 +165,7 @@
{ pred_info_context(PredInfo, Context) },
{ pred_info_name(PredInfo, PredName) },
{ pred_info_non_imported_procids(PredInfo, ProcIds) },
+ { pred_info_get_class_context(PredInfo, ClassContext) },
( { ProcIds = [] } ->
[]
;
@@ -172,7 +173,7 @@
io__write_string("/****\n"),
{ pred_info_get_purity(PredInfo, Purity) },
mercury_output_pred_type(TVarSet, unqualified(PredName),
- ArgTypes, no, Purity, Context),
+ ArgTypes, no, Purity, ClassContext, Context),
{ pred_info_clauses_info(PredInfo, ClausesInfo) },
{ ClausesInfo = clauses_info(VarSet, _VarTypes, _, HeadVars,
@@ -628,6 +629,8 @@
c_gen_goal_2(higher_order_call(_, _, _, _, _, _), _, _, _) -->
{ error("mercury_to_c: higher_order_call not implemented") }.
+c_gen_goal_2(class_method_call(_, _, _, _, _, _), _, _, _) -->
+ { error("mercury_to_c: class_method_call not implemented") }.
c_gen_goal_2(call(PredId, ProcId, ArgVars, _, _, _PredName),
Indent, CGenInfo0, CGenInfo) -->
{ c_gen_info_get_module_info(CGenInfo0, ModuleInfo) },
Index: compiler/mercury_to_goedel.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/mercury_to_goedel.m,v
retrieving revision 1.61
diff -u -r1.61 mercury_to_goedel.m
--- mercury_to_goedel.m 1997/12/09 04:01:00 1.61
+++ mercury_to_goedel.m 1997/12/09 08:11:15
@@ -140,8 +140,9 @@
goedel_output_item(mode_defn(VarSet, ModeDefn, _Cond), Context) -->
goedel_output_mode_defn(VarSet, ModeDefn, Context).
+ % XXX Should we ignore ClassContext, or give an error?
goedel_output_item(pred(VarSet, PredName, TypesAndModes, _Det, _Cond,
- Purity), Context) -->
+ Purity, _ClassContext), Context) -->
io__write_string("\n"),
maybe_write_line_number(Context),
( { Purity = pure } ->
@@ -153,8 +154,9 @@
),
goedel_output_pred(VarSet, PredName, TypesAndModes, Context).
+ % XXX Should we ignore ClassContext, or give an error?
goedel_output_item(func(VarSet, PredName, TypesAndModes, RetTypeAndMode, _Det,
- _Cond, Purity), Context) -->
+ _Cond, Purity, _ClassContext), Context) -->
io__write_string("\n"),
maybe_write_line_number(Context),
( { Purity = pure } ->
@@ -194,6 +196,15 @@
"warning: C header declarations not allowed. Ignoring\n").
goedel_output_item(nothing, _) --> [].
+goedel_output_item(typeclass(_, _, _, _, _), _) -->
+ io__stderr_stream(Stderr),
+ io__write_string(Stderr,
+ "warning: typeclass declarations not allowed. Ignoring\n").
+
+goedel_output_item(instance(_, _, _, _, _), _) -->
+ io__stderr_stream(Stderr),
+ io__write_string(Stderr,
+ "warning: instance declarations not allowed. Ignoring\n").
%-----------------------------------------------------------------------------%
Index: compiler/mercury_to_mercury.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.122
diff -u -r1.122 mercury_to_mercury.m
--- mercury_to_mercury.m 1997/12/09 04:01:04 1.122
+++ mercury_to_mercury.m 1997/12/17 07:22:31
@@ -23,14 +23,15 @@
:- mode convert_to_mercury(in, in, in, di, uo) is det.
:- pred mercury_output_pred_type(varset, sym_name, list(type),
- maybe(determinism), purity, term__context,
- io__state, io__state).
-:- mode mercury_output_pred_type(in, in, in, in, in, in, di, uo) is det.
+ maybe(determinism), purity, list(class_constraint),
+ term__context, io__state, io__state).
+:- mode mercury_output_pred_type(in, in, in, in, in, in, in, di, uo) is det.
:- pred mercury_output_func_type(varset, sym_name, list(type), type,
- maybe(determinism), purity, term__context,
- io__state, io__state).
-:- mode mercury_output_func_type(in, in, in, in, in, in, in, di, uo) is det.
+ maybe(determinism), purity, list(class_constraint),
+ term__context, io__state, io__state).
+:- mode mercury_output_func_type(in, in, in, in, in, in, in, in,
+ di, uo) is det.
:- pred mercury_output_pred_mode_decl(varset, sym_name, list(mode),
maybe(determinism), term__context, io__state, io__state).
@@ -158,6 +159,10 @@
:- pred mercury_convert_var_name(string, string).
:- mode mercury_convert_var_name(in, out) is det.
+:- pred mercury_output_constraint(varset, class_constraint,
+ io__state, io__state).
+:- mode mercury_output_constraint(in, in, di, uo) is det.
+
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -230,16 +235,17 @@
mercury_output_mode_defn(VarSet, ModeDefn, Context).
mercury_output_item(pred(VarSet, PredName, TypesAndModes, Det, _Cond,
- Purity), Context) -->
+ Purity, ClassContext), Context) -->
maybe_output_line_number(Context),
mercury_output_pred_decl(VarSet, PredName, TypesAndModes, Det,
- Purity, Context).
+ Purity, ClassContext, Context, ".\n", ".\n").
mercury_output_item(func(VarSet, PredName, TypesAndModes, RetTypeAndMode, Det,
- _Cond, Purity), Context) -->
+ _Cond, Purity, ClassContext), Context) -->
maybe_output_line_number(Context),
mercury_output_func_decl(VarSet, PredName, TypesAndModes,
- RetTypeAndMode, Det, Purity, Context).
+ RetTypeAndMode, Det, Purity, ClassContext, Context,
+ ".\n", ".\n").
mercury_output_item(pred_mode(VarSet, PredName, Modes, MaybeDet, _Cond),
Context) -->
@@ -335,6 +341,139 @@
).
mercury_output_item(nothing, _) --> [].
+mercury_output_item(typeclass(Constraints, ClassName, Vars, Methods,
+ VarSet), _) -->
+ io__write_string(":- typeclass "),
+
+ % We put an extra set of brackets around the class name in
+ % case the name is an operator
+ mercury_output_sym_name(ClassName),
+ io__write_char('('),
+ io__write_list(Vars, ", ",
+ lambda([V::in, IO0::di, IO::uo] is det,
+ (
+ varset__lookup_name(VarSet, V, VarName),
+ io__write_string(VarName, IO0, IO)
+ )
+ )
+ ),
+ io__write_char(')'),
+
+ (
+ { Constraints = [] }
+ ;
+ { Constraints = [_|_] },
+ io__write_string(" <= ("),
+ output_class_constraints(Constraints, VarSet),
+ io__write_string(")")
+ ),
+
+ io__write_string(" where [\n"),
+
+ output_class_methods(Methods),
+
+ io__write_string("].\n").
+mercury_output_item(instance(Constraints, ClassName, Types, Methods,
+ VarSet), _) -->
+ io__write_string(":- instance "),
+
+ % We put an extra set of brackets around the class name in
+ % case the name is an operator
+ io__write_char('('),
+ mercury_output_sym_name(ClassName),
+ io__write_char('('),
+ io__write_list(Types, ", ", term_io__write_term(VarSet)),
+ io__write_char(')'),
+ io__write_char(')'),
+
+ (
+ { Constraints = [] }
+ ;
+ { Constraints = [_|_] },
+ io__write_string(" <= ("),
+ output_class_constraints(Constraints, VarSet),
+ io__write_string(")")
+ ),
+
+ io__write_string(" where [\n"),
+
+ output_instance_methods(Methods),
+
+ io__write_string("].\n").
+
+%-----------------------------------------------------------------------------%
+:- pred output_class_constraints(list(class_constraint), varset,
+ io__state, io__state).
+:- mode output_class_constraints(in, in, di, uo) is det.
+
+output_class_constraints(Constraints, VarSet) -->
+ io__write_list(Constraints, ", ", output_class_constraint(VarSet)).
+
+:- pred output_class_constraint(varset, class_constraint, io__state, io__state).
+:- mode output_class_constraint(in, in, di, uo) is det.
+
+output_class_constraint(VarSet, constraint(Name, Types)) -->
+ mercury_output_sym_name(Name),
+ io__write_char('('),
+ io__write_list(Types, ", ", term_io__write_term(VarSet)),
+ io__write_char(')').
+
+:- pred output_class_methods(list(class_method), io__state, io__state).
+:- mode output_class_methods(in, di, uo) is det.
+
+output_class_methods(Methods) -->
+ io__write_list(Methods, ",\n", output_class_method).
+
+:- pred output_class_method(class_method, io__state, io__state).
+:- mode output_class_method(in, di, uo) is det.
+
+output_class_method(Method) -->
+ io__write_string("\t("),
+ (
+ { Method = pred(VarSet, Name, TypesAndModes, Detism,
+ _Condition, ClassContext, Context) },
+ mercury_output_pred_decl(VarSet, Name, TypesAndModes, Detism,
+ pure, ClassContext, Context, "),\n(", "\n")
+ ;
+ { Method = func(VarSet, Name, TypesAndModes, TypeAndMode,
+ Detism, _Condition, ClassContext, Context) },
+ mercury_output_func_decl(VarSet, Name, TypesAndModes,
+ TypeAndMode, Detism, pure, ClassContext, Context,
+ "),\n(", "\n")
+ ;
+ { Method = pred_mode(VarSet, Name, Modes, Detism,
+ _Condition, Context) },
+ mercury_output_pred_mode_decl_2(VarSet, Name, Modes, Detism,
+ Context, "\n")
+ ;
+ { Method = func_mode(VarSet, Name, Modes, Mode,
+ Detism, _Condition, Context) },
+ mercury_output_func_mode_decl_2(VarSet, Name, Modes,
+ Mode, Detism, Context, "\n")
+ ),
+ io__write_char(')').
+
+:- pred output_instance_methods(instance_interface, io__state, io__state).
+:- mode output_instance_methods(in, di, uo) is det.
+
+output_instance_methods(Methods) -->
+ { OutputMethod = lambda([Method::in, IO0::di, IO::uo] is det,
+ (
+ (
+ Method = func_instance(Name1, Name2, Arity),
+ io__write_string("func((", IO0, IO1)
+ ;
+ Method = pred_instance(Name1, Name2, Arity),
+ io__write_string("pred((", IO0, IO1)
+ ),
+ mercury_output_bracketed_sym_name(Name1, IO1, IO2),
+ io__write_string(")/", IO2, IO3),
+ io__write_int(Arity, IO3, IO4),
+ io__write_string(") is ", IO4, IO5),
+ mercury_output_bracketed_sym_name(Name2, IO5, IO)
+ )
+ ) },
+ io__write_list(Methods, ",\n", OutputMethod).
%-----------------------------------------------------------------------------%
@@ -893,6 +1032,12 @@
{ string__int_to_string(Arity, ArityString) },
io__write_strings(["<base_type_info for ", Module, ":", Type, "/",
ArityString, ">"]).
+mercury_output_cons_id(base_typeclass_info_const(Module, Class, InstanceString),
+ _) -->
+ io__write_string("<base_typeclass_info for "),
+ io__write(Class),
+ io__write_strings([" from module ", Module, ", instance number",
+ InstanceString]).
mercury_output_mode_defn(VarSet, eqv_mode(Name, Args, Mode), Context) -->
io__write_string(":- mode ("),
@@ -1068,27 +1213,41 @@
%-----------------------------------------------------------------------------%
:- pred mercury_output_pred_decl(varset, sym_name, list(type_and_mode),
- maybe(determinism), purity, term__context,
- io__state, io__state).
-:- mode mercury_output_pred_decl(in, in, in, in, in, in, di, uo) is det.
+ maybe(determinism), purity, list(class_constraint),
+ term__context, string, string, io__state, io__state).
+:- mode mercury_output_pred_decl(in, in, in, in, in, in, in, in, in,
+ di, uo) is det.
-mercury_output_pred_decl(VarSet, PredName, TypesAndModes, MaybeDet, Purity,
- Context) -->
+mercury_output_pred_decl(VarSet, PredName, TypesAndModes, MaybeDet,
+ Purity, ClassContext, Context, Separator, Terminator) -->
{ split_types_and_modes(TypesAndModes, Types, MaybeModes) },
- mercury_output_pred_type(VarSet, PredName, Types, MaybeDet, Purity,
- Context),
(
{ MaybeModes = yes(Modes) },
{ Modes \= [] }
->
- mercury_output_pred_mode_decl(VarSet, PredName, Modes,
- MaybeDet, Context)
+ mercury_output_pred_type_2(VarSet, PredName, Types, MaybeDet,
+ Purity, ClassContext, Context, Separator),
+ mercury_output_pred_mode_decl_2(VarSet, PredName, Modes,
+ MaybeDet, Context, Terminator)
;
- []
+ mercury_output_pred_type_2(VarSet, PredName, Types, MaybeDet,
+ Purity, ClassContext, Context, Terminator)
).
mercury_output_pred_type(VarSet, PredName, Types, MaybeDet, Purity,
- _Context) -->
+ ClassContext, Context) -->
+ mercury_output_pred_type_2(VarSet, PredName, Types, MaybeDet,
+ Purity, ClassContext, Context, ".\n").
+
+
+:- pred mercury_output_pred_type_2(varset, sym_name, list(type),
+ maybe(determinism), purity, list(class_constraint),
+ term__context, string, io__state, io__state).
+:- mode mercury_output_pred_type_2(in, in, in, in, in, in, in, in,
+ di, uo) is det.
+
+mercury_output_pred_type_2(VarSet, PredName, Types, MaybeDet, Purity,
+ ClassContext, _Context, Separator) -->
io__write_string(":- "),
write_purity_prefix(Purity),
io__write_string("pred "),
@@ -1099,9 +1258,11 @@
io__write_string("("),
mercury_output_term(Type, VarSet, no),
mercury_output_remaining_terms(Rest, VarSet, no),
- io__write_string(")")
+ io__write_string(")"),
+ mercury_output_class_context(ClassContext, VarSet)
;
mercury_output_bracketed_sym_name(PredName),
+ mercury_output_class_context(ClassContext, VarSet),
mercury_output_det_annotation(MaybeDet)
),
@@ -1126,7 +1287,7 @@
;
[]
),
- io__write_string(".\n").
+ io__write_string(Separator).
% this works under the assumptions that all purity names but `pure' are prefix
@@ -1147,29 +1308,44 @@
%-----------------------------------------------------------------------------%
:- pred mercury_output_func_decl(varset, sym_name, list(type_and_mode),
- type_and_mode, maybe(determinism), purity, term__context,
+ type_and_mode, maybe(determinism),
+ purity, list(class_constraint), term__context, string, string,
io__state, io__state).
-:- mode mercury_output_func_decl(in, in, in, in, in, in, in, di, uo) is det.
+:- mode mercury_output_func_decl(in, in, in, in, in, in, in, in, in, in,
+ di, uo) is det.
mercury_output_func_decl(VarSet, FuncName, TypesAndModes, RetTypeAndMode,
- MaybeDet, Purity, Context) -->
+ MaybeDet, Purity, ClassContext, Context,
+ Separator, Terminator) -->
{ split_types_and_modes(TypesAndModes, Types, MaybeModes) },
{ split_type_and_mode(RetTypeAndMode, RetType, MaybeRetMode) },
(
{ MaybeModes = yes(Modes) },
{ MaybeRetMode = yes(RetMode) }
->
- mercury_output_func_type(VarSet, FuncName, Types, RetType,
- no, Purity, Context),
- mercury_output_func_mode_decl(VarSet, FuncName, Modes, RetMode,
- MaybeDet, Context)
- ;
- mercury_output_func_type(VarSet, FuncName, Types, RetType,
- MaybeDet, Purity, Context)
- ).
+ mercury_output_func_type_2(VarSet, FuncName, Types, RetType,
+ no, Purity, ClassContext, Context, Separator),
+ mercury_output_func_mode_decl_2(VarSet, FuncName, Modes,
+ RetMode, MaybeDet, Context, Terminator)
+ ;
+ mercury_output_func_type_2(VarSet, FuncName, Types, RetType,
+ MaybeDet, Purity, ClassContext, Context,
+ Terminator)
+ ).
+
+mercury_output_func_type(VarSet, FuncName, Types, RetType, MaybeDet,
+ Purity, ClassContext, Context) -->
+ mercury_output_func_type_2(VarSet, FuncName, Types, RetType, MaybeDet,
+ Purity, ClassContext, Context, ".\n").
+
+:- pred mercury_output_func_type_2(varset, sym_name, list(type), type,
+ maybe(determinism), purity, list(class_constraint),
+ term__context, string, io__state, io__state).
+:- mode mercury_output_func_type_2(in, in, in, in, in, in, in, in, in,
+ di, uo) is det.
-mercury_output_func_type(VarSet, FuncName, Types, RetType, MaybeDet, Purity,
- _Context) -->
+mercury_output_func_type_2(VarSet, FuncName, Types, RetType, MaybeDet,
+ Purity, ClassContext, _Context, Separator) -->
io__write_string(":- "),
write_purity_prefix(Purity),
io__write_string("func "),
@@ -1186,8 +1362,38 @@
),
io__write_string(" = "),
mercury_output_term(RetType, VarSet, no),
+ mercury_output_class_context(ClassContext, VarSet),
mercury_output_det_annotation(MaybeDet),
- io__write_string(".\n").
+ io__write_string(Separator).
+
+%-----------------------------------------------------------------------------%
+
+:- pred mercury_output_class_context(list(class_constraint), varset,
+ io__state, io__state).
+:- mode mercury_output_class_context(in, in, di, uo) is det.
+
+mercury_output_class_context(ClassContext, VarSet) -->
+ (
+ { ClassContext = [] }
+ ;
+ { ClassContext = [_|_] },
+ io__write_string(" <= ("),
+ io__write_list(ClassContext, ", ",
+ mercury_output_constraint(VarSet)),
+ io__write_char(')')
+ ).
+
+mercury_output_constraint(VarSet, constraint(Name, Types)) -->
+ mercury_output_sym_name(Name),
+ io__write_char('('),
+ io__write_list(Types, ", ", output_type(VarSet)),
+ io__write_char(')').
+
+:- pred output_type(varset, term, io__state, io__state).
+:- mode output_type(in, in, di, uo) is det.
+
+output_type(VarSet, Type) -->
+ mercury_output_term(Type, VarSet, no).
%-----------------------------------------------------------------------------%
@@ -1207,10 +1413,20 @@
% Output a mode declaration for a predicate.
mercury_output_pred_mode_decl(VarSet, PredName, Modes, MaybeDet, Context) -->
+ mercury_output_pred_mode_decl_2(VarSet, PredName, Modes, MaybeDet,
+ Context, ".\n").
+
+:- pred mercury_output_pred_mode_decl_2(varset, sym_name, list(mode),
+ maybe(determinism), term__context, string,
+ io__state, io__state).
+:- mode mercury_output_pred_mode_decl_2(in, in, in, in, in, in, di, uo) is det.
+
+mercury_output_pred_mode_decl_2(VarSet, PredName, Modes, MaybeDet, Context,
+ Separator) -->
io__write_string(":- mode "),
mercury_output_pred_mode_subdecl(VarSet, PredName, Modes, MaybeDet,
Context),
- io__write_string(".\n").
+ io__write_string(Separator).
mercury_output_pred_mode_subdecl(VarSet, PredName, Modes, MaybeDet,
_Context) -->
@@ -1230,10 +1446,21 @@
mercury_output_func_mode_decl(VarSet, FuncName, Modes, RetMode, MaybeDet,
Context) -->
+ mercury_output_func_mode_decl_2(VarSet, FuncName, Modes, RetMode,
+ MaybeDet, Context, ".\n").
+
+:- pred mercury_output_func_mode_decl_2(varset, sym_name, list(mode), mode,
+ maybe(determinism), term__context, string,
+ io__state, io__state).
+:- mode mercury_output_func_mode_decl_2(in, in, in, in, in, in, in,
+ di, uo) is det.
+
+mercury_output_func_mode_decl_2(VarSet, FuncName, Modes, RetMode, MaybeDet,
+ Context, Separator) -->
io__write_string(":- mode "),
mercury_output_func_mode_subdecl(VarSet, FuncName, Modes, RetMode,
MaybeDet, Context),
- io__write_string(".\n").
+ io__write_string(Separator).
mercury_output_func_mode_subdecl(VarSet, FuncName, Modes, RetMode, MaybeDet,
_Context) -->
Index: compiler/mode_util.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/mode_util.m,v
retrieving revision 1.101
diff -u -r1.101 mode_util.m
--- mode_util.m 1997/09/29 06:45:48 1.101
+++ mode_util.m 1997/10/14 06:59:42
@@ -1126,6 +1126,13 @@
{ instmap_delta_from_mode_list(Vars, Modes,
ModuleInfo, InstMapDelta) }.
+recompute_instmap_delta_2(_, class_method_call(A, B, Vars, C, Modes, D), _,
+ class_method_call(A, B, Vars, C, Modes, D),
+ _InstMap, InstMapDelta) -->
+ =(ModuleInfo),
+ { instmap_delta_from_mode_list(Vars, Modes,
+ ModuleInfo, InstMapDelta) }.
+
recompute_instmap_delta_2(_, call(PredId, ProcId, Args, D, E, F), _,
call(PredId, ProcId, Args, D, E, F), InstMap, InstMapDelta) -->
recompute_instmap_delta_call(PredId, ProcId,
Index: compiler/modes.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/modes.m,v
retrieving revision 1.210
diff -u -r1.210 modes.m
--- modes.m 1997/12/09 04:01:10 1.210
+++ modes.m 1997/12/09 06:37:16
@@ -925,6 +925,12 @@
modecheck_higher_order_pred_call(PredVar, Args0, PredOrFunc, GoalInfo0,
Goal).
+ % XXX This should be fixed one day, in case we decide to re-run
+ % modechecking or something like that.
love and cuddles,
dgj
--
David Jeffery (dgj at cs.mu.oz.au) | Marge: Did you just call everyone "chicken"?
MEngSc student, | Homer: Noooo. I swear on this Bible!
Department of Computer Science | Marge: That's not a Bible; that's a book of
University of Melbourne | carpet samples!
Australia | Homer: Ooooh... Fuzzy.
More information about the developers
mailing list