[m-rev.] Converting univ values to strings
Ralph Becket
rafe at cs.mu.OZ.AU
Wed Jul 16 14:35:22 AEST 2003
Estimated hours taken: 6
Branches: main
Change the code to print the contents of a univ from io.m to code to turn
the contents of a univ into a string in std_util.m.
The main motivation for this change is that it has always been awkward to
swap between io.format etc. and io.print when including arbitrary values in
printed output. With the new change, all such formatted output can be
done via io.format.
library/io.m:
Move the code for io__do_write_univ etc. to std_util.
Change io__do_write_univ, io__write_type_desc,
io__write_type_ctor_desc, io__write_c_pointer, io__write_array and
io__write_private_builtin_type_info to use the std_util
code instead.
library/std_util.m:
Transferred the code from io__do_write_univ and converted it to
produce strings via functions univ_to_string/1,2 and predicate
univ_to_string/4.
library/string.m:
Added function string__string/1 to construct string representations
of arbitrary values.
library/term_io.m:
Added function term_io__quoted_char/1.
NEWS:
Mention the new additions to the library.
Index: NEWS
===================================================================
RCS file: /home/mercury1/repository/mercury/NEWS,v
retrieving revision 1.314
diff -u -r1.314 NEWS
--- NEWS 26 May 2003 10:05:13 -0000 1.314
+++ NEWS 16 Jul 2003 04:33:05 -0000
@@ -26,7 +26,11 @@
concatenation.
* Several new functions have been added to the string module, namely
elem/2, unsafe_elem/2, chomp/1, lstrip/1, lstrip/2, rstrip/1, rstrip/2,
- strip/1, prefix_length/2, and suffix_length/2.
+ strip/1, prefix_length/2, suffix_length/2, and string/1.
+* Several new functions have been added to the std_util module, namely
+ univ_to_string/1, univ_to_string/2 and the predicate univ_to_string/4.
+* A new function has been added to the term_io module, namely
+ quoted_char.
Portability improvements:
* Nothing yet.
@@ -87,7 +91,12 @@
* Several new functions have been added to the string module, namely
elem/2, unsafe_elem/2, chomp/1, lstrip/1, lstrip/2, rstrip/1, rstrip/2,
- strip/1, prefix_length/2, and suffix_length/2.
+ strip/1, prefix_length/2, suffix_length/2, and string/1.
+
+* Several new functions have been added to the std_util module, namely
+ univ_to_string/1, univ_to_string/2 and the predicate univ_to_string/4.
+
+* A new function quoted_char/1 has been added to the term_io module.
* We've added a new library module, `array2d'.
Index: library/io.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/io.m,v
retrieving revision 1.298
diff -u -r1.298 io.m
--- library/io.m 29 May 2003 12:08:25 -0000 1.298
+++ library/io.m 16 Jul 2003 03:27:26 -0000
@@ -2509,7 +2509,8 @@
; { univ_to_type(Univ, Char) } ->
io__write_char(Char)
; { univ_to_type(Univ, OrigUniv) } ->
- io__write_univ(OrigUniv)
+ io__get_op_table(OpsTable),
+ io__write_string(univ_to_string(OpsTable, OrigUniv))
;
io__print_quoted(NonCanon, Term)
).
@@ -2562,8 +2563,7 @@
:- mode io__do_write(in, in, di, uo) is cc_multi.
io__do_write(NonCanon, Term) -->
- { type_to_univ(Term, Univ) },
- io__do_write_univ(NonCanon, Univ).
+ io__do_write_univ(NonCanon, univ(Term)).
%-----------------------------------------------------------------------------%
@@ -2590,291 +2590,9 @@
:- mode io__do_write_univ(in, in, di, uo) is cc_multi.
io__do_write_univ(NonCanon, Univ) -->
- io__get_op_table(OpTable),
- io__do_write_univ(NonCanon, Univ, ops__max_priority(OpTable) + 1).
-
-:- pred io__do_write_univ(deconstruct__noncanon_handling, univ, ops__priority,
- io__state, io__state).
-:- mode io__do_write_univ(in(do_not_allow), in, in, di, uo) is det.
-:- mode io__do_write_univ(in(canonicalize), in, in, di, uo) is det.
-:- mode io__do_write_univ(in(include_details_cc), in, in, di, uo) is cc_multi.
-:- mode io__do_write_univ(in, in, in, di, uo) is cc_multi.
-
-io__do_write_univ(NonCanon, Univ, Priority) -->
- %
- % we need to special-case the builtin types:
- % int, char, float, string
- % type_info, univ, c_pointer, array
- % and private_builtin:type_info
- %
- ( { univ_to_type(Univ, String) } ->
- term_io__quote_string(String)
- ; { univ_to_type(Univ, Char) } ->
- term_io__quote_char(Char)
- ; { univ_to_type(Univ, Int) } ->
- io__write_int(Int)
- ; { univ_to_type(Univ, Float) } ->
- io__write_float(Float)
- ; { univ_to_type(Univ, TypeDesc) } ->
- io__write_type_desc(TypeDesc)
- ; { univ_to_type(Univ, TypeCtorDesc) } ->
- io__write_type_ctor_desc(TypeCtorDesc)
- ; { univ_to_type(Univ, C_Pointer) } ->
- io__write_c_pointer(C_Pointer)
- ;
- %
- % Check if the type is array:array/1.
- % We can't just use univ_to_type here since
- % array:array/1 is a polymorphic type.
- %
- % The calls to type_ctor_name and type_ctor_module_name
- % are not really necessary -- we could use univ_to_type
- % in the condition instead of det_univ_to_type in the body.
- % However, this way of doing things is probably more efficient
- % in the common case when the thing being printed is
- % *not* of type array:array/1.
- %
- % The ordering of the tests here (arity, then name, then
- % module name, rather than the reverse) is also chosen
- % for efficiency, to find failure cheaply in the common cases,
- % rather than for readability.
- %
- { type_ctor_and_args(univ_type(Univ), TypeCtor, ArgTypes) },
- { ArgTypes = [ElemType] },
- { type_ctor_name(TypeCtor) = "array" },
- { type_ctor_module_name(TypeCtor) = "array" }
- ->
- %
- % Now that we know the element type, we can
- % constrain the type of the variable `Array'
- % so that we can use det_univ_to_type.
- %
- { has_type(Elem, ElemType) },
- { same_array_elem_type(Array, Elem) },
- { det_univ_to_type(Univ, Array) },
- io__write_array(Array)
- ;
- %
- % Check if the type is private_builtin:type_info/1.
- % See the comments above for array:array/1.
- %
- { type_ctor_and_args(univ_type(Univ), TypeCtor, ArgTypes) },
- { ArgTypes = [ElemType] },
- { type_ctor_name(TypeCtor) = "type_info" },
- { type_ctor_module_name(TypeCtor) = "private_builtin" }
- ->
- { has_type(Elem, ElemType) },
- { same_private_builtin_type(PrivateBuiltinTypeInfo, Elem) },
- { det_univ_to_type(Univ, PrivateBuiltinTypeInfo) },
- io__write_private_builtin_type_info(PrivateBuiltinTypeInfo)
- ;
- io__write_ordinary_term(NonCanon, Univ, Priority)
- ).
-
-:- pred same_array_elem_type(array(T), T).
-:- mode same_array_elem_type(unused, unused) is det.
-same_array_elem_type(_, _).
-
-:- pred same_private_builtin_type(private_builtin__type_info(T), T).
-:- mode same_private_builtin_type(unused, unused) is det.
-same_private_builtin_type(_, _).
-
-:- pred io__write_ordinary_term(deconstruct__noncanon_handling, univ,
- ops__priority, io__state, io__state).
-:- mode io__write_ordinary_term(in(do_not_allow), in, in, di, uo) is det.
-:- mode io__write_ordinary_term(in(canonicalize), in, in, di, uo) is det.
-:- mode io__write_ordinary_term(in(include_details_cc), in, in, di, uo)
- is cc_multi.
-:- mode io__write_ordinary_term(in, in, in, di, uo) is cc_multi.
-
-io__write_ordinary_term(NonCanon, Univ, Priority) -->
- { univ_value(Univ) = Term },
- { deconstruct__deconstruct(Term, NonCanon, Functor, _Arity, Args) },
- io__get_op_table(OpTable),
- (
- { Functor = "[|]" },
- { Args = [ListHead, ListTail] }
- ->
- io__write_char('['),
- io__write_arg(NonCanon, ListHead),
- io__write_list_tail(NonCanon, ListTail),
- io__write_char(']')
- ;
- { Functor = "[]" },
- { Args = [] }
- ->
- io__write_string("[]")
- ;
- { Functor = "{}" },
- { Args = [BracedTerm] }
- ->
- io__write_string("{ "),
- io__do_write_univ(NonCanon, BracedTerm),
- io__write_string(" }")
- ;
- { Functor = "{}" },
- { Args = [BracedHead | BracedTail] }
- ->
- io__write_char('{'),
- io__write_arg(NonCanon, BracedHead),
- io__write_term_args(NonCanon, BracedTail),
- io__write_char('}')
- ;
- { Args = [PrefixArg] },
- { ops__lookup_prefix_op(OpTable, Functor,
- OpPriority, OpAssoc) }
- ->
- maybe_write_char('(', Priority, OpPriority),
- term_io__quote_atom(Functor),
- io__write_char(' '),
- { adjust_priority(OpPriority, OpAssoc, NewPriority) },
- io__do_write_univ(NonCanon, PrefixArg, NewPriority),
- maybe_write_char(')', Priority, OpPriority)
- ;
- { Args = [PostfixArg] },
- { ops__lookup_postfix_op(OpTable, Functor,
- OpPriority, OpAssoc) }
- ->
- maybe_write_char('(', Priority, OpPriority),
- { adjust_priority(OpPriority, OpAssoc, NewPriority) },
- io__do_write_univ(NonCanon, PostfixArg, NewPriority),
- io__write_char(' '),
- term_io__quote_atom(Functor),
- maybe_write_char(')', Priority, OpPriority)
- ;
- { Args = [Arg1, Arg2] },
- { ops__lookup_infix_op(OpTable, Functor,
- OpPriority, LeftAssoc, RightAssoc) }
- ->
- maybe_write_char('(', Priority, OpPriority),
- { adjust_priority(OpPriority, LeftAssoc, LeftPriority) },
- io__do_write_univ(NonCanon, Arg1, LeftPriority),
- ( { Functor = "," } ->
- io__write_string(", ")
- ;
- io__write_char(' '),
- term_io__quote_atom(Functor),
- io__write_char(' ')
- ),
- { adjust_priority(OpPriority, RightAssoc, RightPriority) },
- io__do_write_univ(NonCanon, Arg2, RightPriority),
- maybe_write_char(')', Priority, OpPriority)
- ;
- { Args = [Arg1, Arg2] },
- { ops__lookup_binary_prefix_op(OpTable, Functor,
- OpPriority, FirstAssoc, SecondAssoc) }
- ->
- maybe_write_char('(', Priority, OpPriority),
- term_io__quote_atom(Functor),
- io__write_char(' '),
- { adjust_priority(OpPriority, FirstAssoc, FirstPriority) },
- io__do_write_univ(NonCanon, Arg1, FirstPriority),
- io__write_char(' '),
- { adjust_priority(OpPriority, SecondAssoc, SecondPriority) },
- io__do_write_univ(NonCanon, Arg2, SecondPriority),
- maybe_write_char(')', Priority, OpPriority)
- ;
- (
- { Args = [] },
- { ops__lookup_op(OpTable, Functor) },
- { Priority =< ops__max_priority(OpTable) }
- ->
- io__write_char('('),
- term_io__quote_atom(Functor),
- io__write_char(')')
- ;
- term_io__quote_atom(Functor,
- maybe_adjacent_to_graphic_token)
- ),
- (
- { Args = [X|Xs] }
- ->
- io__write_char('('),
- io__write_arg(NonCanon, X),
- io__write_term_args(NonCanon, Xs),
- io__write_char(')')
- ;
- []
- )
- ).
-
-:- pred maybe_write_char(char, ops__priority, ops__priority,
- io__state, io__state).
-:- mode maybe_write_char(in, in, in, di, uo) is det.
-
-maybe_write_char(Char, Priority, OpPriority) -->
- ( { OpPriority > Priority } ->
- io__write_char(Char)
- ;
- []
- ).
-
-:- pred adjust_priority(ops__priority, ops__assoc, ops__priority).
-:- mode adjust_priority(in, in, out) is det.
-
-adjust_priority(Priority, y, Priority).
-adjust_priority(Priority, x, Priority - 1).
-
-:- pred io__write_list_tail(deconstruct__noncanon_handling, univ,
- io__state, io__state).
-:- mode io__write_list_tail(in(do_not_allow), in, di, uo) is det.
-:- mode io__write_list_tail(in(canonicalize), in, di, uo) is det.
-:- mode io__write_list_tail(in(include_details_cc), in, di, uo) is cc_multi.
-:- mode io__write_list_tail(in, in, di, uo) is cc_multi.
-
-io__write_list_tail(NonCanon, Univ) -->
- { Term = univ_value(Univ) },
- { deconstruct__deconstruct(Term, NonCanon, Functor, _Arity, Args) },
- ( { Functor = "[|]", Args = [ListHead, ListTail] } ->
- io__write_string(", "),
- io__write_arg(NonCanon, ListHead),
- io__write_list_tail(NonCanon, ListTail)
- ; { Functor = "[]", Args = [] } ->
- []
- ;
- io__write_string(" | "),
- io__do_write_univ(NonCanon, Univ)
- ).
-
-:- pred io__write_term_args(deconstruct__noncanon_handling, list(univ),
- io__state, io__state).
-:- mode io__write_term_args(in(do_not_allow), in, di, uo) is det.
-:- mode io__write_term_args(in(canonicalize), in, di, uo) is det.
-:- mode io__write_term_args(in(include_details_cc), in, di, uo) is cc_multi.
-:- mode io__write_term_args(in, in, di, uo) is cc_multi.
-
- % write the remaining arguments
-io__write_term_args(_, []) --> [].
-io__write_term_args(NonCanon, [X|Xs]) -->
- io__write_string(", "),
- io__write_arg(NonCanon, X),
- io__write_term_args(NonCanon, Xs).
-
-:- pred io__write_arg(deconstruct__noncanon_handling, univ,
- io__state, io__state).
-:- mode io__write_arg(in(do_not_allow), in, di, uo) is det.
-:- mode io__write_arg(in(canonicalize), in, di, uo) is det.
-:- mode io__write_arg(in(include_details_cc), in, di, uo) is cc_multi.
-:- mode io__write_arg(in, in, di, uo) is cc_multi.
-
-io__write_arg(NonCanon, X) -->
- arg_priority(ArgPriority),
- io__do_write_univ(NonCanon, X, ArgPriority).
-
-:- pred arg_priority(int, io__state, io__state).
-:- mode arg_priority(out, di, uo) is det.
-/*
-arg_priority(ArgPriority) -->
- io__get_op_table(OpTable),
- { ops__lookup_infix_op(OpTable, ",", Priority, _, _) ->
- ArgPriority = Priority }
- ;
- error("arg_priority: can't find the priority of `,'")
- }.
-*/
-% We could implement this as above, but it's more efficient to just
-% hard-code it.
-arg_priority(1000) --> [].
+ io__get_op_table(OpsTable),
+ { univ_to_string(NonCanon, OpsTable, Univ, String) },
+ io__write_string(String).
%-----------------------------------------------------------------------------%
@@ -2882,48 +2600,41 @@
:- mode io__write_type_desc(in, di, uo) is det.
io__write_type_desc(TypeDesc) -->
- io__write_string(type_name(TypeDesc)).
+ io__get_op_table(OpsTable),
+ { univ_to_string(canonicalize, OpsTable, univ(TypeDesc), String) },
+ io__write_string(String).
:- pred io__write_type_ctor_desc(type_ctor_desc, io__state, io__state).
:- mode io__write_type_ctor_desc(in, di, uo) is det.
io__write_type_ctor_desc(TypeCtorDesc) -->
- { type_ctor_name_and_arity(TypeCtorDesc, ModuleName, Name, Arity0) },
- { ModuleName = "builtin", Name = "func" ->
- % The type ctor that we call `builtin:func/N' takes N + 1
- % type parameters: N arguments plus one return value.
- % So we need to subtract one from the arity here.
- Arity = Arity0 - 1
- ;
- Arity = Arity0
- },
- ( { ModuleName = "builtin" } ->
- io__format("%s/%d", [s(Name), i(Arity)])
- ;
- io__format("%s.%s/%d", [s(ModuleName), s(Name), i(Arity)])
- ).
+ io__get_op_table(OpsTable),
+ { univ_to_string(canonicalize, OpsTable, univ(TypeCtorDesc), String) },
+ io__write_string(String).
:- pred io__write_c_pointer(c_pointer, io__state, io__state).
:- mode io__write_c_pointer(in, di, uo) is det.
-io__write_c_pointer(_C_Pointer) -->
- % XXX what should we do here?
- io__write_string("'<<c_pointer>>'").
+io__write_c_pointer(C_Pointer) -->
+ io__get_op_table(OpsTable),
+ { univ_to_string(canonicalize, OpsTable, univ(C_Pointer), String) },
+ io__write_string(String).
:- pred io__write_array(array(T), io__state, io__state).
:- mode io__write_array(in, di, uo) is det.
io__write_array(Array) -->
- io__write_string("array("),
- { array__to_list(Array, List) },
- io__write(List),
- io__write_string(")").
+ io__get_op_table(OpsTable),
+ { univ_to_string(canonicalize, OpsTable, univ(Array), String) },
+ io__write_string(String).
:- pred io__write_private_builtin_type_info(private_builtin__type_info(T)::in,
io__state::di, io__state::uo) is det.
io__write_private_builtin_type_info(PrivateBuiltinTypeInfo) -->
- { TypeInfo = rtti_implementation__unsafe_cast(PrivateBuiltinTypeInfo) },
- io__write_type_desc(TypeInfo).
+ io__get_op_table(OpsTable),
+ { univ_to_string(canonicalize, OpsTable, univ(PrivateBuiltinTypeInfo),
+ String) },
+ io__write_string(String).
%-----------------------------------------------------------------------------%
Index: library/std_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/std_util.m,v
retrieving revision 1.284
diff -u -r1.284 std_util.m
--- library/std_util.m 14 May 2003 14:38:47 -0000 1.284
+++ library/std_util.m 16 Jul 2003 03:57:27 -0000
@@ -18,8 +18,8 @@
:- interface.
-:- import_module list, set, bool.
-:- import_module type_desc.
+:- import_module list, set, bool, string, ops.
+:- import_module type_desc, deconstruct.
%-----------------------------------------------------------------------------%
@@ -77,6 +77,33 @@
% returns the value of the object stored in Univ.
:- some [T] func univ_value(univ) = T.
+ % univ_to_string(Univ):
+ % returns a canonicalized string representation of the object
+ % stored in Univ using the standard Mercury operators.
+:- func univ_to_string(univ) = string.
+
+ % As above, but parameterised by a table of operators.
+ %
+:- func univ_to_string(ops__table, univ) = string.
+
+ % As above, but the caller specifies what behaviour should
+ % occur for non-canonical terms (i.e. terms where multiple
+ % representations may compare as equal):
+ % - `do_not_allow' will throw an exception if any subterm of
+ % the univ value is not canonical;
+ % - `canonicalize' will substitute a string indicating the
+ % presence of a non-canonical subterm;
+ % - `include_details_cc' will show the structure of any
+ % non-canonical subterms, but can only be called from a
+ % committed choice context.
+ %
+:- pred univ_to_string(deconstruct__noncanon_handling, ops__table, univ,
+ string).
+:- mode univ_to_string(in(do_not_allow), in, in, out) is det.
+:- mode univ_to_string(in(canonicalize), in, in, out) is det.
+:- mode univ_to_string(in(include_details_cc), in, in, out) is cc_multi.
+:- mode univ_to_string(in, in, in, out) is cc_multi.
+
%-----------------------------------------------------------------------------%
% The "maybe" type.
@@ -735,8 +762,8 @@
:- implementation.
-:- import_module require, set, int, string, bool.
-:- import_module construct, deconstruct.
+:- import_module require, set, int, string, bool, char, array.
+:- import_module construct, rtti_implementation, term_io.
:- use_module private_builtin. % for the `heap_pointer' type.
% XXX This should not be necessary, but the current compiler is broken in that
@@ -1696,5 +1723,440 @@
aggregate(P, (pred(X::in, A0::in, A::out) is det :- A = F(X, A0)),
Acc0, Acc).
-%------------------------------------------------------------------------------%
-%------------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+ % For efficiency, these predicates collect a list of strings
+ % which, when concatenated in reverse order, produce the final
+ % output.
+ %
+:- type revstrings == list(string).
+
+ % Utility predicate.
+ %
+:- pred add_revstring(string, revstrings, revstrings).
+:- mode add_revstring(in, in, out ) is det.
+
+add_revstring(String, RevStrings, [String | RevStrings]).
+
+
+
+% various different versions of univ_to_string.
+
+univ_to_string(Univ) = String :-
+ univ_to_string(canonicalize, ops__init_mercury_op_table, Univ, String).
+
+univ_to_string(OpsTable, Univ) = String :-
+ univ_to_string(canonicalize, OpsTable, Univ, String).
+
+
+
+univ_to_string(NonCanon, OpsTable, Univ, String) :-
+ univ_to_revstrings(NonCanon, OpsTable, Univ, [], RevStrings),
+ String = string__append_list(list__reverse(RevStrings)).
+
+
+
+:- pred univ_to_revstrings(deconstruct__noncanon_handling,
+ ops__table, univ, revstrings, revstrings).
+:- mode univ_to_revstrings(in(do_not_allow), in, in, in, out) is det.
+:- mode univ_to_revstrings(in(canonicalize), in, in, in, out) is det.
+:- mode univ_to_revstrings(in(include_details_cc), in, in, in, out)
+ is cc_multi.
+:- mode univ_to_revstrings(in, in, in, in, out)
+ is cc_multi.
+
+univ_to_revstrings(NonCanon, OpsTable, Univ, !Rs) :-
+ Priority = max_priority(OpsTable) + 1,
+ univ_to_revstrings(NonCanon, OpsTable, Priority, Univ, !Rs).
+
+
+
+:- pred univ_to_revstrings(deconstruct__noncanon_handling,
+ ops__table, ops__priority, univ, revstrings, revstrings).
+:- mode univ_to_revstrings(in(do_not_allow), in, in, in, in, out) is det.
+:- mode univ_to_revstrings(in(canonicalize), in, in, in, in, out) is det.
+:- mode univ_to_revstrings(in(include_details_cc), in, in, in, in, out)
+ is cc_multi.
+:- mode univ_to_revstrings(in, in, in, in, in, out)
+ is cc_multi.
+
+univ_to_revstrings(NonCanon, OpsTable, Priority, Univ, !Rs) :-
+ %
+ % we need to special-case the builtin types:
+ % int, char, float, string
+ % type_info, univ, c_pointer, array
+ % and private_builtin:type_info
+ %
+ ( univ_to_type(Univ, String) ->
+ add_revstring(term_io__quoted_string(String), !Rs)
+ ; univ_to_type(Univ, Char) ->
+ add_revstring(term_io__quoted_char(Char), !Rs)
+ ; univ_to_type(Univ, Int) ->
+ add_revstring(string__int_to_string(Int), !Rs)
+ ; univ_to_type(Univ, Float) ->
+ add_revstring(string__float_to_string(Float), !Rs)
+ ; univ_to_type(Univ, TypeDesc) ->
+ type_desc_to_revstrings(TypeDesc, !Rs)
+ ; univ_to_type(Univ, TypeCtorDesc) ->
+ type_ctor_desc_to_revstrings(TypeCtorDesc, !Rs)
+ ; univ_to_type(Univ, C_Pointer) ->
+ add_revstring(c_pointer_to_string(C_Pointer), !Rs)
+ ;
+ %
+ % Check if the type is array:array/1.
+ % We can't just use univ_to_type here since
+ % array:array/1 is a polymorphic type.
+ %
+ % The calls to type_ctor_name and type_ctor_module_name
+ % are not really necessary -- we could use univ_to_type
+ % in the condition instead of det_univ_to_type in the body.
+ % However, this way of doing things is probably more efficient
+ % in the common case when the thing being printed is
+ % *not* of type array:array/1.
+ %
+ % The ordering of the tests here (arity, then name, then
+ % module name, rather than the reverse) is also chosen
+ % for efficiency, to find failure cheaply in the common cases,
+ % rather than for readability.
+ %
+ type_desc__type_ctor_and_args(univ_type(Univ),
+ TypeCtor, ArgTypes),
+ ArgTypes = [ElemType],
+ type_desc__type_ctor_name(TypeCtor) = "array",
+ type_desc__type_ctor_module_name(TypeCtor) = "array"
+ ->
+ %
+ % Now that we know the element type, we can
+ % constrain the type of the variable `Array'
+ % so that we can use det_univ_to_type.
+ %
+ type_desc__has_type(Elem, ElemType),
+ same_array_elem_type(Array, Elem),
+ det_univ_to_type(Univ, Array),
+ array_to_revstrings(NonCanon, OpsTable, Array, !Rs)
+ ;
+ %
+ % Check if the type is private_builtin:type_info/1.
+ % See the comments above for array:array/1.
+ %
+ type_desc__type_ctor_and_args(univ_type(Univ),
+ TypeCtor, ArgTypes),
+ ArgTypes = [ElemType],
+ type_desc__type_ctor_name(TypeCtor) = "type_info",
+ type_desc__type_ctor_module_name(TypeCtor) = "private_builtin"
+ ->
+ type_desc__has_type(Elem, ElemType),
+ same_private_builtin_type(PrivateBuiltinTypeInfo, Elem),
+ det_univ_to_type(Univ, PrivateBuiltinTypeInfo),
+ private_builtin_type_info_to_revstrings(
+ PrivateBuiltinTypeInfo, !Rs)
+ ;
+ ordinary_term_to_revstrings(NonCanon, OpsTable, Priority,
+ Univ, !Rs)
+ ).
+
+
+
+:- pred same_array_elem_type(array(T), T).
+:- mode same_array_elem_type(unused, unused) is det.
+same_array_elem_type(_, _).
+
+
+
+:- pred same_private_builtin_type(private_builtin__type_info(T), T).
+:- mode same_private_builtin_type(unused, unused) is det.
+same_private_builtin_type(_, _).
+
+
+
+:- pred ordinary_term_to_revstrings(deconstruct__noncanon_handling,
+ ops__table, ops__priority, univ, revstrings, revstrings).
+:- mode ordinary_term_to_revstrings(in(do_not_allow), in, in, in, in, out)
+ is det.
+:- mode ordinary_term_to_revstrings(in(canonicalize), in, in, in, in, out)
+ is det.
+:- mode ordinary_term_to_revstrings(in(include_details_cc), in, in, in, in, out)
+ is cc_multi.
+:- mode ordinary_term_to_revstrings(in, in, in, in, in, out)
+ is cc_multi.
+
+ordinary_term_to_revstrings(NonCanon, OpsTable, Priority, Univ, !Rs) :-
+ univ_value(Univ) = Term,
+ deconstruct__deconstruct(Term, NonCanon, Functor, _Arity, Args),
+ (
+ Functor = "[|]",
+ Args = [ListHead, ListTail]
+ ->
+ add_revstring("[", !Rs),
+ arg_to_revstrings(NonCanon, OpsTable, ListHead, !Rs),
+ list_tail_to_revstrings(NonCanon, OpsTable, ListTail, !Rs),
+ add_revstring("]", !Rs)
+ ;
+ Functor = "[]",
+ Args = []
+ ->
+ add_revstring("[]", !Rs)
+ ;
+ Functor = "{}",
+ Args = [BracedTerm]
+ ->
+ add_revstring("{ ", !Rs),
+ univ_to_revstrings(NonCanon, OpsTable, BracedTerm, !Rs),
+ add_revstring(" }", !Rs)
+ ;
+ Functor = "{}",
+ Args = [BracedHead | BracedTail]
+ ->
+ add_revstring("{", !Rs),
+ arg_to_revstrings(NonCanon, OpsTable, BracedHead, !Rs),
+ term_args_to_revstrings(NonCanon, OpsTable, BracedTail, !Rs),
+ add_revstring("}", !Rs)
+ ;
+ Args = [PrefixArg],
+ ops__lookup_prefix_op(OpsTable, Functor,
+ OpPriority, OpAssoc)
+ ->
+ maybe_add_revstring("(", Priority, OpPriority, !Rs),
+ add_revstring(term_io__quoted_atom(Functor), !Rs),
+ add_revstring(" ", !Rs),
+ adjust_priority(OpPriority, OpAssoc, NewPriority),
+ univ_to_revstrings(NonCanon, OpsTable, NewPriority,
+ PrefixArg, !Rs),
+ maybe_add_revstring(")", Priority, OpPriority, !Rs)
+ ;
+ Args = [PostfixArg],
+ ops__lookup_postfix_op(OpsTable, Functor,
+ OpPriority, OpAssoc)
+ ->
+ maybe_add_revstring("(", Priority, OpPriority, !Rs),
+ adjust_priority(OpPriority, OpAssoc, NewPriority),
+ univ_to_revstrings(NonCanon, OpsTable, NewPriority,
+ PostfixArg, !Rs),
+ add_revstring(" ", !Rs),
+ add_revstring(term_io__quoted_atom(Functor), !Rs),
+ maybe_add_revstring(")", Priority, OpPriority, !Rs)
+ ;
+ Args = [Arg1, Arg2],
+ ops__lookup_infix_op(OpsTable, Functor,
+ OpPriority, LeftAssoc, RightAssoc)
+ ->
+ maybe_add_revstring("(", Priority, OpPriority, !Rs),
+ adjust_priority(OpPriority, LeftAssoc, LeftPriority),
+ univ_to_revstrings(NonCanon, OpsTable, LeftPriority, Arg1, !Rs),
+ ( Functor = "," ->
+ add_revstring(", ", !Rs)
+ ;
+ add_revstring(" ", !Rs),
+ add_revstring(term_io__quoted_atom(Functor), !Rs),
+ add_revstring(" ", !Rs)
+ ),
+ adjust_priority(OpPriority, RightAssoc, RightPriority),
+ univ_to_revstrings(NonCanon, OpsTable, RightPriority,
+ Arg2, !Rs),
+ maybe_add_revstring(")", Priority, OpPriority, !Rs)
+ ;
+ Args = [Arg1, Arg2],
+ ops__lookup_binary_prefix_op(OpsTable, Functor,
+ OpPriority, FirstAssoc, SecondAssoc)
+ ->
+ maybe_add_revstring("(", Priority, OpPriority, !Rs),
+ add_revstring(term_io__quoted_atom(Functor), !Rs),
+ add_revstring(" ", !Rs),
+ adjust_priority(OpPriority, FirstAssoc, FirstPriority),
+ univ_to_revstrings(NonCanon, OpsTable, FirstPriority,
+ Arg1, !Rs),
+ add_revstring(" ", !Rs),
+ adjust_priority(OpPriority, SecondAssoc, SecondPriority),
+ univ_to_revstrings(NonCanon, OpsTable, SecondPriority,
+ Arg2, !Rs),
+ maybe_add_revstring(")", Priority, OpPriority, !Rs)
+ ;
+ (
+ Args = [],
+ ops__lookup_op(OpsTable, Functor),
+ Priority =< ops__max_priority(OpsTable)
+ ->
+ add_revstring("(", !Rs),
+ add_revstring(term_io__quoted_atom(Functor), !Rs),
+ add_revstring(")", !Rs)
+ ;
+ add_revstring(
+ term_io__quoted_atom(Functor,
+ maybe_adjacent_to_graphic_token),
+ !Rs
+ )
+ ),
+ (
+ Args = [X|Xs]
+ ->
+ add_revstring("(", !Rs),
+ arg_to_revstrings(NonCanon, OpsTable, X, !Rs),
+ term_args_to_revstrings(NonCanon, OpsTable, Xs, !Rs),
+ add_revstring(")", !Rs)
+ ;
+ true
+ )
+ ).
+
+
+
+:- pred maybe_add_revstring(string, ops__priority, ops__priority,
+ revstrings, revstrings).
+:- mode maybe_add_revstring(in, in, in, in, out) is det.
+
+maybe_add_revstring(String, Priority, OpPriority, !Rs) :-
+ ( OpPriority > Priority ->
+ add_revstring(String, !Rs)
+ ;
+ true
+ ).
+
+
+
+:- pred adjust_priority(ops__priority, ops__assoc, ops__priority).
+:- mode adjust_priority(in, in, out) is det.
+
+adjust_priority(Priority, y, Priority).
+adjust_priority(Priority, x, Priority - 1).
+
+
+
+:- pred list_tail_to_revstrings(deconstruct__noncanon_handling,
+ ops__table, univ, revstrings, revstrings).
+:- mode list_tail_to_revstrings(in(do_not_allow), in, in, in, out) is det.
+:- mode list_tail_to_revstrings(in(canonicalize), in, in, in, out) is det.
+:- mode list_tail_to_revstrings(in(include_details_cc), in, in, in, out)
+ is cc_multi.
+:- mode list_tail_to_revstrings(in, in, in, in, out) is cc_multi.
+
+list_tail_to_revstrings(NonCanon, OpsTable, Univ, !Rs) :-
+ Term = univ_value(Univ),
+ deconstruct__deconstruct(Term, NonCanon, Functor, _Arity, Args),
+ ( Functor = "[|]", Args = [ListHead, ListTail] ->
+ add_revstring(", ", !Rs),
+ arg_to_revstrings(NonCanon, OpsTable, ListHead, !Rs),
+ list_tail_to_revstrings(NonCanon, OpsTable, ListTail, !Rs)
+ ; Functor = "[]", Args = [] ->
+ true
+ ;
+ add_revstring(" | ", !Rs),
+ univ_to_revstrings(NonCanon, OpsTable, Univ, !Rs)
+ ).
+
+
+
+:- pred term_args_to_revstrings(deconstruct__noncanon_handling,
+ ops__table, list(univ), revstrings, revstrings).
+:- mode term_args_to_revstrings(in(do_not_allow), in, in, in, out) is det.
+:- mode term_args_to_revstrings(in(canonicalize), in, in, in, out) is det.
+:- mode term_args_to_revstrings(in(include_details_cc), in, in, in, out)
+ is cc_multi.
+:- mode term_args_to_revstrings(in, in, in, in, out) is cc_multi.
+
+ % write the remaining arguments
+term_args_to_revstrings(_, _, [], !Rs).
+term_args_to_revstrings(NonCanon, OpsTable, [X|Xs], !Rs) :-
+ add_revstring(", ", !Rs),
+ arg_to_revstrings(NonCanon, OpsTable, X, !Rs),
+ term_args_to_revstrings(NonCanon, OpsTable, Xs, !Rs).
+
+
+
+:- pred arg_to_revstrings(deconstruct__noncanon_handling,
+ ops__table, univ, revstrings, revstrings).
+:- mode arg_to_revstrings(in(do_not_allow), in, in, in, out) is det.
+:- mode arg_to_revstrings(in(canonicalize), in, in, in, out) is det.
+:- mode arg_to_revstrings(in(include_details_cc), in, in, in, out) is cc_multi.
+:- mode arg_to_revstrings(in, in, in, in, out) is cc_multi.
+
+arg_to_revstrings(NonCanon, OpsTable, X, !Rs) :-
+ univ_to_revstrings(NonCanon, OpsTable,
+ std_util__arg_priority(OpsTable), X, !Rs).
+
+
+
+:- func arg_priority(ops__table) = ops__priority.
+/*
+arg_priority(OpsTable) =
+ ( if ops__lookup_infix_op(OpTable, ",", Priority, _, _) then
+ Priority
+ else
+ func_error("arg_priority: can't find the priority of `,'")
+ ).
+*/
+% We could implement this as above, but it's more efficient to just
+% hard-code it.
+arg_priority(_OpTable) = 1000.
+
+
+
+:- func c_pointer_to_string(c_pointer) = string.
+
+c_pointer_to_string(_C_Pointer) = "<<c_pointer>>".
+
+
+
+:- pred array_to_revstrings(deconstruct__noncanon_handling,
+ ops__table, array(T), revstrings, revstrings).
+:- mode array_to_revstrings(in(do_not_allow), in, in, in, out) is det.
+:- mode array_to_revstrings(in(canonicalize), in, in, in, out) is det.
+:- mode array_to_revstrings(in(include_details_cc), in, in, in, out)
+ is cc_multi.
+:- mode array_to_revstrings(in, in, in, in, out)
+ is cc_multi.
+
+array_to_revstrings(NonCanon, OpsTable, Array, !Rs) :-
+ add_revstring("array(", !Rs),
+ univ_to_revstrings(NonCanon, OpsTable,
+ univ(array__to_list(Array) `with_type` list(T)), !Rs),
+ add_revstring(")", !Rs).
+
+
+
+:- pred type_desc_to_revstrings(type_desc__type_desc, revstrings, revstrings).
+:- mode type_desc_to_revstrings(in, in, out) is det.
+
+type_desc_to_revstrings(TypeDesc, !Rs) :-
+ add_revstring(
+ term_io__quoted_atom(type_desc__type_name(TypeDesc)),
+ !Rs
+ ).
+
+
+
+:- pred type_ctor_desc_to_revstrings(type_desc__type_ctor_desc,
+ revstrings, revstrings).
+:- mode type_ctor_desc_to_revstrings(in, in, out) is det.
+
+type_ctor_desc_to_revstrings(TypeCtorDesc, !Rs) :-
+ type_desc__type_ctor_name_and_arity(TypeCtorDesc,
+ ModuleName, Name0, Arity0),
+ Name = term_io__quoted_atom(Name0),
+ ( ModuleName = "builtin", Name = "func" ->
+ % The type ctor that we call `builtin:func/N' takes N + 1
+ % type parameters: N arguments plus one return value.
+ % So we need to subtract one from the arity here.
+ Arity = Arity0 - 1
+ ;
+ Arity = Arity0
+ ),
+ ( ModuleName = "builtin" ->
+ String = string__format("%s/%d", [s(Name), i(Arity)])
+ ;
+ String = string__format("%s.%s/%d",
+ [s(ModuleName), s(Name), i(Arity)])
+ ),
+ add_revstring(String, !Rs).
+
+
+
+:- pred private_builtin_type_info_to_revstrings(
+ private_builtin__type_info(T), revstrings, revstrings).
+:- mode private_builtin_type_info_to_revstrings(in, in, out) is det.
+
+private_builtin_type_info_to_revstrings(PrivateBuiltinTypeInfo, !Rs) :-
+ TypeDesc = rtti_implementation__unsafe_cast(PrivateBuiltinTypeInfo),
+ type_desc_to_revstrings(TypeDesc, !Rs).
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
Index: library/string.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/string.m,v
retrieving revision 1.203
diff -u -r1.203 string.m
--- library/string.m 5 Jun 2003 05:26:34 -0000 1.203
+++ library/string.m 15 Jul 2003 07:08:42 -0000
@@ -69,6 +69,12 @@
% string__suffix(String, Suffix) is true iff Suffix is a
% suffix of String. Same as string__append(_, Suffix, String).
+:- func string__string(T) = string.
+% string__string(Value)
+% Converts an arbitrary value to a canonicalized string
+% representation using the standard Mercury operator
+% table.
+
:- func string__char_to_string(char) = string.
:- mode string__char_to_string(in) = uo is det.
:- pred string__char_to_string(char, string).
@@ -857,6 +863,8 @@
suffix_2_ioii(String, Suffix, SufLen, Len) :-
SufLen < Len,
suffix_2_ioii(String, Suffix, SufLen + 1, Len).
+
+string__string(Value) = univ_to_string(univ(Value)).
string__char_to_string(Char, String) :-
string__to_char_list(String, [Char]).
Index: library/term_io.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/term_io.m,v
retrieving revision 1.67
diff -u -r1.67 term_io.m
--- library/term_io.m 26 May 2003 09:00:31 -0000 1.67
+++ library/term_io.m 15 Jul 2003 06:33:40 -0000
@@ -111,6 +111,9 @@
% Given a character C, write C in single-quotes,
% escaped if necessary, to stdout.
+:- func term_io__quoted_char(char) = string.
+ % Like term_io__quote_char, but return the result in a string.
+
:- pred term_io__write_escaped_char(char, io__state, io__state).
:- mode term_io__write_escaped_char(in, di, uo) is det.
% Given a character C, write C, escaped if necessary, to stdout.
@@ -528,9 +531,10 @@
%-----------------------------------------------------------------------------%
term_io__quote_char(C) -->
- io__write_char(''''),
- term_io__write_escaped_char(C),
- io__write_char('''').
+ io__write_string(term_io__quoted_char(C)).
+
+term_io__quoted_char(C) =
+ string__format("'%s'", [s(term_io__escaped_char(C))]).
term_io__quote_atom(S) -->
term_io__quote_atom(S, not_adjacent_to_graphic_token).
--------------------------------------------------------------------------
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