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(call_graph_examples, []).   16
   17:- use_module('../metainference/meta_inference_examples').   18
   19abc_de.
   20abc_de(_).
   21de_abc.
   22de_abc(_).
   23
   24xyz.
   25
   26% direct meta call
   27% simple0(0)
   28simple0 :-
   29	simple0(abc_de).
   30
   31% nested meta call
   32% simple1(0)
   33simple1 :-
   34	simple1(abc_de).
   35
   36% meta call in disjunction
   37% simple2(0, *)
   38simple2 :-
   39	simple2(abc_de, xyz).
   40
   41% variable unification
   42% unify0(0)
   43unify0 :-
   44	unify0(abc_de).
   45
   46% term unification
   47% unify1(0)
   48unify1 :-
   49	unify1(abc_de).
   50
   51% unification chain
   52% unify2(0)
   53unify2 :-
   54	unify2(abc_de).
   55
   56% unification chain, other order
   57% unify3(0)
   58unify3 :-
   59	unify3(abc_de).
   60
   61% multiple unification in term
   62% unify4(0, 0)
   63unify4 :-
   64	unify4(abc_de, de_abc).
   65
   66% unification chain via term
   67% unify5(0)
   68unify5 :-
   69	unify5(abc_de).
   70
   71% unification after meta call not relevant
   72% unify6(0, *)
   73unify6 :-
   74	unify6(abc_de, xyz).
   75
   76% term construction via univ/2
   77% construct_term1(univ_list(0))
   78construct_term1 :-
   79	construct_term1([abc_de]).
   80
   81% construct functor with atom_concat/3, add a prefix
   82% construct_functor0(add_prefix(abc, 0))
   83construct_functor0 :-
   84	construct_functor0('_de').
   85
   86% construct functor with atom_concat/3, add a suffix
   87% construct_functor1(add_suffix(abc, 0))
   88construct_functor1 :-
   89	construct_functor1(de_).
   90
   91
   92% construct functor with atom_concat/3, add a suffix
   93% the constructed functor is used to construct a term using functor/3
   94% construct_functor3(add_suffix(abc, has_arity(1, 0))
   95construct_functor3 :-
   96	construct_functor3(de_)