[m-rev.] for review: support for custom univ_to_term and term_to_univ special handlers
Ondrej Bojar
bojar at csse.unimelb.edu.au
Fri Mar 2 16:26:53 AEDT 2007
For review by Ralph or Julien.
Estimated hours taken: 1.5
Branch: main
Added support for user-supplied term_to_univ and univ_to_term special handlers.
This allows to use the standard (de)serialization to term for data structures
containing foreign types, provided that the user supplies special handlers for
such types.
library/term.m:
See above.
Index: library/term.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/term.m,v
retrieving revision 1.127
diff -u -r1.127 term.m
--- library/term.m 13 Feb 2007 01:58:54 -0000 1.127
+++ library/term.m 2 Mar 2007 05:17:59 -0000
@@ -24,6 +24,7 @@
:- import_module enum.
:- import_module list.
:- import_module map.
+:- import_module maybe.
:- import_module type_desc.
:- import_module univ.
@@ -117,6 +118,56 @@
:- func det_term_to_type(term(_)) = T.
:- pred det_term_to_type(term(_)::in, T::out) is det.
+ % For terms containing parts that should be converted to a special type
+ % (e.g. a foreign type), the user can supply a custom special handler.
+ % See the implementation of term.term_to_univ_special_case/8 for an example
+ % of special handlers.
+
+ % Type and mode required for custom term_to_univ special handlers:
+:- type term_to_univ_special_case_handler(T) ==
+ pred(string, string,
+ list(type_desc),
+ term(T),
+ type_desc.type_desc, term_to_type_context,
+ term_to_type_result(univ, T)
+ ).
+:- inst term_to_univ_special_case_handler ==
+ (pred(in, in,
+ in,
+ in(bound(functor(ground, ground, ground))),
+ in, in,
+ out) is semidet
+ ).
+
+ % Like try_term_to_type above, but with an optional custom special handler.
+ %
+:- func try_term_to_type(
+ maybe(term_to_univ_special_case_handler(U))
+ ::in(maybe(term_to_univ_special_case_handler)),
+ term(U)::in) = (term_to_type_result(T, U)::out) is det.
+:- pred try_term_to_type(
+ maybe(term_to_univ_special_case_handler(U))
+ ::in(maybe(term_to_univ_special_case_handler)),
+ term(U)::in, term_to_type_result(T, U)::out) is det.
+
+ % Like term_to_type/2 above, but with an optional custom special handler.
+ %
+:- pred term_to_type(
+ maybe(term_to_univ_special_case_handler(U))
+ ::in(maybe(term_to_univ_special_case_handler)),
+ term(U)::in, T::out) is semidet.
+
+ % Like det_term_to_type above, but with an optional custom special handler.
+ %
+:- func det_term_to_type(
+ maybe(term_to_univ_special_case_handler(U))
+ ::in(maybe(term_to_univ_special_case_handler)),
+ term(U)::in) = (T::out) is det.
+:- pred det_term_to_type(
+ maybe(term_to_univ_special_case_handler(U))
+ ::in(maybe(term_to_univ_special_case_handler)),
+ term(U)::in, T::out) is det.
+
% Converts a value to a term representation of that value.
%
:- func type_to_term(T) = term(_).
@@ -128,6 +179,42 @@
:- func univ_to_term(univ) = term(_).
:- pred univ_to_term(univ::in, term(_)::out) is det.
+
+ % For univs containing parts (e.g. of a foreign type) that should be
+ % converted to the term in a special way, the user can supply a custom
+ % special handler. See the implementation of
+ % term.univ_to_term_special_case/7 for an example of special handlers.
+
+ % Type and mode required for custom univ_to_term special handlers:
+:- type univ_to_term_special_case_handler(T) ==
+ pred(string, string,
+ list(type_desc), univ, context, term(T)).
+:- inst univ_to_term_special_case_handler ==
+ (pred(in, in,
+ in, in, in, out) is semidet).
+
+ % Like type_to_term above, but with an optional custom special handler.
+ %
+:- func type_to_term(
+ maybe(univ_to_term_special_case_handler(U))
+ ::in(maybe(univ_to_term_special_case_handler)),
+ T::in) = (term(U)::out) is det.
+:- pred type_to_term(
+ maybe(univ_to_term_special_case_handler(U))
+ ::in(maybe(univ_to_term_special_case_handler)),
+ T::in, term(U)::out) is det.
+
+ % Convert the value stored in the univ (as distinct from the univ itself)
+ % to a term.
+ %
+:- func univ_to_term(
+ maybe(univ_to_term_special_case_handler(U))
+ ::in(maybe(univ_to_term_special_case_handler)),
+ univ::in) = (term(U)::out) is det.
+:- pred univ_to_term(
+ maybe(univ_to_term_special_case_handler(U))
+ ::in(maybe(univ_to_term_special_case_handler)),
+ univ::in, term(U)::out) is det.
%-----------------------------------------------------------------------------%
% vars(Term, Vars):
@@ -476,10 +563,17 @@
%-----------------------------------------------------------------------------%
term_to_type(Term, Val) :-
- try_term_to_type(Term, ok(Val)).
+ term_to_type(no, Term, Val).
+
+term_to_type(UserHandler, Term, Val) :-
+ try_term_to_type(UserHandler, Term, ok(Val)).
try_term_to_type(Term, Result) :-
- try_term_to_univ(Term, type_desc.type_of(ValTypedVar), UnivResult),
+ try_term_to_type(no, Term, Result).
+
+try_term_to_type(UserHandler, Term, Result) :-
+ try_term_to_univ(UserHandler, Term, type_desc.type_of(ValTypedVar),
+ UnivResult),
(
UnivResult = ok(Univ),
det_univ_to_type(Univ, Val),
@@ -490,34 +584,55 @@
Result = error(Error)
).
-:- pred try_term_to_univ(term(T)::in, type_desc.type_desc::in,
+:- pred try_term_to_univ(
+ maybe(term_to_univ_special_case_handler(T))
+ ::in(maybe(term_to_univ_special_case_handler)),
+ term(T)::in, type_desc.type_desc::in,
term_to_type_result(univ, T)::out) is det.
-try_term_to_univ(Term, Type, Result) :-
- try_term_to_univ_2(Term, Type, [], Result).
+try_term_to_univ(UserHandler, Term, Type, Result) :-
+ try_term_to_univ_2(UserHandler, Term, Type, [], Result).
-:- pred try_term_to_univ_2(term(T)::in,
+:- pred try_term_to_univ_2(
+ maybe(term_to_univ_special_case_handler(T))
+ ::in(maybe(term_to_univ_special_case_handler)),
+ term(T)::in,
type_desc::in, term_to_type_context::in,
term_to_type_result(univ, T)::out) is det.
-try_term_to_univ_2(variable(Var, _), _Type, Context,
+try_term_to_univ_2(_UserHandler, variable(Var, _), _Type, Context,
error(mode_error(Var, Context))).
-try_term_to_univ_2(Term, Type, Context, Result) :-
+try_term_to_univ_2(UserHandler, Term, Type, Context, Result) :-
Term = functor(Functor, ArgTerms, TermContext),
(
type_ctor_and_args(Type, TypeCtor, TypeArgs),
- term_to_univ_special_case(
- type_ctor_module_name(TypeCtor),
- type_ctor_name(TypeCtor),
- TypeArgs, Term, Type, Context, SpecialCaseResult)
+ (
+ term_to_univ_special_case(UserHandler,
+ type_ctor_module_name(TypeCtor),
+ type_ctor_name(TypeCtor),
+ TypeArgs, Term, Type, Context, TempSpecialCaseResult)
+ ->
+ SpecialCaseResult = TempSpecialCaseResult
+ ;
+ (
+ UserHandler = yes(UserHandlerPred),
+ UserHandlerPred(
+ type_ctor_module_name(TypeCtor),
+ type_ctor_name(TypeCtor),
+ TypeArgs, Term, Type, Context, SpecialCaseResult)
+ ;
+ UserHandler = no,
+ fail
+ )
+ )
->
Result = SpecialCaseResult
;
Functor = atom(FunctorName),
list.length(ArgTerms, Arity),
find_functor(Type, FunctorName, Arity, FunctorNumber, ArgTypes),
- term_list_to_univ_list(ArgTerms, ArgTypes, Functor, 1, Context,
- TermContext, ArgsResult)
+ term_list_to_univ_list(UserHandler, ArgTerms, ArgTypes, Functor, 1,
+ Context, TermContext, ArgsResult)
->
(
ArgsResult = ok(ArgValues),
@@ -537,33 +652,38 @@
Result = error(type_error(Term, Type, TermContext, RevContext))
).
-:- pred term_to_univ_special_case(string::in, string::in,
+:- pred term_to_univ_special_case(
+ maybe(term_to_univ_special_case_handler(T))
+ ::in(maybe(term_to_univ_special_case_handler)),
+ string::in, string::in,
list(type_desc)::in,
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_to_univ_special_case("builtin", "character", [], Term, _, _, ok(Univ)) :-
+term_to_univ_special_case(_UserHandler, "builtin", "character", [],
+ Term, _, _, ok(Univ)) :-
Term = functor(atom(FunctorName), [], _),
string.first_char(FunctorName, Char, ""),
type_to_univ(Char, Univ).
-term_to_univ_special_case("builtin", "int", [],
+term_to_univ_special_case(_UserHandler, "builtin", "int", [],
Term, _, _, ok(Univ)) :-
Term = functor(integer(Int), [], _),
type_to_univ(Int, Univ).
-term_to_univ_special_case("builtin", "string", [],
+term_to_univ_special_case(_UserHandler, "builtin", "string", [],
Term, _, _, ok(Univ)) :-
Term = functor(string(String), [], _),
type_to_univ(String, Univ).
-term_to_univ_special_case("builtin", "float", [], Term, _, _, ok(Univ)) :-
+term_to_univ_special_case(_UserHandler, "builtin", "float", [], Term,
+ _, _, ok(Univ)) :-
Term = functor(float(Float), [], _),
type_to_univ(Float, Univ).
-term_to_univ_special_case("bitmap", "bitmap", [],
+term_to_univ_special_case(_UserHandler, "bitmap", "bitmap", [],
Term, _Type, _PrevContext, ok(Univ)) :-
% Bitmaps are represented as hex strings.
Term = functor(string(String), [], _),
type_to_univ(bitmap.from_string(String), Univ).
-term_to_univ_special_case("array", "array", [ElemType],
+term_to_univ_special_case(UserHandler, "array", "array", [ElemType],
Term, _Type, PrevContext, Result) :-
%
% arrays are represented as terms of the form
@@ -579,7 +699,7 @@
ListType = type_of([Elem]),
ArgContext = arg_context(atom("array"), 1, TermContext),
NewContext = [ArgContext | PrevContext],
- try_term_to_univ_2(ArgList, ListType, NewContext, ArgResult),
+ try_term_to_univ_2(UserHandler, ArgList, ListType, NewContext, ArgResult),
(
ArgResult = ok(ListUniv),
has_type(Elem2, ElemType),
@@ -591,9 +711,11 @@
ArgResult = error(Error),
Result = error(Error)
).
-term_to_univ_special_case("builtin", "c_pointer", _, _, _, _, _) :-
+term_to_univ_special_case(_UserHandler, "builtin", "c_pointer", _, _,
+ _, _, _) :-
fail.
-term_to_univ_special_case("univ", "univ", [], Term, _, _, Result) :-
+term_to_univ_special_case(_UserHandler, "univ", "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.
@@ -616,24 +738,28 @@
% like all the other results returned from this procedure.
Result = ok(univ(Univ)).
-term_to_univ_special_case("type_desc", "type_desc", _, _, _, _, _) :-
+term_to_univ_special_case(_UserHandler, "type_desc", "type_desc", _, _,
+ _, _, _) :-
% Ditto.
fail.
-:- pred term_list_to_univ_list(list(term(T))::in,
+:- pred term_list_to_univ_list(
+ maybe(term_to_univ_special_case_handler(T))
+ ::in(maybe(term_to_univ_special_case_handler)),
+ list(term(T))::in,
list(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_list_to_univ_list([], [], _, _, _, _, ok([])).
-term_list_to_univ_list([ArgTerm | ArgTerms],
+term_list_to_univ_list(_UserHandler, [], [], _, _, _, _, ok([])).
+term_list_to_univ_list(UserHandler, [ArgTerm | ArgTerms],
[Type | Types], Functor, ArgNum, PrevContext, TermContext, Result) :-
ArgContext = arg_context(Functor, ArgNum, TermContext),
NewContext = [ArgContext | PrevContext],
- try_term_to_univ_2(ArgTerm, Type, NewContext, ArgResult),
+ try_term_to_univ_2(UserHandler, ArgTerm, Type, NewContext, ArgResult),
(
ArgResult = ok(Arg),
- term_list_to_univ_list(ArgTerms, Types, Functor,
+ term_list_to_univ_list(UserHandler, ArgTerms, Types, Functor,
ArgNum + 1, PrevContext, TermContext, RestResult),
(
RestResult = ok(Rest),
@@ -668,8 +794,8 @@
find_functor_2(TypeInfo, Functor, Arity, Num1, FunctorNumber, ArgTypes)
).
-det_term_to_type(Term, X) :-
- ( term_to_type(Term, X1) ->
+det_term_to_type(UserHandler, Term, X) :-
+ ( term_to_type(UserHandler, Term, X1) ->
X = X1
; \+ is_ground(Term) ->
error("term.det_term_to_type failed, because the term wasn't ground")
@@ -680,26 +806,46 @@
error(Message)
).
+det_term_to_type(Term, X) :-
+ det_term_to_type(no, Term, X).
+
%-----------------------------------------------------------------------------%
-type_to_term(Val, Term) :- type_to_univ(Val, Univ),
- univ_to_term(Univ, Term).
+type_to_term(Val, Term) :- type_to_term(no, Val, Term).
+
+type_to_term(UserHandler, Val, Term) :- type_to_univ(Val, Univ),
+ univ_to_term(UserHandler, Univ, Term).
-univ_to_term(Univ, Term) :-
+univ_to_term(Univ, Term) :- univ_to_term(no, Univ, Term).
+
+univ_to_term(UserHandler, Univ, Term) :-
context_init(Context),
Type = univ_type(Univ),
( construct.num_functors(Type) = _ ->
deconstruct(univ_value(Univ), canonicalize, FunctorString,
_FunctorArity, FunctorArgs),
- univ_list_to_term_list(FunctorArgs, TermArgs),
+ univ_list_to_term_list(UserHandler, FunctorArgs, TermArgs),
Term = functor(atom(FunctorString), TermArgs, Context)
;
(
type_ctor_and_args(Type, TypeCtor, TypeArgs),
TypeName = type_ctor_name(TypeCtor),
ModuleName = type_ctor_module_name(TypeCtor),
- univ_to_term_special_case(ModuleName, TypeName, TypeArgs,
- Univ, Context, SpecialCaseTerm)
+ (
+ univ_to_term_special_case(UserHandler, ModuleName, TypeName,
+ TypeArgs, Univ, Context, TempSpecialCaseTerm)
+ ->
+ SpecialCaseTerm = TempSpecialCaseTerm
+ ;
+ (
+ UserHandler = yes(UserHandlerPred),
+ UserHandlerPred(ModuleName, TypeName, TypeArgs,
+ Univ, Context, SpecialCaseTerm)
+ ;
+ UserHandler = no,
+ fail
+ )
+ )
->
Term = SpecialCaseTerm
;
@@ -709,28 +855,32 @@
)
).
-:- pred univ_to_term_special_case(string::in, string::in,
+:- pred univ_to_term_special_case(
+ maybe(univ_to_term_special_case_handler(T))
+ ::in(maybe(univ_to_term_special_case_handler)),
+ string::in, string::in,
list(type_desc)::in, univ::in, context::in, term(T)::out)
is semidet.
-univ_to_term_special_case("builtin", "int", [], Univ, Context,
+univ_to_term_special_case(_UserHandler, "builtin", "int", [], Univ, Context,
functor(integer(Int), [], Context)) :-
det_univ_to_type(Univ, Int).
-univ_to_term_special_case("builtin", "float", [], Univ, Context,
+univ_to_term_special_case(_UserHandler, "builtin", "float", [], Univ, Context,
functor(float(Float), [], Context)) :-
det_univ_to_type(Univ, Float).
-univ_to_term_special_case("builtin", "character", [], Univ,
+univ_to_term_special_case(_UserHandler, "builtin", "character", [], Univ,
Context, functor(atom(CharName), [], Context)) :-
det_univ_to_type(Univ, Character),
string.char_to_string(Character, CharName).
-univ_to_term_special_case("builtin", "string", [], Univ, Context,
+univ_to_term_special_case(_UserHandler, "builtin", "string", [], Univ, Context,
functor(string(String), [], Context)) :-
det_univ_to_type(Univ, String).
-univ_to_term_special_case("type_desc", "type_desc", [], Univ, Context,
- functor(atom("type_info"), [Term], Context)) :-
+univ_to_term_special_case(_UserHandler, "type_desc", "type_desc", [],
+ Univ, Context, functor(atom("type_info"), [Term], Context)) :-
det_univ_to_type(Univ, TypeInfo),
type_info_to_term(Context, TypeInfo, Term).
-univ_to_term_special_case("univ", "univ", [], Univ, Context, Term) :-
+univ_to_term_special_case(_UserHandler, "univ", "univ", [],
+ Univ, Context, Term) :-
det_univ_to_type(Univ, NestedUniv),
Term = functor(atom("univ"),
% XXX what operator should we use for type qualification?
@@ -739,29 +889,33 @@
type_info_to_term(Context, univ_type(NestedUniv), TypeTerm),
NestedUnivValue = univ_value(NestedUniv),
type_to_term(NestedUnivValue, ValueTerm).
-univ_to_term_special_case("bitmap", "bitmap", [], Univ, Context,
+univ_to_term_special_case(_UserHandler, "bitmap", "bitmap", [], Univ, Context,
functor(string(BitmapStr), [], Context)) :-
det_univ_to_type(Univ, Bitmap),
BitmapStr = bitmap.to_string(Bitmap).
-univ_to_term_special_case("array", "array", [ElemType], Univ, Context, Term) :-
+univ_to_term_special_case(UserHandler, "array", "array", [ElemType],
+ Univ, Context, Term) :-
Term = functor(atom("array"), [ArgsTerm], Context),
has_type(Elem, ElemType),
same_type(List, [Elem]),
det_univ_to_type(Univ, Array),
array.to_list(Array, List),
- type_to_term(List, ArgsTerm).
+ type_to_term(UserHandler, List, ArgsTerm).
:- pred same_type(T::unused, T::unused) is det.
same_type(_, _).
-:- pred univ_list_to_term_list(list(univ)::in, list(term(T))::out) is det.
-
-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).
+:- pred univ_list_to_term_list(
+ maybe(univ_to_term_special_case_handler(T))
+ ::in(maybe(univ_to_term_special_case_handler)),
+ list(univ)::in, list(term(T))::out) is det.
+
+univ_list_to_term_list(_UserHandler, [], []).
+univ_list_to_term_list(UserHandler, [Value|Values], [Term|Terms]) :-
+ univ_to_term(UserHandler, Value, Term),
+ univ_list_to_term_list(UserHandler, Values, Terms).
% Given a type_info, return a term that represents the name of that type.
%
@@ -1225,15 +1379,27 @@
try_term_to_type(T) = TTTR :-
try_term_to_type(T, TTTR).
+try_term_to_type(UH, T) = TTTR :-
+ try_term_to_type(UH, T, TTTR).
+
+det_term_to_type(UH, T1) = T2 :-
+ det_term_to_type(UH, T1, T2).
+
det_term_to_type(T1) = T2 :-
det_term_to_type(T1, T2).
type_to_term(T1) = T2 :-
type_to_term(T1, T2).
+type_to_term(UH, T1) = T2 :-
+ type_to_term(UH, T1, T2).
+
univ_to_term(U) = T :-
univ_to_term(U, T).
+univ_to_term(UH, U) = T :-
+ univ_to_term(UH, U, T).
+
vars(T) = Vs :-
vars(T, Vs).
--------------------------------------------------------------------------
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