diff: support partial module qualifiers
Fergus Henderson
fjh at cs.mu.OZ.AU
Thu Mar 5 06:15:16 AEDT 1998
Add support for the use of partial module qualifiers,
e.g. using `child:foo' to refer to `parent:child:foo'.
Previously we only allowed names to be fully-qualified
or completely unqualified.
Note that we still don't yet keep track of which modules are visible,
so this change does not properly handle the distinction between
`import_module' and `use_module' declarations for parent modules.
It basically assumes that `child:foo' is allowed iff plain `foo'
would be allowed (i.e. iff `parent:child' has been imported)
whereas it ought to be allowed iff `parent' has been imported.
compiler/modules.m:
Add get_partial_qualifiers/2, for use by make_hlds.m
and hlds_module.m.
compiler/make_hlds.m:
Insert partially-qualified symbols into the cons_table.
compiler/hlds_module.m:
Insert partially-qualified symbols into the pred_table.
compiler/module_qual.m:
When searching the symbol tables used for types, insts, modes,
and typeclasses, search for partially-qualified symbols.
compiler/modecheck_unify.m:
When module-qualifying cons_ids, make sure that we fully module
qualify them even if they're already partially qualified.
tests/hard_coded/parent.m:
tests/hard_coded/parent.child.m:
tests/hard_coded/parent.child2.m:
tests/hard_coded/parent.exp:
tests/hard_coded/parent2.child.m:
tests/hard_coded/parent2.exp:
Uncomment the previously-failed test of using partially-qualified
symbol names. Add a new child module, `parent.child2', and import it
using `use_module', so that we test `use_module' as well as
`import_module'. Add code to test importing of types and
constructors.
cvs diff -N compiler/hlds_module.m compiler/make_hlds.m compiler/modecheck_unify.m compiler/module_qual.m compiler/modules.m tests/hard_coded/parent.child.m tests/hard_coded/parent.child2.m tests/hard_coded/parent.exp tests/hard_coded/parent.m tests/hard_coded/parent2.child.m tests/hard_coded/parent2.exp tests/hard_coded/parent2.m
Index: compiler/hlds_module.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_module.m,v
retrieving revision 1.31
diff -u -r1.31 hlds_module.m
--- hlds_module.m 1998/03/03 17:34:31 1.31
+++ hlds_module.m 1998/03/04 17:02:20
@@ -28,8 +28,8 @@
:- implementation.
:- import_module hlds_out, prog_out, prog_data, prog_util.
-:- import_module typecheck.
-:- import_module bool, require, int, string, set.
+:- import_module typecheck, modules.
+:- import_module bool, require, int, string, set, multi_map.
%-----------------------------------------------------------------------------%
@@ -1722,49 +1722,49 @@
predicate_table_do_insert(Module, Name, Arity, NeedQual, PredId,
N_Index0, N_Index, NA_Index0, NA_Index,
MNA_Index0, MNA_Index) :-
+
+ % XXX the code below doesn't handle mixing of
+ % `import_module' and `use_module' for
+ % parent & child modules properly.
+
( NeedQual = may_be_unqualified ->
- % insert the pred_id into the name index
- ( map__search(N_Index0, Name, N_PredIdList0) ->
- N_PredIdList = [PredId | N_PredIdList0],
- map__det_update(N_Index0, Name,
- N_PredIdList, N_Index)
- ;
- N_PredIdList = [PredId],
- map__det_insert(N_Index0, Name,
- N_PredIdList, N_Index)
- ),
+ % insert the unqualified name into the name index
+ multi_map__set(N_Index0, Name, PredId, N_Index),
- % insert it into the name/arity index
+ % insert the unqualified name/arity into the
+ % name/arity index
NA = Name / Arity,
- ( map__search(NA_Index0, NA, NA_PredIdList0) ->
- NA_PredIdList = [PredId | NA_PredIdList0],
- map__det_update(NA_Index0, NA,
- NA_PredIdList, NA_Index)
- ;
- NA_PredIdList = [PredId],
- map__det_insert(NA_Index0, NA,
- NA_PredIdList, NA_Index)
- )
+ multi_map__set(NA_Index0, NA, PredId, NA_Index),
+
+ % insert partially module-qualified versions
+ % of the name into the module:name/arity index
+ get_partial_qualifiers(Module, PartialQuals),
+ list__map_foldl(lambda([AncModule::in, AncModule::out,
+ MNAs0::in, MNAs::out] is det,
+ insert_into_mna_index(AncModule, Name, Arity, PredId,
+ MNAs0, MNAs)),
+ PartialQuals, _, MNA_Index0, MNA_Index1)
;
N_Index = N_Index0,
- NA_Index = NA_Index0
+ NA_Index = NA_Index0,
+ MNA_Index1 = MNA_Index0
),
-
- % insert it into the module:name/arity index
+ % insert the fully-qualified name into the
+ % module:name/arity index
+ insert_into_mna_index(Module, Name, Arity, PredId,
+ MNA_Index1, MNA_Index).
+
+:- pred insert_into_mna_index(module_name, string, arity, pred_id,
+ module_name_arity_index, module_name_arity_index).
+:- mode insert_into_mna_index(in, in, in, in, in, out) is det.
+insert_into_mna_index(Module, Name, Arity, PredId, MNA_Index0, MNA_Index) :-
( map__search(MNA_Index0, Module - Name, MN_Arities0) ->
- ( map__search(MN_Arities0, Arity, MNA_PredIdList0) ->
- map__det_update(MN_Arities0, Arity,
- [PredId | MNA_PredIdList0], MN_Arities)
- ;
- map__det_insert(MN_Arities0, Arity,
- [PredId], MN_Arities)
- ),
+ multi_map__set(MN_Arities0, Arity, PredId, MN_Arities),
map__det_update(MNA_Index0, Module - Name, MN_Arities,
MNA_Index)
;
map__init(MN_Arities0),
- map__det_insert(MN_Arities0, Arity,
- [PredId], MN_Arities),
+ map__det_insert(MN_Arities0, Arity, [PredId], MN_Arities),
map__det_insert(MNA_Index0, Module - Name, MN_Arities,
MNA_Index)
).
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.262
diff -u -r1.262 make_hlds.m
--- make_hlds.m 1998/03/03 17:35:00 1.262
+++ make_hlds.m 1998/03/04 17:32:43
@@ -63,7 +63,7 @@
:- import_module mercury_to_mercury, passes_aux, clause_to_proc, inst_match.
:- import_module fact_table, purity, goal_util, term_util, export, llds.
-:- import_module string, char, int, set, bintree, map, require.
+:- import_module string, char, int, set, bintree, map, multi_map, require.
:- import_module getopt, assoc_list, term_io, varset.
parse_tree_to_hlds(module(Name, Items), MQInfo0, EqvMap, Module,
@@ -1176,28 +1176,39 @@
{ QualifiedConsDefns = [ConsDefn | QualifiedConsDefns1] }
),
{ map__set(Ctors0, QualifiedConsId, QualifiedConsDefns, Ctors1) },
+
+ % XXX the code below does the wrong thing if you mix
+ % `import_module' and `use_module' declarations for
+ % parent and child modules.
+ % It assumes that all parents of an imported module were imported,
+ % and that all parents of a used module were used.
+
{
- QualifiedConsId = cons(qualified(_, ConsName), Arity),
+ QualifiedConsId = cons(qualified(Module, ConsName), Arity),
NeedQual = may_be_unqualified
->
- % Add an unqualified version of the cons_id to the cons_table.
+ % Add unqualified version of the cons_id to the cons_table.
UnqualifiedConsId = cons(unqualified(ConsName), Arity),
- (
- map__search(Ctors1, UnqualifiedConsId,
- UnqualifiedConsDefns)
- ->
- map__det_update(Ctors1, UnqualifiedConsId,
- [ConsDefn | UnqualifiedConsDefns], Ctors2)
- ;
- map__det_insert(Ctors1, UnqualifiedConsId,
- [ConsDefn], Ctors2)
- )
+ multi_map__set(Ctors1, UnqualifiedConsId, ConsDefn, Ctors2),
+
+ % Add partially qualified versions of the cons_id
+ get_partial_qualifiers(Module, PartialQuals),
+ list__map_foldl(add_ctor(ConsName, Arity, ConsDefn),
+ PartialQuals, _PartiallyQualifiedConsIds,
+ Ctors2, Ctors3)
;
- Ctors2 = Ctors1
+ Ctors3 = Ctors1
},
- ctors_add(Rest, TypeId, NeedQual, Context, Ctors2, Ctors).
+ ctors_add(Rest, TypeId, NeedQual, Context, Ctors3, Ctors).
+
+:- pred add_ctor(string::in, int::in, hlds_cons_defn::in, module_name::in,
+ cons_id::out, cons_table::in, cons_table::out) is det.
-%---------------------------------------------------------------------------%
+add_ctor(ConsName, Arity, ConsDefn, ModuleQual, ConsId, CtorsIn, CtorsOut) :-
+ ConsId = cons(qualified(ModuleQual, ConsName), Arity),
+ multi_map__set(CtorsIn, ConsId, ConsDefn, CtorsOut).
+
+%-----------------------------------------------------------------------------%
:- pred module_add_pred(module_info, varset, sym_name, list(type_and_mode),
maybe(determinism), condition, purity, list(class_constraint),
Index: compiler/modecheck_unify.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modecheck_unify.m,v
retrieving revision 1.33
diff -u -r1.33 modecheck_unify.m
--- modecheck_unify.m 1998/03/03 17:35:20 1.33
+++ modecheck_unify.m 1998/03/04 19:03:28
@@ -570,14 +570,18 @@
UnifyContext, HowToCheckGoal, GoalInfo0,
Goal, ModeInfo0, ModeInfo) :-
mode_info_get_module_info(ModeInfo0, ModuleInfo0),
+ %
+ % fully module qualify all cons_ids
+ % (except for builtins such as ints and characters).
+ %
list__length(ArgVars0, Arity),
(
- % module qualify cons_ids
- ConsId0 = cons(unqualified(Name), _),
+ ConsId0 = cons(Name, _),
type_to_type_id(TypeOfX, TypeId, _),
TypeId = qualified(TypeModule, _) - _
->
- ConsId = cons(qualified(TypeModule, Name), Arity)
+ unqualify_name(Name, UnqualName),
+ ConsId = cons(qualified(TypeModule, UnqualName), Arity)
;
ConsId = ConsId0
),
Index: compiler/module_qual.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/module_qual.m,v
retrieving revision 1.31
diff -u -r1.31 module_qual.m
--- module_qual.m 1998/03/03 17:35:24 1.31
+++ module_qual.m 1998/03/04 18:57:51
@@ -94,10 +94,16 @@
:- type mq_info
---> mq_info(
- type_id_set, % Sets of all types, modes and
- inst_id_set, % insts visible in this module.
+ % Sets of all types, insts, modes,
+ % and typeclasses visible
+ % in this module.
+ % XXX we ought to also keep track of
+ % which modules are visible.
+ type_id_set,
+ inst_id_set,
mode_id_set,
class_id_set,
+
set(module_name), % modules imported in the
% interface that are not definitely
% needed in the interface.
@@ -810,69 +816,45 @@
% Find the unique match in the current name space for a given id
% from a list of ids. If none exists, either because no match was
- % found or mulitiple matches were found, report an error.
+ % found or multiple matches were found, report an error.
% This predicate assumes that type_ids, inst_ids, mode_ids and
% class_ids have the same representation.
:- pred find_unique_match(id::in, id::out, id_set::in, id_type::in,
mq_info::in, mq_info::out, io__state::di, io__state::uo) is det.
find_unique_match(Id0, Id, Ids, TypeOfId, Info0, Info) -->
- (
- { Id0 = qualified(Module, Name) - Arity },
+
+ % Find all IDs which match the current id.
+ { Id0 = SymName - Arity },
+ { id_set_search_sym_arity(Ids, SymName, Arity, Modules) },
+
+ ( { Modules = [] } ->
+ % No matches for this id.
{ Id = Id0 },
- ( { id_set_search_m_n_a(Ids, Module, Name, Arity) } ->
- { mq_info_set_module_used(Info0, Module, Info) }
+ ( { mq_info_get_report_error_flag(Info0, yes) } ->
+ { mq_info_get_error_context(Info0, ErrorContext) },
+ report_undefined(ErrorContext, Id0, TypeOfId),
+ { mq_info_set_error_flag(Info0, TypeOfId, Info1) },
+ { mq_info_incr_errors(Info1, Info) }
;
- ( { mq_info_get_report_error_flag(Info0, yes) } ->
- { mq_info_get_error_context(Info0,
- ErrorContext) },
- report_undefined(ErrorContext, Id, TypeOfId),
- { mq_info_set_error_flag(Info0,
- TypeOfId, Info1) },
- { mq_info_incr_errors(Info1, Info) }
- ;
- { Info = Info0 }
- )
+ { Info = Info0 }
)
+ ; { Modules = [Module] } ->
+ % A unique match for this ID.
+ { unqualify_name(SymName, IdName) },
+ { Id = qualified(Module, IdName) - Arity },
+ { mq_info_set_module_used(Info0, Module, Info) }
;
- { Id0 = unqualified(IdName) - Arity },
-
- % Find all IDs which match the current ID's name and
- % arity and which come from modules imported by the
- % module where the current ID is used.
-
- { id_set_search_name_arity(Ids, IdName, Arity, Modules) },
- ( { Modules = [] } ->
- % No matches for this id.
- { Id = Id0 },
- ( { mq_info_get_report_error_flag(Info0, yes) } ->
- { mq_info_get_error_context(Info0,
- ErrorContext) },
- report_undefined(ErrorContext, Id0, TypeOfId),
- { mq_info_set_error_flag(Info0,
- TypeOfId, Info1) },
- { mq_info_incr_errors(Info1, Info) }
- ;
- { Info = Info0 }
- )
- ; { Modules = [Module] } ->
- % A unique match for this ID.
- { Id = qualified(Module, IdName) - Arity },
- { mq_info_set_module_used(Info0, Module, Info) }
+ % There are multiple matches.
+ { Id = Id0 },
+ ( { mq_info_get_report_error_flag(Info0, yes) } ->
+ { mq_info_get_error_context(Info0, ErrorContext) },
+ report_multiply_defined(ErrorContext, Id0, TypeOfId,
+ Modules),
+ { mq_info_set_error_flag(Info0, TypeOfId, Info1) },
+ { mq_info_incr_errors(Info1, Info) }
;
- % There are multiple matches.
- { Id = Id0 },
- ( { mq_info_get_report_error_flag(Info0, yes) } ->
- { mq_info_get_error_context(Info0,
- ErrorContext) },
- report_multiply_defined(ErrorContext, Id0,
- TypeOfId, Modules),
- { mq_info_set_error_flag(Info0,
- TypeOfId, Info1) },
- { mq_info_incr_errors(Info1, Info) }
- ;
- { Info = Info0 }
- )
+ { Info = Info0 }
)
).
@@ -1277,25 +1259,41 @@
),
map__set(IdSet0, Name - Arity, ImportModules - UseModules, IdSet).
-:- pred id_set_search_name_arity(id_set::in, string::in, int::in,
+:- pred id_set_search_sym_arity(id_set::in, sym_name::in, int::in,
list(module_name)::out) is det.
-id_set_search_name_arity(IdSet0, Name, Arity, Modules) :-
- ( map__search(IdSet0, Name - Arity, ImportModules - _) ->
- set__to_sorted_list(ImportModules, Modules)
+id_set_search_sym_arity(IdSet, Sym, Arity, Modules) :-
+ unqualify_name(Sym, UnqualName),
+ (
+ map__search(IdSet, UnqualName - Arity,
+ ImportModules - UseModules)
+ ->
+ (
+ Sym = unqualified(_),
+ set__to_sorted_list(ImportModules, Modules)
+ ;
+ Sym = qualified(Module, _),
+ % XXX The code below is not quite right -
+ % it doesn't handle the cases where
+ % a module is imported but its parent module is used,
+ % or vice versa.
+ % E.g. It allows the use of `bar:baz' to match
+ % `:foo:bar:baz' if `bar' is imported,
+ % whereas this ought to be allowed only if `foo'
+ % is imported.
+ FindMatch =
+ lambda([MatchModule::out] is nondet, (
+ (
+ set__member(MatchModule, ImportModules)
+ ;
+ set__member(MatchModule, UseModules)
+ ),
+ match_sym_name(Module, MatchModule)
+ )),
+ solutions(FindMatch, Modules)
+ )
;
Modules = []
- ).
-
-:- pred id_set_search_m_n_a(id_set::in, module_name::in,
- string::in, int::in) is semidet.
-
-id_set_search_m_n_a(IdSet0, Module, Name, Arity) :-
- map__search(IdSet0, Name - Arity, ImportModules - UseModules),
- (
- set__member(Module, ImportModules)
- ;
- set__member(Module, UseModules)
).
%----------------------------------------------------------------------------%
Index: compiler/modules.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modules.m,v
retrieving revision 1.58
diff -u -r1.58 modules.m
--- modules.m 1998/03/03 17:35:26 1.58
+++ modules.m 1998/03/04 17:37:15
@@ -281,12 +281,20 @@
% get_ancestors(ModuleName, ParentDeps):
% ParentDeps is the list of ancestor modules for this
- % module, oldest first (e.g. if the ModuleName is
- % `foo:bar:baz', then ParentDeps would be [`foo', `foo:bar']).
+ % module, oldest first; e.g. if the ModuleName is
+ % `foo:bar:baz', then ParentDeps would be [`foo', `foo:bar'].
%
:- pred get_ancestors(module_name, list(module_name)).
:- mode get_ancestors(in, out) is det.
+ % get_partial_qualifiers(ModuleName, PartialQualifiers):
+ % PartialQualifiers is the list of partial module
+ % qualifiers for ModuleName; e.g. if the ModuleName is
+ % `foo:bar:baz', then ParentDeps would be [`bar:baz', `baz']).
+ %
+:- pred get_partial_qualifiers(module_name, list(module_name)).
+:- mode get_partial_qualifiers(in, out) is det.
+
%-----------------------------------------------------------------------------%
% touch_interface_datestamp(ModuleName, Ext).
@@ -2302,6 +2310,28 @@
get_ancestors_2(qualified(Parent, _), Ancestors0, Ancestors) :-
Ancestors1 = [Parent | Ancestors0],
get_ancestors_2(Parent, Ancestors1, Ancestors).
+
+%-----------------------------------------------------------------------------%
+
+get_partial_qualifiers(unqualified(_), []).
+get_partial_qualifiers(qualified(ParentQual, ChildName),
+ [PartialQual | PartialQuals]) :-
+ drop_one_qualifier(ParentQual, ChildName, PartialQual),
+ get_partial_qualifiers(PartialQual, PartialQuals).
+
+:- pred drop_one_qualifier(module_name, string, module_name).
+:- mode drop_one_qualifier(in, in, out) is det.
+
+drop_one_qualifier(ParentQual, ChildName, PartialQual) :-
+ (
+ ParentQual = unqualified(_ParentName),
+ PartialQual = unqualified(ChildName)
+ ;
+ ParentQual = qualified(GrandParentQual, ParentName),
+ drop_one_qualifier(GrandParentQual, ParentName,
+ PartialGrantParentQual),
+ PartialQual = qualified(PartialGrantParentQual, ChildName)
+ ).
%-----------------------------------------------------------------------------%
Index: tests/hard_coded/parent.child.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/parent.child.m,v
retrieving revision 1.1
diff -u -r1.1 parent.child.m
--- parent.child.m 1998/03/03 17:47:36 1.1
+++ parent.child.m 1998/03/04 19:04:32
@@ -10,4 +10,4 @@
:- implementation.
-hello --> io__write_string("Hello, world\n").
+hello --> io__write_string("parent:child:hello\n").
Index: tests/hard_coded/parent.child2.m
===================================================================
RCS file: parent.child2.m
diff -N parent.child2.m
--- /dev/null Thu Mar 5 06:05:34 1998
+++ parent.child2.m Thu Mar 5 06:04:32 1998
@@ -0,0 +1,13 @@
+% "Hello World" in Mercury, using nested modules.
+
+:- module parent:child2.
+:- interface.
+:- import_module io.
+
+:- type foo ---> bar ; baz(int).
+
+:- pred hello(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+hello --> io__write_string("parent:child2:hello\n").
Index: tests/hard_coded/parent.exp
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/parent.exp,v
retrieving revision 1.1
diff -u -r1.1 parent.exp
--- parent.exp 1998/03/03 17:47:37 1.1
+++ parent.exp 1998/03/04 18:54:48
@@ -1,2 +1,14 @@
-Hello, world
-Hello, world
+parent:child:hello
+parent:child:hello
+parent:child:hello
+parent:child2:hello
+t1 = parent:child:foo
+t2 = parent:child:foo
+t3 = parent:child:foo
+t4 = parent:child2:foo
+t5 = parent:child2:foo
+has_type_t1 = bar
+has_type_t2 = bar
+has_type_t3 = bar
+has_type_t4 = bar
+has_type_t5 = bar
Index: tests/hard_coded/parent.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/parent.m,v
retrieving revision 1.1
diff -u -r1.1 parent.m
--- parent.m 1998/03/03 17:47:38 1.1
+++ parent.m 1998/03/04 19:04:32
@@ -8,11 +8,53 @@
:- implementation.
-:- include_module child.
+:- include_module child, child2.
+
:- import_module parent:child.
+:- use_module parent:child2.
+:- import_module std_util, require.
+
+:- type t1 == parent:child:foo.
+:- type t2 == child:foo.
+:- type t3 == foo.
+:- type t4 == parent:child2:foo.
+% :- type t5 == child2:foo. % XXX mixing of use_module and import_module
+ % is not yet supported.
+:- type t5 == parent:child2:foo.
main -->
parent:child:hello,
- % child:hello, % not yet supported
- hello.
+ child:hello,
+ hello,
+ parent:child2:hello,
+ % child2:hello, % XXX mixing of use_module and import_module
+ % is not yet supported.
+
+ print("t1 = "), print(type_of(has_type_t1)), nl,
+ print("t2 = "), print(type_of(has_type_t2)), nl,
+ print("t3 = "), print(type_of(has_type_t3)), nl,
+ print("t4 = "), print(type_of(has_type_t4)), nl,
+ print("t5 = "), print(type_of(has_type_t5)), nl,
+
+ print("has_type_t1 = "), print(has_type_t1), nl,
+ print("has_type_t2 = "), print(has_type_t2), nl,
+ print("has_type_t3 = "), print(has_type_t3), nl,
+ print("has_type_t4 = "), print(has_type_t4), nl,
+ print("has_type_t5 = "), print(has_type_t5), nl,
+
+ { true }.
+
+:- func has_type_t1 = t1.
+:- func has_type_t2 = t2.
+:- func has_type_t3 = t3.
+:- func has_type_t4 = t4.
+:- func has_type_t5 = t5.
+
+has_type_t1 = parent:child:bar.
+has_type_t2 = child:bar.
+has_type_t3 = bar.
+has_type_t4 = parent:child2:bar.
+% has_type_t5 = child2:bar. % XXX mixing of use_module and import_module
+ % is not yet supported.
+has_type_t5 = parent:child2:bar.
Index: tests/hard_coded/parent2.child.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/parent2.child.m,v
retrieving revision 1.1
diff -u -r1.1 parent2.child.m
--- parent2.child.m 1998/03/03 17:47:40 1.1
+++ parent2.child.m 1998/03/04 19:04:32
@@ -1,15 +1,42 @@
-% "Hello World" in Mercury,
-% using nested modules.
+% Some test cases to test nested modules.
:- module parent2:child.
:- interface.
% module `io' is imported in parent2
-:- type foo ---> bar ; baz(int).
+:- type t1 == foo.
+:- type t2 == parent2:foo.
:- pred main(io__state::di, io__state::uo) is det.
:- implementation.
+:- import_module std_util.
+
+:- type t3 == foo.
+:- type t4 == parent2:foo.
+
+:- func has_type_t1 = t1.
+:- func has_type_t2 = t2.
+:- func has_type_t3 = t3.
+:- func has_type_t4 = t4.
+
+has_type_t1 = bar.
+has_type_t2 = parent2:bar.
+has_type_t3 = baz(42).
+has_type_t4 = parent2:baz(42).
+
+main -->
+ parent2:hello,
+ hello,
+
+ print("t1 = "), print(type_of(has_type_t1)), nl,
+ print("t2 = "), print(type_of(has_type_t2)), nl,
+ print("t3 = "), print(type_of(has_type_t3)), nl,
+ print("t4 = "), print(type_of(has_type_t4)), nl,
+
+ print("has_type_t1 = "), print(has_type_t1), nl,
+ print("has_type_t2 = "), print(has_type_t2), nl,
+ print("has_type_t3 = "), print(has_type_t3), nl,
+ print("has_type_t4 = "), print(has_type_t4), nl.
-main --> hello, parent2:hello.
Index: tests/hard_coded/parent2.exp
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/parent2.exp,v
retrieving revision 1.1
diff -u -r1.1 parent2.exp
--- parent2.exp 1998/03/03 17:47:42 1.1
+++ parent2.exp 1998/03/04 18:53:42
@@ -1,2 +1,10 @@
-Hello world
-Hello world
+parent2:hello
+parent2:hello
+t1 = parent2:foo
+t2 = parent2:foo
+t3 = parent2:foo
+t4 = parent2:foo
+has_type_t1 = bar
+has_type_t2 = bar
+has_type_t3 = baz(42)
+has_type_t4 = baz(42)
Index: tests/hard_coded/parent2.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/parent2.m,v
retrieving revision 1.1
diff -u -r1.1 parent2.m
--- parent2.m 1998/03/03 17:47:43 1.1
+++ parent2.m 1998/03/04 19:04:32
@@ -9,6 +9,8 @@
:- implementation.
+:- type foo ---> bar ; baz(int).
+
:- pred hello(io__state::di, io__state::uo) is det.
-hello --> print("Hello world\n").
+hello --> print("parent2:hello\n").
--
Fergus Henderson <fjh at cs.mu.oz.au> | "I have always known that the pursuit
WWW: <http://www.cs.mu.oz.au/~fjh> | of excellence is a lethal habit"
PGP: finger fjh at 128.250.37.3 | -- the last words of T. S. Garp.
More information about the developers
mailing list