1 /* Part of SWI-Prolog 2 3 Author: Jan Wielemaker 4 E-mail: J.Wielemaker@vu.nl 5 WWW: http://www.swi-prolog.org 6 Copyright (c) 2004-2018, University of Amsterdam 7 All rights reserved. 8 9 Redistribution and use in source and binary forms, with or without 10 modification, are permitted provided that the following conditions 11 are met: 12 13 1. Redistributions of source code must retain the above copyright 14 notice, this list of conditions and the following disclaimer. 15 16 2. Redistributions in binary form must reproduce the above copyright 17 notice, this list of conditions and the following disclaimer in 18 the documentation and/or other materials provided with the 19 distribution. 20 21 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 24 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 25 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 26 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 27 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 28 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 29 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 30 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 31 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 32 POSSIBILITY OF SUCH DAMAGE. 33 */ 34 35 /*#define O_DEBUG 1*/ 36 #include "pl-incl.h" 37 38 #undef LD 39 #define LD LOCAL_LD 40 41 42 /** '$btree_find_node'(+Key, +Tree, +Pos, -Node, -Arg) 43 44 Assuming Tree is a term x(...) with Value, Left and Right defined by 45 Pos, find a (sub) node for operating on Value. If a node with Key == 46 Value is found Arg is unified with =. If such a node is not found Arg 47 is < if the tree must get a new left-node and > if it must get a new 48 right-node. 49 50 @arg Pos is 256*256*KeyPos + 256*LeftPos + RightPos 51 */ 52 53 54 static 55 PRED_IMPL("$btree_find_node", 5, btree_find_node, 0) 56 { PRED_LD 57 Word t, k; 58 Functor f; 59 functor_t fd; 60 size_t arity; 61 unsigned int p, kp, lp, rp; 62 63 if ( !PL_cvt_i_uint(A3, &p) ) 64 return FALSE; 65 rp = (p & 0xff)-1; 66 lp = ((p>>8) & 0xff)-1; 67 kp = ((p>>16) & 0xff)-1; 68 69 k = valTermRef(A1); 70 t = valTermRef(A2); 71 72 deRef(k); 73 deRef(t); 74 75 if ( !isTerm(*t) ) 76 return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_btree, A2); 77 f = valueTerm(*t); 78 fd = f->definition; 79 arity = arityFunctor(fd); 80 if ( arity < kp || arity < lp || arity < rp ) 81 return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_btree, A2); 82 83 for(;;) 84 { Word a = &f->arguments[kp]; 85 Word n; 86 int d = compareStandard(k, a, FALSE PASS_LD); 87 int arg; 88 89 if ( d == CMP_ERROR ) 90 return FALSE; 91 if ( d == CMP_EQUAL ) 92 { if ( unify_ptrs(t, valTermRef(A4), ALLOW_GC|ALLOW_SHIFT PASS_LD) && 93 PL_unify_atom(A5, ATOM_equals) ) 94 return TRUE; 95 return FALSE; 96 } 97 98 arg = (d == CMP_LESS ? lp : rp); 99 n = &f->arguments[arg]; 100 deRef(n); 101 DEBUG(1, Sdprintf("Taking %s\n", arg == lp ? "left" : "right")); 102 103 if ( !isTerm(*n) ) 104 { nomatch: 105 106 if ( unify_ptrs(t, valTermRef(A4), ALLOW_GC|ALLOW_SHIFT PASS_LD) && 107 PL_unify_atom(A5, arg == lp ? ATOM_smaller : ATOM_larger ) ) 108 return TRUE; 109 return FALSE; 110 } 111 f = valueTerm(*n); 112 if ( f->definition != fd ) 113 goto nomatch; 114 115 t = n; 116 } 117 } 118 119 120 /******************************* 121 * PUBLISH PREDICATES * 122 *******************************/ 123 124 BeginPredDefs(btree) 125 PRED_DEF("$btree_find_node", 5, btree_find_node, 0) 126 EndPredDefs 127