1 /*
2 * Copyright (c) 2020, Masatake YAMATO
3 * Copyright (c) 2020, Red Hat, Inc.
4 *
5 * This source code is released for free distribution under the terms of the
6 * GNU General Public License version 2 or (at your option) any later version.
7 *
8 * This module contains ctags specific optscript objects
9 */
10
11 #include "general.h" /* must always come first */
12
13 #include "debug.h"
14 #include "entry.h"
15 #include "field_p.h"
16 #include "htable.h" /* For HT_PTR_TO_INT */
17 #include "optscript.h"
18 #include "parse.h"
19 #include "routines.h"
20 #include "script_p.h"
21 #include "xtag_p.h"
22
23 #include <ctype.h>
24 #include <string.h>
25
26 EsObject *OPTSCRIPT_ERR_NOTAGENTRY;
27 EsObject *OPTSCRIPT_ERR_UNKNOWNLANGUAGE;
28
29 int OPT_TYPE_MATCHLOC;
30 static int locEqual (const void *a, const void *b);
31 static void locPrint (const void *a, MIO *out);
32
33 int OPT_TYPE_TAG;
34 static void tagFree (void *a);
35 static int tagEqual (const void *a, const void *b);
36 static void tagPrint (const void *a, MIO *out);
37
vStringCatToupperS(vString * str,const char * s)38 static void vStringCatToupperS (vString *str, const char *s)
39 {
40 for (const char *tmp = s; *tmp != '\0'; tmp++)
41 {
42 int c = toupper (*tmp);
43 vStringPut (str, c);
44 }
45 }
46
optscriptInit(void)47 extern OptVM *optscriptInit (void)
48 {
49 opt_init ();
50 MIO *in = mio_new_fp (stdin, NULL);
51
52 /* stdout is for emitting tags.
53 * The interpreter should not touch it; use only stderr. */
54 MIO *out = mio_new_fp (stderr, NULL);
55 MIO *err = mio_new_fp (stderr, NULL);
56
57 OptVM *optvm = opt_vm_new (in, out, err);
58
59 mio_unref (err);
60 mio_unref (out);
61 mio_unref (in);
62
63 OPTSCRIPT_ERR_NOTAGENTRY = es_error_intern ("notagentry");
64
65 OPT_TYPE_MATCHLOC = es_type_define_pointer ("matchloc",
66 eFreeNoNullCheck,
67 locEqual,
68 locPrint);
69 OPT_TYPE_TAG = es_type_define_pointer ("tagEntryInfo",
70 tagFree,
71 tagEqual,
72 tagPrint);
73 return optvm;
74 }
75
lrop_get_field_value(OptVM * vm,EsObject * name)76 static EsObject* lrop_get_field_value (OptVM *vm, EsObject *name)
77 {
78 EsObject *nobj = opt_vm_ostack_top (vm);
79 if (!es_integer_p (nobj))
80 return OPT_ERR_TYPECHECK;
81
82 int n = es_integer_get (nobj);
83 tagEntryInfo *e = getEntryInCorkQueue (n);
84 if (e == NULL)
85 return OPTSCRIPT_ERR_NOTAGENTRY;;
86
87 void * data = es_symbol_get_data (name);
88 fieldType ftype = HT_PTR_TO_INT (data);
89 EsObject *val = getFieldValue (ftype, e);
90 if (es_error_p (val))
91 return val;
92
93 opt_vm_ostack_pop (vm);
94
95 if (isFieldValueAvailableAlways (ftype))
96 {
97 opt_vm_ostack_push (vm, val);
98 es_object_unref (val);
99 }
100 else if (es_null (val))
101 {
102 opt_vm_ostack_push (vm, es_false);
103 }
104 else
105 {
106 opt_vm_ostack_push (vm, val);
107 opt_vm_ostack_push (vm, es_true);
108 es_object_unref (val);
109 }
110 return es_false;
111 }
112
lrop_set_field_value(OptVM * vm,EsObject * name)113 static EsObject* lrop_set_field_value (OptVM *vm, EsObject *name)
114 {
115 EsObject *indexobj = opt_vm_ostack_peek (vm, 1);
116 if (!es_integer_p (indexobj))
117 return OPT_ERR_TYPECHECK;
118
119 int n = es_integer_get (indexobj);
120 tagEntryInfo *e = getEntryInCorkQueue (n);
121 if (e == NULL)
122 return OPTSCRIPT_ERR_NOTAGENTRY;;
123
124 void * data = es_symbol_get_data (name);
125 fieldType ftype = HT_PTR_TO_INT (data);
126 unsigned int fdata_type = getFieldDataType (ftype);
127
128 EsObject *valobj = opt_vm_ostack_top (vm);
129 int valtype = es_object_get_type (valobj);
130
131 if (hasFieldValueCheckerForSetter (ftype))
132 {
133 EsObject *e = checkFieldValueForSetter (ftype, valobj);
134 if (!es_object_equal (e, es_false))
135 return e;
136 }
137 else
138 {
139 if (! (((fdata_type & FIELDTYPE_STRING) && (valtype == OPT_TYPE_STRING))
140 || ((fdata_type & FIELDTYPE_BOOL) && (valtype == ES_TYPE_BOOLEAN))
141 || ((fdata_type & FIELDTYPE_INTEGER) && (valtype == ES_TYPE_INTEGER))))
142 return OPT_ERR_TYPECHECK;
143 }
144
145 EsObject *r = setFieldValue (ftype, e, valobj);
146 if (es_error_p (r))
147 return r;
148
149 opt_vm_ostack_pop (vm);
150 opt_vm_ostack_pop (vm);
151
152 return es_false;
153 }
154
optscriptInstallFieldGetter(EsObject * dict,fieldType ftype,vString * op_name,vString * op_desc)155 static void optscriptInstallFieldGetter (EsObject *dict, fieldType ftype,
156 vString *op_name, vString *op_desc)
157 {
158 const char *fname = getFieldName (ftype);
159 vStringPut (op_name, ':');
160 vStringCatS (op_name, fname);
161 EsObject *op_sym = es_symbol_intern (vStringValue (op_name));
162 es_symbol_set_data (op_sym, HT_INT_TO_PTR (ftype));
163
164 const char *vtype = getFieldGetterValueType (ftype);
165 unsigned int fdata_type = getFieldDataType (ftype);
166
167 vStringCatS (op_desc, "int :");
168 vStringCatToupperS (op_desc, fname);
169 vStringPut (op_desc, ' ');
170
171 if (vtype)
172 vStringCatS (op_desc, vtype);
173 else
174 {
175 Assert (fdata_type);
176 if (fdata_type & FIELDTYPE_STRING)
177 vStringCatS (op_desc, "string|");
178 if (fdata_type & FIELDTYPE_INTEGER)
179 vStringCatS (op_desc, "int|");
180 if (fdata_type & FIELDTYPE_BOOL)
181 vStringCatS (op_desc, "bool|");
182 vStringChop (op_desc);
183 }
184
185 if (!isFieldValueAvailableAlways (ftype))
186 {
187 vStringPut (op_desc, ' ');
188 vStringCatS (op_desc, "true%");
189 vStringCatS (op_desc, "int :");
190 vStringCatToupperS (op_desc, fname);
191 vStringCatS (op_desc, " false");
192 }
193
194 EsObject *op = opt_operator_new (lrop_get_field_value,
195 vStringValue (op_name),
196 1, vStringValue (op_desc));
197 opt_dict_def (dict, op_sym, op);
198 es_object_unref (op);
199 }
200
optscriptInstallFieldSetter(EsObject * dict,fieldType ftype,vString * op_name,vString * op_desc)201 static void optscriptInstallFieldSetter (EsObject *dict, fieldType ftype,
202 vString *op_name, vString *op_desc)
203 {
204 const char *fname = getFieldName (ftype);
205 vStringCatS (op_name, fname);
206 vStringPut (op_name, ':');
207
208 EsObject *op_sym = es_symbol_intern (vStringValue (op_name));
209 es_symbol_set_data (op_sym, HT_INT_TO_PTR (ftype));
210
211 const char *vtype = getFieldSetterValueType (ftype);
212 unsigned int fdata_type = getFieldDataType (ftype);
213 vStringCatS (op_desc, "int ");
214
215 if (vtype)
216 vStringCatS (op_desc, vtype);
217 else
218 {
219 Assert (fdata_type);
220 if (fdata_type & FIELDTYPE_STRING)
221 vStringCatS (op_desc, "string|");
222 if (fdata_type & FIELDTYPE_INTEGER)
223 vStringCatS (op_desc, "int|");
224 if (fdata_type & FIELDTYPE_BOOL)
225 vStringCatS (op_desc, "bool|");
226 vStringChop (op_desc);
227 }
228
229 vStringPut (op_desc, ' ');
230 vStringCatToupperS (op_desc, fname);
231 vStringCatS (op_desc, ": -");
232
233 EsObject *op = opt_operator_new (lrop_set_field_value,
234 vStringValue (op_name),
235 2, vStringValue (op_desc));
236 opt_dict_def (dict, op_sym, op);
237 es_object_unref (op);
238 }
239
optscriptInstallFieldAccessors(EsObject * dict)240 static void optscriptInstallFieldAccessors (EsObject *dict)
241 {
242 vString *op_name = vStringNew ();
243 vString *op_desc = vStringNew ();
244
245 for (fieldType ftype = 0; ftype <= FIELD_BUILTIN_LAST; ftype++)
246 {
247 if (hasFieldGetter (ftype))
248 {
249 optscriptInstallFieldGetter (dict, ftype, op_name, op_desc);
250 vStringClear (op_name);
251 vStringClear (op_desc);
252 }
253 if (hasFieldSetter (ftype))
254 {
255 optscriptInstallFieldSetter (dict, ftype, op_name, op_desc);
256 vStringClear (op_name);
257 vStringClear (op_desc);
258 }
259 }
260
261 vStringDelete (op_name);
262 vStringDelete (op_desc);
263 }
264
265 /* Define \1, \2,... \9 */
optscriptInstallMatchResultProcs(EsObject * dict,OptOperatorFn fun)266 static void optscriptInstallMatchResultProcs (EsObject *dict,
267 OptOperatorFn fun)
268 {
269 char name [] = { [0] = '\\', [2] = '\0' };
270 char help [] = "- \\_ string|false";
271 char *p = strchr (help, '_');
272 for (int i = 1; i <= 9; i++)
273 {
274 name [1] = '0' + i;
275 *p = name [1];
276 EsObject *op_sym = es_symbol_intern (name);
277 es_symbol_set_data (op_sym, HT_INT_TO_PTR (i));
278 EsObject *op = opt_operator_new (fun, name, 0, help);
279 opt_dict_def (dict, op_sym, op);
280 es_object_unref (op);
281 }
282 }
283
optscriptInstallProcs(EsObject * dict,OptOperatorFn matchResultAccessor)284 extern void optscriptInstallProcs (EsObject *dict,
285 OptOperatorFn matchResultAccessor)
286 {
287 optscriptInstallFieldAccessors (dict);
288 optscriptInstallMatchResultProcs (dict, matchResultAccessor);
289 }
290
291 static EsObject *optscript_CorkIndex_sym = es_nil;
optscriptSetup(OptVM * vm,EsObject * dict,int corkIndex)292 extern void optscriptSetup (OptVM *vm, EsObject *dict, int corkIndex)
293 {
294 if (corkIndex != CORK_NIL)
295 {
296 static EsObject *corkIndex_sym = es_nil;
297 if (es_null (corkIndex_sym))
298 corkIndex_sym = es_symbol_intern (".");
299 EsObject *corkIndex_val = es_integer_new (corkIndex);
300 opt_dict_def (dict, corkIndex_sym, corkIndex_val);
301 es_object_unref (corkIndex_val);
302 optscript_CorkIndex_sym = corkIndex_sym;
303 }
304 }
305
optscriptTeardown(OptVM * vm,EsObject * dict)306 extern void optscriptTeardown (OptVM *vm, EsObject *dict)
307 {
308 if (!es_null (optscript_CorkIndex_sym))
309 {
310 opt_dict_undef (dict, optscript_CorkIndex_sym);
311 optscript_CorkIndex_sym = es_nil;
312 }
313 }
314
optscriptRead(OptVM * vm,const char * src,size_t len)315 extern EsObject *optscriptRead (OptVM *vm, const char *src, size_t len)
316 {
317 if (len == 0)
318 len = strlen (src);
319
320 MIO *mio = mio_new_memory ((unsigned char *)src, len, NULL, NULL);
321 EsObject *obj = opt_vm_read (vm, mio);
322 if (es_error_p (obj))
323 opt_vm_report_error (vm, obj, NULL);
324 mio_unref (mio);
325 return obj;
326 }
327
optscriptEval(OptVM * vm,EsObject * code)328 extern EsObject* optscriptEval (OptVM *vm, EsObject *code)
329 {
330 static EsObject *exec = es_nil;
331
332 if (es_null (exec))
333 {
334 MIO *mio = mio_new_memory ((unsigned char*)"//exec", 6, NULL, NULL);
335 exec = opt_vm_read (vm, mio);
336 if (es_error_p (exec))
337 {
338 opt_vm_report_error (vm, exec, NULL);
339 error (FATAL, "failed in converting //exec to an optscript object");
340 }
341 mio_unref (mio);
342 }
343
344 EsObject *o = opt_vm_eval (vm, code);
345 if (es_error_p (o))
346 {
347 opt_vm_report_error (vm, o, NULL);
348 error (FATAL, "failed to push the proc representing the script");
349 }
350 es_object_unref (o);
351
352 EsObject *r = opt_vm_eval (vm, exec);;
353 if (es_error_p (r))
354 opt_vm_report_error (vm, r, NULL);
355 return r;
356 }
357
optscriptDefine(EsObject * dict,const char * name,EsObject * obj)358 extern EsObject* optscriptDefine (EsObject *dict,
359 const char *name, EsObject *obj)
360 {
361 EsObject *sym = es_symbol_intern (name);
362 opt_dict_def (dict, sym, obj);
363 return sym;
364 }
365
366
optscriptLoad(OptVM * vm,MIO * mio)367 extern EsObject *optscriptLoad (OptVM *vm, MIO *mio)
368 {
369 while (true)
370 {
371 EsObject *o = opt_vm_read (vm, mio);
372 if (es_object_equal (o, ES_READER_EOF))
373 {
374 es_object_unref (o);
375 return es_false;
376 }
377 else if (es_error_p (o))
378 {
379 opt_vm_report_error (vm, o, NULL);
380 return o;
381 }
382
383 EsObject *e = opt_vm_eval (vm, o);
384 if (es_error_p (e))
385 {
386 opt_vm_report_error (vm, e, NULL);
387 es_object_unref (o);
388 return e;
389 }
390
391 es_object_unref (o);
392 }
393 }
394
optscriptReadAndEval(OptVM * vm,const char * src,size_t len)395 extern EsObject *optscriptReadAndEval (OptVM *vm, const char *src, size_t len)
396 {
397 EsObject *obj = optscriptRead (vm, src, len);
398 if (es_error_p (obj))
399 return obj;
400
401 EsObject *r = optscriptEval (vm, obj);
402 es_object_unref (obj);
403 return r;
404 }
405
optscriptReadAndDefine(OptVM * vm,EsObject * dict,const char * name,const char * src,size_t len)406 extern EsObject *optscriptReadAndDefine (OptVM *vm, EsObject *dict, const char *name,
407 const char *src, size_t len)
408 {
409 EsObject *obj = optscriptRead (vm, src, len);
410 if (es_error_p (obj))
411 return obj;
412 return optscriptDefine (dict, name, obj);
413 }
414
procdocs_add_key_val(EsObject * proc,EsObject * help_str,void * data)415 static bool procdocs_add_key_val (EsObject *proc, EsObject *help_str, void *data)
416 {
417 ptrArray *a = data;
418
419 if (es_object_get_type (help_str) == OPT_TYPE_STRING)
420 ptrArrayAdd (a, proc);
421
422 return true;
423 }
424
procdocs_get_help_str(EsObject * proc,void * data)425 static const char* procdocs_get_help_str (EsObject *proc, void *data)
426 {
427 EsObject *dict = data;
428 const char *name = opt_name_get_cstr (proc);
429 EsObject *help_str = NULL;
430
431 if (opt_dict_known_and_get_cstr (dict, name, &help_str))
432 return opt_string_get_cstr(help_str);
433 return NULL;
434 }
435
procdocs_add(ptrArray * a,void * data)436 static void procdocs_add (ptrArray *a, void *data)
437 {
438 EsObject *dict = data;
439 opt_dict_foreach (dict, procdocs_add_key_val, a);
440 }
441
442 static struct OptHelpExtender procdocs_help_extender = {
443 .add = procdocs_add,
444 .get_help_str = procdocs_get_help_str,
445 };
446
optscriptHelp(OptVM * vm,FILE * fp,EsObject * procdocs)447 extern void optscriptHelp (OptVM *vm, FILE *fp, EsObject *procdocs)
448 {
449 MIO *out = mio_new_fp (fp, NULL);
450 opt_vm_help (vm, out, procdocs? &procdocs_help_extender: NULL, procdocs);
451 mio_unref (out);
452 }
453
locEqual(const void * a,const void * b)454 static int locEqual (const void *a, const void *b)
455 {
456 if (a == b)
457 return 1;
458
459 const matchLoc *al = a;
460 const matchLoc *bl = b;
461
462 if (al->line == bl->line
463 && memcmp (&al->pos, &bl->pos, sizeof (al->pos)) == 0)
464 return 1;
465 return 0;
466 }
467
locPrint(const void * a,MIO * out)468 static void locPrint (const void *a, MIO *out)
469 {
470 const matchLoc *al = a;
471 mio_printf (out, "#<matchloc %p line: %lu>", a, al->line);
472 }
473
tagFree(void * a)474 static void tagFree (void *a)
475 {
476 tagEntryInfo *e = a;
477 eFree ((void *)e->name); /* TODO */
478 eFree (e);
479 }
480
tagEqual(const void * a,const void * b)481 static int tagEqual (const void *a, const void *b)
482 {
483 if (a == b)
484 return 1;
485 return 0;
486 }
487
tagPrint(const void * a,MIO * out)488 static void tagPrint (const void *a, MIO *out)
489 {
490 const tagEntryInfo *tag = a;
491 mio_printf (out, "#<tagEntryInfo %p name: %s line: %lu>",
492 tag, tag->name, tag->lineNumber);
493 }
494
optscriptRegisterOperators(EsObject * dict,struct optscriptOperatorRegistration regs[],size_t count)495 extern void optscriptRegisterOperators(EsObject * dict,
496 struct optscriptOperatorRegistration regs[], size_t count)
497 {
498 EsObject *op;
499 EsObject *sym;
500
501 for (size_t i = 0; i < count; i++)
502 {
503 sym = es_symbol_intern (regs[i].name);
504 op = opt_operator_new (regs[i].fn, es_symbol_get (sym), regs[i].arity,
505 regs[i].help_str);
506 opt_dict_def (dict, sym, op);
507 es_object_unref (op);
508 }
509 }
510
optscriptGetXtagType(const EsObject * extra)511 extern xtagType optscriptGetXtagType (const EsObject *extra)
512 {
513 EsObject *extra_sym = es_pointer_get (extra);
514 const char *extra_str = es_symbol_get (extra_sym);
515
516 const char *sep = strchr (extra_str, '.');
517 if (sep)
518 {
519 langType lang = getNamedLanguage (extra_str, sep - extra_str);
520 if (lang == LANG_IGNORE)
521 return XTAG_UNKNOWN;
522
523 return getXtagTypeForNameAndLanguage (sep + 1, lang);
524 }
525 else
526 return getXtagTypeForNameAndLanguage (extra_str, LANG_IGNORE);
527 }
528