[m-rev.] for review: delete RTTI predicates from std_util
Zoltan Somogyi
zs at cs.mu.OZ.AU
Wed Mar 22 13:49:11 AEDT 2006
The final diff, which includes the modification required to test cases,
is attached.
Zoltan.
Remove from std_util.m the predicates that merely call predicates in
the type_desc, construct and deconstruct modules, to reduce clutter
in std_util.m.
library/std_util.m:
Remove those predicates from std_util.m.
library/deconstruct.m:
Add a type we need that was previously defined in std_util.m.
library/construct.m:
Delete some module qualifications that have now become unnecessary,
browser/browse.m:
browser/browser_info.m:
browser/declarative_tree.m:
browser/dl.m:
browser/help.m:
browser/sized_pretty.m:
browser/term_rep.m:
compiler/bytecode_gen.m:
compiler/llds_out.m:
compiler/mlds_to_il.m:
compiler/mlds_to_managed.m:
library/assoc_list.m:
library/hash_table.m:
library/io.m:
library/pprint.m:
library/private_builtin.m:
library/prolog.m:
library/require.m:
library/rtti_implementation.m:
library/store.m:
library/term.m:
library/term_to_xml.m:
library/version_hash_table.m:
mdbcomp/program_representation.m:
Import type_desc.m, construct.m and/or deconstruct.m to provide
definitions of functions or predicates that up till now were in
std_util.m. Modify the calls if the called function or predicate
had a slightly different interface in std_util.m.
Also, convert term_to_xml.m to four-space indentation, and delete
unnecessary module qualifications in term.m.
tests/debugger/polymorphic_output.{m,inp,exp,exp2}:
tests/hard_coded/copy_pred_2.m:
tests/hard_coded/deconstruct_arg.exp:
tests/hard_coded/deconstruct_arg.exp2:
tests/hard_coded/deconstruct_arg.m:
tests/hard_coded/elim_special_pred.m:
tests/hard_coded/existential_bound_tvar.m:
tests/hard_coded/expand.m:
tests/hard_coded/foreign_type2.m:
tests/hard_coded/higher_order_type_manip.m:
tests/hard_coded/nullary_ho_func.m:
tests/hard_coded/tuple_test.m:
tests/hard_coded/type_ctor_desc.m:
tests/hard_coded/type_qual.m:
tests/hard_coded/write_xml.m:
tests/hard_coded/sub-modules/class.m:
tests/hard_coded/sub-modules/nested.m:
tests/hard_coded/sub-modules/nested2.m:
tests/hard_coded/sub-modules/nested3.m:
tests/hard_coded/sub-modules/parent.m:
tests/hard_coded/sub-modules/parent2.child.m:
tests/hard_coded/typeclasses/existential_rtti.m:
tests/recompilation/type_qual_re.m.1:
cvs update: Updating tests/submodules
cvs update: Updating tests/tabling
cvs update: Updating tests/term
cvs update: Updating tests/tools
cvs update: Updating tests/trailing
cvs update: Updating tests/typeclasses
cvs update: Updating tests/valid
tests/valid/agc_unbound_typevars.m:
tests/valid/agc_unbound_typevars2.m:
tests/valid/agc_unused_in.m:
Replace references to the deleted predicates in std_util with
references to the equivalent predicates in type_desc, construct
and/or deconstruct. In test cases that already tested both the
functionality in std_util and in the other modules, simply delete
the part exercising std_util.
cvs diff: Diffing .
Index: NEWS
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/NEWS,v
retrieving revision 1.405
diff -u -b -r1.405 NEWS
--- NEWS 21 Mar 2006 22:25:21 -0000 1.405
+++ NEWS 21 Mar 2006 22:44:44 -0000
@@ -26,6 +26,12 @@
with dynamic modes (inst "any") must now be marked as impure.
Changes to the Mercury standard library:
+* We have removed the predicates dealing with runtime type information (RTTI)
+ from std_util.m. Any users impacted by this change should look for required
+ functionality in the construct, deconstruct and type_desc modules of the
+ standard library, in forms that have been mostly unchanged since the
+ 0.11 release. In most cases, the differences are quite minor, but provide
+ more expressive power.
* We have added an `injection' module, for reversible maps that are injective.
Changes to the Mercury compiler:
cvs diff: Diffing analysis
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/doc
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing browser
Index: browser/browse.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/browser/browse.m,v
retrieving revision 1.56
diff -u -b -r1.56 browse.m
--- browser/browse.m 10 Mar 2006 06:31:02 -0000 1.56
+++ browser/browse.m 15 Mar 2006 08:44:38 -0000
@@ -168,6 +168,7 @@
:- import_module bool.
:- import_module char.
+:- import_module construct.
:- import_module deconstruct.
:- import_module getopt.
:- import_module int.
@@ -178,6 +179,7 @@
:- import_module std_util.
:- import_module string.
:- import_module term_to_xml.
+:- import_module type_desc.
%---------------------------------------------------------------------------%
%
@@ -411,7 +413,7 @@
io.write_string("]", !IO)
)
;
- deconstruct_cc(Term, Functor, _Arity, Args),
+ deconstruct(Term, include_details_cc, Functor, _Arity, Args),
write_indent(Indent, !IO),
io.write_string(Functor, !IO),
(
@@ -1383,7 +1385,7 @@
% We assume a root-relative path. We assume Term is the entire term
% passed into browse/3, not a subterm.
:- pred deref_subterm(browser_term::in, list(dir)::in, list(dir)::in,
- deref_result(browser_term)::out) is det.
+ deref_result(browser_term)::out) is cc_multi.
deref_subterm(BrowserTerm, Path, RevPath0, Result) :-
simplify_dirs(Path, SimplifiedPath),
@@ -1448,7 +1450,7 @@
).
:- pred deref_subterm_2(univ::in, list(dir)::in, list(dir)::in,
- deref_result(univ)::out) is det.
+ deref_result(univ)::out) is cc_multi.
deref_subterm_2(Univ, Path, RevPath0, Result) :-
(
@@ -1457,7 +1459,6 @@
;
Path = [Dir | Dirs],
(
- (
Dir = child_num(N),
(
TypeCtor = type_ctor(univ_type(Univ)),
@@ -1465,22 +1466,25 @@
type_ctor_module_name(TypeCtor) = "array"
->
% The first element of an array is at index zero.
- ArgN = argument(univ_value(Univ), N)
+ arg_cc(univ_value(Univ), N, MaybeValue)
;
% The first argument of a non-array is numbered argument 1
% by the user but argument 0 by deconstruct.argument.
- ArgN = argument(univ_value(Univ), N - 1)
+ arg_cc(univ_value(Univ), N - 1, MaybeValue)
)
;
Dir = child_name(Name),
- ArgN = named_argument(univ_value(Univ), Name)
+ named_arg_cc(univ_value(Univ), Name, MaybeValue)
;
Dir = parent,
error("deref_subterm_2: found parent")
- )
- ->
+ ),
+ (
+ MaybeValue = arg(Value),
+ ArgN = univ(Value),
deref_subterm_2(ArgN, Dirs, [Dir | RevPath0], Result)
;
+ MaybeValue = no_arg,
Result = deref_error(list.reverse(RevPath0), Dir)
)
).
Index: browser/browser_info.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/browser/browser_info.m,v
retrieving revision 1.23
diff -u -b -r1.23 browser_info.m
--- browser/browser_info.m 10 Mar 2006 06:31:02 -0000 1.23
+++ browser/browser_info.m 15 Mar 2006 08:45:46 -0000
@@ -259,6 +259,7 @@
:- import_module io.
:- import_module require.
:- import_module string.
+:- import_module type_desc.
:- import_module mdb.term_rep.
@@ -636,7 +637,7 @@
%---------------------------------------------------------------------------%
-:- pred browser_persistent_state_type(type_info::out) is det.
+:- pred browser_persistent_state_type(type_desc::out) is det.
:- pragma export(browser_persistent_state_type(out),
"ML_BROWSE_browser_persistent_state_type").
Index: browser/declarative_tree.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/browser/declarative_tree.m,v
retrieving revision 1.38
diff -u -b -r1.38 declarative_tree.m
--- browser/declarative_tree.m 10 Mar 2006 06:31:04 -0000 1.38
+++ browser/declarative_tree.m 15 Mar 2006 08:57:08 -0000
@@ -60,6 +60,7 @@
:- import_module assoc_list.
:- import_module bool.
+:- import_module deconstruct.
:- import_module exception.
:- import_module int.
:- import_module io.
@@ -810,8 +811,8 @@
trace_dependency(wrap(Store), dynamic(Ref), ArgPos, TermPath, Mode, Origin) :-
find_chain_start(Store, Ref, ArgPos, TermPath, ChainStart),
(
- ChainStart = chain_start(StartLoc, ArgNum, TotalArgs,
- NodeId, StartPath, MaybeProcRep),
+ ChainStart = chain_start(StartLoc, ArgNum, TotalArgs, NodeId,
+ StartPath, MaybeProcRep),
Mode = start_loc_to_subterm_mode(StartLoc),
(
MaybeProcRep = no,
@@ -819,8 +820,8 @@
;
MaybeProcRep = yes(ProcRep),
(
- trace_dependency_special_case(Store, ProcRep,
- Ref, StartLoc, ArgNum, TermPath, NodeId, Origin0)
+ trace_dependency_special_case(Store, ProcRep, Ref,
+ StartLoc, ArgNum, TermPath, NodeId, Origin0)
->
Origin = Origin0
;
@@ -831,51 +832,41 @@
;
ChainStart = require_explicit_subtree,
Origin = require_explicit_subtree,
- % The only time a subtree will be required is if the
- % mode of the subterm is output.
+ % The only time a subtree will be required is if the subterm is output.
Mode = subterm_out
).
- % trace_dependency_special_case handles special cases not
- % handled by the usual subterm dependency tracking algorithm,
- % At the moment it handles tracking of subterms through catch_impl.
+ % trace_dependency_special_case handles special cases not handled
+ % by the usual subterm dependency tracking algorithm. At the moment
+ % it handles tracking of subterms through catch_impl.
%
:- pred trace_dependency_special_case(S::in, proc_rep::in, R::in,
start_loc(R)::in, int::in, term_path::in, R::in,
- subterm_origin(edt_node(R))::out) is semidet
- <= annotated_trace(S, R).
+ subterm_origin(edt_node(R))::out) is semidet <= annotated_trace(S, R).
trace_dependency_special_case(Store, ProcRep, Ref, StartLoc, ArgNum, TermPath,
NodeId, Origin) :-
- %
- % catch_impl's body is a single call to
- % builtin_catch. builtin_catch doesn't
- % generate any events, so we need to
- % handle catch_impl specially.
- %
+ % Catch_impl's body is a single call to builtin_catch. Builtin_catch
+ % doesn't generate any events, so we need to handle catch_impl specially.
+
proc_rep_is_catch_impl(ProcRep),
(
StartLoc = parent_goal(_, _),
- %
- % The subterm being tracked is an
- % input to builtin_catch so we know the
- % origin will be in the first argument of
- % catch_impl, because builtin_catch is
- % only called from catch_impl.
- %
+ % The subterm being tracked is an input to builtin_catch so we know
+ % the origin will be in the first argument of catch_impl, because
+ % builtin_catch is only called from catch_impl.
+
Origin = input(user_head_var(1), [ArgNum | TermPath])
;
StartLoc = cur_goal,
- %
- % The subterm being tracked is an output of
- % catch_impl so we know its origin will be the output
- % of the closure passed to try.
- % If the closure succeeded, then we continue to track the
- % subterm in the child call to
- % exception.wrap_success_or_failure, otherwise we stop tracking
- % at the catch_impl. XXX In future we should track exception
- % values to the throw that created them.
- %
+ % The subterm being tracked is an output of catch_impl so we know
+ % its origin will be the output of the closure passed to try.
+ % If the closure succeeded, then we continue to track the subterm
+ % in the child call to exception.wrap_success_or_failure, otherwise
+ % we stop tracking at the catch_impl.
+ % XXX In future we should track exception values to the throw
+ % that created them.
+
exit_node_from_id(Store, Ref, ExitNode),
ExitAtom = get_trace_exit_atom(ExitNode),
ExitAtom = atom(_, Args),
@@ -883,7 +874,7 @@
TryResultArgInfo = arg_info(_, _, yes(TryResultRep)),
rep_to_univ(TryResultRep, TryResultUniv),
univ_value(TryResultUniv) = TryResult,
- std_util.deconstruct(TryResult, Functor, _, _),
+ deconstruct(TryResult, canonicalize, Functor, _, _),
( Functor = "succeeded" ->
Origin = output(dynamic(NodeId), any_head_var_from_back(1),
TermPath)
@@ -892,10 +883,9 @@
)
).
-:- pred trace_dependency_in_proc_rep(S::in, term_path::in,
- start_loc(R)::in, int::in, int::in, R::in, maybe(goal_path)::in,
- proc_rep::in, subterm_origin(edt_node(R))::out)
- is det <= annotated_trace(S, R).
+:- pred trace_dependency_in_proc_rep(S::in, term_path::in, start_loc(R)::in,
+ int::in, int::in, R::in, maybe(goal_path)::in, proc_rep::in,
+ subterm_origin(edt_node(R))::out) is det <= annotated_trace(S, R).
trace_dependency_in_proc_rep(Store, TermPath, StartLoc, ArgNum,
TotalArgs, NodeId, StartPath, ProcRep, Origin) :-
@@ -915,14 +905,14 @@
(
MaybePrims = yes(primitive_list_and_var(Primitives, Var,
MaybeClosure)),
- %
- % If the subterm is in a closure argument then the argument
- % number of the closure argument is prefixed to the term path,
- % since the closure is itself a term. This is done here
- % because at the time of the closure call it is not easy to
- % decide if the call is higher order or not, without repeating
- % all the work done in make_primitive_list.
- %
+
+ % If the subterm is in a closure argument then the argument number
+ % of the closure argument is prefixed to the term path, since the
+ % closure is itself a term. This is done here because at the time
+ % of the closure call it is not easy to decide if the call is higher
+ % order or not, without repeating all the work done in
+ % make_primitive_list.
+
(
MaybeClosure = yes,
AdjustedTermPath = [ArgNum | TermPath]
@@ -937,10 +927,9 @@
Origin = not_found
).
- % proc_rep_is_catch_impl(ProcRep) is true if ProcRep is a
- % representation of exception.catch_impl (the converse
- % is true assuming exception.builtin_catch is only called from
- % exception.catch_impl).
+ % proc_rep_is_catch_impl(ProcRep) is true if ProcRep is a representation
+ % of exception.catch_impl (the converse is true assuming
+ % exception.builtin_catch is only called from exception.catch_impl).
%
:- pred proc_rep_is_catch_impl(proc_rep::in) is semidet.
@@ -987,7 +976,7 @@
call_node_from_id(Store, CallId, CallNode),
CallAtom = get_trace_call_atom(CallNode),
%
- % XXX we don't yet handle tracking of the exception value.
+ % XXX We don't yet handle tracking of the exception value.
%
( trace_atom_subterm_is_ground(CallAtom, ArgPos, TermPath) ->
find_chain_start_inside(Store, CallId, CallNode,
@@ -1043,7 +1032,6 @@
ProcRep = no
).
- %
% Finds the call node of the parent of the given node. Fails if
% the call node cannot be found because it was not included in the
% annotated trace.
@@ -1569,8 +1557,7 @@
ProcRep = proc_rep(HeadVars, _),
ArgPos = find_arg_pos(HeadVars, Var0),
Origin = input(ArgPos, TermPath0).
-traverse_primitives([Prim | Prims], Var0, TermPath0, Store, ProcRep,
- Origin) :-
+traverse_primitives([Prim | Prims], Var0, TermPath0, Store, ProcRep, Origin) :-
Prim = primitive(File, Line, BoundVars, AtomicGoal, _GoalPath,
MaybeNodeId),
(
@@ -1740,7 +1727,7 @@
---> plain_call_info(
file_name :: string,
line_number :: int,
- flat_module_name:: string,
+ flat_module_name :: string,
pred_name :: string
).
@@ -1772,7 +1759,7 @@
add_paths_to_conjuncts([], _, _, []).
add_paths_to_conjuncts([Goal | Goals], ParentPath, N,
[goal_and_path(Goal, Path) | GoalAndPaths]) :-
- list.append(ParentPath, [conj(N)], Path),
+ Path = ParentPath ++ [conj(N)],
add_paths_to_conjuncts(Goals, ParentPath, N + 1, GoalAndPaths).
%-----------------------------------------------------------------------------%
@@ -1857,8 +1844,8 @@
"not a return node"))
).
-:- pred get_edt_call_node(S::in, R::in, R::out)
- is det <= annotated_trace(S, R).
+:- pred get_edt_call_node(S::in, R::in, R::out) is det
+ <= annotated_trace(S, R).
get_edt_call_node(Store, Ref, CallId) :-
(
Index: browser/dl.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/browser/dl.m,v
retrieving revision 1.26
diff -u -b -r1.26 dl.m
--- browser/dl.m 10 Mar 2006 06:31:05 -0000 1.26
+++ browser/dl.m 15 Mar 2006 08:57:54 -0000
@@ -103,6 +103,7 @@
:- import_module require.
:- import_module std_util.
:- import_module string.
+:- import_module type_desc.
:- pragma foreign_decl("C", "
#include <stdio.h>
Index: browser/help.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/browser/help.m,v
retrieving revision 1.8
diff -u -b -r1.8 help.m
--- browser/help.m 10 Mar 2006 06:31:05 -0000 1.8
+++ browser/help.m 15 Mar 2006 07:59:59 -0000
@@ -27,7 +27,7 @@
:- import_module io.
:- import_module list.
-:- import_module std_util.
+:- import_module type_desc.
:- type system.
@@ -54,8 +54,7 @@
% Print the top-level help nodes. This should give an overview
% of the main topics for which help is available.
%
-:- pred help(system::in, io.output_stream::in,
- io::di, io::uo) is det.
+:- pred help(system::in, io.output_stream::in, io::di, io::uo) is det.
% Print the help node at the given path. If there is none,
% print the top-level nodes.
@@ -164,8 +163,8 @@
insert_into_entry_list(Nodes0, Index, Name, Node, Nodes)
).
-:- pred insert_into_entry_list(list(entry)::in,
- int::in, string::in, node::in, list(entry)::out) is det.
+:- pred insert_into_entry_list(list(entry)::in, int::in, string::in, node::in,
+ list(entry)::out) is det.
insert_into_entry_list([], Index, Name, Node, [Entry]) :-
Entry = entry(Index, Name, Node).
@@ -193,8 +192,8 @@
true
).
-:- pred search_entry_list(list(entry)::in, string::in,
- int::in, int::out, io.output_stream::in, io::di, io::uo) is det.
+:- pred search_entry_list(list(entry)::in, string::in, int::in, int::out,
+ io.output_stream::in, io::di, io::uo) is det.
search_entry_list([], _, !C, _, !IO).
search_entry_list([Entry | Tail], Name, !C, Stream, !IO) :-
@@ -248,8 +247,7 @@
print_node(Node, Stream, !IO),
print_entry_list(Nodes, Stream, !IO).
-:- pred print_node(node::in, io.output_stream::in,
- io::di, io::uo) is det.
+:- pred print_node(node::in, io.output_stream::in, io::di, io::uo) is det.
print_node(node(Text, _Nodes), Stream, !IO) :-
io.write_string(Stream, Text, !IO).
@@ -257,8 +255,7 @@
%-----------------------------------------------------------------------------%
-:- pred one_path_step(list(entry)::in, string::in,
- entry::out) is semidet.
+:- pred one_path_step(list(entry)::in, string::in, entry::out) is semidet.
one_path_step([Head | Tail], Name, Entry) :-
Head = entry(_, HeadName, _),
Index: browser/sized_pretty.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/browser/sized_pretty.m,v
retrieving revision 1.14
diff -u -b -r1.14 sized_pretty.m
--- browser/sized_pretty.m 10 Mar 2006 06:31:06 -0000 1.14
+++ browser/sized_pretty.m 15 Mar 2006 09:06:33 -0000
@@ -188,6 +188,7 @@
:- import_module assoc_list.
:- import_module bool.
+:- import_module deconstruct.
:- import_module list.
:- import_module pprint.
:- import_module require.
@@ -299,13 +300,15 @@
->
annotate_with_size(BrowserDb, plain_term(ReturnValue), Params, Limit,
AnnotReturn),
+ to_doc_sized(AnnotTerm, AnnotTermStr),
+ to_doc_sized(AnnotReturn, AnnotReturnStr),
Doc = group(
- to_doc_sized(AnnotTerm)
+ AnnotTermStr
`<>` line
- `<>` nest(2, text(" = ") `<>` to_doc_sized(AnnotReturn))
+ `<>` nest(2, text(" = ") `<>` AnnotReturnStr)
)
;
- Doc = to_doc_sized(AnnotTerm)
+ to_doc_sized(AnnotTerm, Doc)
),
String = pprint.to_string(LineWidth, Doc).
@@ -585,12 +588,12 @@
% A function to convert a size annotated term to a 'doc' type,
% a type defined in pprint.m.
%
-:- func to_doc_sized(size_annotated_term(T)) = doc.
+:- pred to_doc_sized(size_annotated_term(T)::in, doc::out) is cc_multi.
-to_doc_sized(at_least(BrowserTerm, _, not_deconstructed)) = Doc :-
+to_doc_sized(at_least(BrowserTerm, _, not_deconstructed), Doc) :-
(
BrowserTerm = plain_term(Univ),
- functor(univ_value(Univ), Functor, Arity),
+ functor(univ_value(Univ), include_details_cc, Functor, Arity),
Doc = text(Functor) `<>` text("/") `<>` poly(i(Arity))
;
BrowserTerm = synthetic_term(Functor, Args, MaybeReturn),
@@ -604,39 +607,39 @@
Doc = text(Functor) `<>` text("/") `<>` poly(i(Arity))
)
).
-
-to_doc_sized(at_least(_, _, deconstructed(Functor, Arity, MaybeArgs))) = Doc :-
- Doc = to_doc_sized_2(Functor, Arity, MaybeArgs).
-
-to_doc_sized(exact(_, _, Functor, Arity, MaybeArgs)) = Doc :-
- Doc = to_doc_sized_2(Functor, Arity, MaybeArgs).
+to_doc_sized(at_least(_, _, deconstructed(Functor, Arity, MaybeArgs)), Doc) :-
+ to_doc_sized_2(Functor, Arity, MaybeArgs, Doc).
+to_doc_sized(exact(_, _, Functor, Arity, MaybeArgs), Doc) :-
+ to_doc_sized_2(Functor, Arity, MaybeArgs, Doc).
%---------------------------------------------------------------------------%
% Assumes that every argument must be on a different line
% or all of them should be on the same line.
%
-:- func to_doc_sized_2(string, int, size_annotated_args(T)) = doc.
+:- pred to_doc_sized_2(string::in, int::in, size_annotated_args(T)::in,
+ doc::out) is cc_multi.
-to_doc_sized_2(Functor, _Arity, []) = text(Functor).
-
-to_doc_sized_2(Functor, Arity, [HeadArg|Tail]) = Doc :-
- Args = list.map(handle_arg, [HeadArg|Tail]),
+to_doc_sized_2(Functor, _Arity, [], text(Functor)).
+to_doc_sized_2(Functor, Arity, [HeadArg | Tail], Doc) :-
+ list.map(handle_arg, [HeadArg | Tail], Args),
list.remove_adjacent_dups(Args, NewArgs),
- ( NewArgs \= [nil] ->
+ ( NewArgs = [nil] ->
+ Doc = text(Functor) `<>` text("/") `<>` poly(i(Arity))
+ ;
Doc = text(Functor) `<>`
parentheses(group(nest(2,
line `<>` separated(id, comma_space_line, Args))))
- ;
- Doc = text(Functor) `<>` text("/") `<>` poly(i(Arity))
).
%---------------------------------------------------------------------------%
-:- func handle_arg(maybe(pair(T,size_annotated_term(T)))) = doc.
+:- pred handle_arg(maybe(pair(T,size_annotated_term(T)))::in, doc::out)
+ is cc_multi.
-handle_arg(yes(_ - Arg_Term)) = to_doc_sized(Arg_Term).
-handle_arg(no) = nil.
+handle_arg(yes(_ - Arg_Term), Doc) :-
+ to_doc_sized(Arg_Term, Doc).
+handle_arg(no, nil).
%---------------------------------------------------------------------------%
@@ -1030,11 +1033,11 @@
% to print the functors of the arguments. Also determines the
% length of biggest functor.
%
-:- pred get_arg_length(list(univ)::in, int::out, int::out) is det.
+:- pred get_arg_length(list(univ)::in, int::out, int::out) is cc_multi.
get_arg_length([], 0, 0).
get_arg_length([HeadUniv | Rest], TotalLength, MaxLength) :-
- functor(univ_value(HeadUniv), Functor, Arity),
+ functor(univ_value(HeadUniv), include_details_cc, Functor, Arity),
(
Rest = [],
Correction = 2
Index: browser/term_rep.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/browser/term_rep.m,v
retrieving revision 1.7
diff -u -b -r1.7 term_rep.m
--- browser/term_rep.m 10 Mar 2006 06:31:06 -0000 1.7
+++ browser/term_rep.m 15 Mar 2006 09:10:40 -0000
@@ -50,10 +50,13 @@
:- implementation.
+:- import_module construct.
+:- import_module deconstruct.
:- import_module exception.
:- import_module int.
:- import_module list.
:- import_module string.
+:- import_module type_desc.
:- import_module mdb.declarative_debugger.
@@ -107,13 +110,13 @@
% Argument indexes in the term path start from one, but
% the argument function wants argument indexes to
% start from zero.
- argument_cc(univ_value(Univ), N - 1, MaybeSubUniv),
+ arg_cc(univ_value(Univ), N - 1, MaybeSubUniv),
(
- MaybeSubUniv = yes(SubUniv),
- univ_to_rep(SubUniv, Arg0),
+ MaybeSubUniv = arg(SubValue),
+ univ_to_rep(univ(SubValue), Arg0),
MaybeArg = yes(Arg0)
;
- MaybeSubUniv = no,
+ MaybeSubUniv = no_arg,
MaybeArg = no
)
),
@@ -127,7 +130,7 @@
promise_equivalent_solutions [MaybePos] (
rep_to_univ(Term, Univ),
Value = univ_value(Univ),
- deconstruct_cc(Value, Functor, Arity, _Args),
+ deconstruct(Value, include_details_cc, Functor, Arity, _Args),
Type = type_of(Value),
find_functor(1, num_functors(Type), Type, Functor, Arity,
MaybeFunctorNum),
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/bytecode_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/bytecode_gen.m,v
retrieving revision 1.99
diff -u -b -r1.99 bytecode_gen.m
--- compiler/bytecode_gen.m 17 Mar 2006 01:40:12 -0000 1.99
+++ compiler/bytecode_gen.m 17 Mar 2006 02:01:46 -0000
@@ -66,6 +66,7 @@
:- import_module assoc_list.
:- import_module bool.
:- import_module counter.
+:- import_module deconstruct.
:- import_module int.
:- import_module list.
:- import_module map.
@@ -208,7 +209,7 @@
% string.append_list([
% "bytecode for ", GenericCallFunctor, " calls"], Msg),
% sorry(this_file, Msg)
- functor(GenericCallType, _GenericCallFunctor, _),
+ functor(GenericCallType, canonicalize, _GenericCallFunctor, _),
Code = node([not_supported])
)
;
Index: compiler/llds_out.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/llds_out.m,v
retrieving revision 1.272
diff -u -b -r1.272 llds_out.m
--- compiler/llds_out.m 21 Mar 2006 02:33:35 -0000 1.272
+++ compiler/llds_out.m 21 Mar 2006 22:44:48 -0000
@@ -205,6 +205,7 @@
:- import_module assoc_list.
:- import_module bintree_set.
:- import_module char.
+:- import_module deconstruct.
:- import_module dir.
:- import_module int.
:- import_module library. % for the version number.
@@ -4801,7 +4802,7 @@
;
% The following is just for debugging purposes -
% string operators are not output as `str_eq', etc.
- functor(Op, Name, _)
+ functor(Op, canonicalize, Name, _)
).
%-----------------------------------------------------------------------------%
Index: compiler/mlds_to_il.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mlds_to_il.m,v
retrieving revision 1.159
diff -u -b -r1.159 mlds_to_il.m
--- compiler/mlds_to_il.m 17 Mar 2006 01:40:31 -0000 1.159
+++ compiler/mlds_to_il.m 17 Mar 2006 02:01:49 -0000
@@ -170,6 +170,7 @@
:- import_module assoc_list.
:- import_module counter.
+:- import_module deconstruct.
:- import_module int.
:- import_module library.
:- import_module map.
@@ -3564,7 +3565,7 @@
Type = CastType
;
Unop = std_unop(StdUnop),
- functor(StdUnop, StdUnopStr, _Arity),
+ functor(StdUnop, canonicalize, StdUnopStr, _Arity),
sorry(this_file, "rval_to_type: unop: " ++ StdUnopStr)
).
rval_to_type(binop(_, _, _), _) :-
Index: compiler/mlds_to_managed.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mlds_to_managed.m,v
retrieving revision 1.26
diff -u -b -r1.26 mlds_to_managed.m
--- compiler/mlds_to_managed.m 17 Mar 2006 01:40:31 -0000 1.26
+++ compiler/mlds_to_managed.m 17 Mar 2006 02:01:49 -0000
@@ -69,6 +69,7 @@
:- import_module assoc_list.
:- import_module bool.
:- import_module counter.
+:- import_module deconstruct.
:- import_module int.
:- import_module library.
:- import_module list.
@@ -437,7 +438,7 @@
write_rval(Lang, RVal, !IO),
io.write_string(";\n", !IO)
;
- functor(Statement, SFunctor, _Arity),
+ functor(Statement, canonicalize, SFunctor, _Arity),
sorry(this_file, "foreign code output for " ++ SFunctor)
).
cvs diff: Diffing compiler/notes
cvs diff: Diffing debian
cvs diff: Diffing debian/patches
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
cvs diff: Diffing extras
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/concurrency
cvs diff: Diffing extras/curs
cvs diff: Diffing extras/curs/samples
cvs diff: Diffing extras/curses
cvs diff: Diffing extras/curses/sample
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/error
cvs diff: Diffing extras/gator
cvs diff: Diffing extras/gator/generations
cvs diff: Diffing extras/gator/generations/1
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/easyx
cvs diff: Diffing extras/graphics/easyx/samples
cvs diff: Diffing extras/graphics/mercury_glut
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/gears
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/lex
cvs diff: Diffing extras/lex/samples
cvs diff: Diffing extras/lex/tests
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/moose/tests
cvs diff: Diffing extras/morphine
cvs diff: Diffing extras/morphine/non-regression-tests
cvs diff: Diffing extras/morphine/scripts
cvs diff: Diffing extras/morphine/source
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/quickcheck
cvs diff: Diffing extras/quickcheck/tutes
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/solver_types
cvs diff: Diffing extras/solver_types/library
cvs diff: Diffing extras/stream
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/windows_installer_generator
cvs diff: Diffing extras/windows_installer_generator/sample
cvs diff: Diffing extras/windows_installer_generator/sample/images
cvs diff: Diffing extras/xml
cvs diff: Diffing extras/xml/samples
cvs diff: Diffing extras/xml_stylesheets
cvs diff: Diffing java
cvs diff: Diffing java/runtime
cvs diff: Diffing library
Index: library/assoc_list.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/assoc_list.m,v
retrieving revision 1.19
diff -u -b -r1.19 assoc_list.m
--- library/assoc_list.m 7 Mar 2006 22:23:41 -0000 1.19
+++ library/assoc_list.m 15 Mar 2006 01:15:13 -0000
@@ -87,6 +87,7 @@
:- implementation.
+:- import_module type_desc.
:- import_module require.
:- import_module set.
:- import_module string.
Index: library/construct.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/construct.m,v
retrieving revision 1.26
diff -u -b -r1.26 construct.m
--- library/construct.m 7 Mar 2006 22:23:43 -0000 1.26
+++ library/construct.m 15 Mar 2006 02:02:16 -0000
@@ -33,7 +33,7 @@
% functors have the same name, the one with the lower arity
% will have the lower number.
%
-:- func num_functors(type_desc.type_desc) = int.
+:- func num_functors(type_desc) = int.
% get_functor(Type, FunctorNumber, FunctorName, Arity, ArgTypes)
%
@@ -43,8 +43,8 @@
% Fails if the type is not a discriminated union type, or if
% FunctorNumber is out of range.
%
-:- pred get_functor(type_desc.type_desc::in, int::in, string::out, int::out,
- list(type_desc.pseudo_type_desc)::out) is semidet.
+:- pred get_functor(type_desc::in, int::in, string::out, int::out,
+ list(pseudo_type_desc)::out) is semidet.
% get_functor_with_names(Type, FunctorNumber, FunctorName, Arity, ArgTypes,
% ArgNames)
@@ -55,9 +55,8 @@
% field name of each functor argument, if any. Fails if the type is
% not a discriminated union type, or if FunctorNumber is out of range.
%
-:- pred get_functor_with_names(type_desc.type_desc::in, int::in, string::out,
- int::out, list(type_desc.pseudo_type_desc)::out, list(maybe(string))::out)
- is semidet.
+:- pred get_functor_with_names(type_desc::in, int::in, string::out, int::out,
+ list(pseudo_type_desc)::out, list(maybe(string))::out) is semidet.
% get_functor_ordinal(Type, I, Ordinal)
%
@@ -66,8 +65,7 @@
% in lexicographic order. Fails if the type is not a discriminated
% union type, or if I is out of range.
%
-:- pred get_functor_ordinal(type_desc.type_desc::in, int::in, int::out)
- is semidet.
+:- pred get_functor_ordinal(type_desc::in, int::in, int::out) is semidet.
% construct(TypeInfo, I, Args) = Term
%
@@ -79,8 +77,8 @@
% functor, or if the types of the arguments do not match
% the expected argument types of that functor.
%
-:- func construct(type_desc.type_desc::in, int::in, list(univ)::in)
- = (univ::out) is semidet.
+:- func construct(type_desc::in, int::in, list(univ)::in) = (univ::out)
+ is semidet.
% construct_tuple(Args) = Term
%
@@ -124,8 +122,8 @@
PseudoTypeInfoList, ArgNameList0),
ArgNameList = map(null_to_no, ArgNameList0).
-:- pred get_functor_internal(type_desc.type_desc::in, int::in, string::out,
- int::out, list(type_desc.pseudo_type_desc)::out) is semidet.
+:- pred get_functor_internal(type_desc::in, int::in, string::out,
+ int::out, list(pseudo_type_desc)::out) is semidet.
get_functor_internal(TypeInfo, FunctorNumber, FunctorName, Arity,
MaybeTypeInfoList) :-
@@ -194,9 +192,9 @@
SUCCESS_INDICATOR = success;
}").
-:- pred get_functor_with_names_internal(type_desc.type_desc::in, int::in,
- string::out, int::out, list(type_desc.pseudo_type_desc)::out,
- list(string)::out) is semidet.
+:- pred get_functor_with_names_internal(type_desc::in, int::in,
+ string::out, int::out, list(pseudo_type_desc)::out, list(string)::out)
+ is semidet.
get_functor_with_names_internal(TypeDesc, FunctorNumber, FunctorName, Arity,
MaybeTypeInfoList, Names) :-
@@ -805,7 +803,7 @@
construct_tuple(Args) =
construct_tuple_2(Args, list.map(univ_type, Args), list.length(Args)).
-:- func construct_tuple_2(list(univ), list(type_desc.type_desc), int) = univ.
+:- func construct_tuple_2(list(univ), list(type_desc), int) = univ.
:- pragma foreign_proc("C",
construct_tuple_2(Args::in, ArgTypes::in, Arity::in) = (Term::out),
Index: library/deconstruct.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/deconstruct.m,v
retrieving revision 1.33
diff -u -b -r1.33 deconstruct.m
--- library/deconstruct.m 7 Mar 2006 22:23:43 -0000 1.33
+++ library/deconstruct.m 15 Mar 2006 01:44:32 -0000
@@ -129,10 +129,14 @@
:- mode arg(in, in(canonicalize), in, out) is semidet.
:- mode arg(in, in(canonicalize_or_do_not_allow), in, out) is semidet.
+:- type maybe_arg
+ ---> some [T] arg(T)
+ ; no_arg.
+
% arg_cc/3 is similar to arg/4, except that it handles arguments with
% non-canonical types. See the documentation of std_util.arg_cc.
%
-:- pred arg_cc(T::in, int::in, std_util.maybe_arg::out) is cc_multi.
+:- pred arg_cc(T::in, int::in, maybe_arg::out) is cc_multi.
% named_arg(Data, NonCanon, Name, Argument)
%
@@ -148,7 +152,7 @@
% named_arg_cc/3 is similar to named_arg/4, except that it handles
% arguments with non-canonical types.
%
-:- pred named_arg_cc(T::in, string::in, std_util.maybe_arg::out) is cc_multi.
+:- pred named_arg_cc(T::in, string::in, maybe_arg::out) is cc_multi.
% det_arg(Data, NonCanon, Index, Argument)
%
@@ -273,7 +277,7 @@
( Success \= 0 ->
MaybeArg = 'new arg'(univ_value(Univ))
;
- MaybeArg = std_util.no_arg
+ MaybeArg = no_arg
).
named_arg(Term, NonCanon, Name, Argument) :-
@@ -294,7 +298,7 @@
( Success \= 0 ->
MaybeArg = 'new arg'(univ_value(Univ))
;
- MaybeArg = std_util.no_arg
+ MaybeArg = no_arg
).
% This is a dummy value of type `univ'. It is used only to ensure that
Index: library/hash_table.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/hash_table.m,v
retrieving revision 1.12
diff -u -b -r1.12 hash_table.m
--- library/hash_table.m 7 Mar 2006 22:23:44 -0000 1.12
+++ library/hash_table.m 15 Mar 2006 01:38:23 -0000
@@ -206,11 +206,13 @@
:- implementation.
:- import_module bool.
+:- import_module deconstruct.
:- import_module exception.
:- import_module list.
:- import_module math.
:- import_module require.
:- import_module std_util.
+:- import_module type_desc.
:- type hash_table(K, V)
---> ht(
@@ -559,7 +561,7 @@
else
- deconstruct(T, FunctorName, Arity, Args),
+ deconstruct(T, canonicalize, FunctorName, Arity, Args),
string_double_hash(FunctorName, Ha0, Hb0),
double_munge(Arity, Ha0, Ha1, Arity, Hb0, Hb1),
list.foldl2(
Index: library/io.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/io.m,v
retrieving revision 1.343
diff -u -b -r1.343 io.m
--- library/io.m 7 Mar 2006 22:23:45 -0000 1.343
+++ library/io.m 15 Mar 2006 01:18:22 -0000
@@ -1516,6 +1516,7 @@
:- import_module require.
:- import_module term.
:- import_module term_io.
+:- import_module type_desc.
:- import_module varset.
:- use_module rtti_implementation.
Index: library/pprint.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/pprint.m,v
retrieving revision 1.19
diff -u -b -r1.19 pprint.m
--- library/pprint.m 7 Mar 2006 22:23:46 -0000 1.19
+++ library/pprint.m 15 Mar 2006 01:39:35 -0000
@@ -376,6 +376,7 @@
:- implementation.
:- import_module array.
+:- import_module deconstruct.
:- import_module enum.
:- import_module exception.
:- import_module map.
@@ -383,6 +384,7 @@
:- import_module robdd.
:- import_module sparse_bitset.
:- import_module term.
+:- import_module type_desc.
:- type doc
---> 'NIL'
@@ -716,12 +718,12 @@
then
- functor(X, Name, Arity),
+ functor(X, canonicalize, Name, Arity),
Doc = ( if Arity = 0 then text(Name) else Name ++ "/" ++ Arity )
else
- deconstruct(X, Name, _Arity, UnivArgs),
+ deconstruct(X, canonicalize, Name, _Arity, UnivArgs),
Table = init_mercury_op_table,
Doc =
( if
@@ -959,7 +961,7 @@
dynamic_cast_to_tuple(X, X) :-
% If X is a tuple then it's functor name is {}.
%
- functor(X, "{}", _Arity).
+ functor(X, canonicalize, "{}", _Arity).
%-----------------------------------------------------------------------------%
@@ -1024,7 +1026,7 @@
:- func tuple_to_doc(int, T) = doc.
tuple_to_doc(Depth, Tuple) = Doc :-
- deconstruct(Tuple, _Name, _Arity, UnivArgs),
+ deconstruct(Tuple, canonicalize, _Name, _Arity, UnivArgs),
Doc = group(braces(nest(1, packed_cs_univ_args(Depth - 1, UnivArgs)))).
%-----------------------------------------------------------------------------%
Index: library/private_builtin.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/private_builtin.m,v
retrieving revision 1.152
diff -u -b -r1.152 private_builtin.m
--- library/private_builtin.m 7 Mar 2006 22:23:46 -0000 1.152
+++ library/private_builtin.m 15 Mar 2006 01:18:47 -0000
@@ -115,7 +115,7 @@
:- import_module require.
:- import_module std_util.
:- import_module string.
-:- import_module string.
+:- import_module type_desc.
:- pragma foreign_code("C#", "
Index: library/prolog.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/prolog.m,v
retrieving revision 1.16
diff -u -b -r1.16 prolog.m
--- library/prolog.m 7 Mar 2006 22:23:47 -0000 1.16
+++ library/prolog.m 15 Mar 2006 01:44:53 -0000
@@ -72,6 +72,7 @@
:- implementation.
+:- import_module deconstruct.
:- import_module int.
:- import_module require.
@@ -85,11 +86,13 @@
'=\\='(X, Y) :- X \= Y.
'=..'(Term, Functor - Args) :-
- deconstruct(Term, Functor, _Arity, Args).
+ deconstruct(Term, canonicalize, Functor, _Arity, Args).
% we use a module qualifier here to avoid
% overriding the builtin Prolog version
-prolog.arg(ArgumentIndex, Type, argument(Type, ArgumentIndex - 1)).
+prolog.arg(ArgumentIndex, Type, Univ) :-
+ deconstruct.arg(Type, canonicalize, ArgumentIndex - 1, Arg),
+ type_to_univ(Arg, Univ).
det_arg(ArgumentIndex, Type, Argument) :-
( arg(ArgumentIndex, Type, Arg) ->
Index: library/require.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/require.m,v
retrieving revision 1.37
diff -u -b -r1.37 require.m
--- library/require.m 7 Mar 2006 22:23:47 -0000 1.37
+++ library/require.m 15 Mar 2006 01:18:55 -0000
@@ -69,6 +69,7 @@
:- import_module list.
:- import_module std_util.
:- import_module string.
+:- import_module type_desc.
require(Goal, Message) :-
( call(Goal) ->
Index: library/rtti_implementation.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/rtti_implementation.m,v
retrieving revision 1.63
diff -u -b -r1.63 rtti_implementation.m
--- library/rtti_implementation.m 1 Feb 2006 12:10:17 -0000 1.63
+++ library/rtti_implementation.m 15 Mar 2006 01:22:34 -0000
@@ -101,6 +101,7 @@
:- import_module int.
:- import_module require.
:- import_module string.
+:- import_module type_desc.
% Std_util has a lot of types and functions with the same names,
% so we prefer to keep the namespace separate.
@@ -1275,9 +1276,9 @@
TypeCtorRep = array,
% Constrain the T in array(T) to the correct element type.
- std_util.type_ctor_and_args(std_util.type_of(Term), _, Args),
+ type_ctor_and_args(type_of(Term), _, Args),
( Args = [ElemType] ->
- std_util.has_type(Elem, ElemType),
+ has_type(Elem, ElemType),
same_array_elem_type(Array, Elem)
;
error("An array which doesn't have a type_ctor arg")
Index: library/std_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/std_util.m,v
retrieving revision 1.306
diff -u -b -r1.306 std_util.m
--- library/std_util.m 7 Mar 2006 22:23:49 -0000 1.306
+++ library/std_util.m 15 Mar 2006 01:13:36 -0000
@@ -384,361 +384,6 @@
:- mode cc_multi_equal(in, out) is cc_multi.
%-----------------------------------------------------------------------------%
-
- % The `type_desc' and `type_ctor_desc' types: these
- % provide access to type information.
- % A type_desc represents a type, e.g. `list(int)'.
- % A type_ctor_desc represents a type constructor, e.g. `list/1'.
- %
-:- type type_desc == type_desc.type_desc.
-:- type type_ctor_desc == type_desc.type_ctor_desc.
-
- % Type_info and type_ctor_info are the old names for type_desc and
- % type_ctor_desc. They should not be used by new software.
- %
-:- type type_info == type_desc.type_desc.
-:- type type_ctor_info == type_desc.type_ctor_desc.
-
- % (Note: it is not possible for the type of a variable to be an
- % unbound type variable; if there are no constraints on a type
- % variable, then the typechecker will use the type `void'.
- % `void' is a special (builtin) type that has no constructors.
- % There is no way of creating an object of type `void'.
- % `void' is not considered to be a discriminated union, so
- % get_functor/5 and construct/3 will fail if used upon a value
- % of this type.)
-
- % The function type_of/1 returns a representation of the type
- % of its argument.
- %
-:- func type_of(T::unused) = (type_desc.type_desc::out) is det.
-
- % The predicate has_type/2 is basically an existentially typed
- % inverse to the function type_of/1. It constrains the type
- % of the first argument to be the type represented by the
- % second argument.
- %
-:- some [T] pred has_type(T::unused, type_desc.type_desc::in) is det.
-
- % type_name(Type) returns the name of the specified type
- % (e.g. type_name(type_of([2, 3])) = "list:list(int)").
- % Any equivalence types will be fully expanded.
- % Builtin types (those defined in builtin.m) will
- % not have a module qualifier.
- %
-:- func type_name(type_desc.type_desc) = string.
-
- % type_ctor_and_args(Type, TypeCtor, TypeArgs):
- % True iff `TypeCtor' is a representation of the top-level
- % type constructor for `Type', and `TypeArgs' is a list
- % of the corresponding type arguments to `TypeCtor',
- % and `TypeCtor' is not an equivalence type.
- %
- % For example, type_ctor_and_args(type_of([2, 3]), TypeCtor,
- % TypeArgs) will bind `TypeCtor' to a representation of the
- % type constructor list/1, and will bind `TypeArgs' to the list
- % `[Int]', where `Int' is a representation of the type `int'.
- %
- % Note that the requirement that `TypeCtor' not be an
- % equivalence type is fulfilled by fully expanding any
- % equivalence types. For example, if you have a declaration
- % `:- type foo == bar.', then type_ctor_and_args/3 will always
- % return a representation of type constructor `bar/0', not `foo/0'.
- % (If you don't want them expanded, you can use the reverse mode
- % of make_type/2 instead.)
- %
-:- pred type_ctor_and_args(type_desc.type_desc::in,
- type_desc.type_ctor_desc::out, list(type_desc.type_desc)::out)
- is det.
-
- % type_ctor(Type) = TypeCtor :-
- % type_ctor_and_args(Type, TypeCtor, _).
- %
-:- func type_ctor(type_desc.type_desc) = type_desc.type_ctor_desc.
-
- % type_args(Type) = TypeArgs :-
- % type_ctor_and_args(Type, _, TypeArgs).
- %
-:- func type_args(type_desc.type_desc) = list(type_desc.type_desc).
-
- % type_ctor_name(TypeCtor) returns the name of specified
- % type constructor.
- % (e.g. type_ctor_name(type_ctor(type_of([2, 3]))) = "list").
- %
-:- func type_ctor_name(type_desc.type_ctor_desc) = string.
-
- % type_ctor_module_name(TypeCtor) returns the module name of specified
- % type constructor.
- % (e.g. type_ctor_module_name(type_ctor(type_of(2))) = "builtin").
- %
-:- func type_ctor_module_name(type_desc.type_ctor_desc) = string.
-
- % type_ctor_arity(TypeCtor) returns the arity of specified
- % type constructor.
- % (e.g. type_ctor_arity(type_ctor(type_of([2, 3]))) = 1).
- %
-:- func type_ctor_arity(type_desc.type_ctor_desc) = int.
-
- % type_ctor_name_and_arity(TypeCtor, ModuleName, TypeName, Arity) :-
- % Name = type_ctor_name(TypeCtor),
- % ModuleName = type_ctor_module_name(TypeCtor),
- % Arity = type_ctor_arity(TypeCtor).
- %
-:- pred type_ctor_name_and_arity(type_desc.type_ctor_desc::in, string::out,
- string::out, int::out) is det.
-
- % make_type(TypeCtor, TypeArgs) = Type:
- % True iff `Type' is a type constructed by applying
- % the type constructor `TypeCtor' to the type arguments
- % `TypeArgs'.
- %
- % Operationally, the forwards mode returns the type formed by
- % applying the specified type constructor to the specified
- % argument types, or fails if the length of TypeArgs is not the
- % same as the arity of TypeCtor. The reverse mode returns a
- % type constructor and its argument types, given a type_desc;
- % the type constructor returned may be an equivalence type
- % (and hence this reverse mode of make_type/2 may be more useful
- % for some purposes than the type_ctor/1 function).
- %
-:- func make_type(type_desc.type_ctor_desc, list(type_desc.type_desc)) =
- type_desc.type_desc.
-:- mode make_type(in, in) = out is semidet.
-:- mode make_type(out, out) = in is cc_multi.
-
- % det_make_type(TypeCtor, TypeArgs):
- %
- % Returns the type formed by applying the specified type
- % constructor to the specified argument types. Aborts if the
- % length of `TypeArgs' is not the same as the arity of `TypeCtor'.
- %
-:- func det_make_type(type_desc.type_ctor_desc, list(type_desc.type_desc)) =
- type_desc.type_desc.
-:- mode det_make_type(in, in) = out is det.
-
-%-----------------------------------------------------------------------------%
-
- % num_functors(TypeInfo)
- %
- % Returns the number of different functors for the top-level
- % type constructor of the type specified by TypeInfo, or -1
- % if the type is not a discriminated union type.
- %
- % The functors of a discriminated union type are numbered from
- % zero to N-1, where N is the value returned by num_functors.
- % The functors are numbered in lexicographic order. If two
- % functors have the same name, the one with the lower arity
- % will have the lower number.
- %
-:- func num_functors(type_desc.type_desc) = int.
-
- % get_functor(Type, FunctorNumber, FunctorName, Arity, ArgTypes)
- %
- % Binds FunctorName and Arity to the name and arity of functor number
- % FunctorNumber for the specified type, and binds ArgTypes to the
- % type_descs for the types of the arguments of that functor.
- % Fails if the type is not a discriminated union type, or if
- % FunctorNumber is out of range.
- %
-:- pred get_functor(type_desc.type_desc::in, int::in, string::out, int::out,
- list(type_desc.type_desc)::out) is semidet.
-
- % get_functor_with_names(Type, FunctorNumber, FunctorName, Arity,
- % ArgTypes, ArgNames)
- %
- % Binds FunctorName and Arity to the name and arity of functor number
- % FunctorNumber for the specified type, ArgTypes to the type_descs
- % for the types of the arguments of that functor, and ArgNames to the
- % field name of each functor argument, if any. Fails if the type is
- % not a discriminated union type, or if FunctorNumber is out of range.
- %
-:- pred get_functor_with_names(type_desc.type_desc::in, int::in, string::out,
- int::out, list(type_desc.type_desc)::out, list(maybe(string))::out)
- is semidet.
-
- % get_functor_ordinal(Type, I, Ordinal)
- %
- % Returns Ordinal, where Ordinal is the position in declaration order
- % for the specified type of the function symbol that is in position I
- % in lexicographic order. Fails if the type is not a discriminated
- % union type, or if I is out of range.
- %
-:- pred get_functor_ordinal(type_desc.type_desc::in, int::in, int::out)
- is semidet.
-
- % construct(TypeInfo, I, Args) = Term
- %
- % Returns a term of the type specified by TypeInfo whose functor
- % is functor number I of the type given by TypeInfo, and whose
- % arguments are given by Args. Fails if the type is not a
- % discriminated union type, or if I is out of range, or if the
- % number of arguments supplied doesn't match the arity of the selected
- % functor, or if the types of the arguments do not match
- % the expected argument types of that functor.
- %
-:- func construct(type_desc.type_desc, int, list(univ)) = univ is semidet.
-
- % construct_tuple(Args) = Term
- %
- % Returns a tuple whose arguments are given by Args.
- %
-:- func construct_tuple(list(univ)) = univ.
-
-%-----------------------------------------------------------------------------%
-
-:- type maybe_arg
- ---> some [T] arg(T)
- ; no_arg.
-
- % functor, argument and deconstruct and their variants take any type
- % (including univ), and return representation information for that type.
- %
- % The string representation of the functor that these predicates
- % return is:
- %
- % - for user defined types, the functor that is given
- % in the type definition. For lists, this
- % means the functors [|]/2 and []/0 are used, even if
- % the list uses the [....] shorthand.
- % - for integers, the string is a base 10 number,
- % positive integers have no sign.
- % - for floats, the string is a floating point,
- % base 10 number, positive floating point numbers have
- % no sign.
- % - for strings, the string, inside double quotation marks
- % - for characters, the character inside single quotation marks
- % - for predicates, the string <<predicate>>
- % - for functions, the string <<function>>
- % - for tuples, the string {}
- % - for arrays, the string <<array>>
- %
- % The arity that these predicates return is:
- %
- % - for user defined types, the arity of the functor.
- % - for integers, zero.
- % - for floats, zero.
- % - for strings, zero.
- % - for characters, zero.
- % - for predicates and functions, zero; we do not return the
- % number of arguments expected by the predicate or function.
- % - for tuples, the number of elements in the tuple.
- % - for arrays, the number of elements in the array.
-
- % functor(Data, Functor, Arity)
- %
- % Given a data item (Data), binds Functor to a string
- % representation of the functor and Arity to the arity of this
- % data item. (Aborts if the type of Data is a type with a
- % non-canonical representation, i.e. one for which there is a
- % user-defined equality predicate.)
- %
- % Functor_cc succeeds even if the first argument is of a
- % non-canonical type.
- %
-:- pred functor(T::in, string::out, int::out) is det.
-:- pred functor_cc(T::in, string::out, int::out) is cc_multi.
-
- % arg(Data, ArgumentIndex) = Argument
- % argument(Data, ArgumentIndex) = ArgumentUniv
- %
- % Given a data item (Data) and an argument index
- % (ArgumentIndex), starting at 0 for the first argument, binds
- % Argument to that argument of the functor of the data item. If
- % the argument index is out of range -- that is, greater than or
- % equal to the arity of the functor or lower than 0 -- then
- % the call fails. For argument/2 the argument returned has the
- % type univ, which can store any type. For arg/2, if the
- % argument has the wrong type, then the call fails.
- % (Both abort if the type of Data is a type with a non-canonical
- % representation, i.e. one for which there is a user-defined
- % equality predicate.)
- %
- % arg_cc and argument_cc succeed even if the first argument is
- % of a non-canonical type. They both encode the possible
- % non-existence of an argument at the requested location by using
- % a maybe type.
- %
-:- func arg(T::in, int::in) = (ArgT::out) is semidet.
-:- pred arg_cc(T::in, int::in, maybe_arg::out) is cc_multi.
-:- func argument(T::in, int::in) = (univ::out) is semidet.
-:- pred argument_cc(T::in, int::in, maybe(univ)::out) is cc_multi.
-
- % named_argument(Data, ArgumentName) = ArgumentUniv
- %
- % Same as argument/2, except the chosen argument is specified by giving
- % its name rather than its position. If Data has no argument with that
- % name, named_argument fails.
- %
- % named_argument_cc succeeds even if the first argument is
- % of a non-canonical type.
- %
-:- func named_argument(T::in, string::in) = (univ::out) is semidet.
-:- pred named_argument_cc(T::in, string::in, maybe(univ)::out) is cc_multi.
-
- % det_arg(Data, ArgumentIndex) = Argument
- % det_argument(Data, ArgumentIndex) = ArgumentUniv
- %
- % Same as arg/2 and argument/2 respectively, except that
- % for cases where arg/2 or argument/2 would fail,
- % det_arg/2 or det_argument/2 will abort.
- %
- % det_arg_cc and det_argument_cc succeed even if the first argument is
- % of a non-canonical type.
- %
-:- func det_arg(T::in, int::in) = (ArgT::out) is det.
-:- pred det_arg_cc(T::in, int::in, ArgT::out) is cc_multi.
-:- func det_argument(T::in, int::in) = (univ::out) is det.
-:- pred det_argument_cc(T::in, int::in, univ::out) is cc_multi.
-
- % det_named_argument(Data, ArgumentName) = ArgumentUniv
- %
- % Same as named_argument/2, except that for cases where
- % named_argument/2 would fail, det_named_argument/2 will abort.
- %
-:- func det_named_argument(T::in, string::in) = (univ::out) is det.
-:- pred det_named_argument_cc(T::in, string::in, univ::out) is cc_multi.
-
- % deconstruct(Data, Functor, Arity, Arguments)
- %
- % Given a data item (Data), binds Functor to a string
- % representation of the functor, Arity to the arity of this data
- % item, and Arguments to a list of arguments of the functor.
- % The arguments in the list are each of type univ.
- % (Aborts if the type of Data is a type with a non-canonical
- % representation, i.e. one for which there is a user-defined
- % equality predicate.)
- %
- % The cost of calling deconstruct depends greatly on how many arguments
- % Data has. If Data is an array, then each element of the array is
- % considered one of its arguments. Therefore calling deconstruct
- % on large arrays can take a very large amount of memory and a very
- % long time. If you call deconstruct in a situation in which you may
- % pass it a large array, you should probably use limited_deconstruct
- % instead.
- %
- % deconstruct_cc succeeds even if the first argument is
- % of a non-canonical type.
- %
-:- pred deconstruct(T::in, string::out, int::out, list(univ)::out) is det.
-:- pred deconstruct_cc(T::in, string::out, int::out, list(univ)::out)
- is cc_multi.
-
- % limited_deconstruct(Data, MaxArity, Functor, Arity, Arguments)
- %
- % limited_deconstruct works like deconstruct, but if the arity of T is
- % greater than MaxArity, limited_deconstruct fails. This is useful in
- % avoiding bad performance in cases where Data may be a large array.
- %
- % limited_deconstruct_cc succeeds even if the first argument is
- % of a non-canonical type. limited_deconstruct_cc encodes the
- % possible failure of the predicate by using a maybe type.
- %
-:- pred limited_deconstruct(T::in, int::in, string::out,
- int::out, list(univ)::out) is semidet.
-:- pred limited_deconstruct_cc(T::in, int::in,
- maybe({string, int, list(univ)})::out) is cc_multi.
-
-%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
@@ -1407,7 +1052,8 @@
%%% :- implementation.
% This type is a builtin-in type whose operations are implemented in C.
-:- type mutvar(T) ---> mutvar(private_builtin.ref(T)).
+:- type mutvar(T)
+ ---> mutvar(private_builtin.ref(T)).
:- pragma inline(new_mutvar/2).
:- pragma inline(get_mutvar/2).
@@ -1695,183 +1341,6 @@
dynamic_cast(X, Y) :-
private_builtin.typed_unify(X, Y).
-
-%-----------------------------------------------------------------------------%
-
-% The actual code of these predicates and functions is now in
-% the file type_desc.m.
-
-type_of(Value) =
- type_desc.type_of(Value).
-
-has_type(Arg, TypeInfo) :-
- type_desc.has_type(Arg, TypeInfo).
-
-type_name(Type) =
- type_desc.type_name(Type).
-
-type_args(Type) =
- type_desc.type_args(Type).
-
-type_ctor_name(TypeCtor) =
- type_desc.type_ctor_name(TypeCtor).
-
-type_ctor_module_name(TypeCtor) =
- type_desc.type_ctor_module_name(TypeCtor).
-
-type_ctor_arity(TypeCtor) =
- type_desc.type_ctor_arity(TypeCtor).
-
-det_make_type(TypeCtor, ArgTypes) =
- type_desc.det_make_type(TypeCtor, ArgTypes).
-
-type_ctor(TypeInfo) =
- type_desc.type_ctor(TypeInfo).
-
-type_ctor_and_args(TypeDesc, TypeCtorDesc, ArgTypes) :-
- type_desc.type_ctor_and_args(TypeDesc, TypeCtorDesc, ArgTypes).
-
-make_type(TypeCtorDesc, ArgTypes) =
- type_desc.make_type(TypeCtorDesc, ArgTypes).
-
-type_ctor_name_and_arity(TypeCtorDesc, TypeCtorModuleName,
- TypeCtorName, TypeCtorArity) :-
- type_desc.type_ctor_name_and_arity(TypeCtorDesc, TypeCtorModuleName,
- TypeCtorName, TypeCtorArity).
-
-%-----------------------------------------------------------------------------%
-%-----------------------------------------------------------------------------%
-
-% The actual code of these predicates and functions is now in
-% the file construct.m.
-
-num_functors(TypeInfo) =
- construct.num_functors(TypeInfo).
-
-get_functor(TypeDesc, FunctorNumber, FunctorName, Arity, TypeInfoList) :-
- construct.get_functor(TypeDesc, FunctorNumber, FunctorName,
- Arity, PseudoTypeInfoList),
- % If a pseudo_type_info in PseudoTypeInfoList is not ground, then
- % we get an exception thrown. This is not good, but is no worse than
- % the current behavior. If you want to avoid this, use construct.m's
- % version of get_functor.
- TypeInfoList = list.map(ground_pseudo_type_desc_to_type_desc_det,
- PseudoTypeInfoList).
-
-get_functor_with_names(TypeDesc, FunctorNumber, FunctorName, Arity,
- TypeInfoList, ArgNameList) :-
- construct.get_functor_with_names(TypeDesc, FunctorNumber, FunctorName,
- Arity, PseudoTypeInfoList, ArgNameList),
- % If a pseudo_type_info in PseudoTypeInfoList is not ground, then
- % we get an exception thrown. This is not good, but is no worse than
- % the current behavior. If you want to avoid this, use construct.m's
- % version of get_functor_with_names.
- TypeInfoList = list.map(ground_pseudo_type_desc_to_type_desc_det,
- PseudoTypeInfoList).
-
-get_functor_ordinal(TypeDesc, FunctorNumber, Ordinal) :-
- construct.get_functor_ordinal(TypeDesc, FunctorNumber, Ordinal).
-
-construct(TypeDesc, FunctorNumber, ArgList) =
- construct.construct(TypeDesc, FunctorNumber, ArgList).
-
-construct_tuple(Args) =
- construct.construct_tuple(Args).
-
-%-----------------------------------------------------------------------------%
-
-% The actual code of these predicates and functions is now in
-% the file deconstruct.m.
-
-functor(Term, Functor, Arity) :-
- deconstruct.functor(Term, canonicalize, Functor, Arity).
-
-functor_cc(Term, Functor, Arity) :-
- deconstruct.functor(Term, include_details_cc, Functor, Arity).
-
-arg(Term, Index) = Argument :-
- deconstruct.arg(Term, canonicalize, Index, Argument0),
- private_builtin.typed_unify(Argument0, Argument).
-
-arg_cc(Term, Index, Argument) :-
- deconstruct.arg_cc(Term, Index, Argument).
-
-argument(Term, Index) = ArgumentUniv :-
- deconstruct.arg(Term, canonicalize, Index, Argument),
- type_to_univ(Argument, ArgumentUniv).
-
-argument_cc(Term, Index, MaybeArgumentUniv) :-
- deconstruct.arg_cc(Term, Index, MaybeArgument),
- (
- MaybeArgument = arg(Argument),
- type_to_univ(Argument, ArgumentUniv),
- MaybeArgumentUniv = yes(ArgumentUniv)
- ;
- MaybeArgument = no_arg,
- MaybeArgumentUniv = no
- ).
-
-named_argument(Term, Name) = ArgumentUniv :-
- deconstruct.named_arg(Term, canonicalize, Name, Argument),
- type_to_univ(Argument, ArgumentUniv).
-
-named_argument_cc(Term, Name, MaybeArgumentUniv) :-
- deconstruct.named_arg_cc(Term, Name, MaybeArgument),
- (
- MaybeArgument = arg(Argument),
- type_to_univ(Argument, ArgumentUniv),
- MaybeArgumentUniv = yes(ArgumentUniv)
- ;
- MaybeArgument = no_arg,
- MaybeArgumentUniv = no
- ).
-
-deconstruct(Term, Functor, Arity, Arguments) :-
- deconstruct.deconstruct(Term, canonicalize,
- Functor, Arity, Arguments).
-
-deconstruct_cc(Term, Functor, Arity, Arguments) :-
- deconstruct.deconstruct(Term, include_details_cc,
- Functor, Arity, Arguments).
-
-limited_deconstruct(Term, MaxArity, Functor, Arity, Arguments) :-
- deconstruct.limited_deconstruct(Term, canonicalize,
- MaxArity, Functor, Arity, Arguments).
-
-limited_deconstruct_cc(Term, MaxArity, Result) :-
- deconstruct.limited_deconstruct_cc(Term, MaxArity, Result).
-
-det_arg(Type, Index) = Argument :-
- deconstruct.det_arg(Type, canonicalize, Index, Argument0),
- ( private_builtin.typed_unify(Argument0, Argument1) ->
- Argument = Argument1
- ;
- error("det_arg: argument has wrong type")
- ).
-
-det_arg_cc(Type, Index, Argument) :-
- deconstruct.det_arg(Type, include_details_cc, Index, Argument0),
- ( private_builtin.typed_unify(Argument0, Argument1) ->
- Argument = Argument1
- ;
- error("det_arg_cc: argument has wrong type")
- ).
-
-det_argument(Type, Index) = ArgumentUniv :-
- deconstruct.det_arg(Type, canonicalize, Index, Argument),
- type_to_univ(Argument, ArgumentUniv).
-
-det_argument_cc(Type, Index, ArgumentUniv) :-
- deconstruct.det_arg(Type, include_details_cc, Index, Argument),
- type_to_univ(Argument, ArgumentUniv).
-
-det_named_argument(Type, Name) = ArgumentUniv :-
- deconstruct.det_named_arg(Type, canonicalize, Name, Argument),
- type_to_univ(Argument, ArgumentUniv).
-
-det_named_argument_cc(Type, Name, ArgumentUniv) :-
- deconstruct.det_named_arg(Type, include_details_cc, Name, Argument),
- type_to_univ(Argument, ArgumentUniv).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
Index: library/store.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/store.m,v
retrieving revision 1.54
diff -u -b -r1.54 store.m
--- library/store.m 7 Mar 2006 22:23:49 -0000 1.54
+++ library/store.m 15 Mar 2006 02:11:44 -0000
@@ -236,8 +236,8 @@
:- implementation.
+:- import_module deconstruct.
:- import_module require.
-:- import_module std_util.
:- typeclass store(T) where [].
:- instance store(store(S)) where [].
@@ -513,7 +513,7 @@
ref_functor(Ref, Functor, Arity, !Store) :-
unsafe_ref_value(Ref, Val, !Store),
- functor(Val, Functor, Arity).
+ functor(Val, canonicalize, Functor, Arity).
:- pragma foreign_decl("C",
"
Index: library/string.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/string.m,v
retrieving revision 1.242
diff -u -b -r1.242 string.m
--- library/string.m 27 Jan 2006 05:52:14 -0000 1.242
+++ library/string.m 15 Mar 2006 01:22:59 -0000
@@ -753,10 +753,10 @@
:- import_module integer.
:- import_module require.
:- import_module std_util.
+:- import_module type_desc.
:- use_module rtti_implementation.
:- use_module term_io.
-:- use_module type_desc.
string.replace(Str, Pat, Subst, Result) :-
sub_string_search(Str, Pat, Index),
Index: library/term.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/term.m,v
retrieving revision 1.115
diff -u -b -r1.115 term.m
--- library/term.m 7 Mar 2006 22:23:50 -0000 1.115
+++ library/term.m 15 Mar 2006 02:05:41 -0000
@@ -29,23 +29,23 @@
%-----------------------------------------------------------------------------%
:- type term(T)
- ---> term.functor(
+ ---> functor(
const,
list(term(T)),
term.context
)
- ; term.variable(
+ ; variable(
var(T)
).
:- type const
- ---> term.atom(string)
- ; term.integer(int)
- ; term.string(string)
- ; term.float(float).
+ ---> atom(string)
+ ; integer(int)
+ ; string(string)
+ ; float(float).
:- type term.context
- ---> term.context(string, int).
+ ---> context(string, int).
% file name, line number.
:- type var(T).
@@ -82,15 +82,14 @@
% ArgContexts specifies the path from the root of the term
% to the offending subterm.
%
-:- func term.try_term_to_type(term(U)) = term_to_type_result(T, U).
-:- pred term.try_term_to_type(term(U)::in, term_to_type_result(T, U)::out)
- is det.
+:- func try_term_to_type(term(U)) = term_to_type_result(T, U).
+:- pred try_term_to_type(term(U)::in, term_to_type_result(T, U)::out) is det.
:- type term_to_type_error(T)
---> type_error(
term(T),
type_desc.type_desc,
- term.context,
+ context,
term_to_type_context
)
; mode_error(
@@ -104,263 +103,263 @@
---> arg_context(
const, % functor
int, % argument number (starting from 1)
- term.context % filename & line number
+ context % filename & line number
).
% term_to_type(Term, Type) :- try_term_to_type(Term, ok(Type)).
%
-:- pred term.term_to_type(term(U)::in, T::out) is semidet.
+:- pred term_to_type(term(U)::in, T::out) is semidet.
% Like term_to_type, but calls error/1 rather than failing.
%
-:- func term.det_term_to_type(term(_)) = T.
-:- pred term.det_term_to_type(term(_)::in, T::out) is det.
+:- func det_term_to_type(term(_)) = T.
+:- pred det_term_to_type(term(_)::in, T::out) is det.
% Converts a value to a term representation of that value.
%
-:- func term.type_to_term(T) = term(_).
-:- pred term.type_to_term(T::in, term(_)::out) is det.
+:- func type_to_term(T) = term(_).
+:- pred type_to_term(T::in, term(_)::out) is det.
% Convert the value stored in the univ (as distinct from the univ itself)
% to a term.
%
-:- func term.univ_to_term(univ) = term(_).
-:- pred term.univ_to_term(univ::in, term(_)::out) is det.
+:- func univ_to_term(univ) = term(_).
+:- pred univ_to_term(univ::in, term(_)::out) is det.
%-----------------------------------------------------------------------------%
- % term.vars(Term, Vars):
+ % vars(Term, Vars):
%
% Vars is the list of variables contained in Term, in the order
% obtained by traversing the term depth first, left-to-right.
%
-:- func term.vars(term(T)) = list(var(T)).
-:- pred term.vars(term(T)::in, list(var(T))::out) is det.
+:- func vars(term(T)) = list(var(T)).
+:- pred vars(term(T)::in, list(var(T))::out) is det.
% As above, but with an accumulator.
%
-:- func term.vars_2(term(T), list(var(T))) = list(var(T)).
-:- pred term.vars_2(term(T)::in, list(var(T))::in, list(var(T))::out) is det.
+:- func vars_2(term(T), list(var(T))) = list(var(T)).
+:- pred vars_2(term(T)::in, list(var(T))::in, list(var(T))::out) is det.
- % term.vars_list(TermList, Vars):
+ % vars_list(TermList, Vars):
%
% Vars is the list of variables contained in TermList, in the order
% obtained by traversing the list of terms depth-first, left-to-right.
%
-:- func term.vars_list(list(term(T))) = list(var(T)).
-:- pred term.vars_list(list(term(T))::in, list(var(T))::out) is det.
+:- func vars_list(list(term(T))) = list(var(T)).
+:- pred vars_list(list(term(T))::in, list(var(T))::out) is det.
- % term.contains_var(Term, Var):
+ % contains_var(Term, Var):
%
% True if Term contains Var. On backtracking returns all the variables
% contained in Term.
%
-:- pred term.contains_var(term(T), var(T)).
-:- mode term.contains_var(in, in) is semidet.
-:- mode term.contains_var(in, out) is nondet.
+:- pred contains_var(term(T), var(T)).
+:- mode contains_var(in, in) is semidet.
+:- mode contains_var(in, out) is nondet.
- % term.contains_var_list(TermList, Var):
+ % contains_var_list(TermList, Var):
%
% True if TermList contains Var. On backtracking returns all the variables
% contained in Term.
%
-:- pred term.contains_var_list(list(term(T)), var(T)).
-:- mode term.contains_var_list(in, in) is semidet.
-:- mode term.contains_var_list(in, out) is nondet.
+:- pred contains_var_list(list(term(T)), var(T)).
+:- mode contains_var_list(in, in) is semidet.
+:- mode contains_var_list(in, out) is nondet.
:- type substitution(T) == map(var(T), term(T)).
:- type substitution == substitution(generic).
- % term.unify(Term1, Term2, Bindings0, Bindings):
+ % unify(Term1, Term2, Bindings0, Bindings):
%
% Unify (with occur check) two terms with respect to a set of bindings
% and possibly update the set of bindings.
%
-:- pred term.unify(term(T)::in, term(T)::in, substitution(T)::in,
+:- pred unify(term(T)::in, term(T)::in, substitution(T)::in,
substitution(T)::out) is semidet.
% As above, but unify the corresponding elements of two lists of terms.
% Fails if the lists are not of equal length.
%
-:- pred term.unify_list(list(term(T))::in, list(term(T))::in,
+:- pred unify_list(list(term(T))::in, list(term(T))::in,
substitution(T)::in, substitution(T)::out) is semidet.
- % term.unify(Term1, Term2, BoundVars, !Bindings):
+ % unify(Term1, Term2, BoundVars, !Bindings):
%
% Unify (with occur check) two terms with respect to a set of bindings
% and possibly update the set of bindings. Fails if any of the variables
% in BoundVars would become bound by the unification.
%
-:- pred term.unify(term(T)::in, term(T)::in, list(var(T))::in,
+:- pred unify(term(T)::in, term(T)::in, list(var(T))::in,
substitution(T)::in, substitution(T)::out) is semidet.
% As above, but unify the corresponding elements of two lists of terms.
% Fails if the lists are not of equal length.
%
-:- pred term.unify_list(list(term(T))::in, list(term(T))::in,
+:- pred unify_list(list(term(T))::in, list(term(T))::in,
list(var(T))::in, substitution(T)::in, substitution(T)::out) is semidet.
- % term.list_subsumes(Terms1, Terms2, Subst) succeeds iff the list
+ % list_subsumes(Terms1, Terms2, Subst) succeeds iff the list
% Terms1 subsumes (is more general than) Terms2, producing a substitution
% which when applied to Terms1 will give Terms2.
%
-:- pred term.list_subsumes(list(term(T))::in, list(term(T))::in,
+:- pred list_subsumes(list(term(T))::in, list(term(T))::in,
substitution(T)::out) is semidet.
- % term.substitute(Term0, Var, Replacement, Term):
+ % substitute(Term0, Var, Replacement, Term):
%
% Replace all occurrences of Var in Term0 with Replacement,
% and return the result in Term.
%
-:- func term.substitute(term(T), var(T), term(T)) = term(T).
-:- pred term.substitute(term(T)::in, var(T)::in, term(T)::in, term(T)::out)
+:- func substitute(term(T), var(T), term(T)) = term(T).
+:- pred substitute(term(T)::in, var(T)::in, term(T)::in, term(T)::out)
is det.
- % As above, except for a list of terms rather than a single term.
+ % As above, except for a list of terms rather than a single
%
-:- func term.substitute_list(list(term(T)), var(T), term(T)) = list(term(T)).
-:- pred term.substitute_list(list(term(T))::in, var(T)::in, term(T)::in,
+:- func substitute_list(list(term(T)), var(T), term(T)) = list(term(T)).
+:- pred substitute_list(list(term(T))::in, var(T)::in, term(T)::in,
list(term(T))::out) is det.
- % term.substitute_corresponding(Vars, Repls, Term0, Term):
+ % substitute_corresponding(Vars, Repls, Term0, Term):
%
% Replace all occurrences of variables in Vars with the corresponding
% term in Repls, and return the result in Term. If Vars contains
% duplicates, or if Vars is not the same length as Repls, the behaviour
% is undefined and probably harmful.
%
-:- func term.substitute_corresponding(list(var(T)), list(term(T)),
+:- func substitute_corresponding(list(var(T)), list(term(T)),
term(T)) = term(T).
-:- pred term.substitute_corresponding(list(var(T))::in, list(term(T))::in,
+:- pred substitute_corresponding(list(var(T))::in, list(term(T))::in,
term(T)::in, term(T)::out) is det.
% As above, except applies to a list of terms rather than a single term.
%
-:- func term.substitute_corresponding_list(list(var(T)),
+:- func substitute_corresponding_list(list(var(T)),
list(term(T)), list(term(T))) = list(term(T)).
-:- pred term.substitute_corresponding_list(list(var(T))::in,
+:- pred substitute_corresponding_list(list(var(T))::in,
list(term(T))::in, list(term(T))::in, list(term(T))::out) is det.
- % term.apply_rec_substitution(Term0, Substitution, Term):
+ % apply_rec_substitution(Term0, Substitution, Term):
%
% Recursively apply substitution to Term0 until no more substitutions
% can be applied, and then return the result in Term.
%
-:- func term.apply_rec_substitution(term(T), substitution(T)) = term(T).
-:- pred term.apply_rec_substitution(term(T)::in, substitution(T)::in,
+:- func apply_rec_substitution(term(T), substitution(T)) = term(T).
+:- pred apply_rec_substitution(term(T)::in, substitution(T)::in,
term(T)::out) is det.
% As above, except applies to a list of terms rather than a single term.
%
-:- func term.apply_rec_substitution_to_list(list(term(T)),
+:- func apply_rec_substitution_to_list(list(term(T)),
substitution(T)) = list(term(T)).
-:- pred term.apply_rec_substitution_to_list(list(term(T))::in,
+:- pred apply_rec_substitution_to_list(list(term(T))::in,
substitution(T)::in, list(term(T))::out) is det.
- % term.apply_substitution(Term0, Substitution, Term):
+ % apply_substitution(Term0, Substitution, Term):
%
% Apply substitution to Term0 and return the result in Term.
%
-:- func term.apply_substitution(term(T), substitution(T)) = term(T).
-:- pred term.apply_substitution(term(T)::in, substitution(T)::in,
+:- func apply_substitution(term(T), substitution(T)) = term(T).
+:- pred apply_substitution(term(T)::in, substitution(T)::in,
term(T)::out) is det.
% As above, except applies to a list of terms rather than a single term.
%
-:- func term.apply_substitution_to_list(list(term(T)),
+:- func apply_substitution_to_list(list(term(T)),
substitution(T)) = list(term(T)).
-:- pred term.apply_substitution_to_list(list(term(T))::in,
+:- pred apply_substitution_to_list(list(term(T))::in,
substitution(T)::in, list(term(T))::out) is det.
- % term.occurs(Term0, Var, Substitution):
+ % occurs(Term0, Var, Substitution):
% True iff Var occurs in the term resulting after applying Substitution
% to Term0. Var variable must not be mapped by Substitution.
%
-:- pred term.occurs(term(T)::in, var(T)::in, substitution(T)::in) is semidet.
+:- pred occurs(term(T)::in, var(T)::in, substitution(T)::in) is semidet.
% As above, except for a list of terms rather than a single term.
%
-:- pred term.occurs_list(list(term(T))::in, var(T)::in, substitution(T)::in)
+:- pred occurs_list(list(term(T))::in, var(T)::in, substitution(T)::in)
is semidet.
- % term.relabel_variable(Term0, OldVar, NewVar, Term):
+ % relabel_variable(Term0, OldVar, NewVar, Term):
%
% Replace all occurrences of OldVar in Term0 with NewVar and put the result
% in Term.
%
-:- func term.relabel_variable(term(T), var(T), var(T)) = term(T).
-:- pred term.relabel_variable(term(T)::in, var(T)::in, var(T)::in,
- term(T)::out) is det.
+:- func relabel_variable(term(T), var(T), var(T)) = term(T).
+:- pred relabel_variable(term(T)::in, var(T)::in, var(T)::in, term(T)::out)
+ is det.
% As above, except applies to a list of terms rather than a single term.
% XXX the name of the predicate is misleading.
%
-:- func term.relabel_variables(list(term(T)), var(T), var(T)) = list(term(T)).
-:- pred term.relabel_variables(list(term(T))::in, var(T)::in, var(T)::in,
+:- func relabel_variables(list(term(T)), var(T), var(T)) = list(term(T)).
+:- pred relabel_variables(list(term(T))::in, var(T)::in, var(T)::in,
list(term(T))::out) is det.
- % Same as term.relabel_variable, except relabels multiple variables.
+ % Same as relabel_variable, except relabels multiple variables.
% If a variable is not in the map, it is not replaced.
%
-:- func term.apply_variable_renaming(term(T), map(var(T), var(T))) = term(T).
-:- pred term.apply_variable_renaming(term(T)::in, map(var(T), var(T))::in,
+:- func apply_variable_renaming(term(T), map(var(T), var(T))) = term(T).
+:- pred apply_variable_renaming(term(T)::in, map(var(T), var(T))::in,
term(T)::out) is det.
- % Applies term.apply_variable_renaming to a list of terms.
+ % Applies apply_variable_renaming to a list of terms.
%
-:- func term.apply_variable_renaming_to_list(list(term(T)),
+:- func apply_variable_renaming_to_list(list(term(T)),
map(var(T), var(T))) = list(term(T)).
-:- pred term.apply_variable_renaming_to_list(list(term(T))::in,
+:- pred apply_variable_renaming_to_list(list(term(T))::in,
map(var(T), var(T))::in, list(term(T))::out) is det.
- % Applies term.apply_variable_renaming to a var.
+ % Applies apply_variable_renaming to a var.
%
-:- func term.apply_variable_renaming_to_var(map(var(T), var(T)),
+:- func apply_variable_renaming_to_var(map(var(T), var(T)),
var(T)) = var(T).
-:- pred term.apply_variable_renaming_to_var(map(var(T), var(T))::in,
+:- pred apply_variable_renaming_to_var(map(var(T), var(T))::in,
var(T)::in, var(T)::out) is det.
- % Applies term.apply_variable_renaming to a list of vars.
+ % Applies apply_variable_renaming to a list of vars.
%
-:- func term.apply_variable_renaming_to_vars(map(var(T), var(T)),
+:- func apply_variable_renaming_to_vars(map(var(T), var(T)),
list(var(T))) = list(var(T)).
-:- pred term.apply_variable_renaming_to_vars(map(var(T), var(T))::in,
+:- pred apply_variable_renaming_to_vars(map(var(T), var(T))::in,
list(var(T))::in, list(var(T))::out) is det.
- % term.is_ground(Term, Bindings) is true iff no variables contained
+ % is_ground(Term, Bindings) is true iff no variables contained
% in Term are non-ground in Bindings.
%
-:- pred term.is_ground(term(T)::in, substitution(T)::in) is semidet.
+:- pred is_ground(term(T)::in, substitution(T)::in) is semidet.
- % term.is_ground(Term) is true iff Term contains no variables.
+ % is_ground(Term) is true iff Term contains no variables.
%
-:- pred term.is_ground(term(T)::in) is semidet.
+:- pred is_ground(term(T)::in) is semidet.
%-----------------------------------------------------------------------------%
% To manage a supply of variables, use the following 2 predicates.
% (We might want to give these a unique mode later.)
- % term.init_var_supply(VarSupply):
+ % init_var_supply(VarSupply):
%
% Returns a fresh var_supply for producing fresh variables.
%
-:- func term.init_var_supply = var_supply(T).
-:- pred term.init_var_supply(var_supply(T)).
-:- mode term.init_var_supply(out) is det.
-:- mode term.init_var_supply(in) is semidet. % implied
+:- func init_var_supply = var_supply(T).
+:- pred init_var_supply(var_supply(T)).
+:- mode init_var_supply(out) is det.
+:- mode init_var_supply(in) is semidet. % implied
- % term.create_var(VarSupply0, Variable, VarSupply):
+ % create_var(VarSupply0, Variable, VarSupply):
% Create a fresh variable (var) and return the updated var_supply.
%
-:- pred term.create_var(var_supply(T), var(T), var_supply(T)).
-:- mode term.create_var(in, out, out) is det.
+:- pred create_var(var_supply(T), var(T), var_supply(T)).
+:- mode create_var(in, out, out) is det.
- % term.var_id(Variable):
+ % var_id(Variable):
% Returns a unique number associated with this variable w.r.t.
% its originating var_supply.
%
-:- func term.var_id(var(T)) = int.
+:- func var_id(var(T)) = int.
%-----------------------------------------------------------------------------%
@@ -372,67 +371,66 @@
% Convert a variable to an int. Different variables map to different ints.
% Other than that, the mapping is unspecified.
%
-:- func term.var_to_int(var(T)) = int.
-:- pred term.var_to_int(var(T)::in, int::out) is det.
+:- func var_to_int(var(T)) = int.
+:- pred var_to_int(var(T)::in, int::out) is det.
%-----------------------------------------------------------------------------%
% Given a term context, return the source line number.
%
-:- func term.context_line(term.context) = int.
-:- pred term.context_line(term.context::in, int::out) is det.
+:- func context_line(context) = int.
+:- pred context_line(context::in, int::out) is det.
% Given a term context, return the source file.
%
-:- func term.context_file(term.context) = string.
-:- pred term.context_file(term.context::in, string::out) is det.
+:- func context_file(context) = string.
+:- pred context_file(context::in, string::out) is det.
% Used to initialize the term context when reading in
- % (or otherwise constructing) a term.
+ % (or otherwise constructing) a
%
-:- func term.context_init = term.context.
-:- pred term.context_init(term.context::out) is det.
-:- func term.context_init(string, int) = term.context.
-:- pred term.context_init(string::in, int::in, term.context::out) is det.
+:- func context_init = context.
+:- pred context_init(context::out) is det.
+:- func context_init(string, int) = context.
+:- pred context_init(string::in, int::in, context::out) is det.
% Convert a list of terms which are all vars into a list of vars.
% Abort (call error/1) if the list contains any non-variables.
%
-:- func term.term_list_to_var_list(list(term(T))) = list(var(T)).
-:- pred term.term_list_to_var_list(list(term(T))::in, list(var(T))::out)
- is det.
+:- func term_list_to_var_list(list(term(T))) = list(var(T)).
+:- pred term_list_to_var_list(list(term(T))::in, list(var(T))::out) is det.
% Convert a list of terms which are all vars into a list of vars
% (or vice versa).
%
-:- func term.var_list_to_term_list(list(var(T))) = list(term(T)).
-:- pred term.var_list_to_term_list(list(var(T)), list(term(T))).
-:- mode term.var_list_to_term_list(in, out) is det.
-:- mode term.var_list_to_term_list(out, in) is semidet.
+:- func var_list_to_term_list(list(var(T))) = list(term(T)).
+:- pred var_list_to_term_list(list(var(T)), list(term(T))).
+:- mode var_list_to_term_list(in, out) is det.
+:- mode var_list_to_term_list(out, in) is semidet.
%-----------------------------------------------------------------------------%
- % term.generic_term(Term) is true iff `Term' is a term of type
+ % generic_term(Term) is true iff `Term' is a term of type
% `term' ie `term(generic)'. It is useful because in some instances
% it doesn't matter what the type of a term is, and passing it to this
% predicate will ground the type avoiding unbound type variable warnings.
%
-:- pred term.generic_term(term::in) is det.
+:- pred generic_term(term::in) is det.
% Coerce a term of type `T' into a term of type `U'.
%
-:- func term.coerce(term(T)) = term(U).
-:- pred term.coerce(term(T)::in, term(U)::out) is det.
+:- func coerce(term(T)) = term(U).
+:- pred coerce(term(T)::in, term(U)::out) is det.
% Coerce a var of type `T' into a var of type `U'.
%
-:- func term.coerce_var(var(T)) = var(U).
-:- pred term.coerce_var(var(T)::in, var(U)::out) is det.
+:- func coerce_var(var(T)) = var(U).
+:- pred coerce_var(var(T)::in, var(U)::out) is det.
% Coerce a var_supply of type `T' into a var_supply of type `U'.
%
-:- func term.coerce_var_supply(var_supply(T)) = var_supply(U).
-:- pred term.coerce_var_supply(var_supply(T)::in, var_supply(U)::out) is det.
+:- func coerce_var_supply(var_supply(T)) = var_supply(U).
+:- pred coerce_var_supply(var_supply(T)::in, var_supply(U)::out) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -451,12 +449,12 @@
% because Aditi does not have a builtin character type. This also allows
% an integer where a float is expected.
-:- pred term.term_to_type_with_int_instead_of_char(term(U)::in, T::out)
+:- pred term_to_type_with_int_instead_of_char(term(U)::in, T::out)
is semidet.
% Returns the highest numbered variable returned from this var_supply.
%
-:- func term.var_supply_max_var(var_supply(T)) = var(T).
+:- func var_supply_max_var(var_supply(T)) = var(T).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -467,6 +465,7 @@
:- import_module bool.
:- import_module char.
:- import_module construct.
+:- import_module deconstruct.
:- import_module float.
:- import_module int.
:- import_module require.
@@ -484,22 +483,22 @@
%-----------------------------------------------------------------------------%
-term.term_to_type(Term, Val) :-
- term.try_term_to_type(Term, ok(Val)).
+term_to_type(Term, Val) :-
+ try_term_to_type(Term, ok(Val)).
-term.term_to_type_with_int_instead_of_char(Term, Val) :-
+term_to_type_with_int_instead_of_char(Term, Val) :-
IsAditiTuple = yes,
- term.try_term_to_type(IsAditiTuple, Term, ok(Val)).
+ try_term_to_type(IsAditiTuple, Term, ok(Val)).
-term.try_term_to_type(Term, Result) :-
+try_term_to_type(Term, Result) :-
IsAditiTuple = no,
- term.try_term_to_type(IsAditiTuple, Term, Result).
+ try_term_to_type(IsAditiTuple, Term, Result).
-:- pred term.try_term_to_type(bool::in, term(U)::in,
+:- pred try_term_to_type(bool::in, term(U)::in,
term_to_type_result(T, U)::out) is det.
-term.try_term_to_type(IsAditiTuple, Term, Result) :-
- term.try_term_to_univ(IsAditiTuple, Term, type_desc.type_of(ValTypedVar),
+try_term_to_type(IsAditiTuple, Term, Result) :-
+ try_term_to_univ(IsAditiTuple, Term, type_desc.type_of(ValTypedVar),
UnivResult),
(
UnivResult = ok(Univ),
@@ -511,33 +510,33 @@
Result = error(Error)
).
-:- pred term.try_term_to_univ(bool::in, term(T)::in, type_desc.type_desc::in,
+:- pred try_term_to_univ(bool::in, term(T)::in, type_desc.type_desc::in,
term_to_type_result(univ, T)::out) is det.
-term.try_term_to_univ(IsAditiTuple, Term, Type, Result) :-
- term.try_term_to_univ_2(IsAditiTuple, Term, Type, [], Result).
+try_term_to_univ(IsAditiTuple, Term, Type, Result) :-
+ try_term_to_univ_2(IsAditiTuple, Term, Type, [], Result).
-:- pred term.try_term_to_univ_2(bool::in, term(T)::in,
+:- pred try_term_to_univ_2(bool::in, term(T)::in,
type_desc.type_desc::in, term_to_type_context::in,
term_to_type_result(univ, T)::out) is det.
-term.try_term_to_univ_2(_, term.variable(Var), _Type, Context,
+try_term_to_univ_2(_, variable(Var), _Type, Context,
error(mode_error(Var, Context))).
-term.try_term_to_univ_2(IsAditiTuple, Term, Type, Context, Result) :-
- Term = term.functor(Functor, ArgTerms, TermContext),
+try_term_to_univ_2(IsAditiTuple, Term, Type, Context, Result) :-
+ Term = functor(Functor, ArgTerms, TermContext),
(
type_desc.type_ctor_and_args(Type, TypeCtor, TypeArgs),
- term.term_to_univ_special_case(IsAditiTuple,
+ term_to_univ_special_case(IsAditiTuple,
type_desc.type_ctor_module_name(TypeCtor),
type_desc.type_ctor_name(TypeCtor),
TypeArgs, Term, Type, Context, SpecialCaseResult)
->
Result = SpecialCaseResult
;
- Functor = term.atom(FunctorName),
+ Functor = atom(FunctorName),
list.length(ArgTerms, Arity),
find_functor(Type, FunctorName, Arity, FunctorNumber, ArgTypes),
- term.term_list_to_univ_list(IsAditiTuple, ArgTerms,
+ term_list_to_univ_list(IsAditiTuple, ArgTerms,
ArgTypes, Functor, 1, Context, TermContext, ArgsResult)
->
(
@@ -558,49 +557,49 @@
Result = error(type_error(Term, Type, TermContext, RevContext))
).
-:- pred term.term_to_univ_special_case(bool::in, string::in, string::in,
+:- pred term_to_univ_special_case(bool::in, string::in, string::in,
list(type_desc.type_desc)::in,
- term(T)::in(bound(term.functor(ground, ground, ground))),
+ term(T)::in(bound(functor(ground, ground, ground))),
type_desc.type_desc::in, term_to_type_context::in,
term_to_type_result(univ, T)::out) is semidet.
-term.term_to_univ_special_case(IsAditiTuple, "builtin", "character", [],
+term_to_univ_special_case(IsAditiTuple, "builtin", "character", [],
Term, _, _, ok(Univ)) :-
(
IsAditiTuple = no,
- Term = term.functor(term.atom(FunctorName), [], _),
+ Term = functor(atom(FunctorName), [], _),
string.first_char(FunctorName, Char, "")
;
IsAditiTuple = yes,
- Term = term.functor(term.integer(Int), [], _),
+ Term = functor(integer(Int), [], _),
char.to_int(Char, Int)
),
type_to_univ(Char, Univ).
-term.term_to_univ_special_case(_, "builtin", "int", [],
+term_to_univ_special_case(_, "builtin", "int", [],
Term, _, _, ok(Univ)) :-
- Term = term.functor(term.integer(Int), [], _),
+ Term = functor(integer(Int), [], _),
type_to_univ(Int, Univ).
-term.term_to_univ_special_case(_, "builtin", "string", [],
+term_to_univ_special_case(_, "builtin", "string", [],
Term, _, _, ok(Univ)) :-
- Term = term.functor(term.string(String), [], _),
+ Term = functor(string(String), [], _),
type_to_univ(String, Univ).
-term.term_to_univ_special_case(IsAditiTuple, "builtin", "float", [],
+term_to_univ_special_case(IsAditiTuple, "builtin", "float", [],
Term, _, _, ok(Univ)) :-
- ( Term = term.functor(term.float(Float), [], _) ->
+ ( Term = functor(float(Float), [], _) ->
type_to_univ(Float, Univ)
;
IsAditiTuple = yes,
- Term = term.functor(term.integer(Int), [], _),
+ Term = functor(integer(Int), [], _),
Float = float.float(Int),
type_to_univ(Float, Univ)
).
-term.term_to_univ_special_case(IsAditiTuple, "array", "array", [ElemType],
+term_to_univ_special_case(IsAditiTuple, "array", "array", [ElemType],
Term, _Type, PrevContext, Result) :-
%
% arrays are represented as terms of the form
% array([elem1, elem2, ...])
%
- Term = term.functor(term.atom("array"), [ArgList], TermContext),
+ Term = functor(atom("array"), [ArgList], TermContext),
% To convert such terms back to arrays, we first
% convert the term representing the list of elements back to a list,
@@ -608,10 +607,9 @@
%
type_desc.has_type(Elem, ElemType),
ListType = type_desc.type_of([Elem]),
- ArgContext = arg_context(term.atom("array"), 1, TermContext),
+ ArgContext = arg_context(atom("array"), 1, TermContext),
NewContext = [ArgContext | PrevContext],
- term.try_term_to_univ_2(IsAditiTuple, ArgList, ListType, NewContext,
- ArgResult),
+ try_term_to_univ_2(IsAditiTuple, ArgList, ListType, NewContext, ArgResult),
(
ArgResult = ok(ListUniv),
type_desc.has_type(Elem2, ElemType),
@@ -623,51 +621,51 @@
ArgResult = error(Error),
Result = error(Error)
).
-term.term_to_univ_special_case(_, "builtin", "c_pointer", _, _, _, _, _) :-
+term_to_univ_special_case(_, "builtin", "c_pointer", _, _, _, _, _) :-
fail.
-term.term_to_univ_special_case(_, "std_util", "univ", [],
+term_to_univ_special_case(_, "std_util", "univ", [],
Term, _, _, Result) :-
% Implementing this properly would require keeping a global table mapping
% from type names to type_infos for all of the types in the program...
% so for the moment, we only allow it for basic types.
- Term = term.functor(term.atom("univ"), [Arg], _),
- Arg = term.functor(term.atom(":"), [Value, Type], _),
+ Term = functor(atom("univ"), [Arg], _),
+ Arg = functor(atom(":"), [Value, Type], _),
(
- Type = term.functor(term.atom("int"), [], _),
- Value = term.functor(term.integer(Int), [], _),
+ Type = functor(atom("int"), [], _),
+ Value = functor(integer(Int), [], _),
Univ = univ(Int)
;
- Type = term.functor(term.atom("string"), [], _),
- Value = term.functor(term.string(String), [], _),
+ Type = functor(atom("string"), [], _),
+ Value = functor(string(String), [], _),
Univ = univ(String)
;
- Type = term.functor(term.atom("float"), [], _),
- Value = term.functor(term.float(Float), [], _),
+ Type = functor(atom("float"), [], _),
+ Value = functor(float(Float), [], _),
Univ = univ(Float)
),
% The result is a `univ', but it is also wrapped in a `univ'
% like all the other results returned from this procedure.
Result = ok(univ(Univ)).
-term.term_to_univ_special_case(_, "std_util", "type_info", _, _, _, _, _) :-
+term_to_univ_special_case(_, "std_util", "type_info", _, _, _, _, _) :-
% Ditto.
fail.
-:- pred term.term_list_to_univ_list(bool::in, list(term(T))::in,
- list(type_desc.type_desc)::in, term.const::in, int::in,
- term_to_type_context::in, term.context::in,
+:- pred term_list_to_univ_list(bool::in, list(term(T))::in,
+ list(type_desc.type_desc)::in, const::in, int::in,
+ term_to_type_context::in, context::in,
term_to_type_result(list(univ), T)::out) is semidet.
-term.term_list_to_univ_list(_, [], [], _, _, _, _, ok([])).
-term.term_list_to_univ_list(IsAditiTuple, [ArgTerm | ArgTerms],
+term_list_to_univ_list(_, [], [], _, _, _, _, ok([])).
+term_list_to_univ_list(IsAditiTuple, [ArgTerm | ArgTerms],
[Type | Types], Functor, ArgNum, PrevContext, TermContext, Result) :-
ArgContext = arg_context(Functor, ArgNum, TermContext),
NewContext = [ArgContext | PrevContext],
- term.try_term_to_univ_2(IsAditiTuple, ArgTerm, Type, NewContext,
+ try_term_to_univ_2(IsAditiTuple, ArgTerm, Type, NewContext,
ArgResult),
(
ArgResult = ok(Arg),
- term.term_list_to_univ_list(IsAditiTuple, ArgTerms, Types, Functor,
+ term_list_to_univ_list(IsAditiTuple, ArgTerms, Types, Functor,
ArgNum + 1, PrevContext, TermContext, RestResult),
(
RestResult = ok(Rest),
@@ -681,31 +679,31 @@
Result = error(Error)
).
-:- pred term.find_functor(type_desc.type_desc::in, string::in, int::in,
+:- pred find_functor(type_desc.type_desc::in, string::in, int::in,
int::out, list(type_desc.type_desc)::out) is semidet.
-term.find_functor(Type, Functor, Arity, FunctorNumber, ArgTypes) :-
+find_functor(Type, Functor, Arity, FunctorNumber, ArgTypes) :-
N = construct.num_functors(Type),
- term.find_functor_2(Type, Functor, Arity, N, FunctorNumber, ArgTypes).
+ find_functor_2(Type, Functor, Arity, N, FunctorNumber, ArgTypes).
-:- pred term.find_functor_2(type_desc.type_desc::in, string::in, int::in,
- int::in, int::out, list(type_desc.type_desc)::out) is semidet.
+:- pred find_functor_2(type_desc.type_desc::in, string::in, int::in,
+ int::in, int::out, list(type_desc)::out) is semidet.
-term.find_functor_2(TypeInfo, Functor, Arity, Num, FunctorNumber, ArgTypes) :-
+find_functor_2(TypeInfo, Functor, Arity, Num, FunctorNumber, ArgTypes) :-
Num >= 0,
Num1 = Num - 1,
- ( std_util.get_functor(TypeInfo, Num1, Functor, Arity, ArgTypes1) ->
- ArgTypes = ArgTypes1,
+ ( get_functor(TypeInfo, Num1, Functor, Arity, ArgPseudoTypes) ->
+ ArgTypes = list.map(ground_pseudo_type_desc_to_type_desc_det,
+ ArgPseudoTypes),
FunctorNumber = Num1
;
- term.find_functor_2(TypeInfo, Functor, Arity, Num1,
- FunctorNumber, ArgTypes)
+ find_functor_2(TypeInfo, Functor, Arity, Num1, FunctorNumber, ArgTypes)
).
-term.det_term_to_type(Term, X) :-
- ( term.term_to_type(Term, X1) ->
+det_term_to_type(Term, X) :-
+ ( term_to_type(Term, X1) ->
X = X1
- ; \+ term.is_ground(Term) ->
+ ; \+ is_ground(Term) ->
error("term.det_term_to_type failed, because the term wasn't ground")
;
Message = "term.det_term_to_type failed, due to a type error:\n"
@@ -716,11 +714,11 @@
%-----------------------------------------------------------------------------%
-term.type_to_term(Val, Term) :- type_to_univ(Val, Univ),
- term.univ_to_term(Univ, Term).
+type_to_term(Val, Term) :- type_to_univ(Val, Univ),
+ univ_to_term(Univ, Term).
-term.univ_to_term(Univ, Term) :-
- term.context_init(Context),
+univ_to_term(Univ, Term) :-
+ context_init(Context),
Type = univ_type(Univ),
% NU-Prolog barfs on `num_functors(Type) < 0'
( construct.num_functors(Type) = N, N < 0 ->
@@ -728,7 +726,7 @@
type_desc.type_ctor_and_args(Type, TypeCtor, TypeArgs),
TypeName = type_desc.type_ctor_name(TypeCtor),
ModuleName = type_desc.type_ctor_module_name(TypeCtor),
- term.univ_to_term_special_case(ModuleName, TypeName, TypeArgs,
+ univ_to_term_special_case(ModuleName, TypeName, TypeArgs,
Univ, Context, SpecialCaseTerm)
->
Term = SpecialCaseTerm
@@ -738,67 +736,65 @@
error(Message)
)
;
- deconstruct(univ_value(Univ), FunctorString, _FunctorArity,
- FunctorArgs),
- term.univ_list_to_term_list(FunctorArgs, TermArgs),
- Term = term.functor(term.atom(FunctorString), TermArgs, Context)
+ deconstruct(univ_value(Univ), canonicalize, FunctorString,
+ _FunctorArity, FunctorArgs),
+ univ_list_to_term_list(FunctorArgs, TermArgs),
+ Term = functor(atom(FunctorString), TermArgs, Context)
).
-:- pred term.univ_to_term_special_case(string::in, string::in,
- list(type_desc.type_desc)::in, univ::in, term.context::in, term(T)::out)
+:- pred univ_to_term_special_case(string::in, string::in,
+ list(type_desc.type_desc)::in, univ::in, context::in, term(T)::out)
is semidet.
-term.univ_to_term_special_case("builtin", "int", [], Univ, Context,
- term.functor(term.integer(Int), [], Context)) :-
+univ_to_term_special_case("builtin", "int", [], Univ, Context,
+ functor(integer(Int), [], Context)) :-
det_univ_to_type(Univ, Int).
-term.univ_to_term_special_case("builtin", "float", [], Univ, Context,
- term.functor(term.float(Float), [], Context)) :-
+univ_to_term_special_case("builtin", "float", [], Univ, Context,
+ functor(float(Float), [], Context)) :-
det_univ_to_type(Univ, Float).
-term.univ_to_term_special_case("builtin", "character", [], Univ,
- Context, term.functor(term.atom(CharName), [], Context)) :-
+univ_to_term_special_case("builtin", "character", [], Univ,
+ Context, functor(atom(CharName), [], Context)) :-
det_univ_to_type(Univ, Character),
string.char_to_string(Character, CharName).
-term.univ_to_term_special_case("builtin", "string", [], Univ, Context,
- term.functor(term.string(String), [], Context)) :-
+univ_to_term_special_case("builtin", "string", [], Univ, Context,
+ functor(string(String), [], Context)) :-
det_univ_to_type(Univ, String).
-term.univ_to_term_special_case("std_util", "type_info", [], Univ, Context,
- term.functor(term.atom("type_info"), [Term], Context)) :-
+univ_to_term_special_case("std_util", "type_info", [], Univ, Context,
+ functor(atom("type_info"), [Term], Context)) :-
det_univ_to_type(Univ, TypeInfo),
type_info_to_term(Context, TypeInfo, Term).
-term.univ_to_term_special_case("std_util", "univ", [], Univ, Context, Term) :-
+univ_to_term_special_case("std_util", "univ", [], Univ, Context, Term) :-
det_univ_to_type(Univ, NestedUniv),
- Term = term.functor(term.atom("univ"),
+ Term = functor(atom("univ"),
% XXX what operator should we use for type qualification?
- [term.functor(term.atom(":"), % TYPE_QUAL_OP
+ [functor(atom(":"), % TYPE_QUAL_OP
[ValueTerm, TypeTerm], Context)], Context),
type_info_to_term(Context, univ_type(NestedUniv), TypeTerm),
NestedUnivValue = univ_value(NestedUniv),
- term.type_to_term(NestedUnivValue, ValueTerm).
+ type_to_term(NestedUnivValue, ValueTerm).
-term.univ_to_term_special_case("array", "array", [ElemType], Univ, Context,
- Term) :-
- Term = term.functor(term.atom("array"), [ArgsTerm], Context),
+univ_to_term_special_case("array", "array", [ElemType], Univ, Context, Term) :-
+ Term = functor(atom("array"), [ArgsTerm], Context),
type_desc.has_type(Elem, ElemType),
same_type(List, [Elem]),
det_univ_to_type(Univ, Array),
array.to_list(Array, List),
- term.type_to_term(List, ArgsTerm).
+ type_to_term(List, ArgsTerm).
:- pred same_type(T::unused, T::unused) is det.
same_type(_, _).
-:- pred term.univ_list_to_term_list(list(univ)::in, list(term(T))::out)
- is det.
+:- pred univ_list_to_term_list(list(univ)::in, list(term(T))::out) is det.
-term.univ_list_to_term_list([], []).
-term.univ_list_to_term_list([Value|Values], [Term|Terms]) :-
- term.univ_to_term(Value, Term),
- term.univ_list_to_term_list(Values, Terms).
+univ_list_to_term_list([], []).
+univ_list_to_term_list([Value|Values], [Term|Terms]) :-
+ univ_to_term(Value, Term),
+ univ_list_to_term_list(Values, Terms).
% Given a type_info, return a term that represents the name of that type.
%
-:- pred type_info_to_term(term.context::in, type_desc.type_desc::in,
+:- pred type_info_to_term(context::in, type_desc.type_desc::in,
term(T)::out) is det.
type_info_to_term(Context, TypeInfo, Term) :-
@@ -808,59 +804,59 @@
list.map(type_info_to_term(Context), ArgTypes, ArgTerms),
( ModuleName = "builtin" ->
- Term = term.functor(term.atom(TypeName), ArgTerms, Context)
+ Term = functor(atom(TypeName), ArgTerms, Context)
;
- Arg1 = term.functor(term.atom(ModuleName), [], Context),
- Arg2 = term.functor(term.atom(TypeName), ArgTerms, Context),
- Term = term.functor(term.atom(":"), [Arg1, Arg2], Context)
+ Arg1 = functor(atom(ModuleName), [], Context),
+ Arg2 = functor(atom(TypeName), ArgTerms, Context),
+ Term = functor(atom(":"), [Arg1, Arg2], Context)
).
%-----------------------------------------------------------------------------%
- % term.vars(Term, Vars) is true if Vars is the list of variables
+ % vars(Term, Vars) is true if Vars is the list of variables
% contained in Term obtained by depth-first left-to-right traversal
% in that order.
-term.vars(Term, Vars) :-
- term.vars_2(Term, [], Vars).
+vars(Term, Vars) :-
+ vars_2(Term, [], Vars).
-term.vars_list(Terms, Vars) :-
- term.vars_2_list(Terms, [], Vars).
+vars_list(Terms, Vars) :-
+ vars_2_list(Terms, [], Vars).
-term.vars_2(term.variable(Var), !Vars) :-
+vars_2(variable(Var), !Vars) :-
!:Vars = [Var | !.Vars].
-term.vars_2(term.functor(_, Args, _), !Vars) :-
- term.vars_2_list(Args, !Vars).
+vars_2(functor(_, Args, _), !Vars) :-
+ vars_2_list(Args, !Vars).
-:- pred term.vars_2_list(list(term(T))::in, list(var(T))::in,
+:- pred vars_2_list(list(term(T))::in, list(var(T))::in,
list(var(T))::out) is det.
-term.vars_2_list([], !Vars).
-term.vars_2_list([Term | Terms], !Vars) :-
- term.vars_2_list(Terms, !Vars),
- term.vars_2(Term, !Vars).
+vars_2_list([], !Vars).
+vars_2_list([Term | Terms], !Vars) :-
+ vars_2_list(Terms, !Vars),
+ vars_2(Term, !Vars).
%-----------------------------------------------------------------------------%
-term.contains_var(term.variable(Var), Var).
-term.contains_var(term.functor(_, Args, _), Var) :-
- term.contains_var_list(Args, Var).
+contains_var(variable(Var), Var).
+contains_var(functor(_, Args, _), Var) :-
+ contains_var_list(Args, Var).
-term.contains_var_list([Term | _], Var) :-
- term.contains_var(Term, Var).
-term.contains_var_list([_ | Terms], Var) :-
- term.contains_var_list(Terms, Var).
+contains_var_list([Term | _], Var) :-
+ contains_var(Term, Var).
+contains_var_list([_ | Terms], Var) :-
+ contains_var_list(Terms, Var).
%-----------------------------------------------------------------------------%
-term.context_line(term.context(_, LineNumber), LineNumber).
-term.context_file(term.context(FileName, _), FileName).
-term.context_init(term.context("", 0)).
-term.context_init(File, LineNumber, term.context(File, LineNumber)).
+context_line(context(_, LineNumber), LineNumber).
+context_file(context(FileName, _), FileName).
+context_init(context("", 0)).
+context_init(File, LineNumber, context(File, LineNumber)).
%-----------------------------------------------------------------------------%
-term.unify(term.variable(X), term.variable(Y), !Bindings) :-
+term.unify(variable(X), variable(Y), !Bindings) :-
( map.search(!.Bindings, X, BindingOfX) ->
( map.search(!.Bindings, Y, BindingOfY) ->
% Both X and Y already have bindings - just unify the terms
@@ -868,24 +864,22 @@
term.unify(BindingOfX, BindingOfY, !Bindings)
;
% Y is a variable which hasn't been bound yet.
- term.apply_rec_substitution(BindingOfX, !.Bindings,
- SubstBindingOfX),
- ( SubstBindingOfX = term.variable(Y) ->
+ apply_rec_substitution(BindingOfX, !.Bindings, SubstBindingOfX),
+ ( SubstBindingOfX = variable(Y) ->
true
;
- \+ term.occurs(SubstBindingOfX, Y, !.Bindings),
+ \+ occurs(SubstBindingOfX, Y, !.Bindings),
map.set(!.Bindings, Y, SubstBindingOfX, !:Bindings)
)
)
;
( map.search(!.Bindings, Y, BindingOfY) ->
% X is a variable which hasn't been bound yet
- term.apply_rec_substitution(BindingOfY, !.Bindings,
- SubstBindingOfY),
- ( SubstBindingOfY = term.variable(X) ->
+ apply_rec_substitution(BindingOfY, !.Bindings, SubstBindingOfY),
+ ( SubstBindingOfY = variable(X) ->
true
;
- \+ term.occurs(SubstBindingOfY, X, !.Bindings),
+ \+ occurs(SubstBindingOfY, X, !.Bindings),
map.set(!.Bindings, X, SubstBindingOfY, !:Bindings)
)
;
@@ -894,28 +888,28 @@
( X = Y ->
true
;
- map.set(!.Bindings, X, term.variable(Y), !:Bindings)
+ map.set(!.Bindings, X, variable(Y), !:Bindings)
)
)
).
term.unify(term.variable(X), term.functor(F, As, C), !Bindings) :-
( map.search(!.Bindings, X, BindingOfX) ->
- term.unify(BindingOfX, term.functor(F, As, C), !Bindings)
+ term.unify(BindingOfX, functor(F, As, C), !Bindings)
;
- \+ term.occurs_list(As, X, !.Bindings),
- map.set(!.Bindings, X, term.functor(F, As, C), !:Bindings)
+ \+ occurs_list(As, X, !.Bindings),
+ map.set(!.Bindings, X, functor(F, As, C), !:Bindings)
).
-term.unify(term.functor(F, As, C), term.variable(X), !Bindings) :-
+term.unify(functor(F, As, C), variable(X), !Bindings) :-
( map.search(!.Bindings, X, BindingOfX) ->
- term.unify(term.functor(F, As, C), BindingOfX, !Bindings)
+ term.unify(functor(F, As, C), BindingOfX, !Bindings)
;
- \+ term.occurs_list(As, X, !.Bindings),
- map.set(!.Bindings, X, term.functor(F, As, C), !:Bindings)
+ \+ occurs_list(As, X, !.Bindings),
+ map.set(!.Bindings, X, functor(F, As, C), !:Bindings)
).
-term.unify(term.functor(F, AsX, _), term.functor(F, AsY, _), !Bindings) :-
+term.unify(functor(F, AsX, _), functor(F, AsY, _), !Bindings) :-
term.unify_list(AsX, AsY, !Bindings).
term.unify_list([], [], !Bindings).
@@ -923,7 +917,7 @@
term.unify(X, Y, !Bindings),
term.unify_list(Xs, Ys, !Bindings).
-term.unify(term.variable(X), term.variable(Y), BoundVars, !Bindings) :-
+term.unify(variable(X), variable(Y), BoundVars, !Bindings) :-
( list.member(Y, BoundVars) ->
unify_bound_var(X, Y, BoundVars, !Bindings)
; list.member(X, BoundVars) ->
@@ -932,27 +926,25 @@
( map.search(!.Bindings, Y, BindingOfY) ->
% Both X and Y already have bindings - just unify the
% terms they are bound to.
- term.unify(BindingOfX, BindingOfY, BoundVars, !Bindings)
+ unify(BindingOfX, BindingOfY, BoundVars, !Bindings)
;
- term.apply_rec_substitution(BindingOfX, !.Bindings,
- SubstBindingOfX),
+ apply_rec_substitution(BindingOfX, !.Bindings, SubstBindingOfX),
% Y is a variable which hasn't been bound yet.
- ( SubstBindingOfX = term.variable(Y) ->
+ ( SubstBindingOfX = variable(Y) ->
true
;
- \+ term.occurs(SubstBindingOfX, Y, !.Bindings),
+ \+ occurs(SubstBindingOfX, Y, !.Bindings),
svmap.det_insert(Y, SubstBindingOfX, !Bindings)
)
)
;
( map.search(!.Bindings, Y, BindingOfY) ->
- term.apply_rec_substitution(BindingOfY, !.Bindings,
- SubstBindingOfY),
+ apply_rec_substitution(BindingOfY, !.Bindings, SubstBindingOfY),
% X is a variable which hasn't been bound yet.
- ( SubstBindingOfY = term.variable(X) ->
+ ( SubstBindingOfY = variable(X) ->
true
;
- \+ term.occurs(SubstBindingOfY, X, !.Bindings),
+ \+ occurs(SubstBindingOfY, X, !.Bindings),
svmap.det_insert(X, SubstBindingOfY, !Bindings)
)
;
@@ -960,35 +952,33 @@
( X = Y ->
true
;
- svmap.det_insert(X, term.variable(Y), !Bindings)
+ svmap.det_insert(X, variable(Y), !Bindings)
)
)
).
-term.unify(term.variable(X), term.functor(F, As, C), BoundVars,
- !Bindings) :-
+term.unify(variable(X), functor(F, As, C), BoundVars, !Bindings) :-
( map.search(!.Bindings, X, BindingOfX) ->
- term.unify(BindingOfX, term.functor(F, As, C), BoundVars, !Bindings)
+ term.unify(BindingOfX, functor(F, As, C), BoundVars, !Bindings)
;
- \+ term.occurs_list(As, X, !.Bindings),
+ \+ occurs_list(As, X, !.Bindings),
\+ list.member(X, BoundVars),
- svmap.det_insert(X, term.functor(F, As, C), !Bindings)
+ svmap.det_insert(X, functor(F, As, C), !Bindings)
).
-term.unify(term.functor(F, As, C), term.variable(X), BoundVars,
- !Bindings) :-
+term.unify(functor(F, As, C), variable(X), BoundVars, !Bindings) :-
(
map.search(!.Bindings, X, BindingOfX)
->
- term.unify(term.functor(F, As, C), BindingOfX, BoundVars, !Bindings)
+ term.unify(functor(F, As, C), BindingOfX, BoundVars, !Bindings)
;
- \+ term.occurs_list(As, X, !.Bindings),
+ \+ occurs_list(As, X, !.Bindings),
\+ list.member(X, BoundVars),
- svmap.det_insert(X, term.functor(F, As, C), !Bindings)
+ svmap.det_insert(X, functor(F, As, C), !Bindings)
).
-term.unify(term.functor(FX, AsX, _CX), term.functor(FY, AsY, _CY),
- BoundVars, !Bindings) :-
+term.unify(functor(FX, AsX, _CX), functor(FY, AsY, _CY), BoundVars,
+ !Bindings) :-
list.length(AsX, ArityX),
list.length(AsY, ArityY),
(
@@ -1010,132 +1000,132 @@
unify_bound_var(Var, BoundVar, BoundVars, !Bindings) :-
( map.search(!.Bindings, Var, BindingOfVar) ->
- BindingOfVar = term.variable(Var2),
+ BindingOfVar = variable(Var2),
unify_bound_var(Var2, BoundVar, BoundVars, !Bindings)
;
( Var = BoundVar ->
true
;
\+ list.member(Var, BoundVars),
- svmap.det_insert(Var, term.variable(BoundVar), !Bindings)
+ svmap.det_insert(Var, variable(BoundVar), !Bindings)
)
).
-term.list_subsumes(Terms1, Terms2, Subst) :-
+list_subsumes(Terms1, Terms2, Subst) :-
% Terms1 subsumes Terms2 iff Terms1 can be unified with Terms2
% without binding any of the variables in Terms2.
- term.vars_list(Terms2, Terms2Vars),
+ vars_list(Terms2, Terms2Vars),
map.init(Subst0),
term.unify_list(Terms1, Terms2, Terms2Vars, Subst0, Subst).
%-----------------------------------------------------------------------------%
-term.occurs(term.variable(X), Y, Bindings) :-
+occurs(variable(X), Y, Bindings) :-
( X = Y ->
true
;
map.search(Bindings, X, BindingOfX),
- term.occurs(BindingOfX, Y, Bindings)
+ occurs(BindingOfX, Y, Bindings)
).
-term.occurs(term.functor(_F, As, _), Y, Bindings) :-
- term.occurs_list(As, Y, Bindings).
+occurs(functor(_F, As, _), Y, Bindings) :-
+ occurs_list(As, Y, Bindings).
-term.occurs_list([Term | Terms], Y, Bindings) :-
- ( term.occurs(Term, Y, Bindings) ->
+occurs_list([Term | Terms], Y, Bindings) :-
+ ( occurs(Term, Y, Bindings) ->
true
;
- term.occurs_list(Terms, Y, Bindings)
+ occurs_list(Terms, Y, Bindings)
).
%-----------------------------------------------------------------------------%
-term.substitute(term.variable(Var), SearchVar, Replacement, Term) :-
+substitute(variable(Var), SearchVar, Replacement, Term) :-
( Var = SearchVar ->
Term = Replacement
;
- Term = term.variable(Var)
+ Term = variable(Var)
).
-term.substitute(term.functor(Name, Args0, Context), Var, Replacement,
- term.functor(Name, Args, Context)) :-
- term.substitute_list(Args0, Var, Replacement, Args).
-
-term.substitute_list([], _Var, _Replacement, []).
-term.substitute_list([Term0 | Terms0], Var, Replacement, [Term | Terms]) :-
- term.substitute(Term0, Var, Replacement, Term),
- term.substitute_list(Terms0, Var, Replacement, Terms).
+substitute(functor(Name, Args0, Context), Var, Replacement,
+ functor(Name, Args, Context)) :-
+ substitute_list(Args0, Var, Replacement, Args).
+
+substitute_list([], _Var, _Replacement, []).
+substitute_list([Term0 | Terms0], Var, Replacement, [Term | Terms]) :-
+ substitute(Term0, Var, Replacement, Term),
+ substitute_list(Terms0, Var, Replacement, Terms).
-term.substitute_corresponding(Ss, Rs, Term0, Term) :-
+substitute_corresponding(Ss, Rs, Term0, Term) :-
map.init(Subst0),
- ( term.substitute_corresponding_2(Ss, Rs, Subst0, Subst) ->
- term.apply_substitution(Term0, Subst, Term)
+ ( substitute_corresponding_2(Ss, Rs, Subst0, Subst) ->
+ apply_substitution(Term0, Subst, Term)
;
error("term.substitute_corresponding: different length lists")
).
-term.substitute_corresponding_list(Ss, Rs, TermList0, TermList) :-
+substitute_corresponding_list(Ss, Rs, TermList0, TermList) :-
map.init(Subst0),
- ( term.substitute_corresponding_2(Ss, Rs, Subst0, Subst) ->
- term.apply_substitution_to_list(TermList0, Subst, TermList)
+ ( substitute_corresponding_2(Ss, Rs, Subst0, Subst) ->
+ apply_substitution_to_list(TermList0, Subst, TermList)
;
error("term.substitute_corresponding_list: different length lists")
).
-:- pred term.substitute_corresponding_2(list(var(T))::in, list(term(T))::in,
+:- pred substitute_corresponding_2(list(var(T))::in, list(term(T))::in,
substitution(T)::in, substitution(T)::out) is semidet.
-term.substitute_corresponding_2([], [], !Subst).
-term.substitute_corresponding_2([S | Ss], [R | Rs], !Subst) :-
+substitute_corresponding_2([], [], !Subst).
+substitute_corresponding_2([S | Ss], [R | Rs], !Subst) :-
map.set(!.Subst, S, R, !:Subst),
- term.substitute_corresponding_2(Ss, Rs, !Subst).
+ substitute_corresponding_2(Ss, Rs, !Subst).
%-----------------------------------------------------------------------------%
-term.apply_rec_substitution(term.variable(Var), Substitution, Term) :-
+apply_rec_substitution(variable(Var), Substitution, Term) :-
( map.search(Substitution, Var, Replacement) ->
% Recursively apply the substition to the replacement.
- term.apply_rec_substitution(Replacement, Substitution, Term)
+ apply_rec_substitution(Replacement, Substitution, Term)
;
- Term = term.variable(Var)
+ Term = variable(Var)
).
-term.apply_rec_substitution(term.functor(Name, Args0, Context), Substitution,
- term.functor(Name, Args, Context)) :-
- term.apply_rec_substitution_to_list(Args0, Substitution, Args).
+apply_rec_substitution(functor(Name, Args0, Context), Substitution,
+ functor(Name, Args, Context)) :-
+ apply_rec_substitution_to_list(Args0, Substitution, Args).
-term.apply_rec_substitution_to_list([], _Substitution, []).
-term.apply_rec_substitution_to_list([Term0 | Terms0], Substitution,
+apply_rec_substitution_to_list([], _Substitution, []).
+apply_rec_substitution_to_list([Term0 | Terms0], Substitution,
[Term | Terms]) :-
- term.apply_rec_substitution(Term0, Substitution, Term),
- term.apply_rec_substitution_to_list(Terms0, Substitution, Terms).
+ apply_rec_substitution(Term0, Substitution, Term),
+ apply_rec_substitution_to_list(Terms0, Substitution, Terms).
%-----------------------------------------------------------------------------%
-term.apply_substitution(term.variable(Var), Substitution, Term) :-
+apply_substitution(variable(Var), Substitution, Term) :-
( map.search(Substitution, Var, Replacement) ->
Term = Replacement
;
- Term = term.variable(Var)
+ Term = variable(Var)
).
-term.apply_substitution(term.functor(Name, Args0, Context), Substitution,
- term.functor(Name, Args, Context)) :-
- term.apply_substitution_to_list(Args0, Substitution, Args).
+apply_substitution(functor(Name, Args0, Context), Substitution,
+ functor(Name, Args, Context)) :-
+ apply_substitution_to_list(Args0, Substitution, Args).
-term.apply_substitution_to_list([], _Substitution, []).
-term.apply_substitution_to_list([Term0 | Terms0], Substitution,
+apply_substitution_to_list([], _Substitution, []).
+apply_substitution_to_list([Term0 | Terms0], Substitution,
[Term | Terms]) :-
- term.apply_substitution(Term0, Substitution, Term),
- term.apply_substitution_to_list(Terms0, Substitution, Terms).
+ apply_substitution(Term0, Substitution, Term),
+ apply_substitution_to_list(Terms0, Substitution, Terms).
%-----------------------------------------------------------------------------%
-term.init_var_supply(var_supply(0)).
+init_var_supply(var_supply(0)).
-term.create_var(var_supply(V0), var(V), var_supply(V)) :-
+create_var(var_supply(V0), var(V), var_supply(V)) :-
% We number variables using sequential numbers,
V = V0 + 1.
%------------------------------------------------------------------------------%
-term.var_id(var(V)) = V.
+var_id(var(V)) = V.
%-----------------------------------------------------------------------------%
@@ -1144,212 +1134,210 @@
from_int(X) = term.unsafe_int_to_var(X)
].
-term.var_to_int(var(Var), Var).
+var_to_int(var(Var), Var).
% Cast an integer to a var(T), subverting the type-checking.
%
:- func unsafe_int_to_var(int) = var(T).
-term.unsafe_int_to_var(Var) = var(Var).
+unsafe_int_to_var(Var) = var(Var).
-term.var_supply_max_var(var_supply(V)) = var(V).
+var_supply_max_var(var_supply(V)) = var(V).
%-----------------------------------------------------------------------------%
-term.relabel_variable(term.functor(Const, Terms0, Cont), OldVar, NewVar,
- term.functor(Const, Terms, Cont)) :-
- term.relabel_variables(Terms0, OldVar, NewVar, Terms).
-term.relabel_variable(term.variable(Var0), OldVar, NewVar,
- term.variable(Var)) :-
+relabel_variable(functor(Const, Terms0, Cont), OldVar, NewVar,
+ functor(Const, Terms, Cont)) :-
+ relabel_variables(Terms0, OldVar, NewVar, Terms).
+relabel_variable(variable(Var0), OldVar, NewVar, variable(Var)) :-
( Var0 = OldVar ->
Var = NewVar
;
Var = Var0
).
-term.relabel_variables([], _, _, []).
-term.relabel_variables([Term0|Terms0], OldVar, NewVar, [Term|Terms]):-
- term.relabel_variable(Term0, OldVar, NewVar, Term),
- term.relabel_variables(Terms0, OldVar, NewVar, Terms).
-
-term.apply_variable_renaming(term.functor(Const, Args0, Cont), Renaming,
- term.functor(Const, Args, Cont)) :-
- term.apply_variable_renaming_to_list(Args0, Renaming, Args).
-term.apply_variable_renaming(term.variable(Var0), Renaming,
- term.variable(Var)) :-
- term.apply_variable_renaming_to_var(Renaming, Var0, Var).
-
-term.apply_variable_renaming_to_list([], _, []).
-term.apply_variable_renaming_to_list([Term0|Terms0], Renaming, [Term|Terms]) :-
- term.apply_variable_renaming(Term0, Renaming, Term),
- term.apply_variable_renaming_to_list(Terms0, Renaming, Terms).
+relabel_variables([], _, _, []).
+relabel_variables([Term0|Terms0], OldVar, NewVar, [Term|Terms]):-
+ relabel_variable(Term0, OldVar, NewVar, Term),
+ relabel_variables(Terms0, OldVar, NewVar, Terms).
+
+apply_variable_renaming(functor(Const, Args0, Cont), Renaming,
+ functor(Const, Args, Cont)) :-
+ apply_variable_renaming_to_list(Args0, Renaming, Args).
+apply_variable_renaming(variable(Var0), Renaming,
+ variable(Var)) :-
+ apply_variable_renaming_to_var(Renaming, Var0, Var).
+
+apply_variable_renaming_to_list([], _, []).
+apply_variable_renaming_to_list([Term0|Terms0], Renaming, [Term|Terms]) :-
+ apply_variable_renaming(Term0, Renaming, Term),
+ apply_variable_renaming_to_list(Terms0, Renaming, Terms).
-term.apply_variable_renaming_to_var(Renaming, Var0, Var) :-
+apply_variable_renaming_to_var(Renaming, Var0, Var) :-
( map.search(Renaming, Var0, NewVar) ->
Var = NewVar
;
Var = Var0
).
-term.apply_variable_renaming_to_vars(_Renaming, [], []).
-term.apply_variable_renaming_to_vars(Renaming, [Var0 | Vars0],
- [Var | Vars]) :-
- term.apply_variable_renaming_to_var(Renaming, Var0, Var),
- term.apply_variable_renaming_to_vars(Renaming, Vars0, Vars).
+apply_variable_renaming_to_vars(_Renaming, [], []).
+apply_variable_renaming_to_vars(Renaming, [Var0 | Vars0], [Var | Vars]) :-
+ apply_variable_renaming_to_var(Renaming, Var0, Var),
+ apply_variable_renaming_to_vars(Renaming, Vars0, Vars).
%-----------------------------------------------------------------------------%
-term.term_list_to_var_list(Terms, Vars) :-
- ( term.var_list_to_term_list(Vars0, Terms) ->
+term_list_to_var_list(Terms, Vars) :-
+ ( var_list_to_term_list(Vars0, Terms) ->
Vars = Vars0
;
error("term.term_list_to_var_list")
).
-term.var_list_to_term_list([], []).
-term.var_list_to_term_list([Var | Vars], [term.variable(Var) | Terms]) :-
- term.var_list_to_term_list(Vars, Terms).
+var_list_to_term_list([], []).
+var_list_to_term_list([Var | Vars], [variable(Var) | Terms]) :-
+ var_list_to_term_list(Vars, Terms).
%-----------------------------------------------------------------------------%
-term.is_ground(term.variable(V), Bindings) :-
+is_ground(variable(V), Bindings) :-
map.search(Bindings, V, Binding),
- term.is_ground(Binding, Bindings).
-term.is_ground(term.functor(_, Args, _), Bindings) :-
- term.is_ground_2(Args, Bindings).
+ is_ground(Binding, Bindings).
+is_ground(functor(_, Args, _), Bindings) :-
+ is_ground_2(Args, Bindings).
-:- pred term.is_ground_2(list(term(T))::in, substitution(T)::in) is semidet.
+:- pred is_ground_2(list(term(T))::in, substitution(T)::in) is semidet.
-term.is_ground_2([], _Bindings).
-term.is_ground_2([Term | Terms], Bindings) :-
- term.is_ground(Term, Bindings),
- term.is_ground_2(Terms, Bindings).
+is_ground_2([], _Bindings).
+is_ground_2([Term | Terms], Bindings) :-
+ is_ground(Term, Bindings),
+ is_ground_2(Terms, Bindings).
%-----------------------------------------------------------------------------%
-term.is_ground(term.functor(_, Args, _)) :-
- term.is_ground_2(Args).
+is_ground(functor(_, Args, _)) :-
+ is_ground_2(Args).
-:- pred term.is_ground_2(list(term(T))::in) is semidet.
+:- pred is_ground_2(list(term(T))::in) is semidet.
-term.is_ground_2([]).
-term.is_ground_2([Term | Terms]) :-
- term.is_ground(Term),
- term.is_ground_2(Terms).
+is_ground_2([]).
+is_ground_2([Term | Terms]) :-
+ is_ground(Term),
+ is_ground_2(Terms).
%-----------------------------------------------------------------------------%
-term.generic_term(_).
+generic_term(_).
%-----------------------------------------------------------------------------%
-term.coerce(A, B) :-
+coerce(A, B) :-
% Normally calls to this predicate should only be generated by the
% compiler, but type coercion by copying was taking about 3% of the
% compiler's runtime.
private_builtin.unsafe_type_cast(A, B).
-term.coerce_var(var(V), var(V)).
+coerce_var(var(V), var(V)).
-term.coerce_var_supply(var_supply(Supply), var_supply(Supply)).
+coerce_var_supply(var_supply(Supply), var_supply(Supply)).
% ---------------------------------------------------------------------------- %
% ---------------------------------------------------------------------------- %
% Ralph Becket <rwab1 at cl.cam.ac.uk> 30/04/99
% Function forms added.
-term.context_init = C :-
- term.context_init(C).
+context_init = C :-
+ context_init(C).
-term.init_var_supply = VS :-
- term.init_var_supply(VS).
+init_var_supply = VS :-
+ init_var_supply(VS).
-term.try_term_to_type(T) = TTTR :-
- term.try_term_to_type(T, TTTR).
+try_term_to_type(T) = TTTR :-
+ try_term_to_type(T, TTTR).
-term.det_term_to_type(T1) = T2 :-
- term.det_term_to_type(T1, T2).
+det_term_to_type(T1) = T2 :-
+ det_term_to_type(T1, T2).
-term.type_to_term(T1) = T2 :-
- term.type_to_term(T1, T2).
+type_to_term(T1) = T2 :-
+ type_to_term(T1, T2).
-term.univ_to_term(U) = T :-
- term.univ_to_term(U, T).
+univ_to_term(U) = T :-
+ univ_to_term(U, T).
-term.vars(T) = Vs :-
- term.vars(T, Vs).
+vars(T) = Vs :-
+ vars(T, Vs).
-term.vars_2(T, Vs1) = Vs2 :-
- term.vars_2(T, Vs1, Vs2).
+vars_2(T, Vs1) = Vs2 :-
+ vars_2(T, Vs1, Vs2).
-term.vars_list(Ts) = Vs :-
- term.vars_list(Ts, Vs).
+vars_list(Ts) = Vs :-
+ vars_list(Ts, Vs).
-term.substitute(T1, V, T2) = T3 :-
- term.substitute(T1, V, T2, T3).
+substitute(T1, V, T2) = T3 :-
+ substitute(T1, V, T2, T3).
-term.substitute_list(Ts1, V, T) = Ts2 :-
- term.substitute_list(Ts1, V, T, Ts2).
+substitute_list(Ts1, V, T) = Ts2 :-
+ substitute_list(Ts1, V, T, Ts2).
-term.substitute_corresponding(Vs, T1s, T) = T2 :-
- term.substitute_corresponding(Vs, T1s, T, T2).
+substitute_corresponding(Vs, T1s, T) = T2 :-
+ substitute_corresponding(Vs, T1s, T, T2).
-term.substitute_corresponding_list(Vs, Ts1, Ts2) = Ts3 :-
- term.substitute_corresponding_list(Vs, Ts1, Ts2, Ts3).
+substitute_corresponding_list(Vs, Ts1, Ts2) = Ts3 :-
+ substitute_corresponding_list(Vs, Ts1, Ts2, Ts3).
-term.apply_rec_substitution(T1, S) = T2 :-
- term.apply_rec_substitution(T1, S, T2).
+apply_rec_substitution(T1, S) = T2 :-
+ apply_rec_substitution(T1, S, T2).
-term.apply_rec_substitution_to_list(Ts1, S) = Ts2 :-
- term.apply_rec_substitution_to_list(Ts1, S, Ts2).
+apply_rec_substitution_to_list(Ts1, S) = Ts2 :-
+ apply_rec_substitution_to_list(Ts1, S, Ts2).
-term.apply_substitution(T1, S) = T2 :-
- term.apply_substitution(T1, S, T2).
+apply_substitution(T1, S) = T2 :-
+ apply_substitution(T1, S, T2).
-term.apply_substitution_to_list(Ts1, S) = Ts2 :-
- term.apply_substitution_to_list(Ts1, S, Ts2).
+apply_substitution_to_list(Ts1, S) = Ts2 :-
+ apply_substitution_to_list(Ts1, S, Ts2).
-term.relabel_variable(T1, V1, V2) = T2 :-
- term.relabel_variable(T1, V1, V2, T2).
+relabel_variable(T1, V1, V2) = T2 :-
+ relabel_variable(T1, V1, V2, T2).
-term.relabel_variables(Ts1, V1, V2) = Ts2 :-
- term.relabel_variables(Ts1, V1, V2, Ts2).
+relabel_variables(Ts1, V1, V2) = Ts2 :-
+ relabel_variables(Ts1, V1, V2, Ts2).
-term.apply_variable_renaming(T1, M) = T2 :-
- term.apply_variable_renaming(T1, M, T2).
+apply_variable_renaming(T1, M) = T2 :-
+ apply_variable_renaming(T1, M, T2).
-term.apply_variable_renaming_to_list(Ts1, M) = Ts2 :-
- term.apply_variable_renaming_to_list(Ts1, M, Ts2).
+apply_variable_renaming_to_list(Ts1, M) = Ts2 :-
+ apply_variable_renaming_to_list(Ts1, M, Ts2).
-term.apply_variable_renaming_to_vars(M, Vs0) = Vs :-
- term.apply_variable_renaming_to_vars(M, Vs0, Vs).
+apply_variable_renaming_to_vars(M, Vs0) = Vs :-
+ apply_variable_renaming_to_vars(M, Vs0, Vs).
-term.apply_variable_renaming_to_var(M, V0) = V :-
- term.apply_variable_renaming_to_var(M, V0, V).
+apply_variable_renaming_to_var(M, V0) = V :-
+ apply_variable_renaming_to_var(M, V0, V).
-term.var_to_int(V) = N :-
- term.var_to_int(V, N).
+var_to_int(V) = N :-
+ var_to_int(V, N).
-term.context_line(C) = N :-
- term.context_line(C, N).
+context_line(C) = N :-
+ context_line(C, N).
-term.context_file(C) = S :-
- term.context_file(C, S).
+context_file(C) = S :-
+ context_file(C, S).
-term.context_init(S, N) = C :-
- term.context_init(S, N, C).
+context_init(S, N) = C :-
+ context_init(S, N, C).
-term.term_list_to_var_list(Ts) = Vs :-
- term.term_list_to_var_list(Ts, Vs).
+term_list_to_var_list(Ts) = Vs :-
+ term_list_to_var_list(Ts, Vs).
-term.var_list_to_term_list(Vs) = Ts :-
- term.var_list_to_term_list(Vs, Ts).
+var_list_to_term_list(Vs) = Ts :-
+ var_list_to_term_list(Vs, Ts).
-term.coerce(T1) = T2 :-
- term.coerce(T1, T2).
+coerce(T1) = T2 :-
+ coerce(T1, T2).
-term.coerce_var(V1) = V2 :-
- term.coerce_var(V1, V2).
+coerce_var(V1) = V2 :-
+ coerce_var(V1, V2).
-term.coerce_var_supply(VS1) = VS2 :-
- term.coerce_var_supply(VS1, VS2).
+coerce_var_supply(VS1) = VS2 :-
+ coerce_var_supply(VS1, VS2).
Index: library/term_to_xml.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/term_to_xml.m,v
retrieving revision 1.10
diff -u -b -r1.10 term_to_xml.m
--- library/term_to_xml.m 15 Nov 2005 04:59:23 -0000 1.10
+++ library/term_to_xml.m 15 Mar 2006 01:59:18 -0000
@@ -1,4 +1,6 @@
%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et wm=0 tw=0
+%-----------------------------------------------------------------------------%
% Copyright (C) 1993-2005 The University of Melbourne.
% This file may only be copied under the terms of the GNU Library General
% Public License - see the file COPYING.LIB in the Mercury distribution.
@@ -73,38 +75,36 @@
% an XML document.
%
:- type xml
- %
+ ---> elem(
% An XML element with a name, list of attributes
% and a list of children.
- %
- ---> elem(
element_name :: string,
attributes :: list(attr),
children :: list(xml)
)
+ ; data(string)
% Textual data. `<', `>', `&', `'' and `"' characters
% will be replaced by `<', `>', `&', `''
% and `"' respectively.
- ; data(string)
+ ; cdata(string)
% Data to be enclosed in `<![CDATA[' and `]]>' tags.
% Any occurrences of `]]>' in the data will be
% converted to `]]>'.
- ; cdata(string)
+ ; comment(string)
% An XML comment. The comment should not
% include the `<!--' and `-->'. Any occurrences of
% `--' will be replaced by ` - '.
- ; comment(string)
+ ; entity(string)
% An entity reference. The string will
% have `&' prepended and `;' appended before being
% output.
- ; entity(string)
- % Raw XML data. The data will be written out verbatim.
; raw(string).
+ % Raw XML data. The data will be written out verbatim.
% An XML document must have an element at the top-level.
%
@@ -117,7 +117,8 @@
% An element attribute, mapping a name to a value.
%
-:- type attr ---> attr(string, string).
+:- type attr
+ ---> attr(string, string).
% Values of this type specify the DOCTYPE of an XML document when
% the DOCTYPE is defined by an external DTD.
@@ -131,13 +132,15 @@
% a generated XML document and if so how.
%
:- type maybe_dtd
+ ---> embed
% Generate and embed the entire DTD in the document
% (only available for method 2).
- ---> embed
- % Included a reference to an external DTD.
+
; external(doctype)
- % Do not include any DOCTYPE information.
+ % Included a reference to an external DTD.
+
; no_dtd.
+ % Do not include any DOCTYPE information.
:- inst non_embedded_dtd
---> external(ground)
@@ -153,19 +156,22 @@
)
; no_stylesheet.
- % write_xml_doc(Term, !IO).
+ % write_xml_doc(Term, !IO):
+ %
% Output Term as an XML document to the current output stream.
% Term must be an instance of the xmlable typeclass.
%
:- pred write_xml_doc(T::in, io::di, io::uo) is det <= xmlable(T).
- % write_xml_doc(Stream, Term, !IO).
+ % write_xml_doc(Stream, Term, !IO):
+ %
% Same as write_xml_doc/3, but use the given output stream.
%
:- pred write_xml_doc(io.output_stream::in, T::in, io::di, io::uo) is det
<= xmlable(T).
- % write_xml_doc(Term, MaybeStyleSheet, MaybeDTD, !IO).
+ % write_xml_doc(Term, MaybeStyleSheet, MaybeDTD, !IO):
+ %
% Write Term to the current output stream as an XML document.
% MaybeStyleSheet and MaybeDTD specify whether or not a stylesheet
% reference and/or a DTD should be included.
@@ -176,9 +182,9 @@
:- pred write_xml_doc(T::in, maybe_stylesheet::in,
maybe_dtd::in(non_embedded_dtd), io::di, io::uo) is det <= xmlable(T).
- % write_xml_doc(Stream, Term, MaybeStyleSheet, MaybeDTD, !IO).
- % Same as write_xml_doc/5, but write output to the given output
- % stream.
+ % write_xml_doc(Stream, Term, MaybeStyleSheet, MaybeDTD, !IO):
+ %
+ % Same as write_xml_doc/5, but write output to the given output stream.
%
:- pred write_xml_doc(io.output_stream::in, T::in, maybe_stylesheet::in,
maybe_dtd::in(non_embedded_dtd), io::di, io::uo) is det <= xmlable(T).
@@ -192,13 +198,15 @@
%
:- pred write_xml_element(int::in, T::in, io::di, io::uo) is det <= xmlable(T).
- % write_xml_element(Stream, Indent, Term, !IO).
+ % write_xml_element(Stream, Indent, Term, !IO):
+ %
% Same as write_xml_element/4, but use the given output stream.
%
:- pred write_xml_element(io.output_stream::in, int::in, T::in, io::di, io::uo)
is det <= xmlable(T).
- % write_xml_header(MaybeEncoding, !IO).
+ % write_xml_header(MaybeEncoding, !IO):
+ %
% Write an XML header (i.e. `<?xml version="1.0"?>) to the
% current output stream.
% If MaybeEncoding is yes(Encoding), then include `encoding="Encoding"'
@@ -208,8 +216,8 @@
% Same as write_xml_header/3, but use the given output stream.
%
-:- pred write_xml_header(io.output_stream::in, maybe(string)::in, io::di,
- io::uo) is det.
+:- pred write_xml_header(io.output_stream::in, maybe(string)::in,
+ io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
%
@@ -274,7 +282,7 @@
% for that element. See the types `maybe_functor_info' and
% `attr_from_source' below.
%
-:- type element_pred == (pred(type_desc.type_desc, maybe_functor_info, string,
+:- type element_pred == (pred(type_desc, maybe_functor_info, string,
list(attr_from_source))).
:- inst element_pred == (pred(in, in, out, out) is det).
@@ -286,13 +294,14 @@
% the predicate when requesting an element for the type.
%
:- type maybe_functor_info
- % The functor's name and arity.
---> du_functor(
+ % The functor's name and arity.
functor_name :: string,
functor_arity :: int
)
- % The type is not a discriminated union.
+
; none_du.
+ % The type is not a discriminated union.
% Values of this type specify attributes that should be set from
% a particular source. The attribute_name field specifies the name
@@ -308,18 +317,21 @@
% Possible attribute sources.
%
:- type attr_source
+ ---> functor
% The original functor name as returned by
% deconstruct.deconstruct/5.
- ---> functor
+
+ ; field_name
% The field name if the functor appears in a
% named field (If the field is not named then this
% attribute is omitted).
- ; field_name
- % The fully qualified type name the functor is for.
+
; type_name
+ % The fully qualified type name the functor is for.
+
+ ; arity.
% The arity of the functor as returned by
% deconstruct.deconstruct/5.
- ; arity.
% To support third parties generating XML which is compatible with the
% XML generated using method 2, a DTD for a Mercury type can also be
@@ -348,42 +360,38 @@
%
:- type dtd_generation_result
---> ok
+
+ ; multiple_functors_for_root
% The root type is a discriminated union with
% multiple functors.
- %
- ; multiple_functors_for_root
+ ; duplicate_elements(
% The functor-to-element mapping maps different
% functors to the same element. The duplicate element
% and a list of types whose functors map to that
% element is given.
- %
- ; duplicate_elements(
duplicate_element :: string,
- duplicate_types :: list(type_desc.type_desc)
+ duplicate_types :: list(type_desc)
)
- ;
- % At the moment we only support generation of DTDs for
- % types made up of discriminated unions, arrays,
- % strings, ints, characters and floats. If a type is
- % not supported, then it is returned as the argument
- % of this functor.
- %
- unsupported_dtd_type(type_desc.type_desc)
- ;
- % If one of the arguments of a functor is existentially
- % typed, then the pseudo_type_desc for the
- % existentially quantified argument is returned as the
- % argument of this functor. Since the values of
- % existentially typed arguments can be of any type
- % (provided any typeclass constraints are satisfied) it
- % is not generally possible to generate DTD rules for
- % functors with existentially typed arguments.
- %
- type_not_ground(pseudo_type_desc).
+
+ ; unsupported_dtd_type(type_desc)
+ % At the moment we only support generation of DTDs for types
+ % made up of discriminated unions, arrays, strings, ints,
+ % characters and floats. If a type is not supported, then it is
+ % returned as the argument of this functor.
+
+ ; type_not_ground(pseudo_type_desc).
+ % If one of the arguments of a functor is existentially typed,
+ % then the pseudo_type_desc for the existentially quantified
+ % argument is returned as the argument of this functor.
+ % Since the values of existentially typed arguments can be of
+ % any type (provided any typeclass constraints are satisfied)
+ % it is not generally possible to generate DTD rules for functors
+ % with existentially typed arguments.
% write_xml_doc(Term, ElementMapping, MaybeStyleSheet, MaybeDTD,
- % DTDResult, !IO).
+ % DTDResult, !IO):
+ %
% Write Term to the current output stream as an XML document using
% ElementMapping as the scheme to map functors to elements.
% MaybeStyleSheet and MaybeDTD specify whether or not a stylesheet
@@ -395,11 +403,12 @@
% possible values of DTDResult and their meanings.
%
:- pred write_xml_doc(T::in, element_mapping::in(element_mapping),
- maybe_stylesheet::in, maybe_dtd::in,
- dtd_generation_result::out, io::di, io::uo) is det.
+ maybe_stylesheet::in, maybe_dtd::in, dtd_generation_result::out,
+ io::di, io::uo) is det.
% write_xml_doc(Stream, Term, ElementMapping, MaybeStyleSheet,
- % MaybeDTD, DTDResult, !IO).
+ % MaybeDTD, DTDResult, !IO):
+ %
% Same as write_xml_doc/7 except write the XML doc to the given
% output stream.
%
@@ -408,7 +417,8 @@
maybe_dtd::in, dtd_generation_result::out, io::di, io::uo) is det.
% write_xml_doc_cc(Term, ElementMapping, MaybeStyleSheet, MaybeDTD,
- % DTDResult, !IO).
+ % DTDResult, !IO):
+ %
% Write Term to the current output stream as an XML document using
% ElementMapping as the scheme to map functors to elements.
% MaybeStyleSheet and MaybeDTD specify whether or not a stylesheet
@@ -424,7 +434,8 @@
io::di, io::uo) is cc_multi.
% write_xml_doc_cc(Stream, Term, ElementMapping, MaybeStyleSheet,
- % MaybeDTD, DTDResult, !IO).
+ % MaybeDTD, DTDResult, !IO):
+ %
% Same as write_xml_doc/7 except write the XML doc to the given
% output stream.
%
@@ -432,7 +443,8 @@
element_mapping::in(element_mapping), maybe_stylesheet::in,
maybe_dtd::in, dtd_generation_result::out, io::di, io::uo) is cc_multi.
- % can_generate_dtd(ElementMapping, Type) = Result.
+ % can_generate_dtd(ElementMapping, Type) = Result:
+ %
% Check if a DTD can be generated for the given Type using the
% functor-to-element mapping scheme ElementMapping. Return `ok' if it
% is possible to generate a DTD. See the documentation of the
@@ -440,9 +452,10 @@
% it is not `ok'.
%
:- func can_generate_dtd(element_mapping::in(element_mapping),
- type_desc.type_desc::in) = (dtd_generation_result::out) is det.
+ type_desc::in) = (dtd_generation_result::out) is det.
- % write_dtd(Term, ElementMapping, DTDResult, !IO).
+ % write_dtd(Term, ElementMapping, DTDResult, !IO):
+ %
% Write a DTD for the given term to the current output stream using
% ElementMapping to map functors to elements. If a DTD
% cannot be generated for Term using ElementMapping then a value
@@ -453,7 +466,8 @@
:- pred write_dtd(T::unused, element_mapping::in(element_mapping),
dtd_generation_result::out, io::di, io::uo) is det.
- % write_dtd(Stream, Term, ElementMapping, DTDResult, !IO).
+ % write_dtd(Stream, Term, ElementMapping, DTDResult, !IO):
+ %
% Same as write_dtd/5 except the DTD will be written to the given
% output stream.
%
@@ -461,26 +475,29 @@
element_mapping::in(element_mapping), dtd_generation_result::out,
io::di, io::uo) is det.
- % write_dtd_for_type(Type, ElementMapping, DTDResult, !IO).
+ % write_dtd_for_type(Type, ElementMapping, DTDResult, !IO):
+ %
% Write a DTD for the given type to the current output stream. If a DTD
% cannot be generated for Type using ElementMapping then a value
% other than `ok' is returned in DTDResult and nothing is written.
% See the dtd_generation_result type for a list of the other
% possible values of DTDResult and their meanings.
%
-:- pred write_dtd_from_type(type_desc.type_desc::in,
+:- pred write_dtd_from_type(type_desc::in,
element_mapping::in(element_mapping), dtd_generation_result::out,
io::di, io::uo) is det.
- % write_dtd_for_type(Stream, Type, ElementMapping, DTDResult, !IO).
+ % write_dtd_for_type(Stream, Type, ElementMapping, DTDResult, !IO):
+ %
% Same as write_dtd_for_type/5 except the DTD will be written to the
% given output stream.
%
-:- pred write_dtd_from_type(io.output_stream::in, type_desc.type_desc::in,
+:- pred write_dtd_from_type(io.output_stream::in, type_desc::in,
element_mapping::in(element_mapping), dtd_generation_result::out,
io::di, io::uo) is det.
- % write_xml_element(NonCanon, MakeElement, IndentLevel, Term, !IO).
+ % write_xml_element(NonCanon, MakeElement, IndentLevel, Term, !IO):
+ %
% Write XML elements for the given term and all its descendents,
% using IndentLevel as the initial indentation level (each
% indentation level is one tab character) and using the MakeElement
@@ -491,8 +508,8 @@
%
:- pred write_xml_element(deconstruct.noncanon_handling,
element_mapping, int, T, io, io).
-:- mode write_xml_element(in(do_not_allow), in(element_mapping), in, in, di, uo)
- is det.
+:- mode write_xml_element(in(do_not_allow), in(element_mapping), in, in,
+ di, uo) is det.
:- mode write_xml_element(in(canonicalize), in(element_mapping), in, in,
di, uo) is det.
:- mode write_xml_element(in(include_details_cc), in(element_mapping), in, in,
@@ -559,10 +576,9 @@
write_xml_element(Indent, Term, !IO),
io.set_output_stream(OrigStream, _, !IO).
-write_xml_doc(Term, ElementMapping, MaybeStyleSheet, MaybeDTD, DTDResult, !IO)
- :-
- DTDResult = can_generate_dtd(MaybeDTD, ElementMapping,
- type_desc.type_of(Term)),
+write_xml_doc(Term, ElementMapping, MaybeStyleSheet, MaybeDTD, DTDResult,
+ !IO) :-
+ DTDResult = can_generate_dtd(MaybeDTD, ElementMapping, type_of(Term)),
(
DTDResult = ok
->
@@ -584,8 +600,7 @@
write_xml_doc_cc(Term, ElementMapping, MaybeStyleSheet, MaybeDTD, DTDResult,
!IO) :-
- DTDResult = can_generate_dtd(MaybeDTD, ElementMapping,
- type_desc.type_of(Term)),
+ DTDResult = can_generate_dtd(MaybeDTD, ElementMapping, type_of(Term)),
(
DTDResult = ok
->
@@ -613,7 +628,7 @@
!IO).
write_dtd(Term, ElementMapping, DTDResult, !IO) :-
- type_desc.type_of(Term) = TypeDesc,
+ type_of(Term) = TypeDesc,
write_dtd_from_type(TypeDesc, ElementMapping, DTDResult, !IO).
write_dtd(Stream, Term, ElementMapping, DTDResult, !IO) :-
@@ -671,14 +686,12 @@
write_doctype(NonCanon, T, ElementMapping, external(DocType), ok, !IO) :-
get_element_pred(ElementMapping, MakeElement),
deconstruct.deconstruct(T, NonCanon, Functor, Arity, _),
- (
- is_discriminated_union(type_desc.type_of(T), _)
- ->
+ ( is_discriminated_union(type_of(T), _) ->
Request = du_functor(Functor, Arity)
;
Request = none_du
),
- MakeElement(type_desc.type_of(T), Request, Root, _),
+ MakeElement(type_of(T), Request, Root, _),
write_external_doctype(Root, DocType, !IO).
:- pred write_external_doctype(string::in, doctype::in, io::di, io::uo)
@@ -706,61 +719,49 @@
% Implementation of the `unique' predefined mapping scheme.
%
-:- pred make_unique_element(type_desc.type_desc::in, maybe_functor_info::in,
+:- pred make_unique_element(type_desc::in, maybe_functor_info::in,
string::out, list(attr_from_source)::out) is det.
make_unique_element(TypeDesc, du_functor(Functor, Arity), Element,
all_attr_sources) :-
- (
- common_mercury_functor(Functor, ReservedElement)
- ->
+ ( common_mercury_functor(Functor, ReservedElement) ->
MangledElement = ReservedElement
;
MangledElement = mangle(Functor)
),
Element = MangledElement ++ "--" ++ string.int_to_string(Arity) ++
- "--" ++ mangle(type_desc.type_name(TypeDesc)).
+ "--" ++ mangle(type_name(TypeDesc)).
make_unique_element(TypeDesc, none_du, Element, AttrFromSources) :-
- (
- is_primitive_type(TypeDesc, PrimitiveElement)
- ->
+ ( is_primitive_type(TypeDesc, PrimitiveElement) ->
Element = PrimitiveElement,
AttrFromSources = [attr_from_source("type", type_name),
attr_from_source("field", field_name)]
- ;
- is_array(TypeDesc, _)
- ->
+ ; is_array(TypeDesc, _) ->
Element = array_element ++ "--" ++
- mangle(type_desc.type_name(TypeDesc)),
+ mangle(type_name(TypeDesc)),
AttrFromSources = all_attr_sources
;
- Element = mangle(type_desc.type_name(TypeDesc)),
+ Element = mangle(type_name(TypeDesc)),
AttrFromSources = all_attr_sources
).
% Implementation of the `simple' mapping scheme.
%
-:- pred make_simple_element(type_desc.type_desc::in, maybe_functor_info::in,
+:- pred make_simple_element(type_desc::in, maybe_functor_info::in,
string::out, list(attr_from_source)::out) is det.
make_simple_element(_, du_functor(Functor, _), Element, all_attr_sources) :-
- (
- common_mercury_functor(Functor, ReservedElement)
- ->
+ ( common_mercury_functor(Functor, ReservedElement) ->
Element = ReservedElement
;
Element = mangle(Functor)
).
make_simple_element(TypeDesc, none_du, Element, AttrFromSources) :-
- (
- is_primitive_type(TypeDesc, PrimitiveElement)
- ->
+ ( is_primitive_type(TypeDesc, PrimitiveElement) ->
Element = PrimitiveElement,
AttrFromSources = [attr_from_source("type", type_name),
attr_from_source("field", field_name)]
- ;
- is_array(TypeDesc, _)
- ->
+ ; is_array(TypeDesc, _) ->
Element = array_element,
AttrFromSources = all_attr_sources
;
@@ -811,23 +812,17 @@
array_element = "Array".
-:- pred is_primitive_type(type_desc.type_desc::in, string::out) is semidet.
+:- pred is_primitive_type(type_desc::in, string::out) is semidet.
is_primitive_type(TypeDesc, Element) :-
- (
- type_desc.type_of("") = TypeDesc
- ->
+ ( type_of("") = TypeDesc ->
Element = "String"
- ;
- type_desc.type_of('c') = TypeDesc
- ->
+ ; type_of('c') = TypeDesc ->
Element = "Char"
- ;
- type_desc.type_of(1) = TypeDesc
- ->
+ ; type_of(1) = TypeDesc ->
Element = "Int"
;
- type_desc.type_of(1.0) = TypeDesc,
+ type_of(1.0) = TypeDesc,
Element = "Float"
).
@@ -866,8 +861,7 @@
string.foldl(mangle_char, Rest, [], ElementChrs),
Element = First ++ string.from_char_list(ElementChrs).
-:- pred mangle_char(char::in, list(char)::in, list(char)::out)
- is det.
+:- pred mangle_char(char::in, list(char)::in, list(char)::out) is det.
% XXX This is system dependent since char.to_int is system dependent.
%
@@ -889,16 +883,13 @@
% will be in each list if the type is not a discriminated union.
%
:- pred get_elements_and_args(element_pred::in(element_pred),
- type_desc.type_desc::in, list(string)::out,
- list(maybe(string))::out,
- list(maybe(int))::out, list(list(type_desc.pseudo_type_desc))::out,
+ type_desc::in, list(string)::out, list(maybe(string))::out,
+ list(maybe(int))::out, list(list(pseudo_type_desc))::out,
list(list(attr_from_source))::out) is det.
get_elements_and_args(MakeElement, TypeDesc, Elements, MaybeFunctors,
MaybeArities, ArgTypeLists, AttributeLists) :-
- (
- is_discriminated_union(TypeDesc, NumFunctors)
- ->
+ ( is_discriminated_union(TypeDesc, NumFunctors) ->
FunctorNums = 0 .. (NumFunctors - 1),
(
list.map3(construct.get_functor(TypeDesc), FunctorNums,
@@ -939,17 +930,11 @@
:- pred primitive_value(univ::in, string::out) is semidet.
primitive_value(Univ, PrimValue) :-
- (
- univ_to_type(Univ, String)
- ->
+ ( univ_to_type(Univ, String) ->
PrimValue = String`with_type`string
- ;
- univ_to_type(Univ, Char)
- ->
+ ; univ_to_type(Univ, Char) ->
PrimValue = char_to_string(Char)
- ;
- univ_to_type(Univ, Int)
- ->
+ ; univ_to_type(Univ, Int) ->
PrimValue = int_to_string(Int)
;
univ_to_type(Univ, Float),
@@ -958,13 +943,12 @@
%-----------------------------------------------------------------------------%
- % The following type is used to decide if an entity should be
- % formatted (i.e. be indented and have a newline at the end).
- % We do not format an entity if any of its siblings are anything
- % besides an element, a CDATA entity or a comment, since then
- % whitespaces are more likely to be significant.
- % (Although technically spaces are always significant, they are
- % usually interpreted as only formatting when they are between
+ % The following type is used to decide if an entity should be formatted
+ % (i.e. be indented and have a newline at the end). We do not format
+ % an entity if any of its siblings are anything besides an element,
+ % a CDATA entity or a comment, since then whitespaces are more likely
+ % to be significant. (Although technically spaces are always significant,
+ % they are usually interpreted as only formatting when they are between
% markup).
%
:- type maybe_format
@@ -974,8 +958,8 @@
:- pred write_xml_element_format(maybe_format::in, int::in, xml::in,
io::di, io::uo) is det.
-write_xml_element_format(Format, IndentLevel, elem(Name, Attrs, Children), !IO)
- :-
+write_xml_element_format(Format, IndentLevel, elem(Name, Attrs, Children),
+ !IO) :-
maybe_indent(Format, IndentLevel, !IO),
(
Children = [],
@@ -1084,40 +1068,31 @@
),
deconstruct.deconstruct(Term, NonCanon, Functor, Arity, Args),
Term = univ_value(Univ),
- TypeDesc = type_desc.type_of(Term),
- (
- is_discriminated_union(TypeDesc, _)
- ->
+ TypeDesc = type_of(Term),
+ ( is_discriminated_union(TypeDesc, _) ->
Request = du_functor(Functor, Arity)
;
Request = none_du
),
MakeElement(TypeDesc, Request, Element, AttrFromSources),
- (
- primitive_value(Univ, PrimValue)
- ->
+ ( primitive_value(Univ, PrimValue) ->
indent(IndentLevel, !IO),
- write_primitive_element_with_attr_from_source(Element,
- AttrFromSources, PrimValue, MaybeFieldName, TypeDesc,
- !IO)
+ write_primitive_element_with_attr_from_source(Element, AttrFromSources,
+ PrimValue, MaybeFieldName, TypeDesc, !IO)
;
(
Args = [],
indent(IndentLevel, !IO),
write_empty_element_with_attr_from_source(Element,
- AttrFromSources, yes(Functor),
- yes(Arity), MaybeFieldName, TypeDesc, !IO)
+ AttrFromSources, yes(Functor), yes(Arity), MaybeFieldName,
+ TypeDesc, !IO)
;
Args = [_ | _],
- ChildMaybeFieldNames = get_field_names(TypeDesc,
- Functor, Arity),
+ ChildMaybeFieldNames = get_field_names(TypeDesc, Functor, Arity),
indent(IndentLevel, !IO),
- write_element_start_with_attr_from_source(Element,
- AttrFromSources, yes(Functor),
- yes(Arity), MaybeFieldName,
- TypeDesc, !IO),
- write_child_xml_elements(NonCanon, MakeElement,
- IndentLevel + 1,
+ write_element_start_with_attr_from_source(Element, AttrFromSources,
+ yes(Functor), yes(Arity), MaybeFieldName, TypeDesc, !IO),
+ write_child_xml_elements(NonCanon, MakeElement, IndentLevel + 1,
Args, ChildMaybeFieldNames, !IO),
indent(IndentLevel, !IO),
write_element_end(Element, !IO),
@@ -1125,34 +1100,29 @@
)
).
-:- pred is_discriminated_union(type_desc.type_desc::in, int::out) is semidet.
+:- pred is_discriminated_union(type_desc::in, int::out) is semidet.
is_discriminated_union(TypeDesc, NumFunctors) :-
- NumFunctors = std_util.num_functors(TypeDesc),
+ NumFunctors = num_functors(TypeDesc),
NumFunctors > -1.
-:- pred is_array(type_desc.type_desc::in, type_desc.pseudo_type_desc::out)
- is semidet.
+:- pred is_array(type_desc::in, pseudo_type_desc::out) is semidet.
is_array(TypeDesc, ArgPseudoType) :-
PseudoTypeDesc = type_desc_to_pseudo_type_desc(TypeDesc),
- type_desc.pseudo_type_ctor_and_args(PseudoTypeDesc, TypeCtor,
- ArgPseudoTypes),
+ pseudo_type_ctor_and_args(PseudoTypeDesc, TypeCtor, ArgPseudoTypes),
ArgPseudoTypes = [ArgPseudoType],
- type_desc.type_ctor_name(TypeCtor) = "array",
- type_desc.type_ctor_module_name(TypeCtor) = "array".
+ type_ctor_name(TypeCtor) = "array",
+ type_ctor_module_name(TypeCtor) = "array".
-:- func get_field_names(type_desc.type_desc, string, int)
- = list(maybe(string)).
+:- func get_field_names(type_desc, string, int) = list(maybe(string)).
get_field_names(TypeDesc, Functor, Arity) = MaybeFields :-
- (
- is_discriminated_union(TypeDesc, NumFunctors)
- ->
+ ( is_discriminated_union(TypeDesc, NumFunctors) ->
FunctorNums = 0 .. (NumFunctors - 1),
(
- find_field_names(TypeDesc, FunctorNums, Functor,
- Arity, FoundMaybeFields)
+ find_field_names(TypeDesc, FunctorNums, Functor, Arity,
+ FoundMaybeFields)
->
MaybeFields = FoundMaybeFields
;
@@ -1162,7 +1132,7 @@
MaybeFields = []
).
-:- pred find_field_names(type_desc.type_desc::in, list(int)::in, string::in,
+:- pred find_field_names(type_desc::in, list(int)::in, string::in,
int::in, list(maybe(string))::out) is semidet.
find_field_names(TypeDesc, [FunctorNum | FunctorNums], Functor, Arity,
@@ -1253,19 +1223,16 @@
:- pred indent(int::in, io::di, io::uo) is det.
indent(IndentLevel, !IO) :-
- (
- IndentLevel > 0
- ->
+ ( IndentLevel > 0 ->
io.write_char('\t', !IO),
indent(IndentLevel - 1, !IO)
;
true
).
-:- pred write_primitive_element_with_attr_from_source(
- string::in, list(attr_from_source)::in,
- string::in, maybe(string)::in, type_desc.type_desc::in, io::di, io::uo)
- is det.
+:- pred write_primitive_element_with_attr_from_source(string::in,
+ list(attr_from_source)::in, string::in, maybe(string)::in,
+ type_desc::in, io::di, io::uo) is det.
write_primitive_element_with_attr_from_source(Element, AttrFromSources, Value,
MaybeField, TypeDesc, !IO) :-
@@ -1283,7 +1250,7 @@
:- pred write_element_start_with_attr_from_source(string::in,
list(attr_from_source)::in,
maybe(string)::in, maybe(int)::in, maybe(string)::in,
- type_desc.type_desc::in, io::di, io::uo) is det.
+ type_desc::in, io::di, io::uo) is det.
write_element_start_with_attr_from_source(Element, AttrFromSources,
MaybeFunctor, MaybeArity, MaybeField, TypeDesc, !IO) :-
@@ -1301,9 +1268,8 @@
io.write_string(">", !IO).
:- pred write_empty_element_with_attr_from_source(string::in,
- list(attr_from_source)::in,
- maybe(string)::in, maybe(int)::in, maybe(string)::in,
- type_desc.type_desc::in, io::di, io::uo) is det.
+ list(attr_from_source)::in, maybe(string)::in, maybe(int)::in,
+ maybe(string)::in, type_desc::in, io::di, io::uo) is det.
write_empty_element_with_attr_from_source(Element, AttrFromSources,
MaybeFunctor, MaybeArity, MaybeField, TypeDesc, !IO) :-
@@ -1327,9 +1293,8 @@
io.write_string(Element, !IO),
io.write_string(">", !IO).
-:- func attr_from_source_to_maybe_attr(maybe(string),
- maybe(int), type_desc.type_desc, maybe(string), attr_from_source)
- = maybe(attr).
+:- func attr_from_source_to_maybe_attr(maybe(string), maybe(int), type_desc,
+ maybe(string), attr_from_source) = maybe(attr).
attr_from_source_to_maybe_attr(MaybeFunctor, MaybeArity, TypeDesc,
MaybeFieldName, attr_from_source(Name, Source)) = MaybeAttr :-
@@ -1354,7 +1319,7 @@
)
;
Source = type_name,
- MaybeAttr = yes(attr(Name, type_desc.type_name(TypeDesc)))
+ MaybeAttr = yes(attr(Name, type_name(TypeDesc)))
;
Source = field_name,
(
@@ -1366,7 +1331,7 @@
)
).
-:- func make_attrs_from_sources(maybe(string), maybe(int), type_desc.type_desc,
+:- func make_attrs_from_sources(maybe(string), maybe(int), type_desc,
maybe(string), list(attr_from_source)) = list(attr).
make_attrs_from_sources(MaybeFunctor, MaybeArity, TypeDesc, MaybeField,
@@ -1396,9 +1361,7 @@
:- pred write_xml_escaped_char(char::in, io::di, io::uo) is det.
write_xml_escaped_char(Chr, !IO) :-
- (
- xml_predefined_entity(Chr, Str)
- ->
+ ( xml_predefined_entity(Chr, Str) ->
io.write_string(Str, !IO)
;
io.write_char(Chr, !IO)
@@ -1427,15 +1390,12 @@
get_elements_and_args(MakeElement, TypeDesc,
[RootElement], [_], [_], [PseudoArgTypes], _)
->
- ArgTypes = list.map(
- ground_pseudo_type_desc_to_type_desc_det,
+ ArgTypes = list.map(ground_pseudo_type_desc_to_type_desc_det,
PseudoArgTypes),
io.write_string("<!DOCTYPE ", !IO),
io.write_string(RootElement, !IO),
- io.write_string(" [\n\n",
- !IO),
- write_dtd_types(MakeElement, [TypeDesc | ArgTypes],
- map.init, !IO),
+ io.write_string(" [\n\n", !IO),
+ write_dtd_types(MakeElement, [TypeDesc | ArgTypes], map.init, !IO),
io.write_string("\n]>", !IO),
DTDResult = ok
;
@@ -1448,19 +1408,16 @@
can_generate_dtd(ElementMapping, TypeDesc) = Result :-
get_element_pred(ElementMapping, MakeElement),
- (
- get_elements_and_args(MakeElement, TypeDesc, [_], [_], [_],
- [_], [_])
- ->
+ ( get_elements_and_args(MakeElement, TypeDesc, [_], [_], [_], [_], [_]) ->
PseudoTypeDesc = type_desc_to_pseudo_type_desc(TypeDesc),
- Result = can_generate_dtd_for_types(MakeElement,
- [PseudoTypeDesc], map.init, map.init)
+ Result = can_generate_dtd_for_types(MakeElement, [PseudoTypeDesc],
+ map.init, map.init)
;
Result = multiple_functors_for_root
).
:- func can_generate_dtd(maybe_dtd::in, element_mapping::in(element_mapping),
- type_desc.type_desc::in) = (dtd_generation_result::out) is det.
+ type_desc::in) = (dtd_generation_result::out) is det.
can_generate_dtd(no_dtd, _, _) = ok.
can_generate_dtd(external(_), _, _) = ok.
@@ -1475,9 +1432,8 @@
% quantified.
%
:- func can_generate_dtd_for_types(element_pred::in(element_pred),
- list(type_desc.pseudo_type_desc)::in,
- map(type_desc.type_desc, unit)::in,
- map(string, type_desc.type_desc)::in) =
+ list(pseudo_type_desc)::in,
+ map(type_desc, unit)::in, map(string, type_desc)::in) =
(dtd_generation_result::out) is det.
can_generate_dtd_for_types(_, [], _, _) = ok.
@@ -1496,46 +1452,29 @@
is_primitive_type(TypeDesc, _)
)
->
-
- (
- map.contains(Done, TypeDesc)
- ->
- Result = can_generate_dtd_for_types(
- MakeElement, PseudoTypeDescs,
- Done, ElementsSoFar)
+ ( map.contains(Done, TypeDesc) ->
+ Result = can_generate_dtd_for_types(MakeElement,
+ PseudoTypeDescs, Done, ElementsSoFar)
;
- get_elements_and_args(MakeElement,
- TypeDesc, Elements, _, _,
+ get_elements_and_args(MakeElement, TypeDesc, Elements, _, _,
ArgLists, _),
- list.filter(map.contains(ElementsSoFar),
- Elements, DupElements),
+ list.filter(map.contains(ElementsSoFar), Elements,
+ DupElements),
(
DupElements = [DupElement | _],
- map.lookup(ElementsSoFar, DupElement,
- DupTypeDesc),
+ map.lookup(ElementsSoFar, DupElement, DupTypeDesc),
DupTypes = [TypeDesc, DupTypeDesc],
- Result = duplicate_elements(DupElement,
- DupTypes)
+ Result = duplicate_elements(DupElement, DupTypes)
;
DupElements = [],
- list.merge_and_remove_dups(
- list.condense(ArgLists),
- PseudoTypeDescs,
- NewPseudoTypeDescs),
- list.duplicate(length(Elements),
- TypeDesc,
- TypeDescList),
- map.det_insert_from_corresponding_lists(
- ElementsSoFar, Elements,
- TypeDescList,
- NewElementsSoFar),
- map.det_insert(Done, TypeDesc,
- unit, NewDone),
- Result = can_generate_dtd_for_types(
- MakeElement,
- NewPseudoTypeDescs,
- NewDone,
- NewElementsSoFar)
+ list.merge_and_remove_dups(list.condense(ArgLists),
+ PseudoTypeDescs, NewPseudoTypeDescs),
+ list.duplicate(length(Elements), TypeDesc, TypeDescList),
+ map.det_insert_from_corresponding_lists(ElementsSoFar,
+ Elements, TypeDescList, NewElementsSoFar),
+ map.det_insert(Done, TypeDesc, unit, NewDone),
+ Result = can_generate_dtd_for_types(MakeElement,
+ NewPseudoTypeDescs, NewDone, NewElementsSoFar)
)
)
;
@@ -1551,18 +1490,15 @@
% entry written.
%
:- pred write_dtd_types(element_pred::in(element_pred),
- list(type_desc.type_desc)::in, map(type_desc.type_desc, unit)::in,
+ list(type_desc)::in, map(type_desc, unit)::in,
io::di, io::uo) is det.
write_dtd_types(_, [], _, !IO).
write_dtd_types(MakeElement, [TypeDesc | TypeDescs], AlreadyDone, !IO) :-
- (
- map.search(AlreadyDone, TypeDesc, _)
- ->
+ ( map.search(AlreadyDone, TypeDesc, _) ->
write_dtd_types(MakeElement, TypeDescs, AlreadyDone, !IO)
;
- write_dtd_type_elements(MakeElement, TypeDesc, ChildArgTypes,
- !IO),
+ write_dtd_type_elements(MakeElement, TypeDesc, ChildArgTypes, !IO),
map.set(AlreadyDone, TypeDesc, unit, NewAlreadyDone),
write_dtd_types(MakeElement, append(ChildArgTypes, TypeDescs),
NewAlreadyDone, !IO)
@@ -1597,7 +1533,7 @@
% Write an ATTLIST entry for the given attribute.
%
:- pred write_dtd_attlist(string::in, maybe(string)::in, maybe(int)::in,
- type_desc.type_desc::in, attr_from_source::in, io::di, io::uo) is det.
+ type_desc::in, attr_from_source::in, io::di, io::uo) is det.
write_dtd_attlist(Element, MaybeFunctor, MaybeArity, TypeDesc,
attr_from_source(Name, Source), !IO) :-
@@ -1615,7 +1551,7 @@
)
;
Source = type_name,
- MaybeValue = yes(type_desc.type_name(TypeDesc))
+ MaybeValue = yes(type_name(TypeDesc))
;
Source = field_name,
MaybeValue = no
@@ -1629,8 +1565,7 @@
io.write_string(">\n", !IO).
:- pred write_dtd_attlists(string::in, list(attr_from_source)::in,
- maybe(string)::in, maybe(int)::in, type_desc.type_desc::in,
- io::di, io::uo) is det.
+ maybe(string)::in, maybe(int)::in, type_desc::in, io::di, io::uo) is det.
write_dtd_attlists(Element, AttrFromSources, MaybeFunctor, MaybeArity,
TypeDesc, !IO) :-
@@ -1640,7 +1575,7 @@
% Write DTD entries for all the functors for a type.
%
:- pred write_dtd_type_elements(element_pred::in(element_pred),
- type_desc.type_desc::in, list(type_desc.type_desc)::out,
+ type_desc::in, list(type_desc)::out,
io::di, io::uo) is det.
write_dtd_type_elements(MakeElement, TypeDesc, ChildArgTypes, !IO) :-
@@ -1651,14 +1586,14 @@
ground_pseudo_type_desc_to_type_desc_det), ArgPseudoTypeLists),
list.condense(ArgTypeLists, ChildArgTypes),
io.write_string("<!-- Elements for functors of type """, !IO),
- write_xml_escaped_string(type_desc.type_name(TypeDesc), !IO),
+ write_xml_escaped_string(type_name(TypeDesc), !IO),
io.write_string(""" -->\n\n", !IO),
write_dtd_entries(MakeElement, TypeDesc, Elements, MaybeFunctors,
MaybeArities, ArgTypeLists, AttributeLists, !IO).
:- pred write_dtd_entries(element_pred::in(element_pred),
- type_desc.type_desc::in, list(string)::in, list(maybe(string))::in,
- list(maybe(int))::in, list(list(type_desc.type_desc))::in,
+ type_desc::in, list(string)::in, list(maybe(string))::in,
+ list(maybe(int))::in, list(list(type_desc))::in,
list(list(attr_from_source))::in, io::di, io::uo) is det.
% Write all the given DTD entries.
@@ -1695,9 +1630,7 @@
Braces = yes
;
Tail = [],
- (
- std_util.num_functors(Head) > 1
- ->
+ ( num_functors(Head) > 1 ->
Braces = no
;
Braces = yes
@@ -1719,8 +1652,7 @@
),
io.write_list(ArgTypeList, ",",
- write_dtd_allowed_functors_regex(MakeElement),
- !IO),
+ write_dtd_allowed_functors_regex(MakeElement), !IO),
(
Braces = yes,
@@ -1748,13 +1680,11 @@
% expression.
%
:- pred write_dtd_allowed_functors_regex(element_pred::in(element_pred),
- type_desc.type_desc::in, io::di, io::uo) is det.
+ type_desc::in, io::di, io::uo) is det.
write_dtd_allowed_functors_regex(MakeElement, TypeDesc, !IO) :-
get_elements_and_args(MakeElement, TypeDesc, Elements, _, _, _, _),
- (
- length(Elements) > 1
- ->
+ ( length(Elements) > 1 ->
io.write_string("(", !IO),
io.write_list(Elements, "|", io.write_string, !IO),
io.write_string(")", !IO)
Index: library/version_hash_table.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/version_hash_table.m,v
retrieving revision 1.4
diff -u -b -r1.4 version_hash_table.m
--- library/version_hash_table.m 7 Mar 2006 22:23:51 -0000 1.4
+++ library/version_hash_table.m 15 Mar 2006 01:56:41 -0000
@@ -148,11 +148,13 @@
:- import_module array.
:- import_module bool.
+:- import_module deconstruct.
:- import_module exception.
:- import_module list.
:- import_module math.
:- import_module require.
:- import_module std_util.
+:- import_module type_desc.
:- import_module version_array.
:- type version_hash_table(K, V)
@@ -454,7 +456,7 @@
else
- deconstruct(T, FunctorName, Arity, Args),
+ deconstruct(T, canonicalize, FunctorName, Arity, Args),
string_double_hash(FunctorName, Ha0, Hb0),
double_munge(Arity, Ha0, Ha1, Arity, Hb0, Hb1),
list.foldl2(
cvs diff: Diffing mdbcomp
Index: mdbcomp/program_representation.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/mdbcomp/program_representation.m,v
retrieving revision 1.10
diff -u -b -r1.10 program_representation.m
--- mdbcomp/program_representation.m 7 Dec 2005 16:07:11 -0000 1.10
+++ mdbcomp/program_representation.m 15 Mar 2006 07:56:27 -0000
@@ -41,6 +41,7 @@
:- import_module char.
:- import_module list.
:- import_module std_util.
+:- import_module type_desc.
% A representation of the goal we execute. These need to be generated
% statically and stored inside the executable.
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/tests
cvs diff: Diffing samples/tests/c_interface
cvs diff: Diffing samples/tests/c_interface/c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/tests/c_interface/mercury_calls_c
cvs diff: Diffing samples/tests/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/tests/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/tests/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/tests/diff
cvs diff: Diffing samples/tests/muz
cvs diff: Diffing samples/tests/rot13
cvs diff: Diffing samples/tests/solutions
cvs diff: Diffing samples/tests/toplevel
cvs diff: Diffing scripts
cvs diff: Diffing slice
cvs diff: Diffing tests
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
Index: tests/debugger/polymorphic_output.exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/debugger/polymorphic_output.exp,v
retrieving revision 1.14
diff -u -b -r1.14 polymorphic_output.exp
--- tests/debugger/polymorphic_output.exp 8 Feb 2006 21:48:34 -0000 1.14
+++ tests/debugger/polymorphic_output.exp 17 Mar 2006 06:37:03 -0000
@@ -1,4 +1,4 @@
- E1: C1 CALL pred polymorphic_output.main/2-0 (det) polymorphic_output.m:20
+ E1: C1 CALL pred polymorphic_output.main/2-0 (det) polymorphic_output.m:27
mdb> echo on
Command echo enabled.
mdb> register --quiet
@@ -53,7 +53,4 @@
mdb> b std_util__det_arg
mdb: there is no such procedure.
mdb> c
-Uncaught Mercury exception:
-Software Error: det_arg: argument has wrong type
-Last trace event was event #E3.
-Last trace event before the unhandled exception was event #E4.
+two
Index: tests/debugger/polymorphic_output.exp2
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/debugger/polymorphic_output.exp2,v
retrieving revision 1.18
diff -u -b -r1.18 polymorphic_output.exp2
--- tests/debugger/polymorphic_output.exp2 8 Feb 2006 21:48:34 -0000 1.18
+++ tests/debugger/polymorphic_output.exp2 22 Mar 2006 00:38:15 -0000
@@ -1,4 +1,4 @@
- E1: C1 CALL pred polymorphic_output.main/2-0 (det) polymorphic_output.m:20
+ E1: C1 CALL pred polymorphic_output.main/2-0 (det) polymorphic_output.m:27
mdb> echo on
Command echo enabled.
mdb> register --quiet
@@ -50,20 +50,28 @@
browser> p
'_'
browser> quit
-mdb> b std_util__det_arg
- 0: + stop interface func std_util.det_arg/2-0 (det)
+mdb> b -A deconstruct.det_arg/4
+ 0: + stop interface pred deconstruct.det_arg/4-3 (cc_multi)
+ 1: + stop interface pred deconstruct.det_arg/4-2 (cc_multi)
+ 2: + stop interface pred deconstruct.det_arg/4-1 (det)
+ 3: + stop interface pred deconstruct.det_arg/4-0 (det)
mdb> c
- E3: C3 CALL func std_util.det_arg/2-0 (det)
+ E3: C3 CALL pred deconstruct.det_arg/4-1 (det)
mdb> P
- Type (arg 1) two("three", 3, three("four", 4, "one", 1, empty, empty, empty), two/4)
- Index (arg 2) 3
+ Term (arg 1) two("three", 3, three("four", 4, "one", 1, empty, empty, empty), two/4)
+ NonCanon (arg 2) canonicalize
+ Index (arg 3) 3
mdb> f
- E4: C3 EXCP func std_util.det_arg/2-0 (det)
+ E4: C3 EXIT pred deconstruct.det_arg/4-1 (det)
mdb> P
- Type (arg 1) two("three", 3, three("four", 4, "one", 1, empty, empty, empty), two/4)
- Index (arg 2) 3
+ Term (arg 1) two("three", 3, three("four", 4, "one", 1, empty, empty, empty), two/4)
+ NonCanon (arg 2) canonicalize
+ Index (arg 3) 3
+ Argument (arg 4) two("two", 2, empty, empty)
+mdb> disable *
+ 0: - stop interface pred deconstruct.det_arg/4-3 (cc_multi)
+ 1: - stop interface pred deconstruct.det_arg/4-2 (cc_multi)
+ 2: - stop interface pred deconstruct.det_arg/4-1 (det)
+ 3: - stop interface pred deconstruct.det_arg/4-0 (det)
mdb> c
-Uncaught Mercury exception:
-Software Error: det_arg: argument has wrong type
-Last trace event was event #E5.
-Last trace event before the unhandled exception was event #E3.
+two
Index: tests/debugger/polymorphic_output.inp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/debugger/polymorphic_output.inp,v
retrieving revision 1.3
diff -u -b -r1.3 polymorphic_output.inp
--- tests/debugger/polymorphic_output.inp 12 Jan 2002 09:08:13 -0000 1.3
+++ tests/debugger/polymorphic_output.inp 21 Mar 2006 22:44:39 -0000
@@ -19,9 +19,10 @@
^..^r
p
quit
-b std_util__det_arg
+b -A deconstruct.det_arg/4
c
P
f
P
+disable *
c
Index: tests/debugger/polymorphic_output.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/debugger/polymorphic_output.m,v
retrieving revision 1.1
diff -u -b -r1.1 polymorphic_output.m
--- tests/debugger/polymorphic_output.m 11 Apr 2000 10:35:35 -0000 1.1
+++ tests/debugger/polymorphic_output.m 17 Mar 2006 00:32:16 -0000
@@ -1,40 +1,46 @@
% This is a regression test.
%
% It tests for a bug that showed up when tracing
-% calls to procedures like `std_util__det_arg'
-% or `io__read' that have an output argument
-% whose type is a universally quantified type
-% variable that does not occur in the type of
-% any of the input arguments.
+% calls to procedures like `std_util.det_arg' (now deconstruct.det_arg)
+% or `io.read' that have an output argument whose type is a universally
+% quantified type variable that does not occur in the type of any of the
+% input arguments.
+%
% Version rotd-2000-04-10 failed this test case.
:- module polymorphic_output.
:- interface.
:- import_module io.
-:- pred main(io__state::di, io__state::uo) is det.
+:- pred main(io::di, io::uo) is det.
:- implementation.
-:- import_module std_util, list, string, map, int.
-main -->
- { map__from_assoc_list(["two"-2, "one"-1, "three"-3, "four"-4], M) },
- io__write_list(functor_names(M), "\n", io__write_string),
- io__nl.
+:- import_module construct.
+:- import_module deconstruct.
+:- import_module int.
+:- import_module list.
+:- import_module map.
+:- import_module std_util.
+:- import_module string.
+
+main(!IO) :-
+ map.from_assoc_list(["two"-2, "one"-1, "three"-3, "four"-4], M),
+ io.write_list(functor_names(M), "\n", io.write_string, !IO),
+ io.nl(!IO).
:- func functor_names(T) = list(string).
-functor_names(X) =
- [Name | ( if Arity = 0 then ArgNames else [] ) ]
-:-
- functor(X, Name, Arity),
+functor_names(X) = [Name | ( if Arity = 0 then ArgNames else [] )] :-
+ functor(X, canonicalize, Name, Arity),
ArgNames = arg_names(X, Arity - 1).
:- func arg_names(T, int) = list(string).
-arg_names(X, I) =
+arg_names(X, I) = Strs :-
( if I < 0 then
- []
+ Strs = []
else
- list__append(functor_names(det_arg(X, I)), arg_names(X, I - 1))
+ det_arg(X, canonicalize, I, Arg),
+ Strs = functor_names(Arg) ++ arg_names(X, I - 1)
).
cvs diff: Diffing tests/debugger/declarative
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/general
cvs diff: Diffing tests/general/accumulator
cvs diff: Diffing tests/general/string_format
cvs diff: Diffing tests/general/structure_reuse
cvs diff: Diffing tests/grade_subdirs
cvs diff: Diffing tests/hard_coded
Index: tests/hard_coded/copy_pred_2.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/copy_pred_2.m,v
retrieving revision 1.2
diff -u -b -r1.2 copy_pred_2.m
--- tests/hard_coded/copy_pred_2.m 28 Nov 2002 16:33:44 -0000 1.2
+++ tests/hard_coded/copy_pred_2.m 16 Mar 2006 21:43:51 -0000
@@ -1,42 +1,44 @@
- :- module copy_pred_2.
- :- interface.
- :- import_module io.
+:- module copy_pred_2.
+:- interface.
+:- import_module io.
- :- pred main(io__state::di, io__state::uo) is det.
+:- pred main(io::di, io::uo) is det.
- :- implementation.
+:- implementation.
- :- import_module list, map.
- :- import_module std_util, string.
+:- import_module deconstruct.
+:- import_module list.
+:- import_module map.
+:- import_module string.
- main -->
+main -->
{ make_closure(10, 20, P0) },
- io__write_string("copying\n"),
+ io.write_string("copying\n"),
{ copy(P0, P1) },
{ inst_cast(P1, P) },
- io__write_string("calling\n"),
+ io.write_string("calling\n"),
{ P("blah", S) },
- io__write_string("printing\n"),
+ io.write_string("printing\n"),
print(S), nl.
- :- pred make_closure(T, T, pred(string, string)).
- :- mode make_closure(in, in, out(pred(in, out) is det)) is det.
- :- pragma no_inline(make_closure/3).
-
- make_closure(A, B, foo(A, B)).
-
- :- pred inst_cast(pred(string, string), pred(string, string)).
- :- mode inst_cast(in, out(pred(in, out) is det)) is det.
- :- pragma c_code(inst_cast(X::in, Y::out(pred(in, out) is det)),
+:- pred make_closure(T, T, pred(string, string)).
+:- mode make_closure(in, in, out(pred(in, out) is det)) is det.
+:- pragma no_inline(make_closure/3).
+
+make_closure(A, B, foo(A, B)).
+
+:- pred inst_cast(pred(string, string), pred(string, string)).
+:- mode inst_cast(in, out(pred(in, out) is det)) is det.
+:- pragma c_code(inst_cast(X::in, Y::out(pred(in, out) is det)),
[will_not_call_mercury, thread_safe], "Y = X").
- :- pragma foreign_proc("C#",
+:- pragma foreign_proc("C#",
inst_cast(X::in, Y::out(pred(in, out) is det)),
[will_not_call_mercury, thread_safe, promise_pure], "Y = X;").
- :- pred foo(T, T, string, string).
- :- mode foo(in, in, in, out) is det.
- foo(A, B, S0, S) :-
- functor(A, FA, _),
- functor(B, FB, _),
- string__format("%s, %s, %s",
+:- pred foo(T, T, string, string).
+:- mode foo(in, in, in, out) is det.
+foo(A, B, S0, S) :-
+ functor(A, canonicalize, FA, _),
+ functor(B, canonicalize, FB, _),
+ string.format("%s, %s, %s",
[s(FA), s(FB), s(S0)], S).
Index: tests/hard_coded/deconstruct_arg.exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/deconstruct_arg.exp,v
retrieving revision 1.7
diff -u -b -r1.7 deconstruct_arg.exp
--- tests/hard_coded/deconstruct_arg.exp 26 May 2005 00:17:06 -0000 1.7
+++ tests/hard_coded/deconstruct_arg.exp 16 Mar 2006 23:59:58 -0000
@@ -1,340 +1,180 @@
-std_util functor: apple/1
deconstruct functor: apple/1
-std_util argument 0 of apple([]) is []
deconstruct argument 0 of apple([]) is []
-std_util argument 1 of apple([]) doesn't exist
deconstruct argument 1 of apple([]) doesn't exist
-std_util argument 2 of apple([]) doesn't exist
deconstruct argument 2 of apple([]) doesn't exist
-std_util deconstruct: functor apple arity 1
-[[]]
deconstruct deconstruct: functor apple arity 1
[[]]
-std_util limited deconstruct 3 of apple([])
-functor apple arity 1 [[]]
deconstruct limited deconstruct 3 of apple([])
functor apple arity 1 [[]]
-std_util functor: apple/1
deconstruct functor: apple/1
-std_util argument 0 of apple([9, 5, 1]) is [9, 5, 1]
deconstruct argument 0 of apple([9, 5, 1]) is [9, 5, 1]
-std_util argument 1 of apple([9, 5, 1]) doesn't exist
deconstruct argument 1 of apple([9, 5, 1]) doesn't exist
-std_util argument 2 of apple([9, 5, 1]) doesn't exist
deconstruct argument 2 of apple([9, 5, 1]) doesn't exist
-std_util deconstruct: functor apple arity 1
-[[9, 5, 1]]
deconstruct deconstruct: functor apple arity 1
[[9, 5, 1]]
-std_util limited deconstruct 3 of apple([9, 5, 1])
-functor apple arity 1 [[9, 5, 1]]
deconstruct limited deconstruct 3 of apple([9, 5, 1])
functor apple arity 1 [[9, 5, 1]]
-std_util functor: zop/2
deconstruct functor: zop/2
-std_util argument 0 of zop(3.30000000000000, 2.03000000000000) is 3.30000000000000
deconstruct argument 0 of zop(3.30000000000000, 2.03000000000000) is 3.30000000000000
-std_util argument 1 of zop(3.30000000000000, 2.03000000000000) is 2.03000000000000
deconstruct argument 1 of zop(3.30000000000000, 2.03000000000000) is 2.03000000000000
-std_util argument 2 of zop(3.30000000000000, 2.03000000000000) doesn't exist
deconstruct argument 2 of zop(3.30000000000000, 2.03000000000000) doesn't exist
-std_util deconstruct: functor zop arity 2
-[3.30000000000000, 2.03000000000000]
deconstruct deconstruct: functor zop arity 2
[3.30000000000000, 2.03000000000000]
-std_util limited deconstruct 3 of zop(3.30000000000000, 2.03000000000000)
-functor zop arity 2 [3.30000000000000, 2.03000000000000]
deconstruct limited deconstruct 3 of zop(3.30000000000000, 2.03000000000000)
functor zop arity 2 [3.30000000000000, 2.03000000000000]
-std_util functor: zap/3
deconstruct functor: zap/3
-std_util argument 0 of zap(50, 51.0000000000000, 52) is 50
deconstruct argument 0 of zap(50, 51.0000000000000, 52) is 50
-std_util argument 1 of zap(50, 51.0000000000000, 52) is 51.0000000000000
deconstruct argument 1 of zap(50, 51.0000000000000, 52) is 51.0000000000000
-std_util argument 2 of zap(50, 51.0000000000000, 52) is 52
deconstruct argument 2 of zap(50, 51.0000000000000, 52) is 52
-std_util deconstruct: functor zap arity 3
-[50, 51.0000000000000, 52]
deconstruct deconstruct: functor zap arity 3
[50, 51.0000000000000, 52]
-std_util limited deconstruct 3 of zap(50, 51.0000000000000, 52)
-functor zap arity 3 [50, 51.0000000000000, 52]
deconstruct limited deconstruct 3 of zap(50, 51.0000000000000, 52)
functor zap arity 3 [50, 51.0000000000000, 52]
-std_util functor: zip/4
deconstruct functor: zip/4
-std_util argument 0 of zip(50, 51, 52, 53) is 50
deconstruct argument 0 of zip(50, 51, 52, 53) is 50
-std_util argument 1 of zip(50, 51, 52, 53) is 51
deconstruct argument 1 of zip(50, 51, 52, 53) is 51
-std_util argument 2 of zip(50, 51, 52, 53) is 52
deconstruct argument 2 of zip(50, 51, 52, 53) is 52
-std_util deconstruct: functor zip arity 4
-[50, 51, 52, 53]
deconstruct deconstruct: functor zip arity 4
[50, 51, 52, 53]
-std_util limited deconstruct 3 of zip(50, 51, 52, 53)
-failed
deconstruct limited deconstruct 3 of zip(50, 51, 52, 53)
failed
-std_util functor: wombat/0
deconstruct functor: wombat/0
-std_util argument 0 of wombat doesn't exist
deconstruct argument 0 of wombat doesn't exist
-std_util argument 1 of wombat doesn't exist
deconstruct argument 1 of wombat doesn't exist
-std_util argument 2 of wombat doesn't exist
deconstruct argument 2 of wombat doesn't exist
-std_util deconstruct: functor wombat arity 0
-[]
deconstruct deconstruct: functor wombat arity 0
[]
-std_util limited deconstruct 3 of wombat
-functor wombat arity 0 []
deconstruct limited deconstruct 3 of wombat
functor wombat arity 0 []
-std_util functor: qwerty/1
deconstruct functor: qwerty/1
-std_util argument 0 of qwerty(5) is 5
deconstruct argument 0 of qwerty(5) is 5
-std_util argument 1 of qwerty(5) doesn't exist
deconstruct argument 1 of qwerty(5) doesn't exist
-std_util argument 2 of qwerty(5) doesn't exist
deconstruct argument 2 of qwerty(5) doesn't exist
-std_util deconstruct: functor qwerty arity 1
-[5]
deconstruct deconstruct: functor qwerty arity 1
[5]
-std_util limited deconstruct 3 of qwerty(5)
-functor qwerty arity 1 [5]
deconstruct limited deconstruct 3 of qwerty(5)
functor qwerty arity 1 [5]
-std_util functor: 'a'/0
deconstruct functor: 'a'/0
-std_util argument 0 of a doesn't exist
deconstruct argument 0 of a doesn't exist
-std_util argument 1 of a doesn't exist
deconstruct argument 1 of a doesn't exist
-std_util argument 2 of a doesn't exist
deconstruct argument 2 of a doesn't exist
-std_util deconstruct: functor 'a' arity 0
-[]
deconstruct deconstruct: functor 'a' arity 0
[]
-std_util limited deconstruct 3 of a
-functor 'a' arity 0 []
deconstruct limited deconstruct 3 of a
functor 'a' arity 0 []
-std_util functor: 0.12345678901234566/0
deconstruct functor: 0.12345678901234566/0
-std_util argument 0 of 0.12345678901234566 doesn't exist
deconstruct argument 0 of 0.12345678901234566 doesn't exist
-std_util argument 1 of 0.12345678901234566 doesn't exist
deconstruct argument 1 of 0.12345678901234566 doesn't exist
-std_util argument 2 of 0.12345678901234566 doesn't exist
deconstruct argument 2 of 0.12345678901234566 doesn't exist
-std_util deconstruct: functor 0.12345678901234566 arity 0
-[]
deconstruct deconstruct: functor 0.12345678901234566 arity 0
[]
-std_util limited deconstruct 3 of 0.12345678901234566
-functor 0.12345678901234566 arity 0 []
deconstruct limited deconstruct 3 of 0.12345678901234566
functor 0.12345678901234566 arity 0 []
-std_util functor: 4/0
deconstruct functor: 4/0
-std_util argument 0 of 4 doesn't exist
deconstruct argument 0 of 4 doesn't exist
-std_util argument 1 of 4 doesn't exist
deconstruct argument 1 of 4 doesn't exist
-std_util argument 2 of 4 doesn't exist
deconstruct argument 2 of 4 doesn't exist
-std_util deconstruct: functor 4 arity 0
-[]
deconstruct deconstruct: functor 4 arity 0
[]
-std_util limited deconstruct 3 of 4
-functor 4 arity 0 []
deconstruct limited deconstruct 3 of 4
functor 4 arity 0 []
-std_util functor: univ_cons/1
deconstruct functor: univ_cons/1
-std_util argument 0 of ["hi! I\'m a univ!"] is ["hi! I\'m a univ!"]
deconstruct argument 0 of ["hi! I\'m a univ!"] is ["hi! I\'m a univ!"]
-std_util argument 1 of ["hi! I\'m a univ!"] doesn't exist
deconstruct argument 1 of ["hi! I\'m a univ!"] doesn't exist
-std_util argument 2 of ["hi! I\'m a univ!"] doesn't exist
deconstruct argument 2 of ["hi! I\'m a univ!"] doesn't exist
-std_util deconstruct: functor univ_cons arity 1
-[["hi! I\'m a univ!"]]
deconstruct deconstruct: functor univ_cons arity 1
[["hi! I\'m a univ!"]]
-std_util limited deconstruct 3 of ["hi! I\'m a univ!"]
-functor univ_cons arity 1 [["hi! I\'m a univ!"]]
deconstruct limited deconstruct 3 of ["hi! I\'m a univ!"]
functor univ_cons arity 1 [["hi! I\'m a univ!"]]
-std_util functor: <<deconstruct_arg.set/1>>/0
deconstruct functor: set_rep/1
-std_util argument 0 of '<<deconstruct_arg.set/1>>' doesn't exist
deconstruct argument 0 of '<<deconstruct_arg.set/1>>' is [1, 2, 3, 3]
-std_util argument 1 of '<<deconstruct_arg.set/1>>' doesn't exist
deconstruct argument 1 of '<<deconstruct_arg.set/1>>' doesn't exist
-std_util argument 2 of '<<deconstruct_arg.set/1>>' doesn't exist
deconstruct argument 2 of '<<deconstruct_arg.set/1>>' doesn't exist
-std_util deconstruct: functor <<deconstruct_arg.set/1>> arity 0
-[]
deconstruct deconstruct: functor set_rep arity 1
[[1, 2, 3, 3]]
-std_util limited deconstruct 3 of '<<deconstruct_arg.set/1>>'
-functor <<deconstruct_arg.set/1>> arity 0 []
deconstruct limited deconstruct 3 of '<<deconstruct_arg.set/1>>'
functor set_rep arity 1 [[1, 2, 3, 3]]
-std_util functor: <<predicate>>/0
deconstruct functor: newline/0
-std_util argument 0 of '<<predicate>>' doesn't exist
deconstruct argument 0 of '<<predicate>>' doesn't exist
-std_util argument 1 of '<<predicate>>' doesn't exist
deconstruct argument 1 of '<<predicate>>' doesn't exist
-std_util argument 2 of '<<predicate>>' doesn't exist
deconstruct argument 2 of '<<predicate>>' doesn't exist
-std_util deconstruct: functor <<predicate>> arity 0
-[]
deconstruct deconstruct: functor newline arity 0
[]
-std_util limited deconstruct 3 of '<<predicate>>'
-functor <<predicate>> arity 0 []
deconstruct limited deconstruct 3 of '<<predicate>>'
functor newline arity 0 []
-std_util functor: <<predicate>>/0
-deconstruct functor: lambda_deconstruct_arg_m_85/1
-std_util argument 0 of '<<predicate>>' doesn't exist
+deconstruct functor: lambda_deconstruct_arg_m_106/1
deconstruct argument 0 of '<<predicate>>' is [1, 2]
-std_util argument 1 of '<<predicate>>' doesn't exist
deconstruct argument 1 of '<<predicate>>' doesn't exist
-std_util argument 2 of '<<predicate>>' doesn't exist
deconstruct argument 2 of '<<predicate>>' doesn't exist
-std_util deconstruct: functor <<predicate>> arity 0
-[]
-deconstruct deconstruct: functor lambda_deconstruct_arg_m_85 arity 1
+deconstruct deconstruct: functor lambda_deconstruct_arg_m_106 arity 1
[[1, 2]]
-std_util limited deconstruct 3 of '<<predicate>>'
-functor <<predicate>> arity 0 []
deconstruct limited deconstruct 3 of '<<predicate>>'
-functor lambda_deconstruct_arg_m_85 arity 1 [[1, 2]]
+functor lambda_deconstruct_arg_m_106 arity 1 [[1, 2]]
-std_util functor: {}/2
deconstruct functor: {}/2
-std_util argument 0 of {1, 'b'} is 1
deconstruct argument 0 of {1, 'b'} is 1
-std_util argument 1 of {1, 'b'} is 'b'
deconstruct argument 1 of {1, 'b'} is 'b'
-std_util argument 2 of {1, 'b'} doesn't exist
deconstruct argument 2 of {1, 'b'} doesn't exist
-std_util deconstruct: functor {} arity 2
-[1, 'b']
deconstruct deconstruct: functor {} arity 2
[1, 'b']
-std_util limited deconstruct 3 of {1, 'b'}
-functor {} arity 2 [1, 'b']
deconstruct limited deconstruct 3 of {1, 'b'}
functor {} arity 2 [1, 'b']
-std_util functor: {}/3
deconstruct functor: {}/3
-std_util argument 0 of {1, 'b', "third"} is 1
deconstruct argument 0 of {1, 'b', "third"} is 1
-std_util argument 1 of {1, 'b', "third"} is 'b'
deconstruct argument 1 of {1, 'b', "third"} is 'b'
-std_util argument 2 of {1, 'b', "third"} is "third"
deconstruct argument 2 of {1, 'b', "third"} is "third"
-std_util deconstruct: functor {} arity 3
-[1, 'b', "third"]
deconstruct deconstruct: functor {} arity 3
[1, 'b', "third"]
-std_util limited deconstruct 3 of {1, 'b', "third"}
-functor {} arity 3 [1, 'b', "third"]
deconstruct limited deconstruct 3 of {1, 'b', "third"}
functor {} arity 3 [1, 'b', "third"]
-std_util functor: {}/4
deconstruct functor: {}/4
-std_util argument 0 of {1, 'b', "third", {1, 2, 3, 4}} is 1
deconstruct argument 0 of {1, 'b', "third", {1, 2, 3, 4}} is 1
-std_util argument 1 of {1, 'b', "third", {1, 2, 3, 4}} is 'b'
deconstruct argument 1 of {1, 'b', "third", {1, 2, 3, 4}} is 'b'
-std_util argument 2 of {1, 'b', "third", {1, 2, 3, 4}} is "third"
deconstruct argument 2 of {1, 'b', "third", {1, 2, 3, 4}} is "third"
-std_util deconstruct: functor {} arity 4
-[1, 'b', "third", {1, 2, 3, 4}]
deconstruct deconstruct: functor {} arity 4
[1, 'b', "third", {1, 2, 3, 4}]
-std_util limited deconstruct 3 of {1, 'b', "third", {1, 2, 3, 4}}
-failed
deconstruct limited deconstruct 3 of {1, 'b', "third", {1, 2, 3, 4}}
failed
-std_util functor: <<array>>/2
deconstruct functor: <<array>>/2
-std_util argument 0 of array([1000, 2000]) is 1000
deconstruct argument 0 of array([1000, 2000]) is 1000
-std_util argument 1 of array([1000, 2000]) is 2000
deconstruct argument 1 of array([1000, 2000]) is 2000
-std_util argument 2 of array([1000, 2000]) doesn't exist
deconstruct argument 2 of array([1000, 2000]) doesn't exist
-std_util deconstruct: functor <<array>> arity 2
-[1000, 2000]
deconstruct deconstruct: functor <<array>> arity 2
[1000, 2000]
-std_util limited deconstruct 3 of array([1000, 2000])
-functor <<array>> arity 2 [1000, 2000]
deconstruct limited deconstruct 3 of array([1000, 2000])
functor <<array>> arity 2 [1000, 2000]
-std_util functor: <<array>>/3
deconstruct functor: <<array>>/3
-std_util argument 0 of array([100, 200, 300]) is 100
deconstruct argument 0 of array([100, 200, 300]) is 100
-std_util argument 1 of array([100, 200, 300]) is 200
deconstruct argument 1 of array([100, 200, 300]) is 200
-std_util argument 2 of array([100, 200, 300]) is 300
deconstruct argument 2 of array([100, 200, 300]) is 300
-std_util deconstruct: functor <<array>> arity 3
-[100, 200, 300]
deconstruct deconstruct: functor <<array>> arity 3
[100, 200, 300]
-std_util limited deconstruct 3 of array([100, 200, 300])
-functor <<array>> arity 3 [100, 200, 300]
deconstruct limited deconstruct 3 of array([100, 200, 300])
functor <<array>> arity 3 [100, 200, 300]
-std_util functor: <<array>>/4
deconstruct functor: <<array>>/4
-std_util argument 0 of array([10, 20, 30, 40]) is 10
deconstruct argument 0 of array([10, 20, 30, 40]) is 10
-std_util argument 1 of array([10, 20, 30, 40]) is 20
deconstruct argument 1 of array([10, 20, 30, 40]) is 20
-std_util argument 2 of array([10, 20, 30, 40]) is 30
deconstruct argument 2 of array([10, 20, 30, 40]) is 30
-std_util deconstruct: functor <<array>> arity 4
-[10, 20, 30, 40]
deconstruct deconstruct: functor <<array>> arity 4
[10, 20, 30, 40]
-std_util limited deconstruct 3 of array([10, 20, 30, 40])
-failed
deconstruct limited deconstruct 3 of array([10, 20, 30, 40])
failed
Index: tests/hard_coded/deconstruct_arg.exp2
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/deconstruct_arg.exp2,v
retrieving revision 1.3
diff -u -b -r1.3 deconstruct_arg.exp2
--- tests/hard_coded/deconstruct_arg.exp2 17 Jan 2003 05:57:04 -0000 1.3
+++ tests/hard_coded/deconstruct_arg.exp2 17 Mar 2006 07:56:31 -0000
@@ -1,340 +1,180 @@
-std_util functor: apple/1
deconstruct functor: apple/1
-std_util argument 0 of apple([]) is []
deconstruct argument 0 of apple([]) is []
-std_util argument 1 of apple([]) doesn't exist
deconstruct argument 1 of apple([]) doesn't exist
-std_util argument 2 of apple([]) doesn't exist
deconstruct argument 2 of apple([]) doesn't exist
-std_util deconstruct: functor apple arity 1
-[[]]
deconstruct deconstruct: functor apple arity 1
[[]]
-std_util limited deconstruct 3 of apple([])
-functor apple arity 1 [[]]
deconstruct limited deconstruct 3 of apple([])
functor apple arity 1 [[]]
-std_util functor: apple/1
deconstruct functor: apple/1
-std_util argument 0 of apple([9, 5, 1]) is [9, 5, 1]
deconstruct argument 0 of apple([9, 5, 1]) is [9, 5, 1]
-std_util argument 1 of apple([9, 5, 1]) doesn't exist
deconstruct argument 1 of apple([9, 5, 1]) doesn't exist
-std_util argument 2 of apple([9, 5, 1]) doesn't exist
deconstruct argument 2 of apple([9, 5, 1]) doesn't exist
-std_util deconstruct: functor apple arity 1
-[[9, 5, 1]]
deconstruct deconstruct: functor apple arity 1
[[9, 5, 1]]
-std_util limited deconstruct 3 of apple([9, 5, 1])
-functor apple arity 1 [[9, 5, 1]]
deconstruct limited deconstruct 3 of apple([9, 5, 1])
functor apple arity 1 [[9, 5, 1]]
-std_util functor: zop/2
deconstruct functor: zop/2
-std_util argument 0 of zop(3.30000000000000, 2.03000000000000) is 3.30000000000000
deconstruct argument 0 of zop(3.30000000000000, 2.03000000000000) is 3.30000000000000
-std_util argument 1 of zop(3.30000000000000, 2.03000000000000) is 2.03000000000000
deconstruct argument 1 of zop(3.30000000000000, 2.03000000000000) is 2.03000000000000
-std_util argument 2 of zop(3.30000000000000, 2.03000000000000) doesn't exist
deconstruct argument 2 of zop(3.30000000000000, 2.03000000000000) doesn't exist
-std_util deconstruct: functor zop arity 2
-[3.30000000000000, 2.03000000000000]
deconstruct deconstruct: functor zop arity 2
[3.30000000000000, 2.03000000000000]
-std_util limited deconstruct 3 of zop(3.30000000000000, 2.03000000000000)
-functor zop arity 2 [3.30000000000000, 2.03000000000000]
deconstruct limited deconstruct 3 of zop(3.30000000000000, 2.03000000000000)
functor zop arity 2 [3.30000000000000, 2.03000000000000]
-std_util functor: zap/3
deconstruct functor: zap/3
-std_util argument 0 of zap(50, 51.0000000000000, 52) is 50
deconstruct argument 0 of zap(50, 51.0000000000000, 52) is 50
-std_util argument 1 of zap(50, 51.0000000000000, 52) is 51.0000000000000
deconstruct argument 1 of zap(50, 51.0000000000000, 52) is 51.0000000000000
-std_util argument 2 of zap(50, 51.0000000000000, 52) is 52
deconstruct argument 2 of zap(50, 51.0000000000000, 52) is 52
-std_util deconstruct: functor zap arity 3
-[50, 51.0000000000000, 52]
deconstruct deconstruct: functor zap arity 3
[50, 51.0000000000000, 52]
-std_util limited deconstruct 3 of zap(50, 51.0000000000000, 52)
-functor zap arity 3 [50, 51.0000000000000, 52]
deconstruct limited deconstruct 3 of zap(50, 51.0000000000000, 52)
functor zap arity 3 [50, 51.0000000000000, 52]
-std_util functor: zip/4
deconstruct functor: zip/4
-std_util argument 0 of zip(50, 51, 52, 53) is 50
deconstruct argument 0 of zip(50, 51, 52, 53) is 50
-std_util argument 1 of zip(50, 51, 52, 53) is 51
deconstruct argument 1 of zip(50, 51, 52, 53) is 51
-std_util argument 2 of zip(50, 51, 52, 53) is 52
deconstruct argument 2 of zip(50, 51, 52, 53) is 52
-std_util deconstruct: functor zip arity 4
-[50, 51, 52, 53]
deconstruct deconstruct: functor zip arity 4
[50, 51, 52, 53]
-std_util limited deconstruct 3 of zip(50, 51, 52, 53)
-failed
deconstruct limited deconstruct 3 of zip(50, 51, 52, 53)
failed
-std_util functor: wombat/0
deconstruct functor: wombat/0
-std_util argument 0 of wombat doesn't exist
deconstruct argument 0 of wombat doesn't exist
-std_util argument 1 of wombat doesn't exist
deconstruct argument 1 of wombat doesn't exist
-std_util argument 2 of wombat doesn't exist
deconstruct argument 2 of wombat doesn't exist
-std_util deconstruct: functor wombat arity 0
-[]
deconstruct deconstruct: functor wombat arity 0
[]
-std_util limited deconstruct 3 of wombat
-functor wombat arity 0 []
deconstruct limited deconstruct 3 of wombat
functor wombat arity 0 []
-std_util functor: qwerty/1
deconstruct functor: qwerty/1
-std_util argument 0 of qwerty(5) is 5
deconstruct argument 0 of qwerty(5) is 5
-std_util argument 1 of qwerty(5) doesn't exist
deconstruct argument 1 of qwerty(5) doesn't exist
-std_util argument 2 of qwerty(5) doesn't exist
deconstruct argument 2 of qwerty(5) doesn't exist
-std_util deconstruct: functor qwerty arity 1
-[5]
deconstruct deconstruct: functor qwerty arity 1
[5]
-std_util limited deconstruct 3 of qwerty(5)
-functor qwerty arity 1 [5]
deconstruct limited deconstruct 3 of qwerty(5)
functor qwerty arity 1 [5]
-std_util functor: 'a'/0
deconstruct functor: 'a'/0
-std_util argument 0 of a doesn't exist
deconstruct argument 0 of a doesn't exist
-std_util argument 1 of a doesn't exist
deconstruct argument 1 of a doesn't exist
-std_util argument 2 of a doesn't exist
deconstruct argument 2 of a doesn't exist
-std_util deconstruct: functor 'a' arity 0
-[]
deconstruct deconstruct: functor 'a' arity 0
[]
-std_util limited deconstruct 3 of a
-functor 'a' arity 0 []
deconstruct limited deconstruct 3 of a
functor 'a' arity 0 []
-std_util functor: 0.12345678901234566/0
deconstruct functor: 0.12345678901234566/0
-std_util argument 0 of 0.12345678901234566 doesn't exist
deconstruct argument 0 of 0.12345678901234566 doesn't exist
-std_util argument 1 of 0.12345678901234566 doesn't exist
deconstruct argument 1 of 0.12345678901234566 doesn't exist
-std_util argument 2 of 0.12345678901234566 doesn't exist
deconstruct argument 2 of 0.12345678901234566 doesn't exist
-std_util deconstruct: functor 0.12345678901234566 arity 0
-[]
deconstruct deconstruct: functor 0.12345678901234566 arity 0
[]
-std_util limited deconstruct 3 of 0.12345678901234566
-functor 0.12345678901234566 arity 0 []
deconstruct limited deconstruct 3 of 0.12345678901234566
functor 0.12345678901234566 arity 0 []
-std_util functor: 4/0
deconstruct functor: 4/0
-std_util argument 0 of 4 doesn't exist
deconstruct argument 0 of 4 doesn't exist
-std_util argument 1 of 4 doesn't exist
deconstruct argument 1 of 4 doesn't exist
-std_util argument 2 of 4 doesn't exist
deconstruct argument 2 of 4 doesn't exist
-std_util deconstruct: functor 4 arity 0
-[]
deconstruct deconstruct: functor 4 arity 0
[]
-std_util limited deconstruct 3 of 4
-functor 4 arity 0 []
deconstruct limited deconstruct 3 of 4
functor 4 arity 0 []
-std_util functor: univ_cons/1
deconstruct functor: univ_cons/1
-std_util argument 0 of ["hi! I\'m a univ!"] is ["hi! I\'m a univ!"]
deconstruct argument 0 of ["hi! I\'m a univ!"] is ["hi! I\'m a univ!"]
-std_util argument 1 of ["hi! I\'m a univ!"] doesn't exist
deconstruct argument 1 of ["hi! I\'m a univ!"] doesn't exist
-std_util argument 2 of ["hi! I\'m a univ!"] doesn't exist
deconstruct argument 2 of ["hi! I\'m a univ!"] doesn't exist
-std_util deconstruct: functor univ_cons arity 1
-[["hi! I\'m a univ!"]]
deconstruct deconstruct: functor univ_cons arity 1
[["hi! I\'m a univ!"]]
-std_util limited deconstruct 3 of ["hi! I\'m a univ!"]
-functor univ_cons arity 1 [["hi! I\'m a univ!"]]
deconstruct limited deconstruct 3 of ["hi! I\'m a univ!"]
functor univ_cons arity 1 [["hi! I\'m a univ!"]]
-std_util functor: <<deconstruct_arg.set/1>>/0
deconstruct functor: set_rep/1
-std_util argument 0 of '<<deconstruct_arg.set/1>>' doesn't exist
deconstruct argument 0 of '<<deconstruct_arg.set/1>>' is [1, 2, 3, 3]
-std_util argument 1 of '<<deconstruct_arg.set/1>>' doesn't exist
deconstruct argument 1 of '<<deconstruct_arg.set/1>>' doesn't exist
-std_util argument 2 of '<<deconstruct_arg.set/1>>' doesn't exist
deconstruct argument 2 of '<<deconstruct_arg.set/1>>' doesn't exist
-std_util deconstruct: functor <<deconstruct_arg.set/1>> arity 0
-[]
deconstruct deconstruct: functor set_rep arity 1
[[1, 2, 3, 3]]
-std_util limited deconstruct 3 of '<<deconstruct_arg.set/1>>'
-functor <<deconstruct_arg.set/1>> arity 0 []
deconstruct limited deconstruct 3 of '<<deconstruct_arg.set/1>>'
functor set_rep arity 1 [[1, 2, 3, 3]]
-std_util functor: <<predicate>>/0
deconstruct functor: <<predicate>>/0
-std_util argument 0 of '<<predicate>>' doesn't exist
deconstruct argument 0 of '<<predicate>>' doesn't exist
-std_util argument 1 of '<<predicate>>' doesn't exist
deconstruct argument 1 of '<<predicate>>' doesn't exist
-std_util argument 2 of '<<predicate>>' doesn't exist
deconstruct argument 2 of '<<predicate>>' doesn't exist
-std_util deconstruct: functor <<predicate>> arity 0
-[]
deconstruct deconstruct: functor <<predicate>> arity 0
[]
-std_util limited deconstruct 3 of '<<predicate>>'
-functor <<predicate>> arity 0 []
deconstruct limited deconstruct 3 of '<<predicate>>'
functor <<predicate>> arity 0 []
-std_util functor: <<predicate>>/0
deconstruct functor: <<predicate>>/0
-std_util argument 0 of '<<predicate>>' doesn't exist
deconstruct argument 0 of '<<predicate>>' doesn't exist
-std_util argument 1 of '<<predicate>>' doesn't exist
deconstruct argument 1 of '<<predicate>>' doesn't exist
-std_util argument 2 of '<<predicate>>' doesn't exist
deconstruct argument 2 of '<<predicate>>' doesn't exist
-std_util deconstruct: functor <<predicate>> arity 0
-[]
deconstruct deconstruct: functor <<predicate>> arity 0
[]
-std_util limited deconstruct 3 of '<<predicate>>'
-functor <<predicate>> arity 0 []
deconstruct limited deconstruct 3 of '<<predicate>>'
functor <<predicate>> arity 0 []
-std_util functor: {}/2
deconstruct functor: {}/2
-std_util argument 0 of {1, 'b'} is 1
deconstruct argument 0 of {1, 'b'} is 1
-std_util argument 1 of {1, 'b'} is 'b'
deconstruct argument 1 of {1, 'b'} is 'b'
-std_util argument 2 of {1, 'b'} doesn't exist
deconstruct argument 2 of {1, 'b'} doesn't exist
-std_util deconstruct: functor {} arity 2
-[1, 'b']
deconstruct deconstruct: functor {} arity 2
[1, 'b']
-std_util limited deconstruct 3 of {1, 'b'}
-functor {} arity 2 [1, 'b']
deconstruct limited deconstruct 3 of {1, 'b'}
functor {} arity 2 [1, 'b']
-std_util functor: {}/3
deconstruct functor: {}/3
-std_util argument 0 of {1, 'b', "third"} is 1
deconstruct argument 0 of {1, 'b', "third"} is 1
-std_util argument 1 of {1, 'b', "third"} is 'b'
deconstruct argument 1 of {1, 'b', "third"} is 'b'
-std_util argument 2 of {1, 'b', "third"} is "third"
deconstruct argument 2 of {1, 'b', "third"} is "third"
-std_util deconstruct: functor {} arity 3
-[1, 'b', "third"]
deconstruct deconstruct: functor {} arity 3
[1, 'b', "third"]
-std_util limited deconstruct 3 of {1, 'b', "third"}
-functor {} arity 3 [1, 'b', "third"]
deconstruct limited deconstruct 3 of {1, 'b', "third"}
functor {} arity 3 [1, 'b', "third"]
-std_util functor: {}/4
deconstruct functor: {}/4
-std_util argument 0 of {1, 'b', "third", {1, 2, 3, 4}} is 1
deconstruct argument 0 of {1, 'b', "third", {1, 2, 3, 4}} is 1
-std_util argument 1 of {1, 'b', "third", {1, 2, 3, 4}} is 'b'
deconstruct argument 1 of {1, 'b', "third", {1, 2, 3, 4}} is 'b'
-std_util argument 2 of {1, 'b', "third", {1, 2, 3, 4}} is "third"
deconstruct argument 2 of {1, 'b', "third", {1, 2, 3, 4}} is "third"
-std_util deconstruct: functor {} arity 4
-[1, 'b', "third", {1, 2, 3, 4}]
deconstruct deconstruct: functor {} arity 4
[1, 'b', "third", {1, 2, 3, 4}]
-std_util limited deconstruct 3 of {1, 'b', "third", {1, 2, 3, 4}}
-failed
deconstruct limited deconstruct 3 of {1, 'b', "third", {1, 2, 3, 4}}
failed
-std_util functor: <<array>>/2
deconstruct functor: <<array>>/2
-std_util argument 0 of array([1000, 2000]) is 1000
deconstruct argument 0 of array([1000, 2000]) is 1000
-std_util argument 1 of array([1000, 2000]) is 2000
deconstruct argument 1 of array([1000, 2000]) is 2000
-std_util argument 2 of array([1000, 2000]) doesn't exist
deconstruct argument 2 of array([1000, 2000]) doesn't exist
-std_util deconstruct: functor <<array>> arity 2
-[1000, 2000]
deconstruct deconstruct: functor <<array>> arity 2
[1000, 2000]
-std_util limited deconstruct 3 of array([1000, 2000])
-functor <<array>> arity 2 [1000, 2000]
deconstruct limited deconstruct 3 of array([1000, 2000])
functor <<array>> arity 2 [1000, 2000]
-std_util functor: <<array>>/3
deconstruct functor: <<array>>/3
-std_util argument 0 of array([100, 200, 300]) is 100
deconstruct argument 0 of array([100, 200, 300]) is 100
-std_util argument 1 of array([100, 200, 300]) is 200
deconstruct argument 1 of array([100, 200, 300]) is 200
-std_util argument 2 of array([100, 200, 300]) is 300
deconstruct argument 2 of array([100, 200, 300]) is 300
-std_util deconstruct: functor <<array>> arity 3
-[100, 200, 300]
deconstruct deconstruct: functor <<array>> arity 3
[100, 200, 300]
-std_util limited deconstruct 3 of array([100, 200, 300])
-functor <<array>> arity 3 [100, 200, 300]
deconstruct limited deconstruct 3 of array([100, 200, 300])
functor <<array>> arity 3 [100, 200, 300]
-std_util functor: <<array>>/4
deconstruct functor: <<array>>/4
-std_util argument 0 of array([10, 20, 30, 40]) is 10
deconstruct argument 0 of array([10, 20, 30, 40]) is 10
-std_util argument 1 of array([10, 20, 30, 40]) is 20
deconstruct argument 1 of array([10, 20, 30, 40]) is 20
-std_util argument 2 of array([10, 20, 30, 40]) is 30
deconstruct argument 2 of array([10, 20, 30, 40]) is 30
-std_util deconstruct: functor <<array>> arity 4
-[10, 20, 30, 40]
deconstruct deconstruct: functor <<array>> arity 4
[10, 20, 30, 40]
-std_util limited deconstruct 3 of array([10, 20, 30, 40])
-failed
deconstruct limited deconstruct 3 of array([10, 20, 30, 40])
failed
Index: tests/hard_coded/deconstruct_arg.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/deconstruct_arg.m,v
retrieving revision 1.6
diff -u -b -r1.6 deconstruct_arg.m
--- tests/hard_coded/deconstruct_arg.m 2 Dec 2002 15:51:32 -0000 1.6
+++ tests/hard_coded/deconstruct_arg.m 21 Mar 2006 02:02:08 -0000
@@ -7,30 +7,51 @@
:- interface.
:- import_module io.
-:- pred main(io__state::di, io__state::uo) is cc_multi.
+:- pred main(io::di, io::uo) is cc_multi.
:- implementation.
%-----------------------------------------------------------------------------%
-:- import_module array, list, string, std_util, deconstruct.
+:- import_module array.
+:- import_module list.
+:- import_module string.
+:- import_module std_util.
+:- import_module deconstruct.
+
+:- type enum
+ ---> one
+ ; two
+ ; three.
-:- type enum ---> one ; two ; three.
-
-:- type fruit ---> apple(list(int))
+:- type fruit
+ ---> apple(list(int))
; banana(list(enum)).
-:- type thingie ---> foo ; bar(int) ; bar(int, int) ; qux(int) ;
- quux(int) ; quuux(int, int) ; wombat ;
- zoom(int) ; zap(int, float, int) ;
- zip(int, int, int, int) ; zop(float, float).
-
-:- type poly(A, B) ---> poly_one(A) ; poly_two(B) ;
- poly_three(B, A, poly(B, A)).
-
-:- type no_tag ---> qwerty(int).
-
-:- type set(T) ---> set_rep(list(T)) where equality is set_equal.
+:- type thingie
+ ---> foo
+ ; bar(int)
+ ; bar(int, int)
+ ; qux(int)
+ ; quux(int)
+ ; quuux(int, int)
+ ; wombat
+ ; zoom(int)
+ ; zap(int, float, int)
+ ; zip(int, int, int, int)
+ ; zop(float, float).
+
+:- type poly(A, B)
+ ---> poly_one(A)
+ ; poly_two(B)
+ ; poly_three(B, A, poly(B, A)).
+
+:- type no_tag
+ ---> qwerty(int).
+
+:- type set(T)
+ ---> set_rep(list(T))
+ where equality is set_equal.
%-----------------------------------------------------------------------------%
@@ -45,7 +66,7 @@
set_to_sorted_list(Set) =
promise_only_solution((pred(Sorted::out) is cc_multi :-
Set = set_rep(Unsorted),
- list__sort_and_remove_dups(Unsorted, Sorted)
+ list.sort_and_remove_dups(Unsorted, Sorted)
)).
:- pred set_equal(set(T)::in, set(T)::in) is semidet.
@@ -94,146 +115,86 @@
%-----------------------------------------------------------------------------%
-:- pred test_all(T::in, io__state::di, io__state::uo) is cc_multi.
+:- pred test_all(T::in, io.state::di, io.state::uo) is cc_multi.
test_all(T) -->
- test_std_util_functor(T),
test_deconstruct_functor(T),
- test_std_util_arg(T, 0),
test_deconstruct_arg(T, 0),
- test_std_util_arg(T, 1),
test_deconstruct_arg(T, 1),
- test_std_util_arg(T, 2),
test_deconstruct_arg(T, 2),
- test_std_util_deconstruct(T),
test_deconstruct_deconstruct(T),
- test_std_util_limited_deconstruct(T, 3),
test_deconstruct_limited_deconstruct(T, 3).
%-----------------------------------------------------------------------------%
-:- pred test_std_util_functor(T::in, io__state::di, io__state::uo) is det.
-
-test_std_util_functor(T) -->
- io__write_string("std_util functor: "),
- { std_util__functor(T, Functor, Arity) },
- io__write_string(Functor),
- io__write_string("/"),
- io__write_int(Arity),
- io__write_string("\n").
-
-:- pred test_deconstruct_functor(T::in, io__state::di, io__state::uo)
+:- pred test_deconstruct_functor(T::in, io.state::di, io.state::uo)
is cc_multi.
test_deconstruct_functor(T) -->
- io__write_string("deconstruct functor: "),
- { deconstruct__functor(T, include_details_cc, Functor, Arity) },
- io__write_string(Functor),
- io__write_string("/"),
- io__write_int(Arity),
- io__write_string("\n").
-
-:- pred test_std_util_arg(T::in, int::in, io__state::di, io__state::uo) is det.
-
-test_std_util_arg(T, ArgNum) -->
- { string__format("std_util argument %d of ", [i(ArgNum)], Str) },
- io__write_string(Str),
- io__print(T),
- ( { Argument = std_util__argument(T, ArgNum) } ->
- io__write_string(" is "),
- io__write_univ(Argument),
- io__write_string("\n")
- ;
- io__write_string(" doesn't exist\n")
- ).
+ io.write_string("deconstruct functor: "),
+ { deconstruct.functor(T, include_details_cc, Functor, Arity) },
+ io.write_string(Functor),
+ io.write_string("/"),
+ io.write_int(Arity),
+ io.write_string("\n").
-:- pred test_deconstruct_arg(T::in, int::in, io__state::di, io__state::uo)
+:- pred test_deconstruct_arg(T::in, int::in, io.state::di, io.state::uo)
is cc_multi.
test_deconstruct_arg(T, ArgNum) -->
- { string__format("deconstruct argument %d of ", [i(ArgNum)], Str) },
- io__write_string(Str),
- io__print(T),
- { deconstruct__arg_cc(T, ArgNum, MaybeArg) },
- ( { MaybeArg = arg(Arg) } ->
- io__write_string(" is "),
- io__write(Arg),
- io__write_string("\n")
+ { string.format("deconstruct argument %d of ", [i(ArgNum)], Str) },
+ io.write_string(Str),
+ io.print(T),
+ { deconstruct.arg_cc(T, ArgNum, MaybeArg) },
+ (
+ { MaybeArg = arg(Arg) },
+ io.write_string(" is "),
+ io.write(Arg),
+ io.write_string("\n")
;
- io__write_string(" doesn't exist\n")
+ { MaybeArg = no_arg },
+ io.write_string(" doesn't exist\n")
).
-:- pred test_std_util_deconstruct(T::in, io__state::di, io__state::uo) is det.
-
-test_std_util_deconstruct(T) -->
- { std_util__deconstruct(T, Functor, Arity, Arguments) },
- { string__format("std_util deconstruct: functor %s arity %d\n",
- [s(Functor), i(Arity)], Str) },
- io__write_string(Str),
- io__write_string("["),
- io__write_list(Arguments, ", ", io__print),
- io__write_string("]\n").
-
-:- pred test_deconstruct_deconstruct(T::in, io__state::di, io__state::uo)
+:- pred test_deconstruct_deconstruct(T::in, io.state::di, io.state::uo)
is cc_multi.
test_deconstruct_deconstruct(T) -->
- { deconstruct__deconstruct(T, include_details_cc,
+ { deconstruct.deconstruct(T, include_details_cc,
Functor, Arity, Arguments) },
- { string__format("deconstruct deconstruct: functor %s arity %d\n",
+ { string.format("deconstruct deconstruct: functor %s arity %d\n",
[s(Functor), i(Arity)], Str) },
- io__write_string(Str),
- io__write_string("["),
- io__write_list(Arguments, ", ", io__print),
- io__write_string("]\n").
-
-:- pred test_std_util_limited_deconstruct(T::in, int::in,
- io__state::di, io__state::uo) is det.
-
-test_std_util_limited_deconstruct(T, Limit) -->
- { string__format("std_util limited deconstruct %d of ",
- [i(Limit)], Str) },
- io__write_string(Str),
- io__print(T),
- io__write_string("\n"),
- (
- { std_util__limited_deconstruct(T,
- Limit, Functor, Arity, Arguments) }
- ->
- { string__format("functor %s arity %d ",
- [s(Functor), i(Arity)], Str2) },
- io__write_string(Str2),
- io__write_string("["),
- io__write_list(Arguments, ", ", io__print),
- io__write_string("]\n")
- ;
- io__write_string("failed\n")
- ).
+ io.write_string(Str),
+ io.write_string("["),
+ io.write_list(Arguments, ", ", io.print),
+ io.write_string("]\n").
:- pred test_deconstruct_limited_deconstruct(T::in, int::in,
- io__state::di, io__state::uo) is cc_multi.
+ io.state::di, io.state::uo) is cc_multi.
test_deconstruct_limited_deconstruct(T, Limit) -->
- { string__format("deconstruct limited deconstruct %d of ",
+ { string.format("deconstruct limited deconstruct %d of ",
[i(Limit)], Str) },
- io__write_string(Str),
- io__print(T),
- io__write_string("\n"),
- { deconstruct__limited_deconstruct_cc(T, Limit, Result) },
- ( { Result = yes({Functor, Arity, Arguments}) } ->
- { string__format("functor %s arity %d ",
+ io.write_string(Str),
+ io.print(T),
+ io.write_string("\n"),
+ { deconstruct.limited_deconstruct_cc(T, Limit, Result) },
+ (
+ { Result = yes({Functor, Arity, Arguments}) },
+ { string.format("functor %s arity %d ",
[s(Functor), i(Arity)], Str2) },
- io__write_string(Str2),
- io__write_string("["),
- io__write_list(Arguments, ", ", io__print),
- io__write_string("]\n")
+ io.write_string(Str2),
+ io.write_string("["),
+ io.write_list(Arguments, ", ", io.print),
+ io.write_string("]\n")
;
- io__write_string("failed\n")
+ { Result = no },
+ io.write_string("failed\n")
).
%-----------------------------------------------------------------------------%
-:- pred newline(io__state::di, io__state::uo) is det.
+:- pred newline(io.state::di, io.state::uo) is det.
newline -->
- io__write_char('\n').
+ io.write_char('\n').
Index: tests/hard_coded/elim_special_pred.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/elim_special_pred.m,v
retrieving revision 1.3
diff -u -b -r1.3 elim_special_pred.m
--- tests/hard_coded/elim_special_pred.m 17 May 1997 18:54:41 -0000 1.3
+++ tests/hard_coded/elim_special_pred.m 16 Mar 2006 21:48:34 -0000
@@ -1,13 +1,13 @@
% Test case for elimination of special predicates in base_type_infos.
%
-% We can use argument/3 and det_argument/3 to retrieve arguments of types, and
+% We can use arg/3 and det_arg/3 to retrieve arguments of types, and
% unify them. Analysis procedures may incorrectly conclude that
% we cannot call the unification procedure (or other procedures), and
% so eliminate it.
%
-% The Mercury compiler of February 13th, 1997 failed this test - the
-% test ended with a runtime error indicating that an unused predicate
-% had been called.
+% The Mercury compiler of February 13th, 1997 failed an earlier version
+% of this test - the test ended with a runtime error indicating that
+% an unused predicate had been called.
%
% Author: trd
@@ -15,26 +15,35 @@
:- interface.
:- import_module io.
-:- pred main(io__state::di, io__state::uo) is det.
+:- pred main(io::di, io::uo) is det.
:- implementation.
-:- import_module list, int, std_util, term, map, string.
-
-:- type enum ---> one ; two ; three.
-
-:- type fruit ---> banana(enum).
-
-main -->
- { X = banana(three) },
- { Y = banana(two) },
- { XArg = det_argument(X, 0) },
- { YArg = det_argument(Y, 0) },
- (
- { XArg = YArg }
- ->
- io__write_string("same\n")
+:- import_module deconstruct.
+:- import_module int.
+:- import_module list.
+:- import_module map.
+:- import_module string.
+:- import_module std_util.
+:- import_module term.
+
+:- type enum
+ ---> one
+ ; two
+ ; three.
+
+:- type fruit
+ ---> banana(enum).
+
+main(!IO) :-
+ X = banana(three),
+ Y = banana(two),
+ det_arg(X, canonicalize, 0, PseudoXArg),
+ type_to_univ(PseudoXArg, XArg),
+ det_arg(Y, canonicalize, 0, PseudoYArg),
+ type_to_univ(PseudoYArg, YArg),
+ ( XArg = YArg ->
+ io.write_string("same\n", !IO)
;
- io__write_string("different\n")
+ io.write_string("different\n", !IO)
).
-
Index: tests/hard_coded/existential_bound_tvar.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/existential_bound_tvar.m,v
retrieving revision 1.1
diff -u -b -r1.1 existential_bound_tvar.m
--- tests/hard_coded/existential_bound_tvar.m 24 Sep 1998 10:11:51 -0000 1.1
+++ tests/hard_coded/existential_bound_tvar.m 16 Mar 2006 21:47:57 -0000
@@ -2,13 +2,14 @@
:- interface.
-:- pred main(io__state::di, io__state::uo) is det.
+:- pred main(io::di, io::uo) is det.
:- import_module io.
:- implementation.
-:- import_module list, std_util.
+:- import_module list.
+:- import_module type_desc.
main -->
{ blah(101, X) },
@@ -42,4 +43,3 @@
:- mode blah3(in, out) is semidet.
blah3([X], X).
-
Index: tests/hard_coded/expand.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/expand.m,v
retrieving revision 1.6
diff -u -b -r1.6 expand.m
--- tests/hard_coded/expand.m 18 Sep 2000 11:52:44 -0000 1.6
+++ tests/hard_coded/expand.m 16 Mar 2006 21:57:35 -0000
@@ -1,4 +1,4 @@
-% Test case for io__write
+% Test case for io.write
%
% Author: trd
@@ -6,37 +6,58 @@
:- interface.
:- import_module io.
-:- pred main(io__state::di, io__state::uo) is det.
+:- pred main(io::di, io::uo) is det.
:- implementation.
-:- import_module list, int, std_util, term, map, string, prolog.
+:- import_module deconstruct.
+:- import_module int.
+:- import_module list.
+:- import_module map.
+:- import_module prolog.
+:- import_module std_util.
+:- import_module string.
+:- import_module term.
+
+:- pred test_builtins(io::di, io::uo) is det.
+:- pred test_discriminated(io::di, io::uo) is det.
+:- pred test_polymorphism(io::di, io::uo) is det.
+:- pred test_other(io::di, io::uo) is det.
+:- pred newline(io::di, io::uo) is det.
+:- pred test_functor(T::in, io::di, io::uo) is det.
+:- pred test_arg(T::in, io::di, io::uo) is det.
+:- pred test_expand(T::in, io::di, io::uo) is det.
+:- pred test_all(T::in, io::di, io::uo) is det.
+
+:- type enum
+ ---> one
+ ; two
+ ; three.
-:- pred test_builtins(io__state::di, io__state::uo) is det.
-:- pred test_discriminated(io__state::di, io__state::uo) is det.
-:- pred test_polymorphism(io__state::di, io__state::uo) is det.
-:- pred test_other(io__state::di, io__state::uo) is det.
-:- pred newline(io__state::di, io__state::uo) is det.
-:- pred test_functor(T::in, io__state::di, io__state::uo) is det.
-:- pred test_arg(T::in, io__state::di, io__state::uo) is det.
-:- pred test_expand(T::in, io__state::di, io__state::uo) is det.
-:- pred test_all(T::in, io__state::di, io__state::uo) is det.
-
-
-:- type enum ---> one ; two ; three.
-
-:- type fruit ---> apple(list(int))
+:- type fruit
+ ---> apple(list(int))
; banana(list(enum)).
-:- type thingie ---> foo ; bar(int) ; bar(int, int) ; qux(int) ;
- quux(int) ; quuux(int, int) ; wombat ;
- zoom(int) ; zap(int, float) ; zip(int, int) ;
- zop(float, float).
+:- type thingie
+ ---> foo
+ ; bar(int)
+ ; bar(int, int)
+ ; qux(int)
+ ; quux(int)
+ ; quuux(int, int)
+ ; wombat
+ ; zoom(int)
+ ; zap(int, float)
+ ; zip(int, int)
+ ; zop(float, float).
+
+:- type poly(A, B)
+ ---> poly_one(A)
+ ; poly_two(B)
+ ; poly_three(B, A, poly(B, A)).
-:- type poly(A, B) ---> poly_one(A) ; poly_two(B) ;
- poly_three(B, A, poly(B, A)).
-
-:- type no_tag ---> qwerty(int).
+:- type no_tag
+ ---> qwerty(int).
main -->
test_discriminated,
@@ -44,9 +65,8 @@
test_builtins,
test_other.
-
test_discriminated -->
- io__write_string("TESTING DISCRIMINATED UNIONS\n"),
+ io.write_string("TESTING DISCRIMINATED UNIONS\n"),
% test enumerations
test_all(one), newline,
@@ -57,7 +77,6 @@
test_all(apple([9,5,1])), newline,
test_all(banana([three, one, two])), newline,
-
% test complicated tags
test_all(zop(3.3, 2.03)), newline,
test_all(zip(3, 2)), newline,
@@ -76,45 +95,43 @@
test_expand(T), newline.
test_functor(T) -->
- { functor(T, Functor, Arity) },
- io__write_string(Functor),
- io__write_string("/"),
- io__write_int(Arity).
+ { functor(T, canonicalize, Functor, Arity) },
+ io.write_string(Functor),
+ io.write_string("/"),
+ io.write_int(Arity).
test_arg(T) -->
- { functor(T, Functor, Arity) },
+ { functor(T, canonicalize, Functor, Arity) },
(
{ arg(Arity, T, Argument) }
->
- { string__format("argument %d of functor %s was:", [i(Arity),
- s(Functor)], Str) },
- io__write_string(Str),
- io__print(Argument)
+ { string.format("argument %d of functor %s was:",
+ [i(Arity), s(Functor)], Str) },
+ io.write_string(Str),
+ io.print(Argument)
;
- io__write_string("no arguments")
+ io.write_string("no arguments")
).
test_expand(T) -->
- { deconstruct(T, Functor, Arity, Arguments) },
- { string__format("expand: functor %s arity %d arguments ", [s(Functor),
- i(Arity)], Str) },
- io__write_string(Str),
- io__write_string("["),
- io__write_list(Arguments, ", ", io__print),
- io__write_string("]").
-
+ { deconstruct(T, canonicalize, Functor, Arity, Arguments) },
+ { string.format("expand: functor %s arity %d arguments ",
+ [s(Functor), i(Arity)], Str) },
+ io.write_string(Str),
+ io.write_string("["),
+ io.write_list(Arguments, ", ", io.print),
+ io.write_string("]").
test_polymorphism -->
- io__write_string("TESTING POLYMORPHISM\n"),
+ io.write_string("TESTING POLYMORPHISM\n"),
test_all(poly_two(3)), newline,
test_all(poly_three(3.33, 4, poly_one(9.11))), newline,
test_all(poly_one([2399.3])), newline,
newline.
-
test_builtins -->
- io__write_string("TESTING BUILTINS\n"),
+ io.write_string("TESTING BUILTINS\n"),
% test strings
test_all(""), newline,
@@ -152,16 +169,16 @@
% the implementation, the results of this test can change.
test_other -->
- io__write_string("TESTING OTHER TYPES\n"),
- { term__init_var_supply(VarSupply) },
- { term__create_var(VarSupply, Var, NewVarSupply) },
+ io.write_string("TESTING OTHER TYPES\n"),
+ { term.init_var_supply(VarSupply) },
+ { term.create_var(VarSupply, Var, NewVarSupply) },
test_all(Var), newline,
test_all(VarSupply), newline,
test_all(NewVarSupply), newline,
% presently, at least, map is an equivalence and
% an abstract type.
- { map__init(Map) },
+ { map.init(Map) },
test_all(Map), newline,
% a no tag type
@@ -170,6 +187,5 @@
newline.
newline -->
- io__write_char('\n').
-
+ io.write_char('\n').
Index: tests/hard_coded/foreign_type2.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/foreign_type2.m,v
retrieving revision 1.2
diff -u -b -r1.2 foreign_type2.m
--- tests/hard_coded/foreign_type2.m 24 Oct 2002 06:51:04 -0000 1.2
+++ tests/hard_coded/foreign_type2.m 16 Mar 2006 21:58:27 -0000
@@ -8,11 +8,11 @@
:- import_module io.
-:- pred main(io__state::di, io__state::uo) is det.
+:- pred main(io::di, io::uo) is det.
:- implementation.
-:- import_module std_util.
+:- import_module type_desc.
:- type coord(T).
Index: tests/hard_coded/higher_order_type_manip.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/higher_order_type_manip.m,v
retrieving revision 1.2
diff -u -b -r1.2 higher_order_type_manip.m
--- tests/hard_coded/higher_order_type_manip.m 6 Mar 2002 04:32:01 -0000 1.2
+++ tests/hard_coded/higher_order_type_manip.m 16 Mar 2006 21:59:02 -0000
@@ -9,11 +9,12 @@
:- interface.
:- import_module io.
-:- pred main(io__state::di, io__state::uo) is det.
+:- pred main(io::di, io::uo) is det.
:- implementation.
-:- import_module std_util, list.
+:- import_module type_desc.
+:- import_module list.
:- func tryme = int.
Index: tests/hard_coded/nullary_ho_func.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/nullary_ho_func.m,v
retrieving revision 1.2
diff -u -b -r1.2 nullary_ho_func.m
--- tests/hard_coded/nullary_ho_func.m 15 Aug 1997 15:36:54 -0000 1.2
+++ tests/hard_coded/nullary_ho_func.m 16 Mar 2006 22:00:01 -0000
@@ -6,10 +6,11 @@
:- interface.
:- import_module io.
-:- pred main(io__state::di, io__state::uo) is det.
+:- pred main(io::di, io::uo) is det.
:- implementation.
:- import_module std_util.
+:- import_module type_desc.
:- type nullary_func(T) == ((func) = T).
:- inst nullary_func == ((func) = out is det).
@@ -46,4 +47,3 @@
),
print("type_of(F) = "), print(type_of(F)), nl,
print("type_name(type_of(F)) = "), print(type_name(type_of(F))), nl.
-
Index: tests/hard_coded/tuple_test.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/tuple_test.m,v
retrieving revision 1.1
diff -u -b -r1.1 tuple_test.m
--- tests/hard_coded/tuple_test.m 18 Sep 2000 11:52:52 -0000 1.1
+++ tests/hard_coded/tuple_test.m 16 Mar 2006 22:00:52 -0000
@@ -4,12 +4,20 @@
:- import_module io.
-:- pred main(io__state::di, io__state::uo) is det.
+:- pred main(io::di, io::uo) is det.
:- implementation.
-:- import_module bool, list, char, string, int.
-:- import_module term, std_util, term_io, varset.
+:- import_module bool.
+:- import_module list.
+:- import_module char.
+:- import_module string.
+:- import_module int.
+:- import_module term.
+:- import_module std_util.
+:- import_module type_desc.
+:- import_module term_io.
+:- import_module varset.
main -->
io__write_string("testing io__write:\n"),
Index: tests/hard_coded/type_ctor_desc.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/type_ctor_desc.m,v
retrieving revision 1.1
diff -u -b -r1.1 type_ctor_desc.m
--- tests/hard_coded/type_ctor_desc.m 21 Dec 2000 06:24:20 -0000 1.1
+++ tests/hard_coded/type_ctor_desc.m 16 Mar 2006 22:02:00 -0000
@@ -6,15 +6,16 @@
:- interface.
:- use_module io.
-:- pred main(io__state, io__state).
-:- mode main(di, uo) is det.
+:- pred main(io.state::di, io.state::uo) is det.
:- implementation.
-:- import_module int, integer, std_util.
+:- import_module int.
+:- import_module integer.
+:- import_module type_desc.
main -->
- { Type = std_util__type_of(test) },
- { std_util__type_ctor_and_args(Type, TypeCtor, TypeArgs) },
+ { Type = type_of(test) },
+ { type_ctor_and_args(Type, TypeCtor, TypeArgs) },
io__write(TypeCtor),
io__print(" "),
io__write(TypeArgs),
Index: tests/hard_coded/type_qual.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/type_qual.m,v
retrieving revision 1.4
diff -u -b -r1.4 type_qual.m
--- tests/hard_coded/type_qual.m 26 Sep 2005 06:52:08 -0000 1.4
+++ tests/hard_coded/type_qual.m 16 Mar 2006 22:03:02 -0000
@@ -4,11 +4,13 @@
:- interface.
:- import_module io.
-:- pred main(io__state::di, io__state::uo) is det.
-
+:- pred main(io::di, io::uo) is det.
:- implementation.
-:- import_module bool, list, map, std_util.
+:- import_module bool.
+:- import_module list.
+:- import_module map.
+:- import_module type_desc.
main -->
test1,
@@ -82,8 +84,10 @@
io__write_string("bi-implication failed\n")
).
+% inferred
empty_list = [] : list(int).
+% inferred
empty([] : list(int)).
:- some [T] func build_list = list(T).
@@ -94,6 +98,5 @@
:- pred map_search(my_map(K, V)::in, int::in, V::out) is semidet.
-map_search(Map : map(int, V), Key : int,
- Value : V) :-
+map_search(Map : map(int, V), Key : int, Value : V) :-
map__search(Map, Key, Value).
Index: tests/hard_coded/write_xml.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/write_xml.m,v
retrieving revision 1.4
diff -u -b -r1.4 write_xml.m
--- tests/hard_coded/write_xml.m 29 Jul 2005 01:56:59 -0000 1.4
+++ tests/hard_coded/write_xml.m 16 Mar 2006 22:03:53 -0000
@@ -8,8 +8,17 @@
:- implementation.
-:- import_module term_to_xml, bool, list, float, string, int, char, array, map.
+:- import_module array.
+:- import_module bool.
+:- import_module char.
+:- import_module float.
+:- import_module int.
+:- import_module list.
+:- import_module map.
:- import_module std_util.
+:- import_module string.
+:- import_module term_to_xml.
+:- import_module type_desc.
:- type mytype
---> hello(field1::string, 'Field<2>'::int, char,
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/purity
cvs diff: Diffing tests/hard_coded/sub-modules
Index: tests/hard_coded/sub-modules/class.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/sub-modules/class.m,v
retrieving revision 1.2
diff -u -b -r1.2 class.m
--- tests/hard_coded/sub-modules/class.m 17 Jan 2003 05:57:06 -0000 1.2
+++ tests/hard_coded/sub-modules/class.m 17 Mar 2006 00:38:01 -0000
@@ -48,7 +48,9 @@
:- import_module class.char.
:- use_module class.int.
-:- import_module std_util, require.
+:- import_module type_desc.
+:- import_module std_util.
+:- import_module require.
:- type t1 == class.char.foo.
:- type t2 == char.foo.
Index: tests/hard_coded/sub-modules/nested.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/sub-modules/nested.m,v
retrieving revision 1.4
diff -u -b -r1.4 nested.m
--- tests/hard_coded/sub-modules/nested.m 17 Jan 2003 05:57:06 -0000 1.4
+++ tests/hard_coded/sub-modules/nested.m 17 Mar 2006 00:39:02 -0000
@@ -46,7 +46,9 @@
:- import_module nested.child.
:- use_module nested.child2.
-:- import_module std_util, require.
+:- import_module require.
+:- import_module std_util.
+:- import_module type_desc.
:- type t1 == nested.child.foo.
:- type t2 == child.foo.
Index: tests/hard_coded/sub-modules/nested2.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/sub-modules/nested2.m,v
retrieving revision 1.2
diff -u -b -r1.2 nested2.m
--- tests/hard_coded/sub-modules/nested2.m 17 Jan 2003 05:57:06 -0000 1.2
+++ tests/hard_coded/sub-modules/nested2.m 17 Mar 2006 00:39:40 -0000
@@ -25,6 +25,7 @@
:- module nested2.child.
:- implementation.
:- import_module std_util.
+:- import_module type_desc.
:- type t3 == foo.
:- type t4 == nested2.foo.
Index: tests/hard_coded/sub-modules/nested3.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/sub-modules/nested3.m,v
retrieving revision 1.4
diff -u -b -r1.4 nested3.m
--- tests/hard_coded/sub-modules/nested3.m 17 Jan 2003 05:57:06 -0000 1.4
+++ tests/hard_coded/sub-modules/nested3.m 17 Mar 2006 00:40:13 -0000
@@ -51,7 +51,9 @@
:- import_module nested3.child.
:- use_module nested3.child2.
-:- import_module std_util, require.
+:- import_module require.
+:- import_module std_util.
+:- import_module type_desc.
:- type t1 == nested3.child.foo.
:- type t2 == child.foo.
Index: tests/hard_coded/sub-modules/parent.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/sub-modules/parent.m,v
retrieving revision 1.4
diff -u -b -r1.4 parent.m
--- tests/hard_coded/sub-modules/parent.m 17 Jan 2003 05:57:06 -0000 1.4
+++ tests/hard_coded/sub-modules/parent.m 17 Mar 2006 00:40:08 -0000
@@ -12,7 +12,9 @@
:- import_module parent.child.
:- use_module parent.child2.
-:- import_module std_util, require.
+:- import_module require.
+:- import_module std_util.
+:- import_module type_desc.
:- type t1 == parent.child.foo.
:- type t2 == child.foo.
Index: tests/hard_coded/sub-modules/parent2.child.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/sub-modules/parent2.child.m,v
retrieving revision 1.2
diff -u -b -r1.2 parent2.child.m
--- tests/hard_coded/sub-modules/parent2.child.m 17 Jan 2003 05:57:06 -0000 1.2
+++ tests/hard_coded/sub-modules/parent2.child.m 17 Mar 2006 00:41:19 -0000
@@ -12,6 +12,7 @@
:- implementation.
:- import_module std_util.
+:- import_module type_desc.
:- type t3 == foo.
:- type t4 == parent2.foo.
cvs diff: Diffing tests/hard_coded/typeclasses
Index: tests/hard_coded/typeclasses/existential_rtti.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/typeclasses/existential_rtti.m,v
retrieving revision 1.3
diff -u -b -r1.3 existential_rtti.m
--- tests/hard_coded/typeclasses/existential_rtti.m 12 Apr 2005 07:58:17 -0000 1.3
+++ tests/hard_coded/typeclasses/existential_rtti.m 17 Mar 2006 00:36:31 -0000
@@ -42,6 +42,7 @@
:- implementation.
+:- import_module deconstruct.
:- import_module std_util.
:- instance c(int) where [].
@@ -142,7 +143,7 @@
:- pred deconstruct_test(T::in, io__state::di, io__state::uo) is det.
deconstruct_test(Term) -->
- { deconstruct(Term, Functor, Arity, Args) },
+ { deconstruct(Term, canonicalize, Functor, Arity, Args) },
io__write_string(Functor),
io__write_string("/"),
io__write_int(Arity),
cvs diff: Diffing tests/invalid
cvs diff: Diffing tests/invalid/purity
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/mmc_make
cvs diff: Diffing tests/mmc_make/lib
cvs diff: Diffing tests/recompilation
Index: tests/recompilation/type_qual_re.m.1
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/recompilation/type_qual_re.m.1,v
retrieving revision 1.1
diff -u -b -r1.1 type_qual_re.m.1
--- tests/recompilation/type_qual_re.m.1 27 Jun 2001 05:05:19 -0000 1.1
+++ tests/recompilation/type_qual_re.m.1 16 Mar 2006 22:04:49 -0000
@@ -9,7 +9,7 @@
:- implementation.
:- import_module type_qual_re_2.
-:- import_module std_util.
+:- import_module type_desc.
main -->
% Type name used only in type qualification.
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/trailing
cvs diff: Diffing tests/valid
Index: tests/valid/agc_unbound_typevars.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/valid/agc_unbound_typevars.m,v
retrieving revision 1.2
diff -u -b -r1.2 agc_unbound_typevars.m
--- tests/valid/agc_unbound_typevars.m 20 May 1997 02:08:47 -0000 1.2
+++ tests/valid/agc_unbound_typevars.m 16 Mar 2006 22:05:33 -0000
@@ -22,7 +22,11 @@
:- implementation.
-:- import_module std_util, int, map, list.
+:- import_module construct.
+:- import_module int.
+:- import_module list.
+:- import_module map.
+:- import_module type_desc.
foo(X) :-
TypeInfo = type_of([]),
Index: tests/valid/agc_unbound_typevars2.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/valid/agc_unbound_typevars2.m,v
retrieving revision 1.1
diff -u -b -r1.1 agc_unbound_typevars2.m
--- tests/valid/agc_unbound_typevars2.m 3 Jun 1997 06:23:09 -0000 1.1
+++ tests/valid/agc_unbound_typevars2.m 16 Mar 2006 22:06:36 -0000
@@ -23,14 +23,17 @@
:- implementation.
-:- import_module list, std_util.
-
+:- import_module construct.
+:- import_module list.
+:- import_module type_desc.
:- pred test_all(T::in, io__state::di, io__state::uo) is det.
-:- type poly(A, B) ---> poly_one(A) ; poly_two(B) ;
- poly_three(B, A, poly(B, A));
- poly_four(A, B).
+:- type poly(A, B)
+ ---> poly_one(A)
+ ; poly_two(B)
+ ; poly_three(B, A, poly(B, A))
+ ; poly_four(A, B).
%----------------------------------------------------------------------------%
@@ -43,4 +46,3 @@
{ TypeInfo = type_of(poly_one([2399.3])) },
{ N = num_functors(TypeInfo) },
io__write_int(N).
-
Index: tests/valid/agc_unused_in.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/valid/agc_unused_in.m,v
retrieving revision 1.1
diff -u -b -r1.1 agc_unused_in.m
--- tests/valid/agc_unused_in.m 15 May 1997 06:55:32 -0000 1.1
+++ tests/valid/agc_unused_in.m 16 Mar 2006 22:06:52 -0000
@@ -27,7 +27,7 @@
%----------------------------------------------------------------------------%
:- implementation.
-:- import_module std_util.
+:- import_module type_desc.
test_1(T, N) :-
Info = type_of(T),
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
cvs diff: Diffing trace
cvs diff: Diffing util
cvs diff: Diffing vim
cvs diff: Diffing vim/after
cvs diff: Diffing vim/ftplugin
cvs diff: Diffing vim/syntax
--------------------------------------------------------------------------
mercury-reviews mailing list
post: mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
More information about the reviews
mailing list