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) 1985-2006, 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 #include "pl-incl.h"
36 #include "os/pl-ctype.h"
37
38 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
39 Strings are supposed to be meant identical iff one of the following is
40 the case:
41
42 - They ARE identical
43 - One character is different (spy == spu)
44 - One character is inserted/deleted/added (debug == deug)
45 - Two adjecent characters are transposed (trace == tarce)
46 - `Sub-words' have been separated wrong (aB == a_b == ab)
47 - Two `Sub-words' have been transposed (exists_file == file_exists)
48 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
49
50 static bool
oneTypo(const char * s1,const char * s2)51 oneTypo(const char *s1, const char *s2)
52 { if (s1[1] == EOS || streq(&s1[1], &s2[1]) )
53 succeed;
54 fail;
55 }
56
57 static bool
twoTransposed(const char * s1,const char * s2)58 twoTransposed(const char *s1, const char *s2)
59 { if (s1[1] != EOS && s1[0] == s2[1] && s1[1] == s2[0] &&
60 (s1[2] == EOS || streq(&s1[2], &s2[2])))
61 succeed;
62 fail;
63 }
64
65 static bool
oneInserted(const char * s1,const char * s2)66 oneInserted(const char *s1, const char *s2)
67 { if (streq(s1, &s2[1]) )
68 succeed;
69 fail;
70 }
71
72 static bool
differentSeparated(const char * s1,const char * s2)73 differentSeparated(const char *s1, const char *s2)
74 { int c1, c2;
75
76 if ( *s1 != *s2 || *s1 == EOS )
77 fail;
78
79 c1 = *++s1, c2 = *++s2;
80 while(c1 && c1 == c2)
81 { if ((c1 = *++s1) == '_')
82 { c1 = *++s1;
83 } else
84 { if (isLower(s1[-1]) && isUpper(c1))
85 c1 = makeLower(c1);
86 }
87 if ((c2 = *++s2) == '_')
88 { c2 = *++s2;
89 } else
90 { if (isLower(s2[-1]) && isUpper(c2))
91 c2 = makeLower(c2);
92 }
93 }
94 if (c1 == EOS && c2 == EOS)
95 succeed;
96 fail;
97 }
98
99 static const char *
subWord(const char * s,char * store)100 subWord(const char *s, char *store)
101 { *store++ = makeLower(*s);
102 s++;
103
104 for(;;)
105 { if (*s == EOS)
106 { *store = EOS;
107 return s;
108 }
109 if (*s == '_')
110 { *store = EOS;
111 return ++s;
112 }
113 if (isLower(s[-1]) && isUpper(s[0]) )
114 { *store = EOS;
115 return s;
116 }
117 *store++ = *s++;
118 }
119 }
120
121 static bool
subwordsTransposed(const char * s1,const char * s2)122 subwordsTransposed(const char *s1, const char *s2)
123 { char sw1a[1024], sw1b[1024];
124 char sw2a[1024], sw2b[1024];
125
126 while(*s1 && *s2)
127 { s1 = subWord(s1, sw1a);
128 s2 = subWord(s2, sw2a);
129 if (!streq(sw1a, sw2a) )
130 { if (*s1 == EOS || *s2 == EOS)
131 fail;
132 s1 = subWord(s1, sw1b);
133 s2 = subWord(s2, sw2b);
134 if (!streq(sw1a, sw2b) || !streq(sw1b, sw2a) )
135 fail;
136 }
137 }
138 if (*s1 == EOS && *s2 == EOS)
139 succeed;
140 fail;
141 }
142
143
144 static atom_t
dwimMatch(const char * str1,const char * str2)145 dwimMatch(const char *str1, const char *str2)
146 { int cl=0, l1, l2;
147 const char *s1 = str1;
148 const char *s2 = str2;
149
150 while(*s1 && *s1 == *s2) /* delete common part */
151 s1++, s2++, cl++;
152 l2 = (int) strlen(s2);
153 l1 = (int) strlen(s1);
154
155 if (abs(l1-l2) > 5) /* speed up a bit */
156 fail;
157
158 if ( l1 == 0 && l2 == 0 ) return ATOM_equal;
159 if ( cl + l1 < 3 || cl + l2 < 3 )
160 fail;
161 if ( l1 == l2 && oneTypo(s1, s2) ) return ATOM_mismatched_char;
162 if ( l1 == l2 && twoTransposed(s1, s2) ) return ATOM_transposed_char;
163 if ( (l2 == l1 + 1 && oneInserted(s1, s2)) ||
164 (l1 == l2 + 1 && oneInserted(s2, s1)) ) return ATOM_inserted_char;
165 if ( differentSeparated(str1, str2) ) return ATOM_separated;
166 if ( subwordsTransposed(str1, str2) ) return ATOM_transposed_word;
167
168 fail;
169 }
170
171
172 /********************************
173 * PROLOG CONNECTION *
174 *********************************/
175
176 word
pl_dwim_match(term_t a1,term_t a2,term_t mm)177 pl_dwim_match(term_t a1, term_t a2, term_t mm)
178 { GET_LD
179 char *s1, *s2;
180 atom_t type;
181
182 if ( PL_get_chars(a1, &s1, CVT_ALL|BUF_STACK) &&
183 PL_get_chars(a2, &s2, CVT_ALL|BUF_STACK) &&
184 (type = dwimMatch(s1, s2)) &&
185 PL_unify_atom(mm, type) )
186 succeed;
187
188 fail;
189 }
190
191 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
192 $dwim_predicate(+Term, -Dwim) successively returns all predicates of the
193 specified module or context module that match in a DWIM sense the
194 predicate head.
195 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
196
197 word
pl_dwim_predicate(term_t pred,term_t dwim,control_t h)198 pl_dwim_predicate(term_t pred, term_t dwim, control_t h)
199 { GET_LD
200 functor_t fdef;
201 Module module = (Module) NULL;
202 Procedure proc;
203 term_t head = PL_new_term_ref();
204 TableEnum e;
205
206 if ( ForeignControl(h) == FRG_CUTTED )
207 { e = ForeignContextPtr(h);
208 freeTableEnum(e);
209 succeed;
210 }
211
212 if ( !PL_strip_module(pred, &module, head) )
213 fail;
214 if ( !PL_get_functor(head, &fdef) )
215 fail; /* silent: leave errors for later */
216
217 if ( ForeignControl(h) == FRG_FIRST_CALL )
218 e = newTableEnum(module->procedures);
219 else
220 e = ForeignContextPtr(h);
221
222 while( advanceTableEnum(e, NULL, (void**)&proc) )
223 { Definition def;
224 char *name;
225
226 def = proc->definition;
227 name = stringAtom(def->functor->name);
228
229 if ( dwimMatch(stringAtom(nameFunctor(fdef)), name) &&
230 isDefinedProcedure(proc) &&
231 (name[0] != '$' || SYSTEM_MODE) )
232 { if ( !PL_unify_functor(dwim, def->functor->functor) )
233 continue;
234
235 ForeignRedoPtr(e);
236 }
237 }
238
239 freeTableEnum(e);
240 fail;
241 }
242