1% This file is part of the Attempto Parsing Engine (APE).
    2% Copyright 2008-2013, Attempto Group, University of Zurich (see http://attempto.ifi.uzh.ch).
    3%
    4% The Attempto Parsing Engine (APE) is free software: you can redistribute it and/or modify it
    5% under the terms of the GNU Lesser General Public License as published by the Free Software
    6% Foundation, either version 3 of the License, or (at your option) any later version.
    7%
    8% The Attempto Parsing Engine (APE) is distributed in the hope that it will be useful, but WITHOUT
    9% ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
   10% PURPOSE. See the GNU Lesser General Public License for more details.
   11%
   12% You should have received a copy of the GNU Lesser General Public License along with the Attempto
   13% Parsing Engine (APE). If not, see http://www.gnu.org/licenses/.
   14
   15
   16:- module(serialize_term, [
   17		serialize_term/1,            % +Term
   18		serialize_term/2,            % +Stream, +Term
   19		serialize_term_into_atom/2   % +Term, -Atom
   20	]).

Term serializer

The purpose of this module is to provide a single official predicate for serializing Prolog terms that the Attempto tools produce (DRSs, token lists, OWL FSS, etc.).

Serialized terms can be stored in files, sent over HTTP, etc., so that they can be later read back into the exact same term.

Essentially we provide a customized version of Prolog built-ins like write_canonical/[1,2] and writeq/[1,2].

author
- Kaarel Kaljurand
version
- 2009-03-20

TODO:

  • test how \= (ACE non-equality) is serialized, maybe check character_escapes(bool, changeable)
  • find a way to print terms which contain variables so that the output has nice variable names (A vs _G123) but without the detour of numbervars, maybe check: print, portray
  • should we serialize singletons as '_'
  • we make an extra effort to locally undefine some operators, there must be a cleaner way */
 serialize_term(+Stream:stream, +Term:term) is det
 serialize_term(+Term:term) is det
Arguments:
Stream- is the output stream
Term- is a term to be serialized
   54serialize_term(Stream, Term) :-
   55	numbervars(Term, 0, _),
   56	op(0, fy, -),
   57	op(0, fy, ~),
   58	op(0, xfx, =>),
   59	op(0, xfx, v),
   60	op(0, xfx, &),
   61	write_term(Stream, Term, [numbervars(true), quoted(true)]),
   62	fail ; true.
   63
   64
   65serialize_term(Term) :-
   66	numbervars(Term, 0, _),
   67	op(0, fy, -),
   68	op(0, fy, ~),
   69	op(0, xfx, =>),
   70	op(0, xfx, v),
   71	op(0, xfx, &),
   72	write_term(Term, [numbervars(true), quoted(true)]),
   73	fail ; true.
 serialize_term_into_atom(+Term:term, -SerializedTerm:atom) is det
Arguments:
Term- is a term to be serialized
SerializedTerm- is the term serialized as an atom
   81serialize_term_into_atom(Term, SerializedTerm) :-
   82	with_output_to(atom(SerializedTerm), serialize_term(Term))