1%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    2
    3/*	Nan.System.Sources
    4	Nan.System.Sources/Prolog 1.2.0-beta
    5	Answer Sources in Prolog
    6	Copyright 2015-2017 Julio P. Di Egidio
    7	<mailto:julio@diegidio.name>
    8	<http://julio.diegidio.name/Projects/Nan.System.Sources/>
    9	
   10	This file is part of Nan.System.Sources.
   11	
   12	Nan.System.Sources is free software: you can redistribute it and/or modify
   13	it under the terms of the GNU General Public License as published by
   14	the Free Software Foundation, either version 3 of the License, or
   15	(at your option) any later version.
   16	
   17	Nan.System.Sources is distributed in the hope that it will be useful,
   18	but WITHOUT ANY WARRANTY; without even the implied warranty of
   19	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   20	GNU General Public License for more details.
   21	
   22	You should have received a copy of the GNU General Public License
   23	along with Nan.System.Sources.  If not, see <http://www.gnu.org/licenses/>.
   24*/

   25
   26% (SWI-Prolog 7.3.25)
   27
   28:- module(sources_types,
   29	[	is_source/1,  % @Term
   30		is_answer/1   % @Term
   31	]).

Answer Sources :: Types

Part of Nan.System.Sources (nan/system/sources.pl)

Module sources_types (nan/system/sources_types.pl) provides type testing predicates to validate arguments in user code.

For code docs syntax and meaning see sources_docs.txt.

author
- Julio P. Di Egidio
version
- 1.2.0-beta
license
- GNU GPLv3 */
   48%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   49%	PUBLIC interface
   50%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 is_source(@Term:any) is semidet
Tests that a term is a source.

A source term has the form:

  s(source(+Typ:(s(t0); s(t1)), +Id:atom))

Examples:

source(t0, Id)
source(t1, Id)
Arguments:
Term- The term to test.
   69is_source(Src) :-
   70	callable(Src),
   71	Src = source(Typ, Id),
   72	is_source__typ(Typ),
   73	is_source__id(Id).
   74
   75is_source__typ(Typ) :-
   76	atom(Typ),
   77	memberchk(Typ, [t0, t1]).
   78
   79is_source__id(Id) :-
   80	atom(Id).
 is_answer(@Term:any) is semidet
Tests that a term is a answer.

A answer term has the form:

  s(answer(+Det:(s(more); s(last)), +Ret:s(the(?Sol:any))))
; s(answer(+Det:s(fail),            +Ret:s(no)))

Examples:

answer(more, the(Sol))
answer(last, the(Sol))
answer(fail, no)
Arguments:
Term- The term to test.
  101is_answer(Ans) :-
  102	callable(Ans),
  103	Ans = answer(Det, Ret),
  104	is_answer__det(Det),
  105	is_answer__ret(Det, Ret).
  106
  107is_answer__det(Det) :-
  108	atom(Det),
  109	memberchk(Det, [fail, more, last]).
  110
  111is_answer__ret(fail, Ret) :- !,
  112	Ret == no.
  113is_answer__ret(_, Ret) :-
  114	subsumes_term(the(_), Ret).
  115
  116%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%