Optscript: add _foreignreftag operator

Units/optscript.r/with-foreignLanguage-flag.d/args.ctags

@@ -0,0 +1,32 @@
+--sort=no
+--extras=+r
+--fields=+rl
+
+--langdef=XXX{_foreignLanguage=C}
+--map-XXX=.xxx
+--kinddef-XXX=a,abc,abcx
+--_roledef-XXX.a=assigned,assigned
+
+--regex-XXX=/^(a)$/\1/a/
+
+--regex-XXX=/^(b)$//{{
+    \1 /abc _tag _commit pop
+}}
+--regex-XXX=/^(c)$/\1/a/{_role=assigned}
+--regex-XXX=/^(d)$//{{
+    \1 /abc /assigned _reftag _commit pop
+}}
+
+--_roledef-C.f=arolefortesting,a role for testing
+--regex-XXX=/\/\*(A)\(\)\*\//\1/f/{_language=C}
+--regex-XXX=/\/\*(B)\(\)\*\///{{
+    \1 /C /function _foreigntag _commit pop
+}}
+
+--regex-XXX=/\/\*(C)\(\)\*\//\1/f/{_language=C}{_role=arolefortesting}
+--regex-XXX=/\/\*(D)\(\)\*\//\1/f/{_role=arolefortesting}{_language=C}
+--regex-XXX=/\/\*(E)\(\)\*\///{{
+    \1 /C /function /arolefortesting _foreignreftag _commit pop
+}}
+
+--regex-C=/FUNC\(([a-z]*)\);/\1/f/

Units/optscript.r/with-foreignLanguage-flag.d/expected.tags

@@ -0,0 +1,10 @@
+a	input.xxx	/^a$/;"	a	language:XXX	roles:def
+b	input.xxx	/^b$/;"	a	language:XXX	roles:def
+c	input.xxx	/^c$/;"	a	language:XXX	roles:assigned
+d	input.xxx	/^d$/;"	a	language:XXX	roles:assigned
+A	input.xxx	/^\/*A()*\/$/;"	f	language:C	roles:def
+B	input.xxx	/^\/*B()*\/$/;"	f	language:C	roles:def
+C	input.xxx	/^\/*C()*\/$/;"	f	language:C	roles:arolefortesting
+D	input.xxx	/^\/*D()*\/$/;"	f	language:C	roles:arolefortesting
+E	input.xxx	/^\/*E()*\/$/;"	f	language:C	roles:arolefortesting
+myfunc	input-0.c	/^FUNC(myfunc);$/;"	f	language:C	roles:def

Units/optscript.r/with-foreignLanguage-flag.d/input-0.c

@@ -0,0 +1 @@
+FUNC(myfunc);

Units/optscript.r/with-foreignLanguage-flag.d/input.xxx

@@ -0,0 +1,9 @@
+a
+b
+c
+d
+/*A()*/
+/*B()*/
+/*C()*/
+/*D()*/
+/*E()*/

main/CommonPrelude.c

@@ -198,4 +198,40 @@ const char ctagsCommonPrelude []=
 "    exch\n"
 "    [ exch /end /_matchloc cvx ] cvx __bddef\n"
 "} for\n"
+"\n"
+"(name:str kind:name matchloc _TAG tag\n"
+" name:str kind:name _TAG tag)\n"
+"/_tag {\n"
+"    dup type /nametype eq {\n"
+"        % name:str kind:name\n"
+"        null exch null\n"
+"        % name:str null kind:name null\n"
+"    } {\n"
+"        % name:str kind:name matchloc\n"
+"        null 3 1 roll null exch\n"
+"        % name:str null kind:name matchloc null\n"
+"    } ifelse\n"
+"    _foreignreftag\n"
+"} __bddef\n"
+"\n"
+"(name:str kind:name role:name matchloc _REFTAG tag\n"
+" name:str kind:name role:name _REFTAG tag)\n"
+"/_reftag {\n"
+"    dup type /nametype eq {\n"
+"        % name:str kind:name role:name\n"
+"        null 3 1 roll\n"
+"        % name:str null kind:name role:name\n"
+"    } {\n"
+"        % name:str kind:name role:name matchloc\n"
+"        null 4 1 roll\n"
+"        % name:str null kind:name role:name matchloc\n"
+"    } ifelse\n"
+"    _foreignreftag\n"
+"} __bddef\n"
+"\n"
+"(name:str language:name kind:name matchloc _FOREIGNTAG tag\n"
+" name:str lang:name kind:name _FOREIGNTAG tag)\n"
+"/_foreigntag {\n"
+"    null _foreignreftag\n"
+"} __bddef\n"
 ;

