[m-rev.] diff: eliminate ambiguities in term_to_xml and rtti_implementation
Zoltan Somogyi
zs at csse.unimelb.edu.au
Mon Sep 25 11:55:43 AEST 2006
library/term_to_xml.m:
library/rtti_implementation.m:
Rename some function symbols and predicates to eliminate a bunch
of ambiguities.
browser/browse.m:
tests/hard_coded/write_xml.m:
tests/hard_coded/xmlable_test.m:
Conform to the change above.
Zoltan.
cvs diff: Diffing .
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/libatomic_ops-1.2
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/doc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/gcc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/hpc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/ibmc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/icc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/msftc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/sunc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/tests
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing boehm_gc/windows-untested
cvs diff: Diffing boehm_gc/windows-untested/vc60
cvs diff: Diffing boehm_gc/windows-untested/vc70
cvs diff: Diffing boehm_gc/windows-untested/vc71
cvs diff: Diffing browser
Index: browser/browse.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/browser/browse.m,v
retrieving revision 1.62
diff -u -b -r1.62 browse.m
--- browser/browse.m 31 Aug 2006 11:09:46 -0000 1.62
+++ browser/browse.m 23 Sep 2006 11:22:58 -0000
@@ -292,19 +292,19 @@
(
BrowserTerm = plain_term(Univ),
Term = univ_value(Univ),
- term_to_xml.write_xml_doc_cc(Term, simple,
+ term_to_xml.write_xml_doc_general_cc(Term, simple,
no_stylesheet, no_dtd, _, !IO)
;
BrowserTerm = synthetic_term(Functor, Args, MaybeRes),
(
MaybeRes = no,
PredicateTerm = predicate(Functor, Args),
- term_to_xml.write_xml_doc_cc(PredicateTerm,
+ term_to_xml.write_xml_doc_general_cc(PredicateTerm,
simple, no_stylesheet, no_dtd, _, !IO)
;
MaybeRes = yes(Result),
FunctionTerm = function(Functor, Args, Result),
- term_to_xml.write_xml_doc_cc(FunctionTerm,
+ term_to_xml.write_xml_doc_general_cc(FunctionTerm,
simple, no_stylesheet, no_dtd, _, !IO)
)
),
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
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/rtti_implementation.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/rtti_implementation.m,v
retrieving revision 1.71
diff -u -b -r1.71 rtti_implementation.m
--- library/rtti_implementation.m 22 Aug 2006 02:33:41 -0000 1.71
+++ library/rtti_implementation.m 23 Sep 2006 12:18:16 -0000
@@ -112,50 +112,50 @@
% The type_ctor_rep needs to be kept up to date with the real
% definition in runtime/mercury_type_info.h.
:- type type_ctor_rep
- ---> enum
- ; enum_usereq
- ; du
- ; du_usereq
- ; notag
- ; notag_usereq
- ; equiv
- ; (func)
- ; int
- ; char
- ; float
- ; string
- ; (pred)
- ; subgoal
- ; void
- ; c_pointer
- ; typeinfo
- ; typeclassinfo
- ; array
- ; succip
- ; hp
- ; curfr
- ; maxfr
- ; redofr
- ; redoip
- ; trail_ptr
- ; ticket
- ; notag_ground
- ; notag_ground_usereq
- ; equiv_ground
- ; tuple
- ; reserved_addr
- ; reserved_addr_usereq
- ; type_ctor_info
- ; base_typeclass_info
- ; type_desc
- ; type_ctor_desc
- ; foreign
- ; reference
- ; stable_c_pointer
- ; stable_foreign
- ; pseudo_type_desc
- ; dummy
- ; unknown.
+ ---> tcr_enum
+ ; tcr_enum_usereq
+ ; tcr_du
+ ; tcr_du_usereq
+ ; tcr_notag
+ ; tcr_notag_usereq
+ ; tcr_equiv
+ ; tcr_func
+ ; tcr_int
+ ; tcr_char
+ ; tcr_float
+ ; tcr_string
+ ; tcr_pred
+ ; tcr_subgoal
+ ; tcr_void
+ ; tcr_c_pointer
+ ; tcr_typeinfo
+ ; tcr_typeclassinfo
+ ; tcr_array
+ ; tcr_succip
+ ; tcr_hp
+ ; tcr_curfr
+ ; tcr_maxfr
+ ; tcr_redofr
+ ; tcr_redoip
+ ; tcr_trail_ptr
+ ; tcr_ticket
+ ; tcr_notag_ground
+ ; tcr_notag_ground_usereq
+ ; tcr_equiv_ground
+ ; tcr_tuple
+ ; tcr_reserved_addr
+ ; tcr_reserved_addr_usereq
+ ; tcr_type_ctor_info
+ ; tcr_base_typeclass_info
+ ; tcr_type_desc
+ ; tcr_type_ctor_desc
+ ; tcr_foreign
+ ; tcr_reference
+ ; tcr_stable_c_pointer
+ ; tcr_stable_foreign
+ ; tcr_pseudo_type_desc
+ ; tcr_dummy
+ ; tcr_unknown.
% We keep all the other types abstract.
@@ -186,136 +186,63 @@
TypeCtorInfo = get_type_ctor_info(unsafe_cast(TypeDesc)),
TypeCtorRep = TypeCtorInfo ^ type_ctor_rep,
(
- TypeCtorRep = du,
- NumFunctors = TypeCtorInfo ^ type_ctor_num_functors
- ;
- TypeCtorRep = du_usereq,
- NumFunctors = TypeCtorInfo ^ type_ctor_num_functors
- ;
- TypeCtorRep = reserved_addr,
- NumFunctors = TypeCtorInfo ^ type_ctor_num_functors
- ;
- TypeCtorRep = reserved_addr_usereq,
- NumFunctors = TypeCtorInfo ^ type_ctor_num_functors
- ;
- TypeCtorRep = enum,
- NumFunctors = TypeCtorInfo ^ type_ctor_num_functors
- ;
- TypeCtorRep = enum_usereq,
+ ( TypeCtorRep = tcr_du
+ ; TypeCtorRep = tcr_du_usereq
+ ; TypeCtorRep = tcr_reserved_addr
+ ; TypeCtorRep = tcr_reserved_addr_usereq
+ ; TypeCtorRep = tcr_enum
+ ; TypeCtorRep = tcr_enum_usereq
+ ),
NumFunctors = TypeCtorInfo ^ type_ctor_num_functors
;
- TypeCtorRep = dummy,
- NumFunctors = 1
- ;
- TypeCtorRep = notag,
- NumFunctors = 1
- ;
- TypeCtorRep = notag_usereq,
- NumFunctors = 1
- ;
- TypeCtorRep = notag_ground,
+ ( TypeCtorRep = tcr_dummy
+ ; TypeCtorRep = tcr_notag
+ ; TypeCtorRep = tcr_notag_usereq
+ ; TypeCtorRep = tcr_notag_ground
+ ; TypeCtorRep = tcr_notag_ground_usereq
+ ; TypeCtorRep = tcr_tuple
+ ),
NumFunctors = 1
;
- TypeCtorRep = notag_ground_usereq,
- NumFunctors = 1
+ TypeCtorRep = tcr_equiv_ground,
+ error("rtti_implementation num_functors for equiv_ground type")
;
- TypeCtorRep = tuple,
- NumFunctors = 1
- ;
- TypeCtorRep = subgoal,
- NumFunctors = -1
+ TypeCtorRep = tcr_equiv,
+ error("rtti_implementation num_functors for equiv type")
;
- TypeCtorRep = equiv_ground,
- error("rtti_implementation num_functors for equiv types")
- ;
- TypeCtorRep = equiv,
- error("rtti_implementation num_functors for equiv types")
- ;
- TypeCtorRep = int,
- NumFunctors = -1
- ;
- TypeCtorRep = char,
- NumFunctors = -1
- ;
- TypeCtorRep = float,
- NumFunctors = -1
- ;
- TypeCtorRep = string,
- NumFunctors = -1
- ;
- TypeCtorRep = (func),
- NumFunctors = -1
- ;
- TypeCtorRep = (pred),
- NumFunctors = -1
- ;
- TypeCtorRep = void,
- NumFunctors = -1
- ;
- TypeCtorRep = c_pointer,
- NumFunctors = -1
- ;
- TypeCtorRep = stable_c_pointer,
- NumFunctors = -1
- ;
- TypeCtorRep = typeinfo,
- NumFunctors = -1
- ;
- TypeCtorRep = type_ctor_info,
- NumFunctors = -1
- ;
- TypeCtorRep = type_desc,
- NumFunctors = -1
- ;
- TypeCtorRep = pseudo_type_desc,
- NumFunctors = -1
- ;
- TypeCtorRep = type_ctor_desc,
- NumFunctors = -1
- ;
- TypeCtorRep = typeclassinfo,
- NumFunctors = -1
- ;
- TypeCtorRep = base_typeclass_info,
- NumFunctors = -1
- ;
- TypeCtorRep = array,
- NumFunctors = -1
- ;
- TypeCtorRep = succip,
- NumFunctors = -1
- ;
- TypeCtorRep = hp,
- NumFunctors = -1
- ;
- TypeCtorRep = curfr,
- NumFunctors = -1
- ;
- TypeCtorRep = maxfr,
- NumFunctors = -1
- ;
- TypeCtorRep = redofr,
- NumFunctors = -1
- ;
- TypeCtorRep = redoip,
- NumFunctors = -1
- ;
- TypeCtorRep = trail_ptr,
- NumFunctors = -1
- ;
- TypeCtorRep = ticket,
- NumFunctors = -1
- ;
- TypeCtorRep = foreign,
- NumFunctors = -1
- ;
- TypeCtorRep = stable_foreign,
- NumFunctors = -1
- ;
- TypeCtorRep = reference,
+ ( TypeCtorRep = tcr_subgoal
+ ; TypeCtorRep = tcr_int
+ ; TypeCtorRep = tcr_char
+ ; TypeCtorRep = tcr_float
+ ; TypeCtorRep = tcr_string
+ ; TypeCtorRep = tcr_func
+ ; TypeCtorRep = tcr_pred
+ ; TypeCtorRep = tcr_void
+ ; TypeCtorRep = tcr_c_pointer
+ ; TypeCtorRep = tcr_stable_c_pointer
+ ; TypeCtorRep = tcr_typeinfo
+ ; TypeCtorRep = tcr_type_ctor_info
+ ; TypeCtorRep = tcr_type_desc
+ ; TypeCtorRep = tcr_pseudo_type_desc
+ ; TypeCtorRep = tcr_type_ctor_desc
+ ; TypeCtorRep = tcr_typeclassinfo
+ ; TypeCtorRep = tcr_base_typeclass_info
+ ; TypeCtorRep = tcr_array
+ ; TypeCtorRep = tcr_succip
+ ; TypeCtorRep = tcr_hp
+ ; TypeCtorRep = tcr_curfr
+ ; TypeCtorRep = tcr_maxfr
+ ; TypeCtorRep = tcr_redofr
+ ; TypeCtorRep = tcr_redoip
+ ; TypeCtorRep = tcr_trail_ptr
+ ; TypeCtorRep = tcr_ticket
+ ; TypeCtorRep = tcr_foreign
+ ; TypeCtorRep = tcr_stable_foreign
+ ; TypeCtorRep = tcr_reference
+ ),
NumFunctors = -1
;
- TypeCtorRep = unknown,
+ TypeCtorRep = tcr_unknown,
error("num_functors: unknown type_ctor_rep")
).
@@ -340,64 +267,37 @@
TypeCtorInfo = get_type_ctor_info(TypeInfo),
TypeCtorRep = TypeCtorInfo ^ type_ctor_rep,
(
- TypeCtorRep = du,
- get_functor_du(TypeCtorRep, TypeInfo, TypeCtorInfo,
- FunctorNumber, FunctorName, Arity, TypeInfoList, Names)
- ;
- TypeCtorRep = du_usereq,
- get_functor_du(TypeCtorRep, TypeInfo, TypeCtorInfo,
- FunctorNumber, FunctorName, Arity, TypeInfoList, Names)
- ;
- TypeCtorRep = reserved_addr,
- get_functor_du(TypeCtorRep, TypeInfo, TypeCtorInfo,
- FunctorNumber, FunctorName, Arity, TypeInfoList, Names)
- ;
- TypeCtorRep = reserved_addr_usereq,
+ ( TypeCtorRep = tcr_du
+ ; TypeCtorRep = tcr_du_usereq
+ ; TypeCtorRep = tcr_reserved_addr
+ ; TypeCtorRep = tcr_reserved_addr_usereq
+ ),
get_functor_du(TypeCtorRep, TypeInfo, TypeCtorInfo,
FunctorNumber, FunctorName, Arity, TypeInfoList, Names)
;
- TypeCtorRep = subgoal,
- fail
- ;
- TypeCtorRep = enum,
- get_functor_enum(TypeCtorRep, TypeCtorInfo,
- FunctorNumber, FunctorName, Arity, TypeInfoList, Names)
- ;
- TypeCtorRep = enum_usereq,
- get_functor_enum(TypeCtorRep, TypeCtorInfo,
- FunctorNumber, FunctorName, Arity, TypeInfoList, Names)
- ;
- TypeCtorRep = dummy,
+ ( TypeCtorRep = tcr_enum
+ ; TypeCtorRep = tcr_enum_usereq
+ ; TypeCtorRep = tcr_dummy
+ ),
get_functor_enum(TypeCtorRep, TypeCtorInfo,
FunctorNumber, FunctorName, Arity, TypeInfoList, Names)
;
- TypeCtorRep = notag,
- get_functor_notag(TypeCtorRep, TypeCtorInfo,
- FunctorNumber, FunctorName, Arity, TypeInfoList, Names)
- ;
- TypeCtorRep = notag_usereq,
- get_functor_notag(TypeCtorRep, TypeCtorInfo,
- FunctorNumber, FunctorName, Arity, TypeInfoList, Names)
- ;
- TypeCtorRep = notag_ground,
- get_functor_notag(TypeCtorRep, TypeCtorInfo,
- FunctorNumber, FunctorName, Arity, TypeInfoList, Names)
- ;
- TypeCtorRep = notag_ground_usereq,
+ ( TypeCtorRep = tcr_notag
+ ; TypeCtorRep = tcr_notag_usereq
+ ; TypeCtorRep = tcr_notag_ground
+ ; TypeCtorRep = tcr_notag_ground_usereq
+ ),
get_functor_notag(TypeCtorRep, TypeCtorInfo,
FunctorNumber, FunctorName, Arity, TypeInfoList, Names)
;
- TypeCtorRep = equiv_ground,
- NewTypeInfo = collapse_equivalences(TypeInfo),
- get_functor_impl(unsafe_cast(NewTypeInfo), FunctorNumber,
- FunctorName, Arity, TypeInfoList, Names)
- ;
- TypeCtorRep = equiv,
+ ( TypeCtorRep = tcr_equiv_ground
+ ; TypeCtorRep = tcr_equiv
+ ),
NewTypeInfo = collapse_equivalences(TypeInfo),
get_functor_impl(unsafe_cast(NewTypeInfo), FunctorNumber,
FunctorName, Arity, TypeInfoList, Names)
;
- TypeCtorRep = tuple,
+ TypeCtorRep = tcr_tuple,
FunctorName = "{}",
Arity = get_var_arity_typeinfo_arity(TypeInfo),
TypeInfoList = iterate(1, Arity, (func(I) =
@@ -405,91 +305,39 @@
),
Names = list.duplicate(Arity, null_string)
;
- TypeCtorRep = int,
- fail
- ;
- TypeCtorRep = char,
- fail
- ;
- TypeCtorRep = float,
- fail
- ;
- TypeCtorRep = string,
- fail
- ;
- TypeCtorRep = (func),
- fail
- ;
- TypeCtorRep = (pred),
- fail
- ;
- TypeCtorRep = void,
- fail
- ;
- TypeCtorRep = c_pointer,
- fail
- ;
- TypeCtorRep = stable_c_pointer,
- fail
- ;
- TypeCtorRep = typeinfo,
- fail
- ;
- TypeCtorRep = type_ctor_info,
- fail
- ;
- TypeCtorRep = type_desc,
- fail
- ;
- TypeCtorRep = pseudo_type_desc,
- fail
- ;
- TypeCtorRep = type_ctor_desc,
- fail
- ;
- TypeCtorRep = typeclassinfo,
- fail
- ;
- TypeCtorRep = base_typeclass_info,
- fail
- ;
- TypeCtorRep = array,
- fail
- ;
- TypeCtorRep = succip,
- fail
- ;
- TypeCtorRep = hp,
- fail
- ;
- TypeCtorRep = curfr,
- fail
- ;
- TypeCtorRep = maxfr,
- fail
- ;
- TypeCtorRep = redofr,
- fail
- ;
- TypeCtorRep = redoip,
- fail
- ;
- TypeCtorRep = trail_ptr,
- fail
- ;
- TypeCtorRep = ticket,
- fail
- ;
- TypeCtorRep = foreign,
- fail
- ;
- TypeCtorRep = stable_foreign,
- fail
- ;
- TypeCtorRep = reference,
+ ( TypeCtorRep = tcr_subgoal
+ ; TypeCtorRep = tcr_int
+ ; TypeCtorRep = tcr_char
+ ; TypeCtorRep = tcr_float
+ ; TypeCtorRep = tcr_string
+ ; TypeCtorRep = tcr_func
+ ; TypeCtorRep = tcr_pred
+ ; TypeCtorRep = tcr_void
+ ; TypeCtorRep = tcr_c_pointer
+ ; TypeCtorRep = tcr_stable_c_pointer
+ ; TypeCtorRep = tcr_typeinfo
+ ; TypeCtorRep = tcr_type_ctor_info
+ ; TypeCtorRep = tcr_type_desc
+ ; TypeCtorRep = tcr_pseudo_type_desc
+ ; TypeCtorRep = tcr_type_ctor_desc
+ ; TypeCtorRep = tcr_typeclassinfo
+ ; TypeCtorRep = tcr_base_typeclass_info
+ ; TypeCtorRep = tcr_array
+ ; TypeCtorRep = tcr_succip
+ ; TypeCtorRep = tcr_hp
+ ; TypeCtorRep = tcr_curfr
+ ; TypeCtorRep = tcr_maxfr
+ ; TypeCtorRep = tcr_redofr
+ ; TypeCtorRep = tcr_redoip
+ ; TypeCtorRep = tcr_trail_ptr
+ ; TypeCtorRep = tcr_ticket
+ ; TypeCtorRep = tcr_foreign
+ ; TypeCtorRep = tcr_stable_foreign
+ ; TypeCtorRep = tcr_reference
+ ),
fail
;
- TypeCtorRep = unknown,
+ TypeCtorRep = tcr_unknown,
error("get_functor: unknown type_ctor_rep")
).
@@ -617,11 +465,11 @@
TypeCtorInfo = get_type_ctor_info(TypeInfo),
TypeCtorRep = TypeCtorInfo ^ type_ctor_rep,
(
- TypeCtorRep = tuple
+ TypeCtorRep = tcr_tuple
->
compare_tuple(TypeInfo, Res, X, Y)
;
- ( TypeCtorRep = (pred) ; TypeCtorRep = (func) )
+ ( TypeCtorRep = tcr_pred ; TypeCtorRep = tcr_func )
->
error("rtti_implementation.m: unimplemented: higher order comparisons")
;
@@ -668,11 +516,11 @@
TypeCtorInfo = get_type_ctor_info(TypeInfo),
TypeCtorRep = TypeCtorInfo ^ type_ctor_rep,
(
- TypeCtorRep = tuple
+ TypeCtorRep = tcr_tuple
->
unify_tuple(TypeInfo, X, Y)
;
- ( TypeCtorRep = (pred) ; TypeCtorRep = (func) )
+ ( TypeCtorRep = tcr_pred ; TypeCtorRep = tcr_func )
->
error("rtti_implementation.m: unimplemented: higher order unification")
;
@@ -993,9 +841,9 @@
:- pred type_ctor_is_variable_arity(type_ctor_info::in) is semidet.
type_ctor_is_variable_arity(TypeCtorInfo) :-
- ( TypeCtorInfo ^ type_ctor_rep = (pred)
- ; TypeCtorInfo ^ type_ctor_rep = (func)
- ; TypeCtorInfo ^ type_ctor_rep = tuple
+ ( TypeCtorInfo ^ type_ctor_rep = tcr_pred
+ ; TypeCtorInfo ^ type_ctor_rep = tcr_func
+ ; TypeCtorInfo ^ type_ctor_rep = tcr_tuple
).
%-----------------------------------------------------------------------------%
@@ -1013,9 +861,9 @@
TypeCtorInfo = get_type_ctor_info(TypeInfo),
(
(
- TypeCtorInfo ^ type_ctor_rep = equiv_ground
+ TypeCtorInfo ^ type_ctor_rep = tcr_equiv_ground
;
- TypeCtorInfo ^ type_ctor_rep = equiv
+ TypeCtorInfo ^ type_ctor_rep = tcr_equiv
)
->
error("rtti_implementation.m: unimplemented: " ++
@@ -1078,16 +926,16 @@
TypeInfo = get_type_info(Term),
TypeCtorInfo = get_type_ctor_info(TypeInfo),
TypeCtorRep = type_ctor_rep(TypeCtorInfo),
- deconstruct(Term, TypeInfo, TypeCtorInfo, TypeCtorRep, NonCanon,
+ deconstruct_2(Term, TypeInfo, TypeCtorInfo, TypeCtorRep, NonCanon,
Functor, Arity, Arguments).
-:- pred deconstruct(T, type_info, type_ctor_info, type_ctor_rep,
+:- pred deconstruct_2(T, type_info, type_ctor_info, type_ctor_rep,
noncanon_handling, string, int, list(univ)).
-:- mode deconstruct(in, in, in, in, in(do_not_allow), out, out, out) is det.
-:- mode deconstruct(in, in, in, in, in(canonicalize), out, out, out) is det.
-:- mode deconstruct(in, in, in, in,
+:- mode deconstruct_2(in, in, in, in, in(do_not_allow), out, out, out) is det.
+:- mode deconstruct_2(in, in, in, in, in(canonicalize), out, out, out) is det.
+:- mode deconstruct_2(in, in, in, in,
in(include_details_cc), out, out, out) is cc_multi.
-:- mode deconstruct(in, in, in, in, in, out, out, out) is cc_multi.
+:- mode deconstruct_2(in, in, in, in, in, out, out, out) is cc_multi.
% Code to perform deconstructions (XXX not yet complete).
%
@@ -1095,14 +943,14 @@
% immediately useful (e.g. called by io.write) have been implemented
% so far.
-deconstruct(Term, TypeInfo, TypeCtorInfo, TypeCtorRep, NonCanon,
+deconstruct_2(Term, TypeInfo, TypeCtorInfo, TypeCtorRep, NonCanon,
Functor, Arity, Arguments) :-
(
- TypeCtorRep = enum_usereq,
+ TypeCtorRep = tcr_enum_usereq,
handle_usereq_type(Term, TypeInfo, TypeCtorInfo, TypeCtorRep,
NonCanon, Functor, Arity, Arguments)
;
- TypeCtorRep = enum,
+ TypeCtorRep = tcr_enum,
TypeFunctors = type_ctor_functors(TypeCtorInfo),
EnumFunctorDesc = enum_functor_desc(TypeCtorRep,
unsafe_get_enum_value(Term), TypeFunctors),
@@ -1110,25 +958,25 @@
Arity = 0,
Arguments = []
;
- TypeCtorRep = dummy,
+ TypeCtorRep = tcr_dummy,
TypeFunctors = type_ctor_functors(TypeCtorInfo),
EnumFunctorDesc = enum_functor_desc(TypeCtorRep, 0, TypeFunctors),
Functor = enum_functor_name(EnumFunctorDesc),
Arity = 0,
Arguments = []
;
- TypeCtorRep = du_usereq,
+ TypeCtorRep = tcr_du_usereq,
handle_usereq_type(Term, TypeInfo, TypeCtorInfo, TypeCtorRep,
NonCanon, Functor, Arity, Arguments)
;
- TypeCtorRep = du,
+ TypeCtorRep = tcr_du,
LayoutInfo = type_layout(TypeCtorInfo),
PTag = get_primary_tag(Term),
PTagEntry = LayoutInfo ^ ptag_index(PTag),
SecTagLocn = PTagEntry ^ sectag_locn,
(
- SecTagLocn = none,
+ SecTagLocn = stag_none,
FunctorDesc = PTagEntry ^ du_sectag_alternatives(0),
Functor = FunctorDesc ^ du_functor_name,
Arity = FunctorDesc ^ du_functor_arity,
@@ -1137,12 +985,12 @@
get_arg(Term, X, SecTagLocn, FunctorDesc, TypeInfo))
))
;
- SecTagLocn = local,
+ SecTagLocn = stag_local,
Functor = "some_du_local_sectag",
Arity = 0,
Arguments = []
;
- SecTagLocn = remote,
+ SecTagLocn = stag_remote,
SecTag = get_remote_secondary_tag(Term),
FunctorDesc = PTagEntry ^ du_sectag_alternatives(SecTag),
Functor = FunctorDesc ^ du_functor_name,
@@ -1152,53 +1000,53 @@
get_arg(Term, X, SecTagLocn, FunctorDesc, TypeInfo))
))
;
- SecTagLocn = variable,
+ SecTagLocn = stag_variable,
Functor = "some_du_variable_sectag",
Arity = 0,
Arguments = []
)
;
- TypeCtorRep = notag_usereq,
+ TypeCtorRep = tcr_notag_usereq,
handle_usereq_type(Term, TypeInfo, TypeCtorInfo, TypeCtorRep, NonCanon,
Functor, Arity, Arguments)
;
- TypeCtorRep = notag,
+ TypeCtorRep = tcr_notag,
Functor = "some_notag",
Arity = 0,
Arguments = []
;
- TypeCtorRep = notag_ground_usereq,
+ TypeCtorRep = tcr_notag_ground_usereq,
handle_usereq_type(Term, TypeInfo, TypeCtorInfo, TypeCtorRep, NonCanon,
Functor, Arity, Arguments)
;
- TypeCtorRep = notag_ground,
+ TypeCtorRep = tcr_notag_ground,
Functor = "some_notag_ground",
Arity = 0,
Arguments = []
;
- TypeCtorRep = equiv_ground,
+ TypeCtorRep = tcr_equiv_ground,
Functor = "some_equiv_ground",
Arity = 0,
Arguments = []
;
% XXX noncanonical term
- TypeCtorRep = (func),
+ TypeCtorRep = tcr_func,
Functor = "<<function>>",
Arity = 0,
Arguments = []
;
- TypeCtorRep = equiv,
+ TypeCtorRep = tcr_equiv,
Functor = "some_equiv",
Arity = 0,
Arguments = []
;
- TypeCtorRep = int,
+ TypeCtorRep = tcr_int,
det_dynamic_cast(Term, Int),
Functor = string.int_to_string(Int),
Arity = 0,
Arguments = []
;
- TypeCtorRep = char,
+ TypeCtorRep = tcr_char,
det_dynamic_cast(Term, Char),
% XXX should escape characters correctly
@@ -1206,13 +1054,13 @@
Arity = 0,
Arguments = []
;
- TypeCtorRep = float,
+ TypeCtorRep = tcr_float,
det_dynamic_cast(Term, Float),
Functor = float_to_string(Float),
Arity = 0,
Arguments = []
;
- TypeCtorRep = string,
+ TypeCtorRep = tcr_string,
det_dynamic_cast(Term, String),
% XXX should escape characters in the string correctly
@@ -1221,12 +1069,12 @@
Arguments = []
;
% XXX noncanonical term
- TypeCtorRep = (pred),
+ TypeCtorRep = tcr_pred,
Functor = "<<predicate>>",
Arity = 0,
Arguments = []
;
- TypeCtorRep = tuple,
+ TypeCtorRep = tcr_tuple,
type_ctor_and_args(TypeInfo, _TypeCtorInfo, TypeArgs),
Functor = "{}",
Arity = get_var_arity_typeinfo_arity(TypeInfo),
@@ -1238,41 +1086,41 @@
), TypeArgs, Arguments, 0, _)
;
% XXX noncanonical term
- TypeCtorRep = subgoal,
+ TypeCtorRep = tcr_subgoal,
Functor = "<<subgoal>>",
Arity = 0,
Arguments = []
;
% There is no way to create values of type `void', so this
% should never happen.
- TypeCtorRep = void,
+ TypeCtorRep = tcr_void,
error("rtti_implementation.m: cannot deconstruct void types")
;
- TypeCtorRep = c_pointer,
+ TypeCtorRep = tcr_c_pointer,
det_dynamic_cast(Term, CPtr),
Functor = string.c_pointer_to_string(CPtr),
Arity = 0,
Arguments = []
;
- TypeCtorRep = stable_c_pointer,
+ TypeCtorRep = tcr_stable_c_pointer,
det_dynamic_cast(Term, CPtr),
Functor = "stable_" ++ string.c_pointer_to_string(CPtr),
Arity = 0,
Arguments = []
;
% XXX noncanonical term
- TypeCtorRep = typeinfo,
+ TypeCtorRep = tcr_typeinfo,
Functor = "some_typeinfo",
Arity = 0,
Arguments = []
;
% XXX noncanonical term
- TypeCtorRep = typeclassinfo,
+ TypeCtorRep = tcr_typeclassinfo,
Functor = "<<typeclassinfo>>",
Arity = 0,
Arguments = []
;
- TypeCtorRep = array,
+ TypeCtorRep = tcr_array,
% Constrain the T in array(T) to the correct element type.
type_ctor_and_args(type_of(Term), _, Args),
@@ -1291,103 +1139,103 @@
(func(Elem, List) = [univ(Elem) | List]),
Array, [])
;
- TypeCtorRep = succip,
+ TypeCtorRep = tcr_succip,
Functor = "<<succip>>",
Arity = 0,
Arguments = []
;
- TypeCtorRep = hp,
+ TypeCtorRep = tcr_hp,
Functor = "<<hp>>",
Arity = 0,
Arguments = []
;
- TypeCtorRep = curfr,
+ TypeCtorRep = tcr_curfr,
Functor = "<<curfr>>",
Arity = 0,
Arguments = []
;
- TypeCtorRep = maxfr,
+ TypeCtorRep = tcr_maxfr,
Functor = "<<maxfr>>",
Arity = 0,
Arguments = []
;
- TypeCtorRep = redofr,
+ TypeCtorRep = tcr_redofr,
Functor = "<<redofr>>",
Arity = 0,
Arguments = []
;
- TypeCtorRep = redoip,
+ TypeCtorRep = tcr_redoip,
Functor = "<<redoip>>",
Arity = 0,
Arguments = []
;
- TypeCtorRep = trail_ptr,
+ TypeCtorRep = tcr_trail_ptr,
Functor = "<<trail_ptr>>",
Arity = 0,
Arguments = []
;
- TypeCtorRep = ticket,
+ TypeCtorRep = tcr_ticket,
Functor = "<<ticket>>",
Arity = 0,
Arguments = []
;
% XXX FIXME!!!
- TypeCtorRep = reserved_addr,
+ TypeCtorRep = tcr_reserved_addr,
Functor = "some_reserved_addr",
Arity = 0,
Arguments = []
;
- TypeCtorRep = reserved_addr_usereq,
+ TypeCtorRep = tcr_reserved_addr_usereq,
handle_usereq_type(Term, TypeInfo, TypeCtorInfo, TypeCtorRep, NonCanon,
Functor, Arity, Arguments)
;
% XXX noncanonical term
- TypeCtorRep = type_ctor_info,
+ TypeCtorRep = tcr_type_ctor_info,
Functor = "some_typectorinfo",
Arity = 0,
Arguments = []
;
% XXX noncanonical term
- TypeCtorRep = base_typeclass_info,
+ TypeCtorRep = tcr_base_typeclass_info,
Functor = "<<basetypeclassinfo>>",
Arity = 0,
Arguments = []
;
% XXX noncanonical term
- TypeCtorRep = type_desc,
+ TypeCtorRep = tcr_type_desc,
Functor = "some_type_desc",
Arity = 0,
Arguments = []
;
% XXX noncanonical term
- TypeCtorRep = pseudo_type_desc,
+ TypeCtorRep = tcr_pseudo_type_desc,
Functor = "some_pseudo_type_desc",
Arity = 0,
Arguments = []
;
% XXX noncanonical term
- TypeCtorRep = type_ctor_desc,
+ TypeCtorRep = tcr_type_ctor_desc,
Functor = "some_type_ctor_desc",
Arity = 0,
Arguments = []
;
- TypeCtorRep = foreign,
+ TypeCtorRep = tcr_foreign,
Functor = "<<foreign>>",
Arity = 0,
Arguments = []
;
- TypeCtorRep = stable_foreign,
+ TypeCtorRep = tcr_stable_foreign,
Functor = "<<stable_foreign>>",
Arity = 0,
Arguments = []
;
% XXX noncanonical term
- TypeCtorRep = reference,
+ TypeCtorRep = tcr_reference,
Functor = "<<reference>>",
Arity = 0,
Arguments = []
;
- TypeCtorRep = unknown,
+ TypeCtorRep = tcr_unknown,
error("rtti_implementation: unknown type_ctor rep in deconstruct")
).
@@ -1401,8 +1249,8 @@
same_array_elem_type(_, _).
-:- inst usereq == bound(enum_usereq; du_usereq; notag_usereq;
- notag_ground_usereq; reserved_addr_usereq).
+:- inst usereq == bound(tcr_enum_usereq ; tcr_du_usereq ; tcr_notag_usereq ;
+ tcr_notag_ground_usereq ; tcr_reserved_addr_usereq).
:- pred handle_usereq_type(T, type_info, type_ctor_info, type_ctor_rep,
noncanon_handling, string, int, list(univ)).
@@ -1429,22 +1277,22 @@
;
NonCanon = include_details_cc,
(
- TypeCtorRep = enum_usereq,
- BaseTypeCtorRep = enum
+ TypeCtorRep = tcr_enum_usereq,
+ BaseTypeCtorRep = tcr_enum
;
- TypeCtorRep = du_usereq,
- BaseTypeCtorRep = du
+ TypeCtorRep = tcr_du_usereq,
+ BaseTypeCtorRep = tcr_du
;
- TypeCtorRep = notag_usereq,
- BaseTypeCtorRep = notag
+ TypeCtorRep = tcr_notag_usereq,
+ BaseTypeCtorRep = tcr_notag
;
- TypeCtorRep = notag_ground_usereq,
- BaseTypeCtorRep = notag_ground
+ TypeCtorRep = tcr_notag_ground_usereq,
+ BaseTypeCtorRep = tcr_notag_ground
;
- TypeCtorRep = reserved_addr_usereq,
- BaseTypeCtorRep = reserved_addr
+ TypeCtorRep = tcr_reserved_addr_usereq,
+ BaseTypeCtorRep = tcr_reserved_addr
),
- deconstruct(Term, TypeInfo, TypeCtorInfo, BaseTypeCtorRep, NonCanon,
+ deconstruct_2(Term, TypeInfo, TypeCtorInfo, BaseTypeCtorRep, NonCanon,
Functor, Arity, Arguments)
).
@@ -1485,7 +1333,7 @@
PseudoTypeInfo = get_pti_from_arg_types(ArgTypes, Index),
get_arg_type_info(TypeInfo, PseudoTypeInfo, Term, FunctorDesc,
ArgTypeInfo),
- ( ( SecTagLocn = none ; high_level_data ) ->
+ ( ( SecTagLocn = stag_none ; high_level_data ) ->
TagOffset = 0
;
TagOffset = 1
@@ -1944,7 +1792,12 @@
}
").
-:- type sectag_locn ---> none ; local ; remote ; variable.
+:- type sectag_locn
+ ---> stag_none
+ ; stag_local
+ ; stag_remote
+ ; stag_variable.
+
% :- pragma foreign_type("Java", sectag_locn, "mercury.runtime.Sectag_Locn").
:- type du_sectag_alternatives ---> du_sectag_alternatives(c_pointer).
@@ -2466,10 +2319,11 @@
:- pragma foreign_type("Java", notag_functor_desc,
"mercury.runtime.NotagFunctorDesc").
-:- inst du == bound(du; du_usereq; reserved_addr; reserved_addr_usereq).
-:- inst enum == bound(enum ; enum_usereq ; dummy).
-:- inst notag == bound(notag ; notag_usereq ;
- notag_ground ; notag_ground_usereq).
+:- inst du == bound(tcr_du ; tcr_du_usereq ; tcr_reserved_addr ;
+ tcr_reserved_addr_usereq).
+:- inst enum == bound(tcr_enum ; tcr_enum_usereq ; tcr_dummy).
+:- inst notag == bound(tcr_notag ; tcr_notag_usereq ;
+ tcr_notag_ground ; tcr_notag_ground_usereq).
:- func du_functor_desc(type_ctor_rep, int, type_functors) = du_functor_desc.
:- mode du_functor_desc(in(du), in, in) = out is det.
Index: library/term_to_xml.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/term_to_xml.m,v
retrieving revision 1.14
diff -u -b -r1.14 term_to_xml.m
--- library/term_to_xml.m 20 Sep 2006 09:42:25 -0000 1.14
+++ library/term_to_xml.m 23 Sep 2006 11:22:07 -0000
@@ -125,25 +125,25 @@
%
:- type doctype
---> public(string) % FPI
- ; public(string, string) % FPI, URL
+ ; public_system(string, string) % FPI, URL
; system(string). % URL
% Values of this type specify whether a DTD should be included in
% a generated XML document and if so how.
%
:- type maybe_dtd
- ---> embed
+ ---> embed_dtd
% Generate and embed the entire DTD in the document
% (only available for method 2).
- ; external(doctype)
+ ; external_dtd(doctype)
% Included a reference to an external DTD.
; no_dtd.
% Do not include any DOCTYPE information.
:- inst non_embedded_dtd
- ---> external(ground)
+ ---> external_dtd(ground)
; no_dtd.
% Values of this type indicate whether a stylesheet reference should be
@@ -167,10 +167,10 @@
%
% 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).
+:- pred write_xml_doc_to_stream(io.output_stream::in, T::in, io::di, io::uo)
+ is det <= xmlable(T).
- % write_xml_doc(Term, MaybeStyleSheet, MaybeDTD, !IO):
+ % write_xml_doc_style_dtd(Term, MaybeStyleSheet, MaybeDTD, !IO):
%
% Write Term to the current output stream as an XML document.
% MaybeStyleSheet and MaybeDTD specify whether or not a stylesheet
@@ -179,20 +179,22 @@
% a DTD cannot be automatically generated and embedded
% (that feature is available only for method 2 -- see below).
%
-:- pred write_xml_doc(T::in, maybe_stylesheet::in,
+:- pred write_xml_doc_style_dtd(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):
+ % write_xml_doc_style_dtd_stream(Stream, Term, MaybeStyleSheet, MaybeDTD,
+ % !IO):
%
- % Same as write_xml_doc/5, but write output to the given output stream.
+ % Same as write_xml_doc_style_dtd/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).
+:- pred write_xml_doc_style_dtd_stream(io.output_stream::in, T::in,
+ maybe_stylesheet::in, maybe_dtd::in(non_embedded_dtd), io::di, io::uo)
+ is det <= xmlable(T).
% write_xml_element(Indent, Term, !IO).
- % Write Term out as XML to the current output stream,
- % using indentation level Indent (each indentation level is one
- % tab character).
+ % Write Term out as XML to the current output stream, using indentation
+ % level Indent (each indentation level is one tab character).
% No `<?xml ... ?>' header will be written.
% This is useful for generating large XML documents in pieces.
%
@@ -202,8 +204,8 @@
%
% 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).
+:- pred write_xml_element_to_stream(io.output_stream::in, int::in, T::in,
+ io::di, io::uo) is det <= xmlable(T).
% write_xml_header(MaybeEncoding, !IO):
%
@@ -216,7 +218,7 @@
% Same as write_xml_header/3, but use the given output stream.
%
-:- pred write_xml_header(io.output_stream::in, maybe(string)::in,
+:- pred write_xml_header_to_stream(io.output_stream::in, maybe(string)::in,
io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
@@ -389,7 +391,7 @@
% it is not generally possible to generate DTD rules for functors
% with existentially typed arguments.
- % write_xml_doc(Term, ElementMapping, MaybeStyleSheet, MaybeDTD,
+ % write_xml_doc_general(Term, ElementMapping, MaybeStyleSheet, MaybeDTD,
% DTDResult, !IO):
%
% Write Term to the current output stream as an XML document using
@@ -402,21 +404,21 @@
% out. See the dtd_generation_result type for a list of the other
% possible values of DTDResult and their meanings.
%
-:- pred write_xml_doc(T::in, element_mapping::in(element_mapping),
+:- pred write_xml_doc_general(T::in, element_mapping::in(element_mapping),
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):
+ % write_xml_doc_general_to_stream(Stream, Term, ElementMapping,
+ % MaybeStyleSheet, MaybeDTD, DTDResult, !IO):
%
% Same as write_xml_doc/7 except write the XML doc to the given
% output stream.
%
-:- pred write_xml_doc(io.output_stream::in, T::in,
+:- pred write_xml_doc_general_to_stream(io.output_stream::in, T::in,
element_mapping::in(element_mapping), maybe_stylesheet::in,
maybe_dtd::in, dtd_generation_result::out, io::di, io::uo) is det.
- % write_xml_doc_cc(Term, ElementMapping, MaybeStyleSheet, MaybeDTD,
+ % write_xml_doc_general_cc(Term, ElementMapping, MaybeStyleSheet, MaybeDTD,
% DTDResult, !IO):
%
% Write Term to the current output stream as an XML document using
@@ -429,17 +431,17 @@
% written out. See the dtd_generation_result type for a list of the
% other possible values of DTDResult and their meanings.
%
-:- pred write_xml_doc_cc(T::in, element_mapping::in(element_mapping),
+:- pred write_xml_doc_general_cc(T::in, element_mapping::in(element_mapping),
maybe_stylesheet::in, maybe_dtd::in, dtd_generation_result::out,
io::di, io::uo) is cc_multi.
- % write_xml_doc_cc(Stream, Term, ElementMapping, MaybeStyleSheet,
+ % write_xml_doc_general_cc(Stream, Term, ElementMapping, MaybeStyleSheet,
% MaybeDTD, DTDResult, !IO):
%
% Same as write_xml_doc/7 except write the XML doc to the given
% output stream.
%
-:- pred write_xml_doc_cc(io.output_stream::in, T::in,
+:- pred write_xml_doc_general_cc_to_stream(io.output_stream::in, T::in,
element_mapping::in(element_mapping), maybe_stylesheet::in,
maybe_dtd::in, dtd_generation_result::out, io::di, io::uo) is cc_multi.
@@ -471,7 +473,7 @@
% Same as write_dtd/5 except the DTD will be written to the given
% output stream.
%
-:- pred write_dtd(io.output_stream::in, T::unused,
+:- pred write_dtd_to_stream(io.output_stream::in, T::unused,
element_mapping::in(element_mapping), dtd_generation_result::out,
io::di, io::uo) is det.
@@ -487,16 +489,17 @@
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_to_stream(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::in,
+:- pred write_dtd_from_type_to_stream(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_general(NonCanon, MakeElement, IndentLevel, Term, !IO):
%
% Write XML elements for the given term and all its descendents,
% using IndentLevel as the initial indentation level (each
@@ -506,15 +509,16 @@
% according to the value of NonCanon. See the deconstruct
% module in the standard library for more information on this argument.
%
-:- pred write_xml_element(deconstruct.noncanon_handling,
+:- pred write_xml_element_general(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(canonicalize), in(element_mapping), in, in,
- di, uo) is det.
-:- mode write_xml_element(in(include_details_cc), in(element_mapping), in, in,
- di, uo) is cc_multi.
-:- mode write_xml_element(in, in(element_mapping), in, in, di, uo) is cc_multi.
+:- mode write_xml_element_general(in(do_not_allow), in(element_mapping),
+ in, in, di, uo) is det.
+:- mode write_xml_element_general(in(canonicalize), in(element_mapping),
+ in, in, di, uo) is det.
+:- mode write_xml_element_general(in(include_details_cc), in(element_mapping),
+ in, in, di, uo) is cc_multi.
+:- mode write_xml_element_general(in, in(element_mapping),
+ in, in, di, uo) is cc_multi.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -535,12 +539,12 @@
%-----------------------------------------------------------------------------%
write_xml_doc(Term, !IO) :-
- write_xml_doc(Term, no_stylesheet, no_dtd, !IO).
+ write_xml_doc_style_dtd(Term, no_stylesheet, no_dtd, !IO).
-write_xml_doc(Stream, Term, !IO) :-
- write_xml_doc(Stream, Term, no_stylesheet, no_dtd, !IO).
+write_xml_doc_to_stream(Stream, Term, !IO) :-
+ write_xml_doc_style_dtd_stream(Stream, Term, no_stylesheet, no_dtd, !IO).
-write_xml_doc(Term, MaybeStyleSheet, MaybeDTD, !IO) :-
+write_xml_doc_style_dtd(Term, MaybeStyleSheet, MaybeDTD, !IO) :-
write_xml_header(no, !IO),
write_stylesheet_ref(MaybeStyleSheet, !IO),
Root = to_xml(Term),
@@ -548,7 +552,7 @@
(
MaybeDTD = no_dtd
;
- MaybeDTD = external(DocType),
+ MaybeDTD = external_dtd(DocType),
write_external_doctype(RootName, DocType, !IO)
),
( if contains_noformat_xml(Children) then
@@ -558,9 +562,9 @@
),
write_xml_element_format(ChildrenFormat, 0, Root, !IO).
-write_xml_doc(Stream, Term, MaybeStyleSheet, MaybeDTD, !IO) :-
+write_xml_doc_style_dtd_stream(Stream, Term, MaybeStyleSheet, MaybeDTD, !IO) :-
io.set_output_stream(Stream, OrigStream, !IO),
- write_xml_doc(Term, MaybeStyleSheet, MaybeDTD, !IO),
+ write_xml_doc_style_dtd(Term, MaybeStyleSheet, MaybeDTD, !IO),
io.set_output_stream(OrigStream, _, !IO).
write_xml_element(Indent, Term, !IO) :-
@@ -573,14 +577,14 @@
),
write_xml_element_format(ChildrenFormat, Indent, Root, !IO).
-write_xml_element(Stream, Indent, Term, !IO) :-
+write_xml_element_to_stream(Stream, Indent, Term, !IO) :-
io.set_output_stream(Stream, OrigStream, !IO),
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_of(Term)),
+write_xml_doc_general(Term, ElementMapping, MaybeStyleSheet, MaybeDTD,
+ DTDResult, !IO) :-
+ DTDResult = can_generate_dtd_2(MaybeDTD, ElementMapping, type_of(Term)),
(
DTDResult = ok
->
@@ -588,21 +592,21 @@
write_stylesheet_ref(MaybeStyleSheet, !IO),
write_doctype(canonicalize, Term, ElementMapping, MaybeDTD, _,
!IO),
- write_xml_element(canonicalize, ElementMapping, 0, Term, !IO)
+ write_xml_element_general(canonicalize, ElementMapping, 0, Term, !IO)
;
true
).
-write_xml_doc(Stream, Term, ElementMapping, MaybeStyleSheet, MaybeDTD,
- DTDResult, !IO) :-
+write_xml_doc_general_to_stream(Stream, Term, ElementMapping,
+ MaybeStyleSheet, MaybeDTD, DTDResult, !IO) :-
io.set_output_stream(Stream, OrigStream, !IO),
- write_xml_doc(Term, ElementMapping, MaybeStyleSheet, MaybeDTD,
+ write_xml_doc_general(Term, ElementMapping, MaybeStyleSheet, MaybeDTD,
DTDResult, !IO),
io.set_output_stream(OrigStream, _, !IO).
-write_xml_doc_cc(Term, ElementMapping, MaybeStyleSheet, MaybeDTD, DTDResult,
- !IO) :-
- DTDResult = can_generate_dtd(MaybeDTD, ElementMapping, type_of(Term)),
+write_xml_doc_general_cc(Term, ElementMapping, MaybeStyleSheet, MaybeDTD,
+ DTDResult, !IO) :-
+ DTDResult = can_generate_dtd_2(MaybeDTD, ElementMapping, type_of(Term)),
(
DTDResult = ok
->
@@ -610,20 +614,20 @@
write_stylesheet_ref(MaybeStyleSheet, !IO),
write_doctype(include_details_cc, Term, ElementMapping,
MaybeDTD, _, !IO),
- write_xml_element(include_details_cc, ElementMapping,
+ write_xml_element_general(include_details_cc, ElementMapping,
0, Term, !IO)
;
true
).
-write_xml_doc_cc(Stream, Term, ElementMapping, MaybeStyleSheet, MaybeDTD,
- DTDResult, !IO) :-
+write_xml_doc_general_cc_to_stream(Stream, Term, ElementMapping,
+ MaybeStyleSheet, MaybeDTD, DTDResult, !IO) :-
io.set_output_stream(Stream, OrigStream, !IO),
- write_xml_doc_cc(Term, ElementMapping, MaybeStyleSheet, MaybeDTD,
+ write_xml_doc_general_cc(Term, ElementMapping, MaybeStyleSheet, MaybeDTD,
DTDResult, !IO),
io.set_output_stream(OrigStream, _, !IO).
-write_xml_element(NonCanon, ElementMapping, IndentLevel, Term, !IO) :-
+write_xml_element_general(NonCanon, ElementMapping, IndentLevel, Term, !IO) :-
type_to_univ(Term, Univ),
get_element_pred(ElementMapping, MakeElement),
write_xml_element_univ(NonCanon, MakeElement, IndentLevel, Univ, [], _,
@@ -633,12 +637,13 @@
type_of(Term) = TypeDesc,
write_dtd_from_type(TypeDesc, ElementMapping, DTDResult, !IO).
-write_dtd(Stream, Term, ElementMapping, DTDResult, !IO) :-
+write_dtd_to_stream(Stream, Term, ElementMapping, DTDResult, !IO) :-
io.set_output_stream(Stream, OrigStream, !IO),
write_dtd(Term, ElementMapping, DTDResult, !IO),
io.set_output_stream(OrigStream, _, !IO).
-write_dtd_from_type(Stream, TypeDesc, ElementMapping, DTDResult, !IO) :-
+write_dtd_from_type_to_stream(Stream, TypeDesc, ElementMapping, DTDResult,
+ !IO) :-
io.set_output_stream(Stream, OrigStream, !IO),
write_dtd_from_type(TypeDesc, ElementMapping, DTDResult, !IO),
io.set_output_stream(OrigStream, _, !IO).
@@ -655,7 +660,7 @@
io.write_string("?>\n", !IO)
).
-write_xml_header(Stream, MaybeEncoding, !IO) :-
+write_xml_header_to_stream(Stream, MaybeEncoding, !IO) :-
io.set_output_stream(Stream, OrigStream, !IO),
write_xml_header(MaybeEncoding, !IO),
io.set_output_stream(OrigStream, _, !IO).
@@ -682,10 +687,10 @@
di, uo) is cc_multi.
write_doctype(_, _, _, no_dtd, ok, !IO).
-write_doctype(_, T, ElementMapping, embed, DTDResult, !IO) :-
+write_doctype(_, T, ElementMapping, embed_dtd, DTDResult, !IO) :-
write_dtd(T, ElementMapping, DTDResult, !IO),
io.nl(!IO).
-write_doctype(NonCanon, T, ElementMapping, external(DocType), ok, !IO) :-
+write_doctype(NonCanon, T, ElementMapping, external_dtd(DocType), ok, !IO) :-
get_element_pred(ElementMapping, MakeElement),
deconstruct.deconstruct(T, NonCanon, Functor, Arity, _),
( is_discriminated_union(type_of(T), _) ->
@@ -707,7 +712,7 @@
io.write_string(" PUBLIC """, !IO),
io.write_string(PUBLIC, !IO)
;
- DocType = public(PUBLIC, SYSTEM),
+ DocType = public_system(PUBLIC, SYSTEM),
io.write_string(" PUBLIC """, !IO),
io.write_string(PUBLIC, !IO),
io.write_string(""" """, !IO),
@@ -1418,12 +1423,12 @@
Result = multiple_functors_for_root
).
-:- func can_generate_dtd(maybe_dtd::in, element_mapping::in(element_mapping),
+:- func can_generate_dtd_2(maybe_dtd::in, element_mapping::in(element_mapping),
type_desc::in) = (dtd_generation_result::out) is det.
-can_generate_dtd(no_dtd, _, _) = ok.
-can_generate_dtd(external(_), _, _) = ok.
-can_generate_dtd(embed, ElementMapping, TypeDesc)
+can_generate_dtd_2(no_dtd, _, _) = ok.
+can_generate_dtd_2(external_dtd(_), _, _) = ok.
+can_generate_dtd_2(embed_dtd, ElementMapping, TypeDesc)
= can_generate_dtd(ElementMapping, TypeDesc).
% Check that we can reliably generate a DTD for the types in the list.
cvs diff: Diffing mdbcomp
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
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/write_xml.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/write_xml.m,v
retrieving revision 1.5
diff -u -b -r1.5 write_xml.m
--- tests/hard_coded/write_xml.m 22 Mar 2006 02:56:30 -0000 1.5
+++ tests/hard_coded/write_xml.m 23 Sep 2006 15:26:39 -0000
@@ -109,26 +109,27 @@
Map = !.M
),
array.from_list(X, A),
- write_xml_doc_cc(A, unique, with_stylesheet("text/css",
- "http://www.cs.mu.oz.au/a_css.css"), embed, Result1, !IO),
+ write_xml_doc_general_cc(A, unique, with_stylesheet("text/css",
+ "http://www.cs.mu.oz.au/a_css.css"), embed_dtd, Result1, !IO),
write_string("Result 1:\n", !IO),
write(Result1, !IO),
nl(!IO),
nl(!IO),
- write_xml_doc_cc(A, unique, with_stylesheet("text/css",
+ write_xml_doc_general_cc(A, unique, with_stylesheet("text/css",
"http://www.cs.mu.oz.au/a_css.css"), no_dtd, Result2, !IO),
write_string("Result 2:\n", !IO),
write(Result2, !IO),
nl(!IO),
nl(!IO),
- write_xml_doc_cc(wrap(Map), unique, with_stylesheet("text/css",
- "http://www.cs.mu.oz.au/a_css.css"), embed, Result3, !IO),
+ write_xml_doc_general_cc(wrap(Map), unique, with_stylesheet("text/css",
+ "http://www.cs.mu.oz.au/a_css.css"), embed_dtd, Result3, !IO),
write_string("Result 3:\n", !IO),
write(Result3, !IO),
nl(!IO),
nl(!IO),
- write_xml_doc_cc(wrap(Map), simple, with_stylesheet("text/css",
- "http://www.cs.mu.oz.au/a_css.css"), embed, Result3_1, !IO),
+ write_xml_doc_general_cc(wrap(Map), simple, with_stylesheet("text/css",
+ "http://www.cs.mu.oz.au/a_css.css"), embed_dtd, Result3_1,
+ !IO),
write_string("Result 3_1:\n", !IO),
write(Result3_1, !IO),
nl(!IO),
@@ -141,44 +142,45 @@
listPart(7),
listPart(8),
nothing], A2),
- write_xml_doc(A2, unique, with_stylesheet("text/css",
- "http://www.cs.mu.oz.au/a_css.css"), embed, Result4, !IO),
+ write_xml_doc_general(A2, unique, with_stylesheet("text/css",
+ "http://www.cs.mu.oz.au/a_css.css"), embed_dtd, Result4, !IO),
write_string("Result 4:\n", !IO),
write(Result4, !IO),
nl(!IO),
nl(!IO),
- write_xml_doc(X, simple, no_stylesheet,
- external(public("test", "test.dtd")), Result5, !IO),
+ write_xml_doc_general(X, simple, no_stylesheet,
+ external_dtd(public_system("test", "test.dtd")), Result5, !IO),
write_string("Result 5:\n", !IO),
write(Result5, !IO),
nl(!IO),
nl(!IO),
Simple = listPart(666),
- write_xml_doc(Simple, custom(p1), no_stylesheet, external(
- system("test")), Result6, !IO),
+ write_xml_doc_general(Simple, custom(p1), no_stylesheet,
+ external_dtd(system("test")), Result6, !IO),
write_string("Result 6:\n", !IO),
write(Result6, !IO),
nl(!IO),
nl(!IO),
- write_xml_doc(wrap(Simple), custom(p1), no_stylesheet, embed,
- Result7, !IO),
+ write_xml_doc_general(wrap(Simple), custom(p1), no_stylesheet,
+ embed_dtd, Result7, !IO),
write_string("Result 7:\n", !IO),
write(Result7, !IO),
nl(!IO),
nl(!IO),
- write_xml_doc(yes, unique, no_stylesheet, embed, Result8, !IO),
+ write_xml_doc_general_cc(yes, unique, no_stylesheet, embed_dtd,
+ Result8, !IO),
write_string("Result 8:\n", !IO),
write(Result8, !IO),
nl(!IO),
nl(!IO),
- write_xml_doc('new ext'(1), unique, no_stylesheet, no_dtd,
+ write_xml_doc_general_cc('new ext'(1), unique, no_stylesheet, no_dtd,
Result9, !IO),
write_string("Result 9:\n", !IO),
write(Result9, !IO),
nl(!IO),
nl(!IO),
- write_xml_doc('new ext'(1), unique, no_stylesheet, embed,
- Result10, !IO),
+ write_xml_doc_general_cc('new ext'(1), unique, no_stylesheet,
+ embed_dtd, Result10, !IO),
write_string("Result 10:\n", !IO),
write(Result10, !IO),
nl(!IO).
Index: tests/hard_coded/xmlable_test.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/xmlable_test.m,v
retrieving revision 1.2
diff -u -b -r1.2 xmlable_test.m
--- tests/hard_coded/xmlable_test.m 29 Mar 2006 08:08:02 -0000 1.2
+++ tests/hard_coded/xmlable_test.m 23 Sep 2006 15:28:30 -0000
@@ -20,8 +20,9 @@
svmap.set(4, "four", !Map),
svmap.set(5, "five", !Map),
svmap.set(6, "six &<>!@$%^`&*()-+='", !Map),
- write_xml_doc(!.Map, no_stylesheet,
- external(public("-//W3C//DTD XHTML 1.0 Strict//EN",
+ write_xml_doc_style_dtd(!.Map, no_stylesheet,
+ external_dtd(
+ public_system("-//W3C//DTD XHTML 1.0 Strict//EN",
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd")),
!IO),
io.nl(!IO),
@@ -37,8 +38,10 @@
:- func map_to_xhtml(map(K, V)::in) = (xml::out(xml_doc)) is det.
-map_to_xhtml(Map) =
- elem("html", [], [
+map_to_xhtml(Map) = Doc :-
+ map.to_assoc_list(Map, AssocList),
+ Rows = list.map(make_table_row, AssocList),
+ Doc = elem("html", [], [
elem("head", [], [
elem("title", [], [
data("Testing <123>")
@@ -61,9 +64,7 @@
[cdata("document.write('hello');")]
)
])
- ]) :-
- map.to_assoc_list(Map, AssocList),
- Rows = list.map(make_table_row, AssocList).
+ ]).
:- func make_table_row(pair(K, V)) = xml.
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/purity
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
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/par_conj
cvs diff: Diffing tests/recompilation
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/trailing
cvs diff: Diffing tests/valid
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 messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list