1% BEGIN LICENSE BLOCK
2% Version: CMPL 1.1
3%
4% The contents of this file are subject to the Cisco-style Mozilla Public
5% License Version 1.1 (the "License"); you may not use this file except
6% in compliance with the License.  You may obtain a copy of the License
7% at www.eclipse-clp.org/license.
8%
9% Software distributed under the License is distributed on an "AS IS"
10% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied.  See
11% the License for the specific language governing rights and limitations
12% under the License.
13%
14% The Original Code is  The ECLiPSe Constraint Logic Programming System.
15% The Initial Developer of the Original Code is  Cisco Systems, Inc.
16% Portions created by the Initial Developer are
17% Copyright (C) 1998 - 2006 Cisco Systems, Inc.  All Rights Reserved.
18%
19% Contributor(s): Vassilis Liatsos, IC-Parc
20%
21% END LICENSE BLOCK
22% ----------------------------------------------------------------------
23% System:	ECLiPSe Constraint Logic Programming System
24% Version:	$Id: not_equals.pl,v 1.1 2006/09/23 01:53:51 snovello Exp $
25%
26% Emacs:    --*-prolog-*--
27% not_equals.pl -
28%
29% Author:   vassilis liatsos
30%
31% Purpose:  asking whether two variables can
32%           unify or not, taking disequality
33%           constraints into account
34%
35% Usage:
36%     ne/2   asserts a disequality constraint
37%     neqt/2  tests whether variables are not equal
38%
39% This succeeds with the following queries:
40%
41% ne(X,Y),not_unify(X,Y).
42% ne(X,a),not_unify(X,a).
43% ne(a,b).
44%
45% and fails with:
46%
47% ne(X,X).
48% ne(a,a).
49% ne(X,Y),X=Y.
50% ne(X,a),X=a.
51%
52% Date: February 98
53% ----------------------------------------------------------------------
54
55:- pragma(expand).
56
57:- module(not_equals).
58
59
60:- export
61        ne/2,
62        neqt/2.
63
64:- begin_module(not_equals).
65:- lib(structures).
66
67:- import
68        add_attribute/3,
69        setarg/3
70    from sepia_kernel.
71
72:- meta_attribute(not_equals,[
73                    unify:unify_ne/2,
74		    test_unify: test_unify_ne/2,
75		    print:print_ne/2]).
76
77:- define_struct(not_equals(ne)).
78
79ne(X,Y):-
80	nonvar(X),
81	nonvar(Y),!,
82	X\=Y.
83
84ne(X,Y):-
85	(X==Y ->
86	    fail
87        ;
88	    (var(X) ->
89		get_ne_attr(X,AX),
90		AX = not_equals with ne:NeX,
91		sort([Y|NeX],NewX),
92		setarg(ne of not_equals,AX,NewX)
93	    ;
94	        true
95	    ),
96
97	    (var(Y) ->
98		get_ne_attr(Y,AY),
99		AY = not_equals with ne:NeY,
100		sort([X|NeY],NewY),
101		setarg(ne of not_equals,AY,NewY)
102	    ;
103	        true
104	    )
105	).
106
107% neqt(+X,+Y)
108% if X\=Y can be deduced then succeed
109% otherwise fail
110
111neqt(X,Y):-
112	not_unify(X,Y).
113
114/*****************************
115      UTILITY PREDICATES
116******************************/
117
118get_ne_attr(X{A},Attr):-
119	-?->
120	get_ne_attr1(X,Attr,A).
121get_ne_attr(X,Attr):-
122	free(X),
123	new_ne_attr(X,Attr).
124
125get_ne_attr1(X,Attr,A):-
126	var(A),new_ne_attr(X,Attr).
127get_ne_attr1(_,Attr,A):-
128	nonvar(A),Attr = A.
129
130new_ne_attr(X,Attr):-
131	Attr = not_equals with ne:[],
132	add_attribute(X,Attr).
133
134mem_check(X,[Y|_]):- X==Y,!.
135mem_check(X,[_|R]):- mem_check(X,R).
136
137/*****************************
138          HANDLERS
139******************************/
140
141% unify_ne(+Term, Attribute)
142unify_ne(_, Attr):-
143        /*** ANY + VAR ***/
144        var(Attr).             % Ignore if no attributes for this extension
145unify_ne(Term, Attr):-
146        compound(Attr),
147        unify_term_ne(Term, Attr).
148
149unify_term_ne(Value, Attr):-
150        nonvar(Value),         % The metaterm was instantiated
151	Attr = not_equals with ne: List,
152        /*** NONVAR + META ***/
153        not mem_check(Value,List).
154unify_term_ne(Y{AttrY},AttrX):-
155        -?->
156        unify_ne_ne(Y,AttrX,AttrY).
157
158unify_ne_ne(_, AttrX, AttrY):-
159        var(AttrY),            % no attribute for this extension
160        /*** VAR + META ***/
161        AttrX = AttrY.
162unify_ne_ne(Y, AttrX, AttrY):-
163        nonvar(AttrY),
164        /*** META + META ***/
165        AttrX = not_equals with ne:NeX,
166	AttrY = not_equals with ne:NeY,
167	not mem_check(Y,NeX),
168	append(NeX,NeY,NeXY),
169	sort(NeXY,New),
170	setarg(ne of not_equals,AttrY,New).
171
172% test_unify_ne(+Term, Attribute)
173test_unify_ne(_, Attr):-
174        /*** ANY + VAR ***/
175        var(Attr).             % Ignore if no attributes for this extension
176test_unify_ne(Term, Attr):-
177        compound(Attr),
178        test_unify_term_ne(Term, Attr).
179
180test_unify_term_ne(Value, Attr):-
181        nonvar(Value),         % The metaterm was instantiated
182	Attr = not_equals with ne:List,
183        /*** NONVAR + META ***/
184        not mem_check(Value,List).
185test_unify_term_ne(Y{AttrY},AttrX):-
186        -?->
187        test_unify_ne_ne(Y,AttrX,AttrY).
188
189test_unify_ne_ne(_, _, AttrY):-
190        /*** VAR + META ***/
191        var(AttrY).            % no attribute for this extension
192
193test_unify_ne_ne(Y, AttrX, AttrY):-
194        nonvar(AttrY),
195        /*** META + META ***/
196        AttrX = not_equals with ne:NeX,
197	not mem_check(Y,NeX).
198
199print_ne(not_equals(NE),Print):-
200        -?->
201        Print = ( ne: NE).
202