main/lregex.c

@@ -1119,11 +1119,17 @@ static void common_flag_role_long (const char* const s, const char* const v, voi
 		return;
 	}
 
-	role = getLanguageRoleForName((ptrn->foreign_lang == LANG_IGNORE? cdata->owner: ptrn->foreign_lang),
+	langType lang = (ptrn->foreign_lang == LANG_IGNORE)
+		? cdata->owner
+		: ptrn->foreign_lang;
+	role = getLanguageRoleForName(lang,
 								  ptrn->u.tag.kindIndex, v);
 	if (!role)
 	{
-		error (WARNING, "no such role: %s", v);
+		error (WARNING, "no such role: %s in kind: %s of language: %s",
+			   v,
+			   getLanguageKind(lang, ptrn->u.tag.kindIndex)->name,
+			   getLanguageName (lang));
 		return;
 	}
 
@@ -3256,10 +3262,9 @@ extern bool checkRegex (void)
 }
 
 static EsObject *OPTSCRIPT_ERR_UNKNOWNKIND;
+static EsObject *OPTSCRIPT_ERR_UNKNOWNROLE;
 
-/* name:str kind:name loc _TAG tag
- * name:str kind:name     _TAG tag */
-static EsObject* lrop_make_tag (OptVM *vm, EsObject *name)
+static EsObject* lrop_make_foreignreftag (OptVM *vm, EsObject *name)
 {
 	matchLoc *loc;
 
@@ -3270,7 +3275,7 @@ static EsObject* lrop_make_tag (OptVM *vm, EsObject *name)
 	EsObject *top = opt_vm_ostack_top (vm);
 	if (es_object_get_type (top) == OPT_TYPE_MATCHLOC)
 	{
-		if (opt_vm_ostack_count (vm) < 3)
+		if (opt_vm_ostack_count (vm) < 5)
 			return OPT_ERR_UNDERFLOW;
 		loc = es_pointer_get (top);
 		index = 1;
@@ -3280,96 +3285,55 @@ static EsObject* lrop_make_tag (OptVM *vm, EsObject *name)
 		struct lregexControlBlock *lcb = opt_vm_get_app_data (vm);
 		if (lcb->window->patbuf->regptype != REG_PARSER_SINGLE_LINE)
 			return OPT_ERR_TYPECHECK;
-		if (opt_vm_ostack_count (vm) < 2)
+		if (opt_vm_ostack_count (vm) < 4)
 			return OPT_ERR_UNDERFLOW;
 		loc = NULL;
 		index = 0;
 	}
 
-	EsObject *kind = opt_vm_ostack_peek (vm, index++);
-	if (es_object_get_type (kind) != OPT_TYPE_NAME)
+	EsObject *role_obj = opt_vm_ostack_peek (vm, index++);
+	if (es_nil != role_obj
+		&& es_object_get_type (role_obj) != OPT_TYPE_NAME)
 		return OPT_ERR_TYPECHECK;
-	EsObject *kind_sym = es_pointer_get (kind);
-	const char *kind_str = es_symbol_get (kind_sym);
-	kindDefinition* kind_def = getLanguageKindForName (getInputLanguage (),
-													   kind_str);
-	if (!kind_def)
-		return OPTSCRIPT_ERR_UNKNOWNKIND;
-	int kind_index = kind_def->id;
 
-	EsObject *tname = opt_vm_ostack_peek (vm, index++);
-	if (es_object_get_type (tname) != OPT_TYPE_STRING)
+	EsObject *kind_obj = opt_vm_ostack_peek (vm, index++);
+	if (es_object_get_type (kind_obj) != OPT_TYPE_NAME)
 		return OPT_ERR_TYPECHECK;
-	const char *n = opt_string_get_cstr (tname);
-	if (n [0] == '\0')
-		return OPT_ERR_RANGECHECK; /* TODO */
-
-	tagEntryInfo *e = xMalloc (1, tagEntryInfo);
-	initRegexTag (e, eStrdup (n),
-				  kind_index, ROLE_DEFINITION_INDEX, CORK_NIL, 0,
-				  loc? loc->line: 0, loc? &loc->pos: NULL, XTAG_UNKNOWN, LANG_IGNORE);
-	EsObject *obj = es_pointer_new (OPT_TYPE_TAG, e);
-	if (es_error_p (obj))
-		return obj;
-
-	while (index-- > 0)
-		opt_vm_ostack_pop (vm);
-
-	opt_vm_ostack_push (vm, obj);
-	es_object_unref (obj);
-	return es_false;
-}
-
-static EsObject *OPTSCRIPT_ERR_UNKNOWNROLE;
-
-static EsObject* lrop_make_reftag (OptVM *vm, EsObject *name)
-{
-	matchLoc *loc;
-
-	if (opt_vm_ostack_count (vm) < 1)
-		return OPT_ERR_UNDERFLOW;
 
-	int index;
-	EsObject *top = opt_vm_ostack_top (vm);
-	if (es_object_get_type (top) == OPT_TYPE_MATCHLOC)
-	{
-		if (opt_vm_ostack_count (vm) < 4)
-			return OPT_ERR_UNDERFLOW;
-		loc = es_pointer_get (top);
-		index = 1;
+	EsObject *lang_obj = opt_vm_ostack_peek (vm, index++);
+	langType lang;
+	if (es_nil == lang_obj)
+		lang = getInputLanguage ();
+	else if (es_object_get_type (lang_obj) == OPT_TYPE_NAME)
+	{
+		EsObject *lang_sym = es_pointer_get (lang_obj);
+		const char *lang_str = es_symbol_get (lang_sym);
+		lang = getNamedLanguage (lang_str, 0);
+		if (lang == LANG_IGNORE)
+			return OPTSCRIPT_ERR_UNKNOWNLANGUAGE;
 	}
 	else
-	{
-		struct lregexControlBlock *lcb = opt_vm_get_app_data (vm);
-		if (lcb->window->patbuf->regptype != REG_PARSER_SINGLE_LINE)
-			return OPT_ERR_TYPECHECK;
-		if (opt_vm_ostack_count (vm) < 3)
-			return OPT_ERR_UNDERFLOW;
-		loc = NULL;
-		index = 0;
-	}
-
-	EsObject *role = opt_vm_ostack_peek (vm, index++);
-	if (es_object_get_type (role) != OPT_TYPE_NAME)
 		return OPT_ERR_TYPECHECK;
 
-	EsObject *kind = opt_vm_ostack_peek (vm, index++);
-	if (es_object_get_type (kind) != OPT_TYPE_NAME)
-		return OPT_ERR_TYPECHECK;
-	EsObject *kind_sym = es_pointer_get (kind);
+	EsObject *kind_sym = es_pointer_get (kind_obj);
 	const char *kind_str = es_symbol_get (kind_sym);
-	langType lang = getInputLanguage ();
 	kindDefinition* kind_def = getLanguageKindForName (lang, kind_str);
 	if (!kind_def)
 		return OPTSCRIPT_ERR_UNKNOWNKIND;
 	int kind_index = kind_def->id;
 
-	EsObject *role_sym = es_pointer_get (role);
-	const char *role_str = es_symbol_get (role_sym);
-	roleDefinition* role_def = getLanguageRoleForName (lang, kind_index, role_str);
-	if (!role_def)
-		return OPTSCRIPT_ERR_UNKNOWNROLE;
-	int role_index = role_def->id;
+	int role_index;
+	if (es_nil == role_obj)
+		role_index = ROLE_DEFINITION_INDEX;
+	else
+	{
+		EsObject *role_sym = es_pointer_get (role_obj);
+		const char *role_str = es_symbol_get (role_sym);
+		roleDefinition* role_def = getLanguageRoleForName (lang, kind_index, role_str);
+		if (!role_def)
+			return OPTSCRIPT_ERR_UNKNOWNROLE;
+		role_index = role_def->id;
+	}
 
 	EsObject *tname = opt_vm_ostack_peek (vm, index++);
 	if (es_object_get_type (tname) != OPT_TYPE_STRING)
@@ -3384,7 +3348,7 @@ static EsObject* lrop_make_reftag (OptVM *vm, EsObject *name)
 				  loc? loc->line: 0, loc? &loc->pos: NULL,
 				  role_index == ROLE_DEFINITION_INDEX
 				  ? XTAG_UNKNOWN
-				  : XTAG_REFERENCE_TAGS, LANG_IGNORE);
+				  : XTAG_REFERENCE_TAGS, lang);
 	EsObject *obj = es_pointer_new (OPT_TYPE_TAG, e);
 	if (es_error_p (obj))
 		return obj;
@@ -4180,18 +4144,11 @@ static struct optscriptOperatorRegistration lropOperators [] = {
 		.help_str = "index:int _TAGLOC matchloc",
 	},
 	{
-		.name     = "_tag",
-		.fn       = lrop_make_tag,
-		.arity    = -1,
-		.help_str = "name:str kind:name matchloc _TAG tag%"
-		"name:str kind:name _TAG tag",
-	},
-	{
-		.name     = "_reftag",
-		.fn       = lrop_make_reftag,
+		.name     = "_foreignreftag",
+		.fn       = lrop_make_foreignreftag,
 		.arity    = -1,
-		.help_str = "name:str kind:name role:name matchloc _REFTAG tag%"
-		"name:str kind:name role:name _REFTAG tag%",
+		.help_str = "name:str lang:name kind:name role:name matchloc _FOREIGNREFTAG tag%"
+		"name:str lang:name|null kind:name role:name|null _FOREIGNREFTAG tag%",
 	},
 	{
 		.name     = "_commit",

main/parse.c

@@ -4057,39 +4057,15 @@ static rescanReason createTagsForFile (const langType language,
 extern void notifyLanguageRegexInputStart (langType language)
 {
 	parserObject *pobj = LanguageTable + language;
-	parserDefinition *pdef = pobj->def;
 
 	notifyRegexInputStart(pobj->lregexControlBlock);
-	for (unsigned int i = 0; i < pdef->dependencyCount; i++)
-	{
-		parserDependency *d = pdef->dependencies + i;
-		if (d->type != DEPTYPE_FOREIGNER)
-			continue;
-		langType foreigner = getNamedLanguage (d->upperParser, 0);
-		if (foreigner == LANG_IGNORE)
-			continue;
-
-		notifyLanguageRegexInputStart (foreigner);
-	}
 }
 
 extern void notifyLanguageRegexInputEnd (langType language)
 {
 	parserObject *pobj = LanguageTable + language;
-	parserDefinition *pdef = pobj->def;
 
-	for (unsigned int i = 0; i < pdef->dependencyCount; i++)
-	{
-		parserDependency *d = pdef->dependencies + i;
-		if (d->type != DEPTYPE_FOREIGNER)
-			continue;
-		langType foreigner = getNamedLanguage (d->upperParser, 0);
-		if (foreigner == LANG_IGNORE)
-			continue;
-
-		notifyLanguageRegexInputEnd (foreigner);
-	}
-	notifyRegexInputEnd((LanguageTable + language)->lregexControlBlock);
+	notifyRegexInputEnd(pobj->lregexControlBlock);
 }
 
 static unsigned int parserCorkFlags (parserDefinition *parser)