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