1/*****************************************************************************
    2 * This file is part of the Prolog Development Tool (PDT)
    3 * 
    4 * WWW: http://sewiki.iai.uni-bonn.de/research/pdt/start
    5 * Mail: pdt@lists.iai.uni-bonn.de
    6 * Copyright (C): 2004-2012, CS Dept. III, University of Bonn
    7 * 
    8 * All rights reserved. This program is  made available under the terms
    9 * of the Eclipse Public License v1.0 which accompanies this distribution,
   10 * and is available at http://www.eclipse.org/legal/epl-v10.html
   11 * 
   12 ****************************************************************************/
   13
   14:- module(contains, [contains/2]).   15
   16:- if(current_prolog_flag(dialect, yap)).   17
   18:- use_module(library(lists), [sublist/2]). 
   19
   20:- else.   21
   22sublist(S, L) :-
   23  append(_, L2, L),
   24  append(S, _, L2).
   25
   26:- endif.   27
   28contains(A, B) :-
   29  atom(A),
   30  atom(B),
   31  name(A, AA),
   32  name(B, BB),
   33  contains(AA, BB).
   34
   35contains(A, B) :-
   36  atom(B),
   37  name(B, BB),
   38  contains(A, BB).
   39  
   40contains(A, B) :-
   41  atom(A),
   42  name(A, AA),
   43  contains(AA, B).
   44
   45contains(A, B) :-
   46  sublist(B, A),
   47  B \= []