diff: typeclasses (final) [2/6]
David Glen JEFFERY
dgj at cs.mu.oz.au
Fri Dec 19 14:00:20 AEDT 1997
Index: compiler/base_type_info.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/base_type_info.m,v
retrieving revision 1.12
diff -u -r1.12 base_type_info.m
--- base_type_info.m 1997/08/05 04:37:30 1.12
+++ base_type_info.m 1997/08/28 06:13:00
@@ -35,7 +35,7 @@
:- implementation.
-:- import_module prog_data, hlds_data, hlds_pred, hlds_out.
+:- import_module prog_data, hlds_data, hlds_pred, hlds_out, base_typeclass_info.
:- import_module llds, code_util, globals, special_pred, options.
:- import_module bool, string, list, map, std_util, require.
@@ -118,7 +118,10 @@
base_type_info__generate_llds(ModuleInfo, CModules) :-
module_info_base_gen_infos(ModuleInfo, BaseGenInfos),
base_type_info__construct_base_type_infos(BaseGenInfos, ModuleInfo,
- CModules).
+ CModules1),
+ base_typeclass_info__generate_llds(ModuleInfo, CModules2),
+ % XXX make this use an accumulator
+ list__append(CModules1, CModules2, CModules).
:- pred base_type_info__construct_base_type_infos(list(base_gen_info),
module_info, list(c_module)).
Index: compiler/base_type_layout.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/base_type_layout.m,v
retrieving revision 1.24
diff -u -r1.24 base_type_layout.m
--- base_type_layout.m 1997/12/05 15:47:01 1.24
+++ base_type_layout.m 1997/12/09 06:36:45
@@ -1200,7 +1200,10 @@
base_type_layout__tag_type_and_value(int_constant(_), -1, unused).
base_type_layout__tag_type_and_value(pred_closure_tag(_, _), -1, unused).
base_type_layout__tag_type_and_value(code_addr_constant(_, _), -1, unused).
-base_type_layout__tag_type_and_value(base_type_info_constant(_, _, _), -1,unused).
+base_type_layout__tag_type_and_value(base_type_info_constant(_, _, _), -1,
+ unused).
+base_type_layout__tag_type_and_value(base_typeclass_info_constant(_, _, _), -1,
+ unused).
% Get the arguments of this constructor of the current type.
Index: compiler/bytecode.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/bytecode.m,v
retrieving revision 1.29
diff -u -r1.29 bytecode.m
--- bytecode.m 1997/07/27 14:59:51 1.29
+++ bytecode.m 1997/11/25 01:28:21
@@ -82,6 +82,8 @@
arity, byte_proc_id)
; base_type_info_const(byte_module_id, string,
int)
+ ; base_typeclass_info_const(byte_module_id,
+ class_id, string)
; char_const(char)
.
@@ -727,6 +729,11 @@
{ char__to_int(Char, Byte) },
output_byte(Byte).
+ % XXX
+output_cons_id(base_typeclass_info_const(_, _, _)) -->
+ { error("Sorry, bytecode for typeclass not yet implemented") },
+ output_byte(8).
+
:- pred debug_cons_id(byte_cons_id, io__state, io__state).
:- mode debug_cons_id(in, di, uo) is det.
@@ -762,6 +769,15 @@
debug_module_id(ModuleId),
debug_string(TypeName),
debug_int(TypeArity).
+debug_cons_id(base_typeclass_info_const(ModuleId,
+ class_id(ClassName, ClassArity), Instance)) -->
+ debug_string("base_typeclass_info_const"),
+ debug_module_id(ModuleId),
+ debug_string("class_id"),
+ debug_sym_name(ClassName),
+ debug_string("/"),
+ debug_int(ClassArity),
+ debug_string(Instance).
debug_cons_id(char_const(Char)) -->
debug_string("char_const"),
{ string__from_char_list([Char], String) },
@@ -1265,6 +1281,18 @@
debug_float(Val) -->
io__write_float(Val),
+ io__write_char(' ').
+
+:- pred debug_sym_name(sym_name, io__state, io__state).
+:- mode debug_sym_name(in, di, uo) is det.
+
+debug_sym_name(unqualified(Val)) -->
+ io__write_string(Val),
+ io__write_char(' ').
+debug_sym_name(qualified(Module, Val)) -->
+ io__write_string(Module),
+ io__write_char(':'),
+ io__write_string(Val),
io__write_char(' ').
%---------------------------------------------------------------------------%
Index: compiler/bytecode_gen.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/bytecode_gen.m,v
retrieving revision 1.30
diff -u -r1.30 bytecode_gen.m
--- bytecode_gen.m 1997/09/01 14:00:22 1.30
+++ bytecode_gen.m 1997/09/08 04:11:51
@@ -161,6 +161,10 @@
ArgTypes, ArgModes, Detism, ByteInfo0, Code),
ByteInfo = ByteInfo0
;
+ % XXX
+ GoalExpr = class_method_call(_, _, _, _, _, _),
+ error("sorry: bytecode not implemented yet for typeclasses")
+ ;
GoalExpr = call(PredId, ProcId, ArgVars, BuiltinState, _, _),
( BuiltinState = not_builtin ->
goal_info_get_determinism(GoalInfo, Detism),
@@ -618,6 +622,11 @@
ConsId = base_type_info_const(ModuleName, TypeName, TypeArity),
ByteConsId = base_type_info_const(ModuleName, TypeName,
TypeArity)
+ ;
+ ConsId = base_typeclass_info_const(ModuleName, ClassId,
+ Instance),
+ ByteConsId = base_typeclass_info_const(ModuleName, ClassId,
+ Instance)
).
:- pred bytecode_gen__map_cons_tag(cons_tag::in, byte_cons_tag::out) is det.
@@ -639,6 +648,8 @@
error("code_addr_constant cons tag for non-address_const cons id").
bytecode_gen__map_cons_tag(base_type_info_constant(_, _, _), _) :-
error("base_type_info_constant cons tag for non-base_type_info_constant cons id").
+bytecode_gen__map_cons_tag(base_typeclass_info_constant(_, _, _), _) :-
+ error("base_typeclass_info_constant cons tag for non-base_typeclass_info_constant cons id").
%---------------------------------------------------------------------------%
Index: compiler/call_gen.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/call_gen.m,v
retrieving revision 1.114
diff -u -r1.114 call_gen.m
--- call_gen.m 1997/10/03 04:55:25 1.114
+++ call_gen.m 1997/11/25 08:22:12
@@ -27,6 +27,12 @@
:- mode call_gen__generate_higher_order_call(in, in, in, in, in, in, in, out,
in, out) is det.
+:- pred call_gen__generate_class_method_call(code_model, var, int, list(var),
+ list(type), list(mode), determinism, hlds_goal_info,
+ code_tree, code_info, code_info).
+:- mode call_gen__generate_class_method_call(in, in, in, in, in, in, in, in,
+ out, in, out) is det.
+
:- pred call_gen__generate_call(code_model, pred_id, proc_id, list(var),
hlds_goal_info, code_tree, code_info, code_info).
:- mode call_gen__generate_call(in, in, in, in, in, out, in, out) is det.
@@ -252,6 +258,146 @@
tree(TraceCode,
tree(CallCode,
FailHandlingCode))))))))
+ }.
+
+%---------------------------------------------------------------------------%
+
+ %
+ % for a class method call,
+ % we split the arguments into inputs and outputs, put the inputs
+ % in the locations expected by do_call_<detism>_class_method in
+ % runtime/call.mod, generate the call to do_call_<detism>_class_method,
+ % and pick up the outputs from the locations that we know
+ % runtime/call.mod leaves them in.
+ %
+call_gen__generate_class_method_call(_OuterCodeModel, TCVar, MethodNum, Args,
+ Types, Modes, Det, GoalInfo, Code) -->
+ { determinism_to_code_model(Det, InnerCodeModel) },
+ code_info__get_globals(Globals),
+ code_info__get_module_info(ModuleInfo),
+ { globals__get_args_method(Globals, ArgsMethod) },
+ { make_arg_infos(ArgsMethod, Types, Modes, InnerCodeModel, ModuleInfo,
+ ArgInfo) },
+ { assoc_list__from_corresponding_lists(Args, ArgInfo, ArgsAndArgInfo) },
+ { call_gen__partition_args(ArgsAndArgInfo, InVars, OutVars) },
+ call_gen__generate_class_method_call_2(InnerCodeModel, TCVar,
+ MethodNum, InVars, OutVars, GoalInfo, Code).
+
+ % XXX This assumes compact args
+:- pred call_gen__generate_class_method_call_2(code_model, var, int, list(var),
+ list(var), hlds_goal_info, code_tree, code_info, code_info).
+:- mode call_gen__generate_class_method_call_2(in, in, in, in, in, in, out, in,
+ out) is det.
+
+call_gen__generate_class_method_call_2(CodeModel, TCVar, Index, InVars, OutVars,
+ GoalInfo, Code) -->
+ code_info__get_globals(Globals),
+ { globals__get_args_method(Globals, ArgsMethod) },
+ (
+ { ArgsMethod = compact }
+ ->
+ []
+ ;
+ { error("Sorry, typeclasses with simple args_method not yet implemented") }
+ ),
+ code_info__succip_is_used,
+ { set__list_to_set(OutVars, OutArgs) },
+ call_gen__save_variables(OutArgs, SaveCode),
+ (
+ { CodeModel = model_det },
+ { CallModel = det },
+ { RuntimeAddr = do_det_class_method },
+ { FlushCode = empty }
+ ;
+ { CodeModel = model_semi },
+ { CallModel = semidet },
+ { RuntimeAddr = do_semidet_class_method },
+ { FlushCode = empty }
+ ;
+ { CodeModel = model_non },
+ code_info__may_use_nondet_tailcall(TailCall),
+ { CallModel = nondet(TailCall) },
+ { RuntimeAddr = do_nondet_class_method },
+ code_info__unset_failure_cont(FlushCode)
+ ),
+ % place the immediate input arguments in registers
+ % starting at r5.
+ call_gen__generate_immediate_args(InVars, 5, InLocs, ImmediateCode),
+ code_info__generate_stack_livevals(OutArgs, LiveVals0),
+ { set__insert_list(LiveVals0,
+ [reg(r, 1), reg(r, 2), reg(r, 3), reg(r, 4) | InLocs],
+ LiveVals) },
+ (
+ { CodeModel = model_semi }
+ ->
+ { FirstArg = 2 }
+ ;
+ { FirstArg = 1 }
+ ),
+ { call_gen__outvars_to_outargs(OutVars, FirstArg, OutArguments) },
+ { call_gen__output_arg_locs(OutArguments, OutLocs) },
+
+ code_info__get_instmap(InstMap),
+ { goal_info_get_instmap_delta(GoalInfo, InstMapDelta) },
+ { instmap__apply_instmap_delta(InstMap, InstMapDelta,
+ AfterCallInstMap) },
+
+ call_gen__generate_return_livevals(OutArgs, OutLocs, AfterCallInstMap,
+ OutLiveVals),
+ code_info__produce_variable(TCVar, TCVarCode, TCVarRVal),
+ (
+ { TCVarRVal = lval(reg(r, 1)) }
+ ->
+ { CopyCode = empty }
+ ;
+ { CopyCode = node([
+ assign(reg(r, 1), TCVarRVal) - "Copy typeclass info"
+ ])}
+ ),
+ { list__length(InVars, NInVars) },
+ { list__length(OutVars, NOutVars) },
+ { SetupCode = tree(CopyCode, node([
+ assign(reg(r, 2), const(int_const(Index))) -
+ "Index of class method in typeclass info",
+ assign(reg(r, 3), const(int_const(NInVars))) -
+ "Assign number of immediate input arguments",
+ assign(reg(r, 4), const(int_const(NOutVars))) -
+ "Assign number of output arguments"
+ ])
+ ) },
+ code_info__get_next_label(ReturnLabel),
+ { TryCallCode = node([
+ livevals(LiveVals) - "",
+ call(RuntimeAddr, label(ReturnLabel), OutLiveVals, CallModel)
+ - "setup and call class method",
+ label(ReturnLabel) - "Continuation label"
+ ]) },
+ call_gen__rebuild_registers(OutArguments),
+ (
+ { CodeModel = model_semi }
+ ->
+ code_info__generate_failure(FailCode),
+ code_info__get_next_label(ContLab),
+ { TestSuccessCode = node([
+ if_val(lval(reg(r, 1)), label(ContLab)) -
+ "Test for success"
+ ]) },
+ { ContLabelCode = node([label(ContLab) - ""]) },
+ { CallCode =
+ tree(TryCallCode,
+ tree(TestSuccessCode,
+ tree(FailCode,
+ ContLabelCode))) }
+ ;
+ { CallCode = TryCallCode }
+ ),
+ { Code =
+ tree(SaveCode,
+ tree(FlushCode,
+ tree(ImmediateCode,
+ tree(TCVarCode,
+ tree(SetupCode,
+ CallCode)))))
}.
%---------------------------------------------------------------------------%
Index: compiler/code_gen.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/code_gen.m,v
retrieving revision 1.40
diff -u -r1.40 code_gen.m
--- code_gen.m 1997/12/10 07:15:37 1.40
+++ code_gen.m 1997/12/18 07:37:20
@@ -692,6 +692,11 @@
GoalInfo, Instr) -->
call_gen__generate_higher_order_call(model_det, PredVar, Args,
Types, Modes, Det, GoalInfo, Instr).
+code_gen__generate_det_goal_2(class_method_call(TCVar, Num, Args, Types,
+ Modes, Det),
+ GoalInfo, Instr) -->
+ call_gen__generate_class_method_call(model_det, TCVar, Num, Args,
+ Types, Modes, Det, GoalInfo, Instr).
code_gen__generate_det_goal_2(call(PredId, ProcId, Args, BuiltinState, _, _),
GoalInfo, Instr) -->
(
@@ -779,6 +784,10 @@
Det, _PredOrFunc), GoalInfo, Code) -->
call_gen__generate_higher_order_call(model_semi, PredVar, Args,
Types, Modes, Det, GoalInfo, Code).
+code_gen__generate_semi_goal_2(class_method_call(TCVar, Num, Args, Types, Modes,
+ Det), GoalInfo, Code) -->
+ call_gen__generate_class_method_call(model_semi, TCVar, Num, Args,
+ Types, Modes, Det, GoalInfo, Code).
code_gen__generate_semi_goal_2(call(PredId, ProcId, Args, BuiltinState, _, _),
GoalInfo, Code) -->
(
@@ -979,6 +988,11 @@
Det, _PredOrFunc),
GoalInfo, Code) -->
call_gen__generate_higher_order_call(model_non, PredVar, Args, Types,
+ Modes, Det, GoalInfo, Code).
+code_gen__generate_non_goal_2(class_method_call(TCVar, Num, Args, Types, Modes,
+ Det),
+ GoalInfo, Code) -->
+ call_gen__generate_class_method_call(model_non, TCVar, Num, Args, Types,
Modes, Det, GoalInfo, Code).
code_gen__generate_non_goal_2(call(PredId, ProcId, Args, BuiltinState, _, _),
GoalInfo, Code) -->
Index: compiler/code_info.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/code_info.m,v
retrieving revision 1.213
diff -u -r1.213 code_info.m
--- code_info.m 1997/10/03 04:55:31 1.213
+++ code_info.m 1997/11/20 07:16:32
@@ -651,7 +651,7 @@
:- mode code_info__lookup_type_defn(in, out, in, out) is det.
% Given a list of type variables, find the lvals where the
- % corresponding type_infos are being stored.
+ % corresponding type_infos and typeclass_infos are being stored.
:- pred code_info__find_type_infos(list(var), assoc_list(var, lval),
code_info, code_info).
:- mode code_info__find_type_infos(in, out, in, out) is det.
@@ -836,13 +836,13 @@
code_info__find_type_infos([TVar | TVars], [TVar - Lval | Lvals]) -->
code_info__get_proc_info(ProcInfo),
{ proc_info_typeinfo_varmap(ProcInfo, TypeInfoMap) },
- (
- { map__search(TypeInfoMap, TVar, Var0) }
+ {
+ map__search(TypeInfoMap, TVar, Locn)
->
- { Var = Var0 }
+ type_info_locn_var(Locn, Var)
;
- { error("cannot find var for type variable") }
- ),
+ error("cannot find var for type variable")
+ },
{ proc_info_stack_slots(ProcInfo, StackSlots) },
(
{ map__search(StackSlots, Var, Lval0) }
Index: compiler/code_util.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/code_util.m,v
retrieving revision 1.89
diff -u -r1.89 code_util.m
--- code_util.m 1997/09/01 14:00:37 1.89
+++ code_util.m 1997/09/08 04:20:45
@@ -644,6 +644,8 @@
code_util__cons_id_to_tag(pred_const(P,M), _, _, pred_closure_tag(P,M)).
code_util__cons_id_to_tag(base_type_info_const(M,T,A), _, _,
base_type_info_constant(M,T,A)).
+code_util__cons_id_to_tag(base_typeclass_info_const(M,C,N), _, _,
+ base_typeclass_info_constant(M,C,N)).
code_util__cons_id_to_tag(cons(Name, Arity), Type, ModuleInfo, Tag) :-
(
% handle the `character' type specially
@@ -771,6 +773,8 @@
code_util__count_recursive_calls_2(unify(_, _, _, _, _), _, _, 0, 0).
code_util__count_recursive_calls_2(higher_order_call(_, _,_, _, _, _), _, _,
0, 0).
+code_util__count_recursive_calls_2(class_method_call(_, _,_, _, _, _), _, _,
+ 0, 0).
code_util__count_recursive_calls_2(pragma_c_code(_,_,_,_, _, _, _, _), _, _,
0, 0).
code_util__count_recursive_calls_2(call(CallPredId, CallProcId, _, _, _, _),
Index: compiler/constraint.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/constraint.m,v
retrieving revision 1.35
diff -u -r1.35 constraint.m
--- constraint.m 1997/09/01 14:00:47 1.35
+++ constraint.m 1997/09/08 04:12:00
@@ -179,6 +179,12 @@
mode_checkpoint(exit, "higher-order call").
constraint__propagate_goal_2(
+ class_method_call(A, B, C, D, E, F),
+ class_method_call(A, B, C, D, E, F)) -->
+ mode_checkpoint(enter, "class method call"),
+ mode_checkpoint(exit, "class method call").
+
+constraint__propagate_goal_2(
call(PredId, ProcId, ArgVars, Builtin, Sym, Context),
call(PredId, ProcId, ArgVars, Builtin, Sym, Context)) -->
mode_checkpoint(enter, "call"),
Index: compiler/cse_detection.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/cse_detection.m,v
retrieving revision 1.48
diff -u -r1.48 cse_detection.m
--- cse_detection.m 1997/09/01 14:00:51 1.48
+++ cse_detection.m 1997/09/08 04:22:09
@@ -206,6 +206,9 @@
detect_cse_in_goal_2(higher_order_call(A,B,C,D,E,F), _, _, CseInfo, CseInfo,
no, higher_order_call(A,B,C,D,E,F)).
+detect_cse_in_goal_2(class_method_call(A,B,C,D,E,F), _, _, CseInfo, CseInfo,
+ no, class_method_call(A,B,C,D,E,F)).
+
detect_cse_in_goal_2(call(A,B,C,D,E,F), _, _, CseInfo, CseInfo, no,
call(A,B,C,D,E,F)).
Index: compiler/dead_proc_elim.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/dead_proc_elim.m,v
retrieving revision 1.32
diff -u -r1.32 dead_proc_elim.m
--- dead_proc_elim.m 1997/09/01 14:00:56 1.32
+++ dead_proc_elim.m 1997/11/03 05:43:31
@@ -110,7 +110,10 @@
Queue1, Queue2, Needed1, Needed2),
module_info_base_gen_infos(ModuleInfo, BaseGenInfos),
dead_proc_elim__initialize_base_gen_infos(BaseGenInfos,
- Queue2, Queue, Needed2, Needed).
+ Queue2, Queue3, Needed2, Needed3),
+ module_info_instances(ModuleInfo, Instances),
+ dead_proc_elim__initialize_class_methods(Instances,
+ Queue3, Queue, Needed3, Needed).
% Add all normally exported procedures within the listed predicates
% to the queue and map.
@@ -198,6 +201,62 @@
dead_proc_elim__initialize_base_gen_infos(BaseGenInfos,
Queue1, Queue, Needed1, Needed).
+:- pred dead_proc_elim__initialize_class_methods(instance_table,
+ entity_queue, entity_queue, needed_map, needed_map).
+:- mode dead_proc_elim__initialize_class_methods(in, in, out, in, out) is det.
+
+dead_proc_elim__initialize_class_methods(Instances, Queue0, Queue,
+ Needed0, Needed) :-
+ map__values(Instances, InstanceDefns0),
+ list__condense(InstanceDefns0, InstanceDefns),
+ list__foldl2(get_instance_pred_procs, InstanceDefns, Queue0, Queue,
+ Needed0, Needed).
+
+:- pred get_instance_pred_procs(hlds_instance_defn, entity_queue, entity_queue,
+ needed_map, needed_map).
+:- mode get_instance_pred_procs(in, in, out, in, out) is det.
+
+get_instance_pred_procs(Instance, Queue0, Queue, Needed0, Needed) :-
+ Instance = hlds_instance_defn(ImportStatus, _, _, _, PredProcIds, _, _),
+ (
+ % We only need the instance declarations which were
+ % made in this module.
+ ( ImportStatus = exported
+ ; ImportStatus = abstract_exported
+ ; ImportStatus = pseudo_exported
+ ; ImportStatus = local
+ )
+ ->
+ get_instance_pred_procs2(PredProcIds, Queue0, Queue,
+ Needed0, Needed)
+ ;
+ Queue = Queue0,
+ Needed = Needed0
+ ).
+
+:- pred get_instance_pred_procs2(maybe(list(hlds_class_proc)),
+ entity_queue, entity_queue, needed_map, needed_map).
+:- mode get_instance_pred_procs2(in, in, out, in, out) is det.
+
+get_instance_pred_procs2(PredProcIds, Queue0, Queue, Needed0, Needed) :-
+ (
+ % This should never happen
+ PredProcIds = no,
+ Queue = Queue0,
+ Needed = Needed0
+ ;
+ PredProcIds = yes(Ids),
+ AddHldsClassProc = lambda(
+ [PredProc::in, Q0::in, Q::out, N0::in, N::out] is det,
+ (
+ PredProc = hlds_class_proc(PredId, ProcId),
+ queue__put(Q0, proc(PredId, ProcId), Q),
+ map__set(N0, proc(PredId, ProcId), no, N)
+ )),
+ list__foldl2(AddHldsClassProc, Ids, Queue0, Queue,
+ Needed0, Needed)
+ ).
+
%-----------------------------------------------------------------------------%
:- pred dead_proc_elim__examine(entity_queue, examined_set, module_info,
@@ -372,6 +431,8 @@
Needed2, Needed).
dead_proc_elim__examine_expr(higher_order_call(_,_,_,_,_,_), _,
Queue, Queue, Needed, Needed).
+dead_proc_elim__examine_expr(class_method_call(_,_,_,_,_,_), _,
+ Queue, Queue, Needed, Needed).
dead_proc_elim__examine_expr(call(PredId, ProcId, _,_,_,_),
CurrProc, Queue0, Queue, Needed0, Needed) :-
queue__put(Queue0, proc(PredId, ProcId), Queue),
@@ -693,6 +754,7 @@
)) },
list__foldl(ExamineCase, Cases).
pre_modecheck_examine_goal(higher_order_call(_,_,_,_,_,_) - _) --> [].
+pre_modecheck_examine_goal(class_method_call(_,_,_,_,_,_) - _) --> [].
pre_modecheck_examine_goal(not(Goal) - _) -->
pre_modecheck_examine_goal(Goal).
pre_modecheck_examine_goal(some(_, Goal) - _) -->
Index: compiler/dependency_graph.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/dependency_graph.m,v
retrieving revision 1.30
diff -u -r1.30 dependency_graph.m
--- dependency_graph.m 1997/09/01 14:00:59 1.30
+++ dependency_graph.m 1997/09/08 04:26:58
@@ -218,6 +218,8 @@
dependency_graph__add_arcs_in_goal_2(higher_order_call(_, _, _, _, _, _),
_Caller, DepGraph, DepGraph).
+dependency_graph__add_arcs_in_goal_2(class_method_call(_, _, _, _, _, _),
+ _Caller, DepGraph, DepGraph).
dependency_graph__add_arcs_in_goal_2(call(PredId, ProcId, _, Builtin, _, _),
Caller, DepGraph0, DepGraph) :-
@@ -321,6 +323,8 @@
DepGraph = DepGraph0
).
dependency_graph__add_arcs_in_cons(base_type_info_const(_, _, _), _Caller,
+ DepGraph, DepGraph).
+dependency_graph__add_arcs_in_cons(base_typeclass_info_const(_, _, _), _Caller,
DepGraph, DepGraph).
%-----------------------------------------------------------------------------%
Index: compiler/det_analysis.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/det_analysis.m,v
retrieving revision 1.124
diff -u -r1.124 det_analysis.m
--- det_analysis.m 1997/11/17 05:47:30 1.124
+++ det_analysis.m 1997/12/19 00:41:09
@@ -454,7 +454,31 @@
NumSolns = at_most_many_cc,
SolnContext \= first_soln
->
- Msgs = [higher_order_cc_pred_in_wrong_context(GoalInfo, Det)],
+ Msgs = [higher_order_cc_pred_in_wrong_context(GoalInfo, Det0)],
+ % Code elsewhere relies on the assumption that
+ % SolnContext \= first_soln => NumSolns \= at_most_many_cc,
+ % so we need to enforce that here.
+ determinism_components(Det, CanFail, at_most_many)
+ ;
+ Msgs = [],
+ Det = Det0
+ ).
+
+det_infer_goal_2(class_method_call(TCVar, Num, ArgVars, Types, Modes, Det0),
+ GoalInfo, _InstMap0, SolnContext,
+ _MiscInfo, _NonLocalVars, _DeltaInstMap,
+ class_method_call(TCVar, Num, ArgVars, Types, Modes, Det0),
+ Det, Msgs) :-
+ determinism_components(Det0, CanFail, NumSolns),
+ (
+ NumSolns = at_most_many_cc,
+ SolnContext \= first_soln
+ ->
+ % If called, this would give a slightly misleading
+ % error message. class_method_calls are introduced
+ % after det_analysis, though, so it doesn't really
+ % matter.
+ Msgs = [higher_order_cc_pred_in_wrong_context(GoalInfo, Det0)],
% Code elsewhere relies on the assumption that
% SolnContext \= first_soln => NumSolns \= at_most_many_cc,
% so we need to enforce that here.
@@ -972,7 +996,8 @@
segregate_procs(ModuleInfo, PredProcs, DeclaredProcs, UndeclaredProcs).
% get_all_pred_procs takes a module_info and returns a list
- % of all the procedures ids for that module.
+ % of all the procedures ids for that module (except class methods,
+ % which do not need to be checked since we generate the code ourselves).
:- pred get_all_pred_procs(module_info, pred_proc_list).
:- mode get_all_pred_procs(in, out) is det.
@@ -989,8 +1014,20 @@
get_all_pred_procs_2(_Preds, [], PredProcs, PredProcs).
get_all_pred_procs_2(Preds, [PredId|PredIds], PredProcs0, PredProcs) :-
map__lookup(Preds, PredId, Pred),
- pred_info_non_imported_procids(Pred, ProcIds),
- fold_pred_modes(PredId, ProcIds, PredProcs0, PredProcs1),
+ pred_info_get_markers(Pred, Markers),
+ (
+ % ignore class members, since their bodies are filled
+ % in after this pass, and the body is gauranteed to
+ % be determinism-correct. Determinism correctness of
+ % the methods in an instance declaration is checked
+ % separately in check_typeclass.m
+ check_marker(Markers, class_method)
+ ->
+ PredProcs1 = PredProcs0
+ ;
+ pred_info_non_imported_procids(Pred, ProcIds),
+ fold_pred_modes(PredId, ProcIds, PredProcs0, PredProcs1)
+ ),
get_all_pred_procs_2(Preds, PredIds, PredProcs1, PredProcs).
:- pred fold_pred_modes(pred_id, list(proc_id), pred_proc_list, pred_proc_list).
Index: compiler/det_report.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/det_report.m,v
retrieving revision 1.44
diff -u -r1.44 det_report.m
--- det_report.m 1997/12/11 09:15:56 1.44
+++ det_report.m 1997/12/18 07:41:53
@@ -462,6 +462,16 @@
det_diagnose_atomic_goal(Desired, Actual,
report_higher_order_call_context(Context), Context).
+ % There's probably no point in this code being here: we only
+ % insert class_method_calls by hand, so they're gauranteed to be right,
+ % and in any case, we insert them after determinism analysis.
+ % Nonetheless, it's probably safer to include the code.
+det_diagnose_goal_2(class_method_call(_, _, _, _, _, _), GoalInfo,
+ Desired, Actual, _, _MiscInfo, yes) -->
+ { goal_info_get_context(GoalInfo, Context) },
+ det_diagnose_atomic_goal(Desired, Actual,
+ report_higher_order_call_context(Context), Context).
+
det_diagnose_goal_2(unify(LT, RT, _, _, UnifyContext), GoalInfo,
Desired, Actual, _, DetInfo, yes) -->
{ goal_info_get_context(GoalInfo, Context) },
Index: compiler/dnf.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/dnf.m,v
retrieving revision 1.24
diff -u -r1.24 dnf.m
--- dnf.m 1997/11/24 07:26:38 1.24
+++ dnf.m 1997/12/09 05:29:24
@@ -137,10 +137,11 @@
pred_info_name(PredInfo0, PredName),
pred_info_typevarset(PredInfo0, TVarSet),
pred_info_get_markers(PredInfo0, Markers),
+ pred_info_get_class_context(PredInfo0, ClassContext),
proc_info_goal(ProcInfo0, Goal0),
proc_info_variables(ProcInfo0, VarSet),
proc_info_vartypes(ProcInfo0, VarTypes),
- DnfInfo = dnf_info(TVarSet, VarTypes, VarSet, Markers),
+ DnfInfo = dnf_info(TVarSet, VarTypes, ClassContext, VarSet, Markers),
proc_info_get_initial_instmap(ProcInfo0, ModuleInfo0, InstMap),
dnf__transform_goal(Goal0, InstMap, MaybeNonAtomic,
@@ -153,6 +154,7 @@
:- type dnf_info ---> dnf_info(
tvarset,
map(var, type),
+ list(class_constraint),
varset,
pred_markers
).
@@ -208,6 +210,11 @@
NewPredIds = NewPredIds0,
Goal = Goal0
;
+ GoalExpr0 = class_method_call(_, _, _, _, _, _),
+ ModuleInfo = ModuleInfo0,
+ NewPredIds = NewPredIds0,
+ Goal = Goal0
+ ;
GoalExpr0 = call(_, _, _, _, _, _),
ModuleInfo = ModuleInfo0,
NewPredIds = NewPredIds0,
@@ -361,12 +368,15 @@
dnf__define_new_pred(Goal0, Goal, InstMap0, PredName, DnfInfo,
ModuleInfo0, ModuleInfo, PredId) :-
- DnfInfo = dnf_info(TVarSet, VarTypes, VarSet, Markers),
+ DnfInfo = dnf_info(TVarSet, VarTypes, ClassContext, VarSet, Markers),
Goal0 = _GoalExpr - GoalInfo,
goal_info_get_nonlocals(GoalInfo, NonLocals),
set__to_sorted_list(NonLocals, ArgVars),
+ % This ClassContext is a conservative approximation.
+ % We could get rid of some constraints on variables
+ % that are not part of the goal.
hlds_pred__define_new_pred(Goal0, Goal, ArgVars, InstMap0, PredName,
- TVarSet, VarTypes, VarSet, Markers,
+ TVarSet, VarTypes, ClassContext, VarSet, Markers,
ModuleInfo0, ModuleInfo, PredProcId),
PredProcId = proc(PredId, _).
@@ -410,6 +420,7 @@
dnf__is_atomic_expr(conj(_), no).
dnf__is_atomic_expr(higher_order_call(_, _, _, _, _, _), yes).
+dnf__is_atomic_expr(class_method_call(_, _, _, _, _, _), yes).
dnf__is_atomic_expr(call(_, _, _, _, _, _), yes).
dnf__is_atomic_expr(switch(_, _, _, _), no).
dnf__is_atomic_expr(unify(_, _, _, _, _), yes).
Index: compiler/dupelim.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/dupelim.m,v
retrieving revision 1.25
diff -u -r1.25 dupelim.m
--- dupelim.m 1997/12/05 15:47:08 1.25
+++ dupelim.m 1997/12/09 06:36:49
@@ -285,6 +285,11 @@
dupelim__replace_labels_code_addr(do_det_closure, _, do_det_closure).
dupelim__replace_labels_code_addr(do_semidet_closure, _, do_semidet_closure).
dupelim__replace_labels_code_addr(do_nondet_closure, _, do_nondet_closure).
+dupelim__replace_labels_code_addr(do_det_class_method, _, do_det_class_method).
+dupelim__replace_labels_code_addr(do_semidet_class_method, _,
+ do_semidet_class_method).
+dupelim__replace_labels_code_addr(do_nondet_class_method, _,
+ do_nondet_class_method).
dupelim__replace_labels_code_addr(do_not_reached, _, do_not_reached).
:- pred dupelim__replace_labels_label_list(list(label), map(label, label),
Index: compiler/equiv_type.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/equiv_type.m,v
retrieving revision 1.10
diff -u -r1.10 equiv_type.m
--- equiv_type.m 1997/12/09 04:00:36 1.10
+++ equiv_type.m 1997/12/19 00:41:58
@@ -113,19 +113,23 @@
TypeDefn, VarSet, ContainsCirc).
equiv_type__replace_in_item(
- pred(VarSet0, PredName, TypesAndModes0, Det, Cond, Purity),
+ pred(VarSet0, PredName, TypesAndModes0,
+ Det, Cond, Purity, ClassContext),
EqvMap,
- pred(VarSet, PredName, TypesAndModes, Det, Cond, Purity),
+ pred(VarSet, PredName, TypesAndModes,
+ Det, Cond, Purity, ClassContext),
no) :-
equiv_type__replace_in_tms(TypesAndModes0, VarSet0, EqvMap,
TypesAndModes, VarSet).
equiv_type__replace_in_item(
func(VarSet0, PredName, TypesAndModes0,
- RetTypeAndMode0, Det, Cond, Purity),
+ RetTypeAndMode0, Det, Cond, Purity,
+ ClassContext),
EqvMap,
- func(VarSet, PredName, TypesAndModes, RetTypeAndMode,
- Det, Cond, Purity),
+ func(VarSet, PredName, TypesAndModes,
+ RetTypeAndMode, Det, Cond, Purity,
+ ClassContext),
no) :-
equiv_type__replace_in_tms(TypesAndModes0, VarSet0, EqvMap,
TypesAndModes, VarSet1),
Index: compiler/excess.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/excess.m,v
retrieving revision 1.24
diff -u -r1.24 excess.m
--- excess.m 1997/09/01 14:01:24 1.24
+++ excess.m 1997/09/08 04:47:04
@@ -120,6 +120,10 @@
Goal = GoalExpr0 - GoalInfo0,
ElimVars = ElimVars0
;
+ GoalExpr0 = class_method_call(_, _, _, _, _, _),
+ Goal = GoalExpr0 - GoalInfo0,
+ ElimVars = ElimVars0
+ ;
GoalExpr0 = call(_, _, _, _, _, _),
Goal = GoalExpr0 - GoalInfo0,
ElimVars = ElimVars0
Index: compiler/exprn_aux.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/exprn_aux.m,v
retrieving revision 1.24
diff -u -r1.24 exprn_aux.m
--- exprn_aux.m 1997/12/05 15:47:11 1.24
+++ exprn_aux.m 1997/12/09 06:36:52
@@ -150,6 +150,9 @@
exprn_aux__addr_is_constant(do_det_closure, _, no).
exprn_aux__addr_is_constant(do_semidet_closure, _, no).
exprn_aux__addr_is_constant(do_nondet_closure, _, no).
+exprn_aux__addr_is_constant(do_det_class_method, _, no).
+exprn_aux__addr_is_constant(do_semidet_class_method, _, no).
+exprn_aux__addr_is_constant(do_nondet_class_method, _, no).
exprn_aux__addr_is_constant(do_not_reached, _, no).
:- pred exprn_aux__label_is_constant(label, bool, bool, bool).
Index: compiler/follow_code.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/follow_code.m,v
retrieving revision 1.43
diff -u -r1.43 follow_code.m
--- follow_code.m 1997/09/01 14:01:28 1.43
+++ follow_code.m 1997/09/08 04:47:26
@@ -110,6 +110,9 @@
move_follow_code_in_goal_2(higher_order_call(A,B,C,D,E,F),
higher_order_call(A,B,C,D,E,F), _, R, R).
+move_follow_code_in_goal_2(class_method_call(A,B,C,D,E,F),
+ class_method_call(A,B,C,D,E,F), _, R, R).
+
move_follow_code_in_goal_2(call(A,B,C,D,E,F), call(A,B,C,D,E,F), _, R, R).
move_follow_code_in_goal_2(unify(A,B,C,D,E), unify(A,B,C,D,E), _, R, R).
Index: compiler/follow_vars.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/follow_vars.m,v
retrieving revision 1.43
diff -u -r1.43 follow_vars.m
--- follow_vars.m 1997/09/01 14:01:32 1.43
+++ follow_vars.m 1997/10/13 03:40:54
@@ -155,12 +155,30 @@
find_follow_vars_in_goal(Goal0, ArgsMethod, ModuleInfo, FollowVars0,
Goal, FollowVars).
+ % XXX These follow-vars aren't correct since the desired positions for
+ % XXX the arguments are different from an ordinary call --- they are
+ % XXX as required by do_call_{det,semidet,nondet}_closure
find_follow_vars_in_goal_2(
higher_order_call(PredVar, Args, Types, Modes, Det,
IsPredOrFunc),
ArgsMethod, ModuleInfo, _FollowVars0,
higher_order_call(PredVar, Args, Types, Modes, Det,
IsPredOrFunc),
+ FollowVars) :-
+ determinism_to_code_model(Det, CodeModel),
+ make_arg_infos(ArgsMethod, Types, Modes, CodeModel, ModuleInfo,
+ ArgInfo),
+ find_follow_vars_from_arginfo(ArgInfo, Args, FollowVars).
+
+ % XXX These follow-vars aren't correct since the desired positions for
+ % XXX the arguments are different from an ordinary call --- they are
+ % XXX as required by do_call_{det,semidet,nondet}_class_method
+find_follow_vars_in_goal_2(
+ class_method_call(TypeClassInfoVar, Num, Args, Types, Modes,
+ Det),
+ ArgsMethod, ModuleInfo, _FollowVars0,
+ class_method_call(TypeClassInfoVar, Num, Args, Types, Modes,
+ Det),
FollowVars) :-
determinism_to_code_model(Det, CodeModel),
make_arg_infos(ArgsMethod, Types, Modes, CodeModel, ModuleInfo,
Index: compiler/goal_path.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/goal_path.m,v
retrieving revision 1.1
diff -u -r1.1 goal_path.m
--- goal_path.m 1997/10/13 08:09:39 1.1
+++ goal_path.m 1997/10/17 05:10:07
@@ -56,6 +56,8 @@
fill_expr_slots(call(A,B,C,D,E,F), _Path0, call(A,B,C,D,E,F)).
fill_expr_slots(higher_order_call(A,B,C,D,E,F), _Path0,
higher_order_call(A,B,C,D,E,F)).
+fill_expr_slots(class_method_call(A,B,C,D,E,F), _Path0,
+ class_method_call(A,B,C,D,E,F)).
fill_expr_slots(unify(A,B,C,D,E), _Path0, unify(A,B,C,D,E)).
fill_expr_slots(pragma_c_code(A,B,C,D,E,F,G,H), _Path0,
pragma_c_code(A,B,C,D,E,F,G,H)).
Index: compiler/goal_util.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/goal_util.m,v
retrieving revision 1.38
diff -u -r1.38 goal_util.m
--- goal_util.m 1997/09/01 14:01:36 1.38
+++ goal_util.m 1997/09/08 04:50:08
@@ -226,6 +226,15 @@
goal_util__rename_var_list(Args0, Must, Subn, Args).
goal_util__name_apart_2(
+ class_method_call(TypeClassInfoVar0, Num, Args0, Types, Modes,
+ Det),
+ Must, Subn,
+ class_method_call(TypeClassInfoVar, Num, Args, Types, Modes,
+ Det)) :-
+ goal_util__rename_var(TypeClassInfoVar0, Must, Subn, TypeClassInfoVar),
+ goal_util__rename_var_list(Args0, Must, Subn, Args).
+
+goal_util__name_apart_2(
call(PredId, ProcId, Args0, Builtin, Context, Sym),
Must, Subn,
call(PredId, ProcId, Args, Builtin, Context, Sym)) :-
@@ -418,6 +427,10 @@
Set0, Set) :-
set__insert_list(Set0, [PredVar | ArgVars], Set).
+goal_util__goal_vars_2(class_method_call(PredVar, _, ArgVars, _, _, _),
+ Set0, Set) :-
+ set__insert_list(Set0, [PredVar | ArgVars], Set).
+
goal_util__goal_vars_2(call(_, _, ArgVars, _, _, _), Set0, Set) :-
set__insert_list(Set0, ArgVars, Set).
@@ -537,6 +550,7 @@
Size is Size1 + 1.
goal_expr_size(call(_, _, _, _, _, _), 1).
goal_expr_size(higher_order_call(_, _, _, _, _, _), 1).
+goal_expr_size(class_method_call(_, _, _, _, _, _), 1).
goal_expr_size(unify(_, _, _, _, _), 1).
goal_expr_size(pragma_c_code(_, _, _, _, _, _, _, _), 1).
Index: compiler/higher_order.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/higher_order.m,v
retrieving revision 1.34
diff -u -r1.34 higher_order.m
--- higher_order.m 1997/11/24 07:26:40 1.34
+++ higher_order.m 1997/12/10 06:04:25
@@ -295,6 +295,10 @@
{ Goal0 = higher_order_call(_,_,_,_,_,_) - _ },
maybe_specialize_higher_order_call(Goal0, Goal, PredProcId, Changed).
+ % XXX For now, we do not specialize class method calls
+traverse_goal(Goal, Goal, _, unchanged, 1) -->
+ { Goal = class_method_call(_,_,_,_,_,_) - _ }.
+
% check whether this call could be specialized
traverse_goal(Goal0, Goal, PredProcId, Changed, 1) -->
{ Goal0 = call(_,_,_,_,_,_) - _ },
@@ -841,9 +845,14 @@
pred_info_context(PredInfo0, Context),
pred_info_get_markers(PredInfo0, MarkerList),
pred_info_get_goal_type(PredInfo0, GoalType),
+ % When we start specialising class method calls, this
+ % context will need to be updated.
+ % cf. remove_listof_higher_order_args.
+ pred_info_get_class_context(PredInfo0, ClassContext),
Name = qualified(PredModule, PredName),
varset__init(EmptyVarSet),
map__init(EmptyVarTypes),
+ map__init(EmptyProofs),
% This isn't looked at after here, and just clutters up
% hlds dumps if it's filled in.
@@ -851,7 +860,7 @@
EmptyVarTypes, [], []),
pred_info_init(PredModule, Name, Arity, Tvars,
Types, true, Context, ClausesInfo, local, MarkerList, GoalType,
- PredOrFunc, PredInfo1),
+ PredOrFunc, ClassContext, EmptyProofs, PredInfo1),
pred_info_set_typevarset(PredInfo1, TypeVars, PredInfo2),
pred_info_procedures(PredInfo2, Procs0),
next_mode_id(Procs0, no, NewProcId),
Index: compiler/hlds_data.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/hlds_data.m,v
retrieving revision 1.18
diff -u -r1.18 hlds_data.m
--- hlds_data.m 1997/09/14 09:24:23 1.18
+++ hlds_data.m 1997/11/28 05:16:24
@@ -34,8 +34,15 @@
% Used for constructing type_infos.
% Note that a pred_const is for a closure
% whereas a code_addr_const is just an address.
- ; base_type_info_const(string, string, int).
+ ; base_type_info_const(string, string, int)
% module name, type name, type arity
+ ; base_typeclass_info_const(string, class_id,
+ string)
+ % name of module containing instance
+ % declaration, class name and arity, a string
+ % encoding the type names and arities of
+ % arguments to the instance declaration
+ .
% A cons_defn is the definition of a constructor (i.e. a constant
% or a functor) for a particular type.
@@ -112,6 +119,8 @@
error("cons_id_arity: can't get arity of code_addr_const").
cons_id_arity(base_type_info_const(_, _, _), _) :-
error("cons_id_arity: can't get arity of base_type_info_const").
+cons_id_arity(base_typeclass_info_const(_, _, _), _) :-
+ error("cons_id_arity: can't get arity of base_typeclass_info_const").
make_functor_cons_id(term__atom(Name), Arity, cons(unqualified(Name), Arity)).
make_functor_cons_id(term__integer(Int), _, int_const(Int)).
@@ -241,6 +250,14 @@
% the name of the module the type is defined in
% and the name of the type, while the integer is
% the arity.
+ ; base_typeclass_info_constant(string, class_id, string)
+ % This is how we refer to base_typeclass_info structures
+ % represented as global data. The first argument is the
+ % name of the module containing the instance declration,
+ % the second is the class name and arity, while the
+ % third is the string which uniquely identifies the
+ % instance declaration (it is made from the type of
+ % the arguments to the instance decl).
; simple_tag(tag_bits)
% This is for constants or functors which only
% require a simple tag. (A "simple" tag is one
@@ -674,5 +691,65 @@
determinism_to_code_model(cc_multidet, model_det).
determinism_to_code_model(erroneous, model_det).
determinism_to_code_model(failure, model_semi).
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- interface.
+
+:- type class_table == map(class_id, hlds_class_defn).
+
+:- type class_id ---> class_id(sym_name, arity).
+
+ % Information about a single `typeclass' declaration
+:- type hlds_class_defn
+ ---> hlds_class_defn(
+ list(class_constraint), % SuperClasses
+ list(var), % ClassVars
+ hlds_class_interface, % Methods
+ varset, % VarNames
+ term__context % Location of declaration
+ ).
+
+:- type hlds_class_interface == list(hlds_class_proc).
+:- type hlds_class_proc
+ ---> hlds_class_proc(
+ pred_id,
+ proc_id
+ ).
+
+ % For each class, we keep track of a list of its instances, since there
+ % can be more than one instance of each class.
+:- type instance_table == map(class_id, list(hlds_instance_defn)).
+
+ % Information about a single `instance' declaration
+:- type hlds_instance_defn
+ ---> hlds_instance_defn(
+ import_status, % import status of the instance
+ % declaration
+ list(class_constraint), % Constraints
+ list(type), % ClassTypes
+ instance_interface, % Methods
+ maybe(hlds_class_interface),
+ % After check_typeclass, we
+ % will know the pred_ids and
+ % proc_ids of all the methods
+ varset, % VarNames
+ map(class_constraint, constraint_proof)
+ % "Proofs" of how to build the
+ % typeclass_infos for the
+ % superclasses of this class,
+ % for this instance
+ ).
+
+ % `Proof' of why a constraint is redundant
+:- type constraint_proof
+ % Apply the following instance rule, the second
+ % argument being the number of the instance decl.
+ ---> apply_instance(hlds_instance_defn, int)
+
+ % The constraint is redundant because of the following
+ % class's superclass declaration
+ ; superclass(class_constraint).
%-----------------------------------------------------------------------------%
Index: compiler/hlds_goal.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/hlds_goal.m,v
retrieving revision 1.43
diff -u -r1.43 hlds_goal.m
--- hlds_goal.m 1997/12/09 04:00:39 1.43
+++ hlds_goal.m 1997/12/09 06:36:55
@@ -56,6 +56,16 @@
pred_or_func % call/N (pred) or apply/N (func)
)
+ ; class_method_call(
+ var, % the typeclass_info for the instance
+ int, % the number of the method to call
+ list(var), % the list of argument variables (other
+ % than this instance's typeclass_info)
+ list(type), % the types of the argument variables
+ list(mode), % the modes of the argument variables
+ determinism % the determinism of the called pred
+ )
+
% Deterministic disjunctions are converted
% into switches by the switch detection pass.
@@ -907,6 +917,7 @@
goal_is_atomic(conj([])).
goal_is_atomic(disj([], _)).
goal_is_atomic(higher_order_call(_,_,_,_,_,_)).
+goal_is_atomic(class_method_call(_,_,_,_,_,_)).
goal_is_atomic(call(_,_,_,_,_,_)).
goal_is_atomic(unify(_,_,_,_,_)).
goal_is_atomic(pragma_c_code(_,_,_,_,_,_,_,_)).
Index: compiler/hlds_module.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/hlds_module.m,v
retrieving revision 1.25
diff -u -r1.25 hlds_module.m
--- hlds_module.m 1997/09/01 04:17:55 1.25
+++ hlds_module.m 1997/09/08 04:12:21
@@ -7,7 +7,7 @@
% This module defines the part of the High Level Data Structure or HLDS
% that deals with issues that are wider than a single predicate.
-% The four main data structures defined here are the types
+% The three main data structures defined here are the types
%
% module_info
% dependency_info
@@ -179,6 +179,12 @@
:- pred module_info_ctors(module_info, cons_table).
:- mode module_info_ctors(in, out) is det.
+:- pred module_info_classes(module_info, class_table).
+:- mode module_info_classes(in, out) is det.
+
+:- pred module_info_instances(module_info, instance_table).
+:- mode module_info_instances(in, out) is det.
+
:- pred module_info_num_errors(module_info, int).
:- mode module_info_num_errors(in, out) is det.
@@ -243,6 +249,12 @@
:- pred module_info_set_ctors(module_info, cons_table, module_info).
:- mode module_info_set_ctors(in, in, out) is det.
+:- pred module_info_set_classes(module_info, class_table, module_info).
+:- mode module_info_set_classes(in, in, out) is det.
+
+:- pred module_info_set_instances(module_info, instance_table, module_info).
+:- mode module_info_set_instances(in, in, out) is det.
+
:- pred module_info_set_dependency_info(module_info, dependency_info,
module_info).
:- mode module_info_set_dependency_info(in, in, out) is det.
@@ -344,6 +356,8 @@
inst_table,
mode_table,
cons_table,
+ class_table,
+ instance_table,
maybe(dependency_info),
int, % number of errors
%%% num_warnings not used:
@@ -388,47 +402,49 @@
BaseTypeData = base_gen_data([], []),
set__init(StratPreds),
map__init(UnusedArgInfo),
+ map__init(ClassTable),
+ map__init(InstanceTable),
Module_Info = module(Name, C_Code_Info, PredicateTable, Requests,
- UnifyPredMap, ContinuationInfo, Types, Insts, Modes,
- Ctors, DepInfo, 0, 0, PragmaExports, BaseTypeData, Globals,
- StratPreds, UnusedArgInfo, 0).
+ UnifyPredMap, ContinuationInfo, Types, Insts, Modes, Ctors,
+ ClassTable, InstanceTable, DepInfo, 0, 0, PragmaExports,
+ BaseTypeData, Globals, StratPreds, UnusedArgInfo, 0).
% Various access predicates which extract different pieces
% of info from the module_info data structure.
module_info_name(ModuleInfo, Name) :-
- ModuleInfo = module(Name, _, _, _, _, _, _, _, _, _, _, _, _,
- _, _, _, _, _, _).
+ ModuleInfo = module(Name, _, _, _, _, _, _, _, _, _, _, _, _, _,
+ _, _, _, _, _, _, _).
module_info_get_c_header(ModuleInfo, C_Header) :-
- ModuleInfo = module(_, C_Code_Info, _, _, _, _, _, _, _, _, _, _,
- _, _, _, _, _, _, _),
+ ModuleInfo = module(_, C_Code_Info, _, _, _, _, _, _, _, _, _, _, _,
+ _, _, _, _, _, _, _, _),
C_Code_Info = c_code_info(C_Header, _).
module_info_set_c_header(ModuleInfo1, C_Header, ModuleInfo2) :-
ModuleInfo1 = module(A, C_Code_Info0,
- C, D, E, F, G, H, I, J, K, L, M, N, O, P, Q, R, S),
+ C, D, E, F, G, H, I, J, K, L, M, N, O, P, Q, R, S, T, U),
C_Code_Info0 = c_code_info(_C_Header0, C_Body),
C_Code_Info = c_code_info(C_Header, C_Body),
ModuleInfo2 = module(A, C_Code_Info,
- C, D, E, F, G, H, I, J, K, L, M, N, O, P, Q, R, S).
+ C, D, E, F, G, H, I, J, K, L, M, N, O, P, Q, R, S, T, U).
module_info_get_c_body_code(ModuleInfo, C_Body) :-
- ModuleInfo = module(_, C_Code_Info, _, _, _, _, _, _, _, _, _, _,
- _, _, _, _, _, _, _),
+ ModuleInfo = module(_, C_Code_Info, _, _, _, _, _, _, _, _, _, _, _,
+ _, _, _, _, _, _, _, _),
C_Code_Info = c_code_info(_, C_Body).
module_info_set_c_body_code(ModuleInfo1, C_Body, ModuleInfo2) :-
ModuleInfo1 = module(A, C_Code_Info0,
- C, D, E, F, G, H, I, J, K, L, M, N, O, P, Q, R, S),
+ C, D, E, F, G, H, I, J, K, L, M, N, O, P, Q, R, S, T, U),
C_Code_Info0 = c_code_info(C_Header, _C_Body0),
C_Code_Info = c_code_info(C_Header, C_Body),
ModuleInfo2 = module(A, C_Code_Info,
- C, D, E, F, G, H, I, J, K, L, M, N, O, P, Q, R, S).
+ C, D, E, F, G, H, I, J, K, L, M, N, O, P, Q, R, S, T, U).
module_info_get_predicate_table(ModuleInfo, PredicateTable) :-
ModuleInfo = module(_, _, PredicateTable,
- _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _).
+ _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _).
module_info_preds(ModuleInfo, Preds) :-
module_info_get_predicate_table(ModuleInfo, PredicateTable),
@@ -461,25 +477,25 @@
ModuleInfo).
module_info_get_unify_requests(ModuleInfo, Requests) :-
- ModuleInfo = module(_, _, _, Requests, _, _, _, _, _, _, _, _,
- _, _, _, _, _, _, _).
+ ModuleInfo = module(_, _, _, Requests, _, _, _, _, _, _, _, _, _,
+ _, _, _, _, _, _, _, _).
module_info_get_special_pred_map(ModuleInfo, SpecialPredMap) :-
ModuleInfo = module(_, _, _, _, SpecialPredMap,
- _, _, _, _, _, _, _, _, _, _, _, _, _, _).
+ _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _).
module_info_types(ModuleInfo, Types) :-
- ModuleInfo = module(_, _, _, _, _, _, Types, _, _, _, _, _, _,
- _, _, _, _, _, _).
+ ModuleInfo = module(_, _, _, _, _, _, Types, _, _, _, _, _, _, _,
+ _, _, _, _, _, _, _).
module_info_typeids(ModuleInfo, TypeIDs) :-
- ModuleInfo = module(_, _, _, _, _, _, Types, _, _, _, _, _, _,
- _, _, _, _, _, _),
+ ModuleInfo = module(_, _, _, _, _, _, Types, _, _, _, _, _, _, _,
+ _, _, _, _, _, _, _),
map__keys(Types, TypeIDs).
module_info_insts(ModuleInfo, Insts) :-
- ModuleInfo = module(_, _, _, _, _, _, _, Insts, _, _, _, _, _,
- _, _, _, _, _, _).
+ ModuleInfo = module(_, _, _, _, _, _, _, Insts, _, _, _, _, _, _,
+ _, _, _, _, _, _, _).
module_info_instids(ModuleInfo, InstIDs) :-
module_info_insts(ModuleInfo, InstTable),
@@ -487,25 +503,33 @@
user_inst_table_get_inst_ids(UserInstTable, InstIDs).
module_info_modes(ModuleInfo, Modes) :-
- ModuleInfo = module(_, _, _, _, _, _, _, _, Modes, _, _, _, _,
- _, _, _, _, _, _).
+ ModuleInfo = module(_, _, _, _, _, _, _, _, Modes, _, _, _, _, _,
+ _, _, _, _, _, _, _).
module_info_modeids(ModuleInfo, ModeIDs) :-
- ModuleInfo = module(_, _, _, _, _, _, _, _, Modes, _, _, _, _,
- _, _, _, _, _, _),
+ ModuleInfo = module(_, _, _, _, _, _, _, _, Modes, _, _, _, _, _,
+ _, _, _, _, _, _, _),
mode_table_get_mode_ids(Modes, ModeIDs).
module_info_ctors(ModuleInfo, Ctors) :-
- ModuleInfo = module(_, _, _, _, _, _, _, _, _, Ctors, _, _, _,
- _, _, _, _, _, _).
+ ModuleInfo = module(_, _, _, _, _, _, _, _, _, Ctors, _, _, _, _,
+ _, _, _, _, _, _, _).
+
+module_info_classes(ModuleInfo, Classes) :-
+ ModuleInfo = module(_, _, _, _, _, _, _, _, _, _, Classes, _, _, _,
+ _, _, _, _, _, _, _).
+
+module_info_instances(ModuleInfo, Instances) :-
+ ModuleInfo = module(_, _, _, _, _, _, _, _, _, _, _, Instances, _, _,
+ _, _, _, _, _, _, _).
module_info_consids(ModuleInfo, ConsIDs) :-
- ModuleInfo = module(_, _, _, _, _, _, _, _, _, Ctors, _, _, _,
- _, _, _, _, _, _),
+ ModuleInfo = module(_, _, _, _, _, _, _, _, _, Ctors, _, _, _, _,
+ _, _, _, _, _, _, _),
map__keys(Ctors, ConsIDs).
module_info_dependency_info(ModuleInfo, DepInfo) :-
- ModuleInfo = module(_, _, _, _, _, _, _, _, _, _, DepInfo0, _, _,
+ ModuleInfo = module(_, _, _, _, _, _, _, _, _, _, _, _, DepInfo0, _, _,
_, _, _, _, _, _),
( DepInfo0 = yes(DepInfo1) ->
DepInfo = DepInfo1
@@ -514,35 +538,35 @@
).
module_info_unused_arg_info(ModuleInfo, UnusedArgInfo) :-
- ModuleInfo = module(_, _, _, _, _, _, _, _, _, _, _, _, _,
+ ModuleInfo = module(_, _, _, _, _, _, _, _, _, _, _, _, _, _, _,
_, _, _, _, UnusedArgInfo, _).
module_info_dependency_info_built(ModuleInfo) :-
- ModuleInfo = module(_, _, _, _, _, _, _, _, _, _, yes(_), _, _,
+ ModuleInfo = module(_, _, _, _, _, _, _, _, _, _, _, _, yes(_), _, _,
_, _, _, _, _, _).
module_info_num_errors(ModuleInfo, NumErrors) :-
- ModuleInfo = module(_, _, _, _, _, _, _, _, _, _, _, NumErrors,
+ ModuleInfo = module(_, _, _, _, _, _, _, _, _, _, _, _, _, NumErrors,
_, _, _, _, _, _, _).
module_info_base_gen_infos(ModuleInfo, BaseGenInfos) :-
- ModuleInfo = module(_, _, _, _, _, _, _, _, _, _, _, _, _, _,
+ ModuleInfo = module(_, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _,
base_gen_data(BaseGenInfos, _), _, _, _, _).
module_info_base_gen_layouts(ModuleInfo, BaseGenLayouts) :-
- ModuleInfo = module(_, _, _, _, _, _, _, _, _, _, _, _, _, _,
+ ModuleInfo = module(_, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _,
base_gen_data(_, BaseGenLayouts), _, _, _, _).
module_info_globals(ModuleInfo, Globals) :-
- ModuleInfo = module(_, _, _, _, _, _, _, _, _, _, _, _, _, _, _,
+ ModuleInfo = module(_, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _,
Globals, _, _, _).
module_info_stratified_preds(ModuleInfo, StratPreds) :-
- ModuleInfo = module(_, _, _, _, _, _, _, _, _, _, _, _, _, _, _,
+ ModuleInfo = module(_, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _,
_, StratPreds, _, _).
module_info_get_cell_count(ModuleInfo, CellCount) :-
- ModuleInfo = module(_, _, _, _, _, _, _, _, _, _, _, _, _, _, _,
+ ModuleInfo = module(_, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _,
_, _, _, CellCount).
% not used:
@@ -553,15 +577,15 @@
module_info_set_name(ModuleInfo0, Name, ModuleInfo) :-
ModuleInfo0 = module(_, B, C, D, E, F, G, H, I, J, K, L, M, N,
- O, P, Q, R, S),
+ O, P, Q, R, S, T, U),
ModuleInfo = module(Name, B, C, D, E, F, G, H, I, J, K, L, M, N,
- O, P, Q, R, S).
+ O, P, Q, R, S, T, U).
module_info_set_predicate_table(ModuleInfo0, PredicateTable, ModuleInfo) :-
ModuleInfo0 = module(A, B, _, D, E, F, G, H, I, J, K, L, M, N,
- O, P, Q, R, S),
+ O, P, Q, R, S, T, U),
ModuleInfo = module(A, B, PredicateTable,
- D, E, F, G, H, I, J, K, L, M, N, O, P, Q, R, S).
+ D, E, F, G, H, I, J, K, L, M, N, O, P, Q, R, S, T, U).
module_info_set_preds(ModuleInfo0, Preds, ModuleInfo) :-
module_info_get_predicate_table(ModuleInfo0, PredicateTable0),
@@ -576,70 +600,82 @@
module_info_set_unify_requests(ModuleInfo0, Requests, ModuleInfo) :-
ModuleInfo0 = module(A, B, C, _, E, F, G, H, I, J, K, L, M, N,
- O, P, Q, R, S),
+ O, P, Q, R, S, T, U),
ModuleInfo = module(A, B, C, Requests, E, F, G, H, I, J, K, L,
- M, N, O, P, Q, R, S).
+ M, N, O, P, Q, R, S, T, U).
module_info_set_special_pred_map(ModuleInfo0, SpecialPredMap, ModuleInfo) :-
ModuleInfo0 = module(A, B, C, D, _, F, G, H, I, J, K, L, M,
- N, O, P, Q, R, S),
+ N, O, P, Q, R, S, T, U),
ModuleInfo = module(A, B, C, D, SpecialPredMap,
- F, G, H, I, J, K, L, M, N, O, P, Q, R, S).
+ F, G, H, I, J, K, L, M, N, O, P, Q, R, S, T, U).
module_info_set_continuation_info(ModuleInfo0, ContinuationInfo, ModuleInfo) :-
ModuleInfo0 = module(A, B, C, D, E, _, G, H, I, J, K, L, M, N,
- O, P, Q, R, S),
+ O, P, Q, R, S, T, U),
ModuleInfo = module(A, B, C, D, E, ContinuationInfo, G, H, I, J, K, L,
- M, N, O, P, Q, R, S).
+ M, N, O, P, Q, R, S, T, U).
module_info_set_types(ModuleInfo0, Types, ModuleInfo) :-
ModuleInfo0 = module(A, B, C, D, E, F, _, H, I, J, K, L, M, N,
- O, P, Q, R, S),
+ O, P, Q, R, S, T, U),
ModuleInfo = module(A, B, C, D, E, F, Types, H, I, J, K, L, M,
- N, O, P, Q, R, S).
+ N, O, P, Q, R, S, T, U).
module_info_set_insts(ModuleInfo0, Insts, ModuleInfo) :-
ModuleInfo0 = module(A, B, C, D, E, F, G, _, I, J, K, L, M, N,
- O, P, Q, R, S),
+ O, P, Q, R, S, T, U),
ModuleInfo = module(A, B, C, D, E, F, G, Insts, I, J, K, L, M,
- N, O, P, Q, R, S).
+ N, O, P, Q, R, S, T, U).
module_info_set_modes(ModuleInfo0, Modes, ModuleInfo) :-
ModuleInfo0 = module(A, B, C, D, E, F, G, H, _, J, K, L, M, N,
- O, P, Q, R, S),
+ O, P, Q, R, S, T, U),
ModuleInfo = module(A, B, C, D, E, F, G, H, Modes, J, K, L, M,
- N, O, P, Q, R, S).
+ N, O, P, Q, R, S, T, U).
module_info_set_ctors(ModuleInfo0, Ctors, ModuleInfo) :-
ModuleInfo0 = module(A, B, C, D, E, F, G, H, I, _, K, L, M, N,
- O, P, Q, R, S),
+ O, P, Q, R, S, T, U),
ModuleInfo = module(A, B, C, D, E, F, G, H, I, Ctors, K, L, M,
- N, O, P, Q, R, S).
+ N, O, P, Q, R, S, T, U).
-module_info_set_dependency_info(ModuleInfo0, DepInfo, ModuleInfo) :-
+module_info_set_classes(ModuleInfo0, Classes, ModuleInfo) :-
ModuleInfo0 = module(A, B, C, D, E, F, G, H, I, J, _, L, M, N,
- O, P, Q, R, S),
- ModuleInfo = module(A, B, C, D, E, F, G, H, I, J, yes(DepInfo),
- L, M, N, O, P, Q, R, S).
+ O, P, Q, R, S, T, U),
+ ModuleInfo = module(A, B, C, D, E, F, G, H, I, J, Classes, L, M,
+ N, O, P, Q, R, S, T, U).
+
+module_info_set_instances(ModuleInfo0, Instances, ModuleInfo) :-
+ ModuleInfo0 = module(A, B, C, D, E, F, G, H, I, J, K, _, M, N,
+ O, P, Q, R, S, T, U),
+ ModuleInfo = module(A, B, C, D, E, F, G, H, I, J, K, Instances, M,
+ N, O, P, Q, R, S, T, U).
+
+module_info_set_dependency_info(ModuleInfo0, DepInfo, ModuleInfo) :-
+ ModuleInfo0 = module(A, B, C, D, E, F, G, H, I, J, K, L, _, N,
+ O, P, Q, R, S, T, U),
+ ModuleInfo = module(A, B, C, D, E, F, G, H, I, J, K, L, yes(DepInfo),
+ N, O, P, Q, R, S, T, U).
module_info_clobber_dependency_info(ModuleInfo0, ModuleInfo) :-
- ModuleInfo0 = module(A, B, C, D, E, F, G, H, I, J, _,
- L, M, N, O, P, Q, R, S),
- ModuleInfo = module(A, B, C, D, E, F, G, H, I, J, no,
- L, M, N, O, P, Q, R, S).
+ ModuleInfo0 = module(A, B, C, D, E, F, G, H, I, J, K,
+ L, _, N, O, P, Q, R, S, T, U),
+ ModuleInfo = module(A, B, C, D, E, F, G, H, I, J, K, L, no,
+ N, O, P, Q, R, S, T, U).
module_info_set_num_errors(ModuleInfo0, Errs, ModuleInfo) :-
- ModuleInfo0 = module(A, B, C, D, E, F, G, H, I, J, K, _, M, N,
- O, P, Q, R, S),
- ModuleInfo = module(A, B, C, D, E, F, G, H, I, J, K, Errs, M, N,
- O, P, Q, R, S).
+ ModuleInfo0 = module(A, B, C, D, E, F, G, H, I, J, K, L, M, _,
+ O, P, Q, R, S, T, U),
+ ModuleInfo = module(A, B, C, D, E, F, G, H, I, J, K, L, M, Errs,
+ O, P, Q, R, S, T, U).
module_info_incr_errors(ModuleInfo0, ModuleInfo) :-
- ModuleInfo0 = module(A, B, C, D, E, F, G, H, I, J, K, Errs0, M,
- N, O, P, Q, R, S),
+ ModuleInfo0 = module(A, B, C, D, E, F, G, H, I, J, K, L, M, Errs0,
+ O, P, Q, R, S, T, U),
Errs is Errs0 + 1,
- ModuleInfo = module(A, B, C, D, E, F, G, H, I, J, K, Errs, M, N,
- O, P, Q, R, S).
+ ModuleInfo = module(A, B, C, D, E, F, G, H, I, J, K, L, M, Errs,
+ O, P, Q, R, S, T, U).
/* not used
module_info_incr_warnings(ModuleInfo0, ModuleInfo) :-
@@ -648,55 +684,55 @@
ModuleInfo = module(A, B, C, D, E, F, G, H, I, J, K, L, Warns).
*/
module_info_next_lambda_count(ModuleInfo0, Count, ModuleInfo) :-
- ModuleInfo0 = module(A, B, C, D, E, F, G, H, I, J, K, L, Count0, N, O,
- P, Q, R, S),
+ ModuleInfo0 = module(A, B, C, D, E, F, G, H, I, J, K, L, M, Count0, O,
+ P, Q, R, S, T, U),
Count is Count0 + 1,
- ModuleInfo = module(A, B, C, D, E, F, G, H, I, J, K, L, Count,
- N, O, P, Q, R, S).
+ ModuleInfo = module(A, B, C, D, E, F, G, H, I, J, K, L, M, Count, O,
+ P, Q, R, S, T, U).
module_info_get_continuation_info(ModuleInfo, ContinuationInfo) :-
ModuleInfo = module(_, _, _, _, _, ContinuationInfo, _, _, _, _, _, _,
- _, _, _, _, _, _, _).
+ _, _, _, _, _, _, _, _, _).
module_info_get_pragma_exported_procs(ModuleInfo, Procs) :-
- ModuleInfo = module(_, _, _, _, _, _, _, _, _, _, _, _, _,
+ ModuleInfo = module(_, _, _, _, _, _, _, _, _, _, _, _, _, _, _,
Procs, _, _, _, _, _).
module_info_set_pragma_exported_procs(ModuleInfo0, Procs, ModuleInfo) :-
- ModuleInfo0 = module(A, B, C, D, E, F, G, H, I, J, K, L, M, _,
- O, P, Q, R, S),
- ModuleInfo = module(A, B, C, D, E, F, G, H, I, J, K, L, M, Procs,
- O, P, Q, R, S).
+ ModuleInfo0 = module(A, B, C, D, E, F, G, H, I, J, K, L, M, N,
+ O, _, Q, R, S, T, U),
+ ModuleInfo = module(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O, Procs,
+ Q, R, S, T, U).
module_info_set_base_gen_infos(ModuleInfo0, BaseGenInfos, ModuleInfo) :-
- ModuleInfo0 = module(A, B, C, D, E, F, G, H, I, J, K, L, M, N,
- base_gen_data(_, BaseGenLayouts), P, Q, R, S),
- ModuleInfo = module(A, B, C, D, E, F, G, H, I, J, K, L, M, N,
- base_gen_data(BaseGenInfos, BaseGenLayouts), P, Q, R, S).
+ ModuleInfo0 = module(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O, P,
+ base_gen_data(_, BaseGenLayouts), R, S, T, U),
+ ModuleInfo = module(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O, P,
+ base_gen_data(BaseGenInfos, BaseGenLayouts), R, S, T, U).
module_info_set_base_gen_layouts(ModuleInfo0, BaseGenLayouts, ModuleInfo) :-
- ModuleInfo0 = module(A, B, C, D, E, F, G, H, I, J, K, L, M, N,
- base_gen_data(BaseGenInfos, _), P, Q, R, S),
- ModuleInfo = module(A, B, C, D, E, F, G, H, I, J, K, L, M, N,
- base_gen_data(BaseGenInfos, BaseGenLayouts), P, Q, R, S).
+ ModuleInfo0 = module(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O, P,
+ base_gen_data(BaseGenInfos, _), R, S, T, U),
+ ModuleInfo = module(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O, P,
+ base_gen_data(BaseGenInfos, BaseGenLayouts), R, S, T, U).
module_info_set_stratified_preds(ModuleInfo0, StratPreds, ModuleInfo) :-
ModuleInfo0 = module(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O,
- P, _, R, S),
+ P, Q, R, _, T, U),
ModuleInfo = module(A, B, C, D, E, F, G, H, I, J, K, L, M, N,
- O, P, StratPreds, R, S).
+ O, P, Q, R, StratPreds, T, U).
module_info_set_unused_arg_info(ModuleInfo0, UnusedArgInfo, ModuleInfo) :-
ModuleInfo0 = module(A, B, C, D, E, F, G, H, I, J, K,
- L, M, N, O, P, Q, _, S),
+ L, M, N, O, P, Q, R, S, _, U),
ModuleInfo = module(A, B, C, D, E, F, G, H, I, J, K,
- L, M, N, O, P, Q, UnusedArgInfo, S).
+ L, M, N, O, P, Q, R, S, UnusedArgInfo, U).
module_info_set_cell_count(ModuleInfo0, CellCount, ModuleInfo) :-
ModuleInfo0 = module(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O,
- P, Q, R, _),
+ P, Q, R, S, T, _),
ModuleInfo = module(A, B, C, D, E, F, G, H, I, J, K, L, M, N,
- O, P, Q, R, CellCount).
+ O, P, Q, R, S, T, CellCount).
module_info_remove_predid(ModuleInfo0, PredId, ModuleInfo) :-
module_info_get_predicate_table(ModuleInfo0, PredicateTable0),
Index: compiler/hlds_out.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/hlds_out.m,v
retrieving revision 1.177
diff -u -r1.177 hlds_out.m
--- hlds_out.m 1997/12/11 21:20:51 1.177
+++ hlds_out.m 1997/12/18 07:37:29
@@ -205,6 +205,8 @@
hlds_out__cons_id_to_string(pred_const(_, _), "<pred>").
hlds_out__cons_id_to_string(code_addr_const(_, _), "<code_addr>").
hlds_out__cons_id_to_string(base_type_info_const(_, _, _), "<base_type_info>").
+hlds_out__cons_id_to_string(base_typeclass_info_const(_, _, _),
+ "<base_typeclass_info>").
hlds_out__write_cons_id(cons(SymName, Arity)) -->
(
@@ -231,6 +233,8 @@
io__write_string("<code_addr>").
hlds_out__write_cons_id(base_type_info_const(_, _, _)) -->
io__write_string("<base_type_info>").
+hlds_out__write_cons_id(base_typeclass_info_const(_, _, _)) -->
+ io__write_string("<base_typeclass_info>").
hlds_out__write_pred_id(ModuleInfo, PredId) -->
{ module_info_pred_info(ModuleInfo, PredId, PredInfo) },
@@ -452,8 +456,9 @@
{ pred_info_import_status(PredInfo, ImportStatus) },
{ pred_info_get_markers(PredInfo, Markers) },
{ pred_info_get_is_pred_or_func(PredInfo, PredOrFunc) },
- mercury_output_pred_type(TVarSet, qualified(Module, PredName),
- ArgTypes, no, pure, Context),
+ { pred_info_get_class_context(PredInfo, ClassContext) },
+ mercury_output_pred_type(TVarSet, qualified(Module, PredName),
+ ArgTypes, no, pure, ClassContext, Context),
{ ClausesInfo = clauses_info(VarSet, _, VarTypes, HeadVars, Clauses) },
hlds_out__write_indent(Indent),
io__write_string("% pred id: "),
@@ -491,7 +496,12 @@
hlds_out__write_procs(Indent, AppendVarnums, ModuleInfo, PredId,
ImportStatus, ProcTable),
- io__write_string("\n").
+ io__write_string("\n"),
+
+ io__write_string("\n% Class Table:\n"),
+ { module_info_classes(ModuleInfo, ClassTable) },
+ % XXX fix this up.
+ io__print(ClassTable).
:- pred hlds_out__write_marker_list(list(marker), io__state, io__state).
:- mode hlds_out__write_marker_list(in, di, uo) is det.
@@ -509,6 +519,7 @@
hlds_out__marker_name(magic, "magic").
hlds_out__marker_name(obsolete, "obsolete").
hlds_out__marker_name(memo, "memo").
+hlds_out__marker_name(class_method, "class_method").
hlds_out__marker_name((impure), "impure").
hlds_out__marker_name((semipure), "semipure").
hlds_out__marker_name(promised_pure, "promise_pure").
@@ -999,6 +1010,22 @@
io__write_string(Follow),
io__write_string("\n").
+hlds_out__write_goal_2(class_method_call(TCInfoVar, _, ArgVars, _, _, _),
+ _ModuleInfo, VarSet, AppendVarnums, Indent, Follow, _) -->
+ % XXX we should print more info here too
+ globals__io_lookup_string_option(verbose_dump_hlds, Verbose),
+ hlds_out__write_indent(Indent),
+ ( { string__contains_char(Verbose, 'l') } ->
+ io__write_string("% class method call"),
+ hlds_out__write_indent(Indent)
+ ;
+ []
+ ),
+ hlds_out__write_functor(term__atom("class_method_call"),
+ [TCInfoVar|ArgVars], VarSet, AppendVarnums),
+ io__write_string(Follow),
+ io__write_string("\n").
+
hlds_out__write_goal_2(call(PredId, ProcId, ArgVars, Builtin,
MaybeUnifyContext, PredName),
ModuleInfo, VarSet, AppendVarnums, Indent, Follow, TypeQual) -->
@@ -1370,6 +1397,19 @@
io__write_string(""", "),
io__write_int(Arity),
io__write_string(")")
+ ;
+ { ConsId = base_typeclass_info_const(Module,
+ class_id(Name, Arity), Instance) },
+ io__write_string("base_typeclass_info("""),
+ io__write_string(Module),
+ io__write_string(""", """),
+ io__write_string("class_id("),
+ prog_out__write_sym_name(Name),
+ io__write_string(", "),
+ io__write_int(Arity),
+ io__write_string("), "),
+ io__write_string(Instance),
+ io__write_string(")")
).
hlds_out__write_var_modes([], [], _, _) --> [].
@@ -1583,8 +1623,8 @@
hlds_out__write_var_types_2(Vars, Indent, VarSet, AppendVarnums,
VarTypes, TypeVarSet).
-:- pred hlds_out__write_typeinfo_varmap(int, bool, map(tvar, var), varset,
- tvarset, io__state, io__state).
+:- pred hlds_out__write_typeinfo_varmap(int, bool, map(tvar, type_info_locn),
+ varset, tvarset, io__state, io__state).
:- mode hlds_out__write_typeinfo_varmap(in, in, in, in, in, di, uo) is det.
hlds_out__write_typeinfo_varmap(Indent, AppendVarnums, TypeInfoMap, VarSet,
@@ -1596,7 +1636,7 @@
TypeInfoMap, VarSet, TVarSet).
:- pred hlds_out__write_typeinfo_varmap_2(list(tvar), int, bool,
- map(tvar, var), varset, tvarset, io__state, io__state).
+ map(tvar, type_info_locn), varset, tvarset, io__state, io__state).
:- mode hlds_out__write_typeinfo_varmap_2(in, in, in, in, in, in, di, uo)
is det.
@@ -1613,8 +1653,20 @@
io__write_string(")"),
io__write_string(" -> "),
- { map__lookup(TypeInfoMap, TVar, Var) },
- mercury_output_var(Var, VarSet, AppendVarnums),
+ { map__lookup(TypeInfoMap, TVar, Locn) },
+ (
+ { Locn = type_info(Var) },
+ io__write_string("type_info("),
+ mercury_output_var(Var, VarSet, AppendVarnums),
+ io__write_string(") ")
+ ;
+ { Locn = typeclass_info(Var, Index) },
+ io__write_string("typeclass_info("),
+ mercury_output_var(Var, VarSet, AppendVarnums),
+ io__write_string(", "),
+ io__write_int(Index),
+ io__write_string(") ")
+ ),
io__write_string(" (number "),
{ term__var_to_int(Var, VarNum) },
io__write_int(VarNum),
Index: compiler/hlds_pred.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/hlds_pred.m,v
retrieving revision 1.39
diff -u -r1.39 hlds_pred.m
--- hlds_pred.m 1997/12/09 04:00:45 1.39
+++ hlds_pred.m 1997/12/15 06:42:33
@@ -186,7 +186,7 @@
% for undeclared predicates.
; obsolete % Requests warnings if this predicate is used.
% Used for pragma(obsolete).
- ; inline % Requests that this be predicate be inlined.
+ ; inline % Requests that this predicate be inlined.
% Used for pragma(inline).
; no_inline % Requests that this be predicate not be
% inlined.
@@ -201,6 +201,8 @@
; memo % Requests that this predicate be evaluated
% using memoing.
% Used for pragma(memo).
+ ; class_method % Requests that this predicate be transformed
+ % into the appropriate call to a class method
; (impure) % Requests that no transformation that would
% be inappropriate for impure code be
% performed on calls to this predicate. This
@@ -237,41 +239,59 @@
% then it must give an error message.
.
+:- type marker_status
+ ---> request(marker)
+ ; done(marker).
+
+:- type type_info_locn
+ ---> type_info(var) % it is a normal type info
+ % (ie. the type is not constrained)
+ ; typeclass_info(var, int).
+ % it is packed inside a typeclass_info,
+ % and is at the given offset
+:- pred type_info_locn_var(type_info_locn::in, var::out) is det.
+
+:- pred type_info_locn_set_var(type_info_locn::in, var::in,
+ type_info_locn::out) is det.
% hlds_pred__define_new_pred(Goal, CallGoal, Args, InstMap, PredName,
- % TVarSet, VarTypes, VarSet, Markers, ModuleInfo0, ModuleInfo,
- % PredProcId)
+ % TVarSet, VarTypes, ClassContext, VarSet, Markers, ModuleInfo0,
+ % ModuleInfo, PredProcId)
%
% Create a new predicate for the given goal, returning a goal to
% call the created predicate. This must only be called after
% polymorphism.m.
:- pred hlds_pred__define_new_pred(hlds_goal, hlds_goal, list(var),
- instmap, string, tvarset, map(var, type), varset,
+ instmap, string, tvarset, map(var, type),
+ list(class_constraint), varset,
pred_markers, module_info, module_info, pred_proc_id).
:- mode hlds_pred__define_new_pred(in, out, in, in, in,
- in, in, in, in, in, out, out) is det.
+ in, in, in, in, in, in, out, out) is det.
% Various predicates for accessing the information stored in the
% pred_id and pred_info data structures.
:- pred pred_info_init(module_name, sym_name, arity, tvarset, list(type),
condition, term__context, clauses_info, import_status,
- pred_markers, goal_type, pred_or_func, pred_info).
-:- mode pred_info_init(in, in, in, in, in, in, in, in, in, in, in, in, out)
- is det.
+ pred_markers, goal_type, pred_or_func, list(class_constraint),
+ map(class_constraint, constraint_proof), pred_info).
+:- mode pred_info_init(in, in, in, in, in, in, in, in, in, in, in, in, in, in,
+ out) is det.
:- pred pred_info_create(module_name, sym_name, tvarset, list(type),
condition, term__context, import_status, pred_markers,
- pred_or_func, proc_info, proc_id, pred_info).
-:- mode pred_info_create(in, in, in, in, in, in, in, in, in, in, out, out)
+ pred_or_func, list(class_constraint), proc_info, proc_id, pred_info).
+:- mode pred_info_create(in, in, in, in, in, in, in, in, in, in, in, out, out)
is det.
:- pred pred_info_set(tvarset, list(type), condition, clauses_info, proc_table,
term__context, module_name, string, arity, import_status,
- tvarset, goal_type, pred_markers, pred_or_func, pred_info).
-:- mode pred_info_set(in, in, in, in, in, in, in, in, in, in, in, in, in, in,
- out) is det.
+ tvarset, goal_type, pred_markers, pred_or_func,
+ list(class_constraint), map(class_constraint, constraint_proof),
+ pred_info).
+:- mode pred_info_set(in, in, in, in, in, in, in, in, in, in, in, in, in, in,
+ in, in, out) is det.
:- pred pred_info_module(pred_info, module_name).
:- mode pred_info_module(in, out) is det.
@@ -364,6 +384,24 @@
:- pred pred_info_requested_no_inlining(pred_info).
:- mode pred_info_requested_no_inlining(in) is semidet.
+:- pred pred_info_get_is_pred_or_func(pred_info, pred_or_func).
+:- mode pred_info_get_is_pred_or_func(in, out) is det.
+
+:- pred pred_info_get_class_context(pred_info, list(class_constraint)).
+:- mode pred_info_get_class_context(in, out) is det.
+
+:- pred pred_info_set_class_context(pred_info, list(class_constraint),
+ pred_info).
+:- mode pred_info_set_class_context(in, in, out) is det.
+
+:- pred pred_info_get_constraint_proofs(pred_info,
+ map(class_constraint, constraint_proof)).
+:- mode pred_info_get_constraint_proofs(in, out) is det.
+
+:- pred pred_info_set_constraint_proofs(pred_info,
+ map(class_constraint, constraint_proof), pred_info).
+:- mode pred_info_set_constraint_proofs(in, in, out) is det.
+
:- pred pred_info_get_purity(pred_info, purity).
:- mode pred_info_get_purity(in, out) is det.
@@ -373,9 +411,6 @@
:- pred purity_to_markers(purity, pred_markers).
:- mode purity_to_markers(in, out) is det.
-:- pred pred_info_get_is_pred_or_func(pred_info, pred_or_func).
-:- mode pred_info_get_is_pred_or_func(in, out) is det.
-
:- type pred_markers.
:- pred pred_info_get_markers(pred_info, pred_markers).
@@ -462,21 +497,31 @@
% this pred are clauses,
% pragma(c_code, ...) decs, or none
pred_markers, % various boolean flags
- pred_or_func % whether this "predicate" was really
+ pred_or_func, % whether this "predicate" was really
% a predicate or a function
+ list(class_constraint),
+ % the class constraints on the
+ % predicate
+ map(class_constraint, constraint_proof)
+ % explanations of how redundant
+ % constraints were eliminated. These
+ % are needed by polymorphism.m to
+ % work out where to get the
+ % typeclass_infos from.
).
pred_info_init(ModuleName, SymName, Arity, TypeVarSet, Types, Cond, Context,
- ClausesInfo, Status, Markers, GoalType, PredOrFunc, PredInfo) :-
+ ClausesInfo, Status, Markers, GoalType, PredOrFunc,
+ ClassContext, ClassProofs, PredInfo) :-
map__init(Procs),
unqualify_name(SymName, PredName),
sym_name_get_module_name(SymName, ModuleName, PredModuleName),
PredInfo = predicate(TypeVarSet, Types, Cond, ClausesInfo, Procs,
Context, PredModuleName, PredName, Arity, Status, TypeVarSet,
- GoalType, Markers, PredOrFunc).
+ GoalType, Markers, PredOrFunc, ClassContext, ClassProofs).
pred_info_create(ModuleName, SymName, TypeVarSet, Types, Cond, Context,
- Status, Markers, PredOrFunc, ProcInfo, ProcId,
+ Status, Markers, PredOrFunc, ClassContext, ProcInfo, ProcId,
PredInfo) :-
map__init(Procs0),
proc_info_declared_determinism(ProcInfo, MaybeDetism),
@@ -489,19 +534,22 @@
unqualify_name(SymName, PredName),
% The empty list of clauses is a little white lie.
ClausesInfo = clauses_info(VarSet, VarTypes, VarTypes, HeadVars, []),
+ map__init(ClassProofs),
PredInfo = predicate(TypeVarSet, Types, Cond, ClausesInfo, Procs,
Context, ModuleName, PredName, Arity, Status, TypeVarSet,
- clauses, Markers, PredOrFunc).
+ clauses, Markers, PredOrFunc, ClassContext, ClassProofs).
pred_info_set(HeadTVarSet, Types, Cond, ClausesInfo, Procs, Context,
PredModuleName, PredName, Arity, Status, AllTVarSet,
- GoalType, Markers, PredOrFunc, PredInfo) :-
+ GoalType, Markers, PredOrFunc, ClassContext, ClassProofs,
+ PredInfo) :-
PredInfo = predicate(HeadTVarSet, Types, Cond, ClausesInfo, Procs,
Context, PredModuleName, PredName, Arity, Status, AllTVarSet,
- GoalType, Markers, PredOrFunc).
+ GoalType, Markers, PredOrFunc, ClassContext, ClassProofs).
pred_info_procids(PredInfo, ProcIds) :-
- PredInfo = predicate(_, _, _, _, Procs, _, _, _, _, _, _, _, _, _),
+ PredInfo = predicate(_, _, _, _, Procs, _, _, _, _, _, _, _,
+ _, _, _, _),
map__keys(Procs, ProcIds).
pred_info_non_imported_procids(PredInfo, ProcIds) :-
@@ -527,43 +575,51 @@
).
pred_info_clauses_info(PredInfo, Clauses) :-
- PredInfo = predicate(_, _, _, Clauses, _, _, _, _, _, _, _, _, _, _).
+ PredInfo = predicate(_, _, _, Clauses, _, _, _, _, _, _, _, _,
+ _, _, _, _).
pred_info_set_clauses_info(PredInfo0, Clauses, PredInfo) :-
- PredInfo0 = predicate(A, B, C, _, E, F, G, H, I, J, K, L, M, N),
- PredInfo = predicate(A, B, C, Clauses, E, F, G, H, I, J, K, L, M, N).
+ PredInfo0 = predicate(A, B, C, _, E, F, G, H, I, J, K, L, M, N, O, P),
+ PredInfo = predicate(A, B, C, Clauses, E, F, G, H, I, J, K,
+ L, M, N, O, P).
pred_info_arg_types(PredInfo, TypeVars, ArgTypes) :-
PredInfo = predicate(TypeVars, ArgTypes,
- _, _, _, _, _, _, _, _, _, _, _, _).
+ _, _, _, _, _, _, _, _, _, _, _, _, _, _).
pred_info_set_arg_types(PredInfo0, TypeVarSet, ArgTypes, PredInfo) :-
- PredInfo0 = predicate(_, _, C, D, E, F, G, H, I, J, K, L, M, N),
+ PredInfo0 = predicate(_, _, C, D, E, F, G, H, I, J, K, L, M, N, O, P),
PredInfo = predicate(TypeVarSet, ArgTypes,
- C, D, E, F, G, H, I, J, K, L, M, N).
+ C, D, E, F, G, H, I, J, K, L, M, N, O, P).
pred_info_procedures(PredInfo, Procs) :-
- PredInfo = predicate(_, _, _, _, Procs, _, _, _, _, _, _, _, _, _).
+ PredInfo = predicate(_, _, _, _, Procs, _, _, _, _, _, _,
+ _, _, _, _, _).
pred_info_set_procedures(PredInfo0, Procedures, PredInfo) :-
- PredInfo0 = predicate(A, B, C, D, _, F, G, H, I, J, K, L, M, N),
- PredInfo = predicate(A, B, C, D, Procedures, F, G, H, I, J, K, L, M, N).
+ PredInfo0 = predicate(A, B, C, D, _, F, G, H, I, J, K, L, M, N, O, P),
+ PredInfo = predicate(A, B, C, D, Procedures, F, G, H, I, J, K, L, M,
+ N, O, P).
pred_info_context(PredInfo, Context) :-
- PredInfo = predicate(_, _, _, _, _, Context, _, _, _, _, _, _, _, _).
+ PredInfo = predicate(_, _, _, _, _, Context, _, _, _,
+ _, _, _, _, _, _, _).
pred_info_module(PredInfo, Module) :-
- PredInfo = predicate(_, _, _, _, _, _, Module, _, _, _, _, _, _, _).
+ PredInfo = predicate(_, _, _, _, _, _, Module, _, _, _, _,
+ _, _, _, _, _).
pred_info_name(PredInfo, PredName) :-
- PredInfo = predicate(_, _, _, _, _, _, _, PredName, _, _, _, _, _, _).
+ PredInfo = predicate(_, _, _, _, _, _, _, PredName, _, _, _,
+ _, _, _, _, _).
pred_info_arity(PredInfo, Arity) :-
- PredInfo = predicate(_, _, _, _, _, _, _, _, Arity, _, _, _, _, _).
+ PredInfo = predicate(_, _, _, _, _, _, _, _, Arity, _, _,
+ _, _, _, _, _).
pred_info_import_status(PredInfo, ImportStatus) :-
PredInfo = predicate(_, _, _, _, _, _, _, _, _, ImportStatus, _, _, _,
- _).
+ _, _, _).
pred_info_is_imported(PredInfo) :-
pred_info_import_status(PredInfo, imported).
@@ -581,27 +637,32 @@
ImportStatus = pseudo_exported.
pred_info_mark_as_external(PredInfo0, PredInfo) :-
- 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, imported, 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, imported, K, L, M,
+ N, O, P).
pred_info_set_import_status(PredInfo0, Status, PredInfo) :-
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