Prolog: new parser

Close #2628.

Signed-off-by: Masatake YAMATO <[email protected]>

Author: masatake

Tmain/extras-long.d/stdout-expected.txt

@@ -15,6 +15,7 @@ z       nulltag             no      NONE        no    Include tags with empty st
 -       configPrefixed      yes     Kconfig     no    prepend CONFIG_ to config names
 -       CppDef              no      Make        no    Include FOO in -DFOO as as a name of CPreProcessor macro
 -       guessedFromFileName yes     PkgConfig   no    the guessed package name of the .pc file
+-       arityAppended       yes     Prolog      no    Include predicates with their arises
 -       funcmap             yes     QemuHX      no    Include mapping SQMP to C function name
 -       whitespaceSwapped   yes     Robot       no    Include tags swapping whitespace and underscore chars
 # enabling 1
@@ -34,6 +35,7 @@ z       nulltag             no      NONE        no    Include tags with empty st
 -       configPrefixed      yes     Kconfig     no    prepend CONFIG_ to config names
 -       CppDef              no      Make        no    Include FOO in -DFOO as as a name of CPreProcessor macro
 -       guessedFromFileName yes     PkgConfig   no    the guessed package name of the .pc file
+-       arityAppended       yes     Prolog      no    Include predicates with their arises
 -       funcmap             yes     QemuHX      no    Include mapping SQMP to C function name
 -       whitespaceSwapped   yes     Robot       no    Include tags swapping whitespace and underscore chars
 # disabling 1
@@ -53,6 +55,7 @@ z       nulltag             no      NONE        no    Include tags with empty st
 -       configPrefixed      yes     Kconfig     no    prepend CONFIG_ to config names
 -       CppDef              no      Make        no    Include FOO in -DFOO as as a name of CPreProcessor macro
 -       guessedFromFileName yes     PkgConfig   no    the guessed package name of the .pc file
+-       arityAppended       yes     Prolog      no    Include predicates with their arises
 -       funcmap             yes     QemuHX      no    Include mapping SQMP to C function name
 -       whitespaceSwapped   yes     Robot       no    Include tags swapping whitespace and underscore chars
 # combination
@@ -72,6 +75,7 @@ z       nulltag             no      NONE        no    Include tags with empty st
 -       configPrefixed      yes     Kconfig     no    prepend CONFIG_ to config names
 -       CppDef              no      Make        no    Include FOO in -DFOO as as a name of CPreProcessor macro
 -       guessedFromFileName yes     PkgConfig   no    the guessed package name of the .pc file
+-       arityAppended       yes     Prolog      no    Include predicates with their arises
 -       funcmap             yes     QemuHX      no    Include mapping SQMP to C function name
 -       whitespaceSwapped   yes     Robot       no    Include tags swapping whitespace and underscore chars
 # combination with letters
@@ -91,5 +95,6 @@ z       nulltag             no      NONE        no    Include tags with empty st
 -       configPrefixed      yes     Kconfig     no    prepend CONFIG_ to config names
 -       CppDef              no      Make        no    Include FOO in -DFOO as as a name of CPreProcessor macro
 -       guessedFromFileName yes     PkgConfig   no    the guessed package name of the .pc file
+-       arityAppended       yes     Prolog      no    Include predicates with their arises
 -       funcmap             yes     QemuHX      no    Include mapping SQMP to C function name
 -       whitespaceSwapped   yes     Robot       no    Include tags swapping whitespace and underscore chars

Tmain/list-extras.d/stdout-expected.txt

@@ -15,6 +15,7 @@ z       nulltag             yes     NONE        no    Include tags with empty st
 -       configPrefixed      yes     Kconfig     no    prepend CONFIG_ to config names
 -       CppDef              no      Make        no    Include FOO in -DFOO as as a name of CPreProcessor macro
 -       guessedFromFileName yes     PkgConfig   no    the guessed package name of the .pc file
+-       arityAppended       yes     Prolog      no    Include predicates with their arises
 -       funcmap             yes     QemuHX      no    Include mapping SQMP to C function name
 -       whitespaceSwapped   yes     Robot       no    Include tags swapping whitespace and underscore chars
 #LETTER	NAME	ENABLED	LANGUAGE	FIXED	DESCRIPTION
@@ -34,6 +35,7 @@ z	nulltag	yes	NONE	no	Include tags with empty strings as their names
 -	configPrefixed	yes	Kconfig	no	prepend CONFIG_ to config names
 -	CppDef	no	Make	no	Include FOO in -DFOO as as a name of CPreProcessor macro
 -	guessedFromFileName	yes	PkgConfig	no	the guessed package name of the .pc file
