1/*****************************************************************************
    2 * This file is part of the Prolog Development Tool (PDT)
    3 * 
    4 * Author: Andreas Becker
    5 * WWW: http://sewiki.iai.uni-bonn.de/research/pdt/start
    6 * Mail: pdt@lists.iai.uni-bonn.de
    7 * Copyright (C): 2012, CS Dept. III, University of Bonn
    8 * 
    9 * All rights reserved. This program is  made available under the terms
   10 * of the Eclipse Public License v1.0 which accompanies this distribution,
   11 * and is available at http://www.eclipse.org/legal/epl-v10.html
   12 * 
   13 ****************************************************************************/
   14
   15:- module(meta_inference_examples, [
   16	simple0/1,
   17	simple1/1,
   18	simple2/2,
   19	unify0/1,
   20	unify1/1,
   21	unify2/1,
   22	unify3/1,
   23	unify4/2,
   24	unify5/1,
   25	unify6/2,
   26	construct_term0/2,
   27	construct_term1/1,
   28	construct_term2/2,
   29	construct_functor0/1,
   30	construct_functor1/1,
   31	construct_functor2/2,
   32	construct_functor3/1
   33]).   34
   35% direct meta call
   36% simple0(0)
   37simple0(Z) :-
   38	call(Z).
   39
   40% nested meta call
   41% simple1(0)
   42simple1(Z) :-
   43	call(call(Z)).
   44
   45% meta call in disjunction
   46% simple2(0, *)
   47simple2(C1, C2) :-
   48	(	C1 = C2
   49	;	call(C1)
   50	).
   51
   52% variable unification
   53% unify0(0)
   54unify0(Y) :-
   55	Y = Z,
   56	call(Z).
   57
   58% term unification
   59% unify1(0)
   60unify1(X) :-
   61	term(X, _Y) = term(Z, funny),
   62	call(Z).
   63
   64% unification chain
   65% unify2(0)
   66unify2(X) :-
   67	X = Y,
   68	Y = Z,
   69	call(Z).
   70
   71% unification chain, other order
   72% unify3(0)
   73unify3(X) :-
   74	Y = Z,
   75	X = Y,
   76	call(Z).
   77
   78% multiple unification in term
   79% unify4(0, 0)
   80unify4(X, Y) :-
   81	term(X, X) = term(Y, Z),
   82	call(Z).
   83
   84% unification chain via term
   85% unify5(0)
   86unify5(X) :-
   87	Y = term(X),
   88	Y = term(Z),
   89	call(Z).
   90
   91% unification after meta call not relevant
   92% unify6(0, *)
   93unify6(Z, Y) :-
   94	call(Z),
   95	Z = Y.
   96
   97% term construction via functor/3
   98% construct_term0(functor(0), arity(0))
   99construct_term0(X, Y) :-
  100	functor(Z, X, Y),
  101	call(Z).
  102
  103% term construction via univ/2
  104% construct_term1(univ_list(0))
  105construct_term1(Y) :-
  106	Z =.. Y,
  107	call(Z).
  108
  109% term construction via univ/2, only functor
  110% construct_term2(functor(0), *)
  111construct_term2(X, Y) :-
  112	Z =.. [X, 1|Y],
  113	call(Z).
  114
  115% construct functor with atom_concat/3, add a prefix
  116% construct_functor0(add_prefix(abc, 0))
  117construct_functor0(Y) :-
  118	atom_concat(abc, Y, Z),
  119	call(Z).
  120
  121% construct functor with atom_concat/3, add a suffix
  122% construct_functor1(add_suffix(abc, 0))
  123construct_functor1(Y) :-
  124	atom_concat(Y, abc, Z),
  125	call(Z).
  126
  127% construct functor with atom_concat/3, add an unknown prefix and an unknown suffix
  128% construct_functor2(is_prefix(0), is_suffix(0))
  129construct_functor2(X, Y) :-
  130	atom_concat(X, Y, Z),
  131	call(Z).
  132
  133% construct functor with atom_concat/3, add a suffix
  134% the constructed functor is used to construct a term using functor/3
  135% construct_functor3(add_suffix(abc, has_arity(1, 0))
  136construct_functor3(X) :-
  137	atom_concat(X, abc, Y),
  138	functor(Z, Y, 1),
  139	call(Z).
  140
  141% the following predicate are not meta predicates
  142% infer_meta/2 fails
  143non_meta0(Z) :-
  144	call(p(Z)).
  145
  146non_meta1(_Z) :-
  147	call(_Y).
  148
  149non_meta2(Z) :-
  150	Z = 4.
  151
  152non_meta3(Z) :-
  153	Y =.. [p, Z],
  154	call(Y).
  155
  156non_meta4(Z) :-
  157	Y = p(Z),
  158	call(Y).
  159
  160non_meta5(Z) :-
  161	functor(Z, X, Y),
  162	assertz(p(Z, X, Y))