1 /* Part of XPCE --- The SWI-Prolog GUI toolkit
2
3 Author: Jan Wielemaker and Anjo Anjewierden
4 E-mail: jan@swi.psy.uva.nl
5 WWW: http://www.swi.psy.uva.nl/projects/xpce/
6 Copyright (c) 1985-2002, 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 INLINE_UTILITIES 1
36 #include <h/kernel.h>
37 #include <h/trace.h>
38 #include <h/interface.h>
39 #include <itf/c.h>
40 #include <h/unix.h>
41 #include <h/text.h>
42
43 static status typesMethod(Method m, Vector types);
44 static Name getContextNameMethod(Method m);
45 static Name getAccessArrowMethod(Method m);
46
47 status
createMethod(Method m,Name name,Vector types,StringObj doc,Func action)48 createMethod(Method m, Name name, Vector types, StringObj doc, Func action)
49 { m->name = name;
50 m->group = NIL;
51 m->message = NIL;
52 m->types = NIL;
53 m->function = action;
54 m->summary = NIL;
55 m->context = NIL;
56 #ifndef O_RUNTIME
57 m->source = NIL;
58 #endif
59 m->dflags = (uintptr_t) ZERO;
60
61 initialiseMethod(m, name, types, NIL, doc, NIL, DEFAULT);
62 createdObject(m, NAME_new);
63
64 succeed;
65 }
66
67
68 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
69 Create a new method object.
70 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
71
72 status
initialiseMethod(Method m,Name name,Vector types,Code msg,StringObj doc,SourceLocation loc,Name group)73 initialiseMethod(Method m, Name name, Vector types, Code msg, StringObj doc, SourceLocation loc, Name group)
74 { initialiseBehaviour((Behaviour) m, name, NIL);
75
76 if ( isDefault(loc) )
77 loc = NIL;
78
79 assign(m, group, group);
80 assign(m, message, msg);
81 assign(m, summary, doc);
82 #ifndef O_RUNTIME
83 assign(m, source, loc);
84 #endif
85
86 if ( notNil(msg) && instanceOfObject(msg, ClassCPointer) )
87 setDFlag(m, D_HOSTMETHOD);
88
89 return typesMethod(m, types);
90 }
91
92
93 static Method
getInstantiateTemplateMethod(Method m)94 getInstantiateTemplateMethod(Method m)
95 { Method m2 = getCloneObject(m);
96
97 if ( m2 )
98 { setFlag(m2, F_TEMPLATE_METHOD);
99 assign(m2, context, NIL);
100 }
101
102 answer(m2);
103 }
104
105
106 static status
typesMethod(Method m,Vector types)107 typesMethod(Method m, Vector types)
108 { int n;
109 Type type;
110
111 if ( isDefault(types) )
112 { assign(m, types, newObject(ClassVector, EAV));
113 succeed;
114 }
115
116 for(n = 1; n <= valInt(types->size); n++)
117 { Any elm = getElementVector(types, toInt(n));
118
119 if ( !(type = toType(elm)) )
120 return errorPce(types, NAME_elementType, toInt(n), TypeType);
121
122 if ( type != elm )
123 elementVector(types, toInt(n), type);
124 }
125
126 assign(m, types, types);
127 succeed;
128 }
129
130
131 static Int
getArgumentCountMethod(Method m)132 getArgumentCountMethod(Method m)
133 { Type type;
134
135 if ( (type = getTailVector(m->types)) && type->vector == ON )
136 answer(sub(m->types->size, ONE));
137 else
138 answer(m->types->size);
139 }
140
141
142 Type
getArgumentTypeMethod(Method m,Int n)143 getArgumentTypeMethod(Method m, Int n)
144 { Type type;
145
146 if ( (type = getElementVector(m->types, n)) )
147 answer(type);
148
149 if ( (type = getTailVector(m->types)) && type->vector == ON )
150 answer(type);
151
152 fail;
153 }
154
155
156
157 /********************************
158 * TRACING *
159 ********************************/
160
161
162 static status
equalTypeVector(Vector v1,Vector v2)163 equalTypeVector(Vector v1, Vector v2)
164 { if ( classOfObject(v1) == classOfObject(v2) &&
165 v1->size == v2->size &&
166 v1->offset == v2->offset )
167 { Any *e1 = v1->elements;
168 Any *e2 = v2->elements;
169 int n = valInt(v1->size);
170
171 for(; --n >= 0; e1++, e2++)
172 { if ( !equalType(*e1, *e2) )
173 fail;
174 }
175
176 succeed;
177 }
178
179 fail;
180 }
181
182
183 Method
getInheritedFromMethod(Method m)184 getInheritedFromMethod(Method m)
185 { Class class = m->context;
186 int sm = instanceOfObject(m, ClassSendMethod);
187
188 for(class = class->super_class; notNil(class); class = class->super_class)
189 { Chain ch = (sm ? class->send_methods : class->get_methods);
190 Cell cell;
191
192 for_cell(cell, ch)
193 { Method m2 = cell->value;
194
195 if ( m2->name == m->name )
196 { if ( !equalTypeVector(m->types, m2->types) )
197 fail;
198
199 if ( !sm )
200 { GetMethod gm1 = (GetMethod)m;
201 GetMethod gm2 = (GetMethod)m2;
202
203 if ( !equalType(gm1->return_type, gm2->return_type) )
204 fail;
205 }
206
207 answer(m2);
208 }
209 }
210 }
211
212 fail;
213 }
214
215
216
217 static Name
getGroupMethod(Method m)218 getGroupMethod(Method m)
219 { if ( isDefault(m->group) )
220 { Class class = m->context;
221 int sm = instanceOfObject(m, ClassSendMethod);
222
223 while( instanceOfObject(class, ClassClass) )
224 { Vector v = class->instance_variables;
225 int n;
226
227 for(n=0; n<valInt(v->size); n++)
228 { Variable var = v->elements[n];
229
230 if ( var->name == m->name && notDefault(var->group) )
231 answer(var->group);
232 }
233
234 if ( notNil(class = class->super_class) )
235 { Chain ch = (sm ? class->send_methods : class->get_methods);
236 Cell cell;
237
238 for_cell(cell, ch)
239 { Method m2 = cell->value;
240
241 if ( m2->name == m->name && notDefault(m2->group) )
242 answer(m2->group);
243 }
244 }
245 }
246
247 fail;
248 }
249
250 answer(m->group);
251 }
252
253 /********************************
254 * MANUAL SUPPORT *
255 ********************************/
256
257 static Name
getContextNameMethod(Method m)258 getContextNameMethod(Method m)
259 { if ( instanceOfObject(m->context, ClassClass) )
260 { Class class = m->context;
261
262 answer(class->name);
263 }
264
265 answer(CtoName("SELF"));
266 }
267
268
269 static Name
getAccessArrowMethod(Method m)270 getAccessArrowMethod(Method m)
271 { if ( instanceOfObject(m, ClassSendMethod) )
272 answer(CtoName("->"));
273 else
274 answer(CtoName("<-"));
275 }
276
277
278 static StringObj
getSummaryMethod(Method m)279 getSummaryMethod(Method m)
280 { if ( isNil(m->summary) )
281 fail;
282 if ( notDefault(m->summary) )
283 answer(m->summary);
284 else
285 { Class class = m->context;
286
287 if ( instanceOfObject(class, ClassClass) )
288 { Variable var;
289
290 if ( (var = getInstanceVariableClass(class, m->name)) &&
291 instanceOfObject(var->summary, ClassCharArray) )
292 answer(var->summary);
293 while( (m = getInheritedFromMethod(m)) )
294 if ( instanceOfObject(m->summary, ClassCharArray) )
295 answer(m->summary);
296 }
297 }
298
299 fail;
300 }
301
302
303 #ifndef O_RUNTIME
304 static Name
getManIdMethod(Method m)305 getManIdMethod(Method m)
306 { wchar_t buf[LINESIZE];
307 wchar_t *nm, *o;
308 Name ctx = getContextNameMethod(m);
309 size_t len;
310 Name rc;
311
312 len = 6 + ctx->data.s_size + m->name->data.s_size;
313 if ( len < LINESIZE )
314 nm = buf;
315 else
316 nm = pceMalloc(sizeof(wchar_t)*len);
317
318 o = nm;
319 *o++ = 'M';
320 *o++ = '.';
321 wcscpy(o, nameToWC(ctx, &len));
322 o += len;
323 *o++ = '.';
324 *o++ = instanceOfObject(m, ClassSendMethod) ? 'S' : 'G';
325 *o++ = '.';
326 wcscpy(o, nameToWC(m->name, &len));
327 o += len;
328
329 rc = WCToName(nm, o-nm);
330 if ( nm != buf )
331 pceFree(nm);
332
333 answer(rc);
334 }
335
336
337 static Name
getManIndicatorMethod(Method m)338 getManIndicatorMethod(Method m)
339 { answer(CtoName("M"));
340 }
341
342
343 static StringObj
getManSummaryMethod(Method m)344 getManSummaryMethod(Method m)
345 { TextBuffer tb;
346 StringObj str;
347 Vector types = m->types;
348 StringObj s;
349
350 tb = newObject(ClassTextBuffer, EAV);
351 tb->undo_buffer_size = ZERO;
352 CAppendTextBuffer(tb, "M\t");
353
354 appendTextBuffer(tb, (CharArray)getContextNameMethod(m), ONE);
355 CAppendTextBuffer(tb, " ");
356
357 appendTextBuffer(tb, (CharArray)getAccessArrowMethod(m), ONE);
358 appendTextBuffer(tb, (CharArray)m->name, ONE);
359
360 if ( types->size != ZERO )
361 { int i;
362
363 CAppendTextBuffer(tb, ": ");
364 for(i = 1; i <= valInt(types->size); i++)
365 { Type t = getElementVector(types, toInt(i));
366
367 if ( i != 1 )
368 CAppendTextBuffer(tb, ", ");
369
370 appendTextBuffer(tb, (CharArray)t->fullname, ONE);
371 }
372 }
373
374 if ( instanceOfObject(m, ClassGetMethod) )
375 { GetMethod gm = (GetMethod) m;
376
377 CAppendTextBuffer(tb, " -->");
378 appendTextBuffer(tb, (CharArray)gm->return_type->fullname, ONE);
379 }
380
381 if ( (s = getSummaryMethod(m)) )
382 { CAppendTextBuffer(tb, "\t");
383 appendTextBuffer(tb, (CharArray)s, ONE);
384 }
385 if ( send(m, NAME_hasHelp, EAV) )
386 CAppendTextBuffer(tb, " (+)");
387
388 str = getContentsTextBuffer(tb, ZERO, DEFAULT);
389 doneObject(tb);
390
391 answer(str);
392 }
393
394 #else
395
396 static status
rtSourceMethod(Method m,SourceLocation src)397 rtSourceMethod(Method m, SourceLocation src)
398 { succeed;
399 }
400
401 #endif /*O_RUNTIME*/
402
403
404 Method
getMethodFromFunction(Any f)405 getMethodFromFunction(Any f)
406 { for_hash_table(classTable, s,
407 { Class class = s->value;
408
409 if ( class->realised == ON )
410 { Cell cell;
411
412 for_cell(cell, class->send_methods)
413 { Method m = cell->value;
414 if ( (Any) m->function == f )
415 answer(m);
416 }
417 for_cell(cell, class->get_methods)
418 { Method m = cell->value;
419 if ( (Any) m->function == f )
420 answer(m);
421 }
422 }
423 });
424
425 answer(NIL);
426 }
427
428
429 static Name
getPrintNameMethod(Method m)430 getPrintNameMethod(Method m)
431 { char buf[LINESIZE];
432
433 sprintf(buf, "%s %s%s",
434 strName(getContextNameMethod(m)),
435 strName(getAccessArrowMethod(m)),
436 strName(m->name));
437
438 answer(CtoName(buf));
439 }
440
441 /*******************************
442 * CLASS DECLARATION *
443 *******************************/
444
445 /* Type declaractions */
446
447 static char *T_initialise[] =
448 { "name=name", "types=[vector]",
449 "implementation=code|c_pointer", "summary=[string]*",
450 "source=[source_location]*", "group=[name]*" };
451
452 /* Instance Variables */
453
454 static vardecl var_method[] =
455 { IV(NAME_group, "[name]", IV_NONE,
456 NAME_manual, "Conceptual group of method"),
457 IV(NAME_types, "vector", IV_GET,
458 NAME_type, "Argument type specification"),
459 IV(NAME_summary, "[string]*", IV_NONE,
460 NAME_manual, "Summary documentation"),
461 #ifndef O_RUNTIME
462 IV(NAME_source, "source_location*", IV_BOTH,
463 NAME_manual, "Location of definition in the sources"),
464 #endif
465 IV(NAME_message, "code|c_pointer*", IV_BOTH,
466 NAME_implementation, "If implemented in PCE: the code object"),
467 IV(NAME_function, "alien:Func", IV_NONE,
468 NAME_implementation, "If implemented in C: function pointer")
469 };
470
471 /* Send Methods */
472
473 static senddecl send_method[] =
474 { SM(NAME_initialise, 6, T_initialise, initialiseMethod,
475 DEFAULT, "Create from name, types, code and doc"),
476 #ifdef O_RUNTIME
477 SM(NAME_source, 1, "source_location*", rtSourceMethod,
478 NAME_runtime, "Dummy method"),
479 #endif /*O_RUNTIME*/
480 SM(NAME_types, 1, "[vector]", typesMethod,
481 NAME_type, "Set type-check")
482 };
483
484 /* Get Methods */
485
486 static getdecl get_method[] =
487 { GM(NAME_summary, 0, "string", NULL, getSummaryMethod,
488 DEFAULT, "<-summary or try to infer summary"),
489 GM(NAME_accessArrow, 0, "{<-,->}", NULL, getAccessArrowMethod,
490 NAME_manual, "Arrow indicating send- or get-access"),
491 GM(NAME_group, 0, "name", NULL, getGroupMethod,
492 NAME_manual, "(Possible inherited) group-name"),
493 #ifndef O_RUNTIME
494 GM(NAME_manId, 0, "name", NULL, getManIdMethod,
495 NAME_manual, "Card Id for method"),
496 GM(NAME_manIndicator, 0, "name", NULL, getManIndicatorMethod,
497 NAME_manual, "Manual type indicator (`M')"),
498 GM(NAME_manSummary, 0, "string", NULL, getManSummaryMethod,
499 NAME_manual, "New string with documentation summary"),
500 #endif /*O_RUNTIME*/
501 GM(NAME_argumentCount, 0, "int", NULL, getArgumentCountMethod,
502 NAME_meta, "Minimum number of arguments required"),
503 GM(NAME_argumentType, 1, "type", "int", getArgumentTypeMethod,
504 NAME_meta, "Get type for nth-1 argument"),
505 GM(NAME_inheritedFrom, 0, "method", NULL, getInheritedFromMethod,
506 NAME_meta, "Method I'm a refinement of"),
507 GM(NAME_instantiateTemplate, 0, "method", NULL, getInstantiateTemplateMethod,
508 NAME_template, "Instantiate a method for use_class_template/1"),
509 GM(NAME_printName, 0, "name", NULL, getPrintNameMethod,
510 NAME_textual, "Class <->Selector")
511 };
512
513 /* Resources */
514
515 #define rc_method NULL
516 /*
517 static classvardecl rc_method[] =
518 {
519 };
520 */
521
522 /* Class Declaration */
523
524 static Name method_termnames[] = { NAME_name, NAME_types, NAME_message, NAME_summary, NAME_source };
525
526 ClassDecl(method_decls,
527 var_method, send_method, get_method, rc_method,
528 5, method_termnames,
529 "$Rev$");
530
531
532 status
makeClassMethod(Class class)533 makeClassMethod(Class class)
534 { declareClass(class, &method_decls);
535
536 cloneStyleVariableClass(class, NAME_types, NAME_reference);
537 cloneStyleVariableClass(class, NAME_summary, NAME_reference);
538 cloneStyleVariableClass(class, NAME_source, NAME_reference);
539 cloneStyleVariableClass(class, NAME_message, NAME_reference);
540
541 succeed;
542 }
543
544