+-	arityAppended	yes	Prolog	no	Include predicates with their arises
 -	funcmap	yes	QemuHX	no	Include mapping SQMP to C function name
 -	whitespaceSwapped	yes	Robot	no	Include tags swapping whitespace and underscore chars
 #LETTER NAME      ENABLED LANGUAGE FIXED DESCRIPTION

Tmain/list-fields-with-prefix.d/stdout-expected.txt

@@ -41,6 +41,7 @@ x       UCTAGSxpath          no      NONE             s--    no    -- xpath for
 -       UCTAGSprotocols      yes     ObjectiveC       s--    no    -- protocols that the class (or category) confirms to
 -       UCTAGShome           yes     Passwd           s--    no    rw home directory
 -       UCTAGSshell          yes     Passwd           s--    no    rw login shell
+-       UCTAGSarity          yes     Prolog           -i-    no    rw arity of predicate
 -       UCTAGSdecorators     no      Python           s--    no    -- decorators on functions and classes
 -       UCTAGSnameref        yes     Python           s--    no    -- the original name for the tag
 -       UCTAGSassignmentop   no      R                s--    no    -- operator for assignment

Tmain/list-fields.d/stdout-expected.txt

@@ -59,6 +59,7 @@ z	kind	no	NONE	s--	no	r-	[tags output] prepend "kind:" to k/ (or K/) field outpu
 -	protocols	yes	ObjectiveC	s--	no	--	protocols that the class (or category) confirms to
 -	home	yes	Passwd	s--	no	rw	home directory
 -	shell	yes	Passwd	s--	no	rw	login shell
+-	arity	yes	Prolog	-i-	no	rw	arity of predicate
 -	decorators	no	Python	s--	no	--	decorators on functions and classes
 -	nameref	yes	Python	s--	no	--	the original name for the tag
 -	assignmentop	no	R	s--	no	--	operator for assignment

Units/parser-prolog.r/simple.d/args.ctags

@@ -0,0 +1,3 @@
+-G
+--sort=no
+--fields=+nE

Units/parser-prolog.r/simple.d/expected.tags

@@ -0,0 +1,16 @@
+mother_child	input.pl	/^mother_child(trude, sally).$/;"	p	line:2	arity:2
+mother_child/2	input.pl	/^mother_child(trude, sally).$/;"	p	line:2	extras:arityAppended	arity:2
+father_child	input.pl	/^father_child(tom, sally).$/;"	p	line:4	arity:2
+father_child/2	input.pl	/^father_child(tom, sally).$/;"	p	line:4	extras:arityAppended	arity:2
+father_child	input.pl	/^father_child(tom, erica).$/;"	p	line:5	arity:2
+father_child/2	input.pl	/^father_child(tom, erica).$/;"	p	line:5	extras:arityAppended	arity:2
+father_child	input.pl	/^father_child(mike, tom).$/;"	p	line:6	arity:2
+father_child/2	input.pl	/^father_child(mike, tom).$/;"	p	line:6	extras:arityAppended	arity:2
+sibling	input.pl	/^sibling(X, Y)      :- parent_child(Z, X), parent_child(Z, Y).$/;"	p	line:8	arity:2
+sibling/2	input.pl	/^sibling(X, Y)      :- parent_child(Z, X), parent_child(Z, Y).$/;"	p	line:8	extras:arityAppended	arity:2
+parent_child	input.pl	/^parent_child(X, Y) :- father_child(X, Y).$/;"	p	line:10	arity:2
+parent_child/2	input.pl	/^parent_child(X, Y) :- father_child(X, Y).$/;"	p	line:10	extras:arityAppended	arity:2
+parent_child	input.pl	/^parent_child(X, Y) :- mother_child(X, Y).$/;"	p	line:11	arity:2
+parent_child/2	input.pl	/^parent_child(X, Y) :- mother_child(X, Y).$/;"	p	line:11	extras:arityAppended	arity:2
+not_dummy	input.pl	/^not_dummy().$/;"	p	line:15	arity:1
+not_dummy/1	input.pl	/^not_dummy().$/;"	p	line:15	extras:arityAppended	arity:1

Units/parser-prolog.r/simple.d/input.pl

@@ -0,0 +1,15 @@
+%% Taken from https://en.wikipedia.org/wiki/Prolog
+mother_child(trude, sally).
+
+father_child(tom, sally).
+father_child(tom, erica).
+father_child(mike, tom).
+
+sibling(X, Y)      :- parent_child(Z, X), parent_child(Z, Y).
+
+parent_child(X, Y) :- father_child(X, Y).
+parent_child(X, Y) :- mother_child(X, Y).
+
+% dummy0()
+/* dummy1() */
+not_dummy().

main/parsers_p.h

@@ -147,6 +147,7 @@
 	PkgConfigParser, \
 	PodParser, \
 	PowerShellParser, \
+	PrologParser, \
 	ProtobufParser, \
 	PuppetManifestParser, \
 	PythonParser, \

main/selectors.c

@@ -43,6 +43,8 @@ static const char *TR_FORTRAN  = "Fortran";
 static const char *TR_V = "V";
 static const char *TR_VERILOG = "Verilog";
 
+static const char *TR_PROLOG = "Prolog";
+
 #define startsWith(line,prefix)									\
 	(strncmp(line, prefix, strlen(prefix)) == 0? true: false)
 
@@ -422,6 +424,64 @@ selectVOrVerilogByKeywords (MIO *input,
 		return TR_UNKNOWN;
 }
 
+struct PerlOrPrologScore {
+	int perl;
+	int prolog;
+	unsigned int linum;
+};
+
+static const char *
+tastePerlOrPrologLines (const char *line, void *data)
+{
+	struct PerlOrPrologScore *score = (struct PerlOrPrologScore *)data;
+
+	score->linum++;
+
+	if (score->linum > 16)
+		return TR_BREAK;
+
+	if (line[0] == '#' && line[1] != '!')
+	{
+		/* This is not a shebang: the comment line of perl */
+		score->perl++;
+	}
+	else if (line[0] == '%')
+	{
+		score->prolog++;
+	}
+	else if (startsWith (line, "use "))
+	{
+		score->perl++;
+	}
+	else if (startsWith (line, ":-"))
+		score->prolog+=2;
+	else if (strstr (line, ":-"))
+		score->prolog++;
+	else if (strstr (line, "/*"))
+		score->prolog++;
+
+	return TR_UNKNOWN;
+}
+
+const char *
+selectPerlOrPrologByDistinctiveToken (struct _MIO *input, langType *candidates, unsigned int nCandidates)
+{
+	struct PerlOrPrologScore score = {
+		.perl = 0,
+		.prolog = 0,
+		.linum = 0,
+	};
+	selectByLines (input, tastePerlOrPrologLines, TR_UNKNOWN, &score);
+
+	int d = score.perl - score.prolog;
+	if (d > 0)
+		return TR_PERL5;
+	else if (d < 0)
+		return TR_PROLOG;
+	else
+		return TR_UNKNOWN;
+}
+
 #ifdef HAVE_LIBXML
 #include <libxml/parser.h>
 #include <libxml/xpath.h>

main/selectors.h

@@ -39,4 +39,7 @@ selectByXpathFileSpec (struct _MIO *input, langType *candidates, unsigned int nC
 const char *
 selectFortranOrForthByForthMarker (struct _MIO *input, langType *candidates, unsigned int nCandidates);
 
+const char *
+selectPerlOrPrologByDistinctiveToken (struct _MIO *input, langType *candidates, unsigned int nCandidates);
+
 #endif

parsers/perl.c

@@ -1019,8 +1019,10 @@ extern parserDefinition* PerlParser (void)
 		/* cperl is an Emacs' editing mode for Perl source code  */
 		"cperl",
 		NULL };
-	static selectLanguage selectors [] = { selectByPickingPerlVersion,
-					       NULL };
+	static selectLanguage selectors [] = {
+		selectPerlOrPrologByDistinctiveToken,
+		selectByPickingPerlVersion,
+		NULL };
 	parserDefinition* def = parserNew ("Perl");
 	def->kindTable      = PerlKinds;
 	def->kindCount  = ARRAY_SIZE (PerlKinds);

source.mak

@@ -397,6 +397,7 @@ PARSER_SRCS =				\
 	parsers/perl-moose.c		\
 	parsers/php.c			\
 	parsers/powershell.c		\
+	parsers/prolog.c		\
 	parsers/protobuf.c		\
 	parsers/python.c		\
 	parsers/python-entry-points.c	\

win32/ctags_vs2013.vcxproj

@@ -345,6 +345,7 @@
     <ClCompile Include="..\parsers\perl.c" />
     <ClCompile Include="..\parsers\php.c" />
     <ClCompile Include="..\parsers\powershell.c" />
+    <ClCompile Include="..\parsers\prolog.c" />
     <ClCompile Include="..\parsers\protobuf.c" />
     <ClCompile Include="..\parsers\python-entry-points.c" />
     <ClCompile Include="..\parsers\python-logging-config.c" />

win32/ctags_vs2013.vcxproj.filters

@@ -558,6 +558,9 @@
     <ClCompile Include="..\parsers\powershell.c">
       <Filter>Source Files\parsers</Filter>
     </ClCompile>
+    <ClCompile Include="..\parsers\prolog.c">
+      <Filter>Source Files\parsers</Filter>
+    </ClCompile>
     <ClCompile Include="..\parsers\protobuf.c">
       <Filter>Source Files\parsers</Filter>
     </ClCompile>