Branch: refs/heads/master Author: Jiří Techet techet@gmail.com Committer: Jiří Techet techet@gmail.com Date: Tue, 19 Mar 2024 21:38:54 UTC Commit: c509b9000633acd9c9af93f15a84a3f4e6dd5ad3 https://github.com/geany/geany/commit/c509b9000633acd9c9af93f15a84a3f4e6dd5a...
Log Message: ----------- Add Ocaml ctags parser
Modified Paths: -------------- ctags/Makefile.am ctags/parsers/ocaml.c meson.build src/filetypes.c src/tagmanager/tm_parser.c src/tagmanager/tm_parser.h src/tagmanager/tm_parsers.h tests/ctags/Makefile.am tests/ctags/simple.ml tests/ctags/simple.ml.tags tests/meson.build
Modified: ctags/Makefile.am 1 lines changed, 1 insertions(+), 0 deletions(-) =================================================================== @@ -82,6 +82,7 @@ parsers = \ parsers/geany_matlab.c \ parsers/nsis.c \ parsers/objc.c \ + parsers/ocaml.c \ parsers/pascal.c \ parsers/perl.c \ parsers/perl.h \
Modified: ctags/parsers/ocaml.c 2094 lines changed, 2094 insertions(+), 0 deletions(-) =================================================================== @@ -0,0 +1,2094 @@ +/* +* Copyright (c) 2009, Vincent Berthoux +* +* This source code is released for free distribution under the terms of the +* GNU General Public License version 2 or (at your option) any later version. +* +* This module contains functions for generating tags for Objective Caml +* language files. +*/ +/* +* INCLUDE FILES +*/ +#include "general.h" /* must always come first */ + +#include <string.h> + +#include "debug.h" +#include "entry.h" +#include "keyword.h" +#include "options.h" +#include "parse.h" +#include "read.h" +#include "routines.h" +#include "vstring.h" + +#define OCAML_MAX_STACK_SIZE 256 + +typedef enum { + K_CLASS, /* OCaml class, relatively rare */ + K_METHOD, /* class method */ + K_MODULE, /* OCaml module OR functor */ + K_VARIABLE, + K_VAL, + K_TYPE, /* name of an OCaml type */ + K_FUNCTION, + K_CONSTRUCTOR, /* Constructor of a sum type */ + K_RECORDFIELD, + K_EXCEPTION, +} ocamlKind; + +static kindDefinition OcamlKinds[] = { + {true, 'c', "class", "classes"}, + {true, 'm', "method", "Object's method"}, + {true, 'M', "module", "Module or functor"}, + {true, 'v', "var", "Global variable"}, + {true, 'p', "val", "Signature item"}, + {true, 't', "type", "Type name"}, + {true, 'f', "function", "A function"}, + {true, 'C', "Constructor", "A constructor"}, + {true, 'r', "RecordField", "A 'structure' field"}, + {true, 'e', "Exception", "An exception"}, +}; + +typedef enum { + OcaKEYWORD_and, + OcaKEYWORD_begin, + OcaKEYWORD_class, + OcaKEYWORD_do, + OcaKEYWORD_done, + OcaKEYWORD_else, + OcaKEYWORD_end, + OcaKEYWORD_exception, + OcaKEYWORD_for, + OcaKEYWORD_functor, + OcaKEYWORD_fun, + OcaKEYWORD_function, + OcaKEYWORD_if, + OcaKEYWORD_in, + OcaKEYWORD_let, + OcaKEYWORD_value, + OcaKEYWORD_match, + OcaKEYWORD_method, + OcaKEYWORD_module, + OcaKEYWORD_mutable, + OcaKEYWORD_object, + OcaKEYWORD_of, + OcaKEYWORD_rec, + OcaKEYWORD_sig, + OcaKEYWORD_struct, + OcaKEYWORD_then, + OcaKEYWORD_try, + OcaKEYWORD_type, + OcaKEYWORD_val, + OcaKEYWORD_virtual, + OcaKEYWORD_while, + OcaKEYWORD_with, + + OcaIDENTIFIER, + Tok_PARL, /* '(' */ + Tok_PARR, /* ')' */ + Tok_BRL, /* '[' */ + Tok_BRR, /* ']' */ + Tok_CurlL, /* '{' */ + Tok_CurlR, /* '}' */ + Tok_Prime, /* ''' */ + Tok_Pipe, /* '|' */ + Tok_EQ, /* '=' */ + Tok_Val, /* string/number/poo */ + Tok_Op, /* any operator recognized by the language */ + Tok_semi, /* ';' */ + Tok_comma, /* ',' */ + Tok_To, /* '->' */ + Tok_Of, /* ':' */ + Tok_Sharp, /* '#' */ + Tok_Backslash, /* '\' */ + + Tok_EOF /* END of file */ +} ocamlKeyword; + +typedef struct sOcaKeywordDesc { + const char *name; + ocamlKeyword id; +} ocaKeywordDesc; + +typedef ocamlKeyword ocaToken; + +static const keywordTable OcamlKeywordTable[] = { + { "and" , OcaKEYWORD_and }, + { "begin" , OcaKEYWORD_begin }, + { "class" , OcaKEYWORD_class }, + { "do" , OcaKEYWORD_do }, + { "done" , OcaKEYWORD_done }, + { "else" , OcaKEYWORD_else }, + { "end" , OcaKEYWORD_end }, + { "exception" , OcaKEYWORD_exception }, + { "for" , OcaKEYWORD_for }, + { "fun" , OcaKEYWORD_fun }, + { "function" , OcaKEYWORD_fun }, + { "functor" , OcaKEYWORD_functor }, + { "if" , OcaKEYWORD_if }, + { "in" , OcaKEYWORD_in }, + { "let" , OcaKEYWORD_let }, + { "match" , OcaKEYWORD_match }, + { "method" , OcaKEYWORD_method }, + { "module" , OcaKEYWORD_module }, + { "mutable" , OcaKEYWORD_mutable }, + { "object" , OcaKEYWORD_object }, + { "of" , OcaKEYWORD_of }, + { "rec" , OcaKEYWORD_rec }, + { "sig" , OcaKEYWORD_sig }, + { "struct" , OcaKEYWORD_struct }, + { "then" , OcaKEYWORD_then }, + { "try" , OcaKEYWORD_try }, + { "type" , OcaKEYWORD_type }, + { "val" , OcaKEYWORD_val }, + { "value" , OcaKEYWORD_value }, /* just to handle revised syntax */ + { "virtual" , OcaKEYWORD_virtual }, + { "while" , OcaKEYWORD_while }, + { "with" , OcaKEYWORD_with }, + + { "or" , Tok_Op }, + { "mod " , Tok_Op }, + { "land " , Tok_Op }, + { "lor " , Tok_Op }, + { "lxor " , Tok_Op }, + { "lsl " , Tok_Op }, + { "lsr " , Tok_Op }, + { "asr" , Tok_Op }, + { "->" , Tok_To }, + { ":" , Tok_Of }, + { "true" , Tok_Val }, + { "false" , Tok_Val } +}; + +static langType Lang_Ocaml; + +static bool exportLocalInfo = false; + +/*////////////////////////////////////////////////////////////////// +//// lexingInit */ +typedef struct _lexingState { + vString *name; /* current parsed identifier/operator */ + const unsigned char *cp; /* position in stream */ +} lexingState; + +/* array of the size of all possible value for a char */ +static bool isOperator[1 << (8 * sizeof (char))] = { false }; + +/* definition of all the operator in OCaml, + * /!\ certain operator get special treatment + * in regards of their role in OCaml grammar : + * '|' ':' '=' '~' and '?' */ +static void initOperatorTable ( void ) +{ + isOperator['!'] = true; + isOperator['$'] = true; + isOperator['%'] = true; + isOperator['&'] = true; + isOperator['*'] = true; + isOperator['+'] = true; + isOperator['-'] = true; + isOperator['.'] = true; + isOperator['/'] = true; + isOperator[':'] = true; + isOperator['<'] = true; + isOperator['='] = true; + isOperator['>'] = true; + isOperator['?'] = true; + isOperator['@'] = true; + isOperator['^'] = true; + isOperator['~'] = true; + isOperator['|'] = true; +} + +/*////////////////////////////////////////////////////////////////////// +//// Lexing */ +static bool isNum (char c) +{ + return c >= '0' && c <= '9'; +} + +static bool isLowerAlpha (char c) +{ + return c >= 'a' && c <= 'z'; +} + +static bool isUpperAlpha (char c) +{ + return c >= 'A' && c <= 'Z'; +} + +static bool isAlpha (char c) +{ + return isLowerAlpha (c) || isUpperAlpha (c); +} + +static bool isIdent (char c) +{ + return isNum (c) || isAlpha (c) || c == '_' || c == '''; +} + +static bool isSpace (char c) +{ + return c == ' ' || c == '\t' || c == '\r' || c == '\n'; +} + +static void eatWhiteSpace (lexingState * st) +{ + const unsigned char *cp = st->cp; + while (isSpace (*cp)) + cp++; + + st->cp = cp; +} + +static void eatString (lexingState * st) +{ + bool lastIsBackSlash = false; + bool unfinished = true; + const unsigned char *c = st->cp + 1; + + while (unfinished) + { + /* end of line should never happen. + * we tolerate it */ + if (c == NULL || c[0] == '\0') + break; + else if (*c == '"' && !lastIsBackSlash) + unfinished = false; + else + lastIsBackSlash = *c == '\'; + + c++; + } + + st->cp = c; +} + +static void eatComment (lexingState * st) +{ + bool unfinished = true; + bool lastIsStar = false; + const unsigned char *c = st->cp + 2; + + while (unfinished) + { + /* we've reached the end of the line.. + * so we have to reload a line... */ + if (c == NULL || *c == '\0') + { + st->cp = readLineFromInputFile (); + /* WOOPS... no more input... + * we return, next lexing read + * will be null and ok */ + if (st->cp == NULL) + return; + c = st->cp; + } + /* we've reached the end of the comment */ + else if (*c == ')' && lastIsStar) + { + unfinished = false; + c++; + } + /* here we deal with imbricated comment, which + * are allowed in OCaml */ + else if (c[0] == '(' && c[1] == '*') + { + st->cp = c; + eatComment (st); + + c = st->cp; + if (c == NULL) + return; + + lastIsStar = false; + c++; + } + /* OCaml has a rule which says : + * + * "Comments do not occur inside string or character literals. + * Nested comments are handled correctly." + * + * So if we encounter a string beginning, we must parse it to + * get a good comment nesting (bug ID: 3117537) + */ + else if (*c == '"') + { + st->cp = c; + eatString (st); + c = st->cp; + } + else + { + lastIsStar = '*' == *c; + c++; + } + } + + st->cp = c; +} + +static void readIdentifier (lexingState * st) +{ + const unsigned char *p; + vStringClear (st->name); + + /* first char is a simple letter */ + if (isAlpha (*st->cp) || *st->cp == '_') + vStringPut (st->name, (int) *st->cp); + + /* Go till you get identifier chars */ + for (p = st->cp + 1; isIdent (*p); p++) + vStringPut (st->name, (int) *p); + + st->cp = p; +} + +static ocamlKeyword eatNumber (lexingState * st) +{ + while (isNum (*st->cp)) + st->cp++; + return Tok_Val; +} + +/* Operator can be defined in OCaml as a function + * so we must be ample enough to parse them normally */ +static ocamlKeyword eatOperator (lexingState * st) +{ + int count = 0; + const unsigned char *root = st->cp; + + vStringClear (st->name); + + while (isOperator[st->cp[count]]) + { + vStringPut (st->name, st->cp[count]); + count++; + } + + st->cp += count; + if (count <= 1) + { + switch (root[0]) + { + case '|': + return Tok_Pipe; + case '=': + return Tok_EQ; + case ':': + return Tok_Of; + default: + return Tok_Op; + } + } + else if (count == 2 && root[0] == '-' && root[1] == '>') + return Tok_To; + else if (count == 2 && root[0] == '|' && root[1] == '>') + return Tok_Op; + else + return Tok_Op; +} + +/* The lexer is in charge of reading the file. + * Some of sub-lexer (like eatComment) also read file. + * lexing is finished when the lexer return Tok_EOF */ +static ocamlKeyword lex (lexingState * st) +{ + int retType; + /* handling data input here */ + while (st->cp == NULL || st->cp[0] == '\0') + { + st->cp = readLineFromInputFile (); + if (st->cp == NULL) + return Tok_EOF; + } + + if (isAlpha (*st->cp)) + { + readIdentifier (st); + retType = lookupKeyword (vStringValue (st->name), Lang_Ocaml); + + if (retType == -1) /* If it's not a keyword */ + { + return OcaIDENTIFIER; + } + else + { + return retType; + } + } + else if (isNum (*st->cp)) + return eatNumber (st); + else if (isSpace (*st->cp)) + { + eatWhiteSpace (st); + return lex (st); + } + else if (*st->cp == '_') + { // special + readIdentifier (st); + return Tok_Val; + } + + /* OCaml permit the definition of our own operators + * so here we check all the consecutive chars which + * are operators to discard them. */ + else if (isOperator[*st->cp]) + return eatOperator (st); + else + { + switch (*st->cp) + { + case '(': + if (st->cp[1] == '*') /* ergl, a comment */ + { + eatComment (st); + return lex (st); + } + else + { + st->cp++; + return Tok_PARL; + } + + case ')': + st->cp++; + return Tok_PARR; + case '[': + st->cp++; + return Tok_BRL; + case ']': + st->cp++; + return Tok_BRR; + case '{': + st->cp++; + return Tok_CurlL; + case '}': + st->cp++; + return Tok_CurlR; + case ''': + st->cp++; + return Tok_Prime; + case ',': + st->cp++; + return Tok_comma; + case '=': + st->cp++; + return Tok_EQ; + case ';': + st->cp++; + return Tok_semi; + case '"': + eatString (st); + return Tok_Val; + case '#': + st->cp++; + return Tok_Sharp; + case '\': + st->cp++; + return Tok_Backslash; + default: + st->cp++; + break; + } + } + /* default return if nothing is recognized, + * shouldn't happen, but at least, it will + * be handled without destroying the parsing. */ + return Tok_Val; +} + +/*////////////////////////////////////////////////////////////////////// +//// Parsing */ +typedef void (*parseNext) (vString * const ident, ocaToken what, ocaToken whatNext); + +/********** Helpers */ +/* This variable hold the 'parser' which is going to + * handle the next token */ +static parseNext toDoNext; + +/* Special variable used by parser eater to + * determine which action to put after their + * job is finished. */ +static parseNext comeAfter; + +/* If a token put an end to current declaration/ + * statement */ +static ocaToken terminatingToken; + +/* Token to be searched by the different + * parser eater. */ +static ocaToken waitedToken; + +/* name of the last class, used for + * context stacking. */ +static vString *lastClass; + +typedef enum _sContextKind { + ContextStrong, + ContextSoft +} contextKind; + +typedef enum _sContextType { + ContextType, + ContextModule, + ContextClass, + ContextValue, + ContextFunction, + ContextMethod, + ContextBlock, + ContextMatch +} contextType; + +typedef struct _sOcamlContext { + contextKind kind; /* well if the context is strong or not */ + contextType type; + parseNext callback; /* what to do when a context is pop'd */ + vString *contextName; /* name, if any, of the surrounding context */ +} ocamlContext; + +/* context stack, can be used to output scope information + * into the tag file. */ +static ocamlContext stack[OCAML_MAX_STACK_SIZE]; +/* current position in the tag */ +static int stackIndex; + +/* special function, often recalled, so putting it here */ +static void globalScope (vString * const ident, ocaToken what, ocaToken whatNext); + +/* Return : index of the last named context if one + * is found, -1 otherwise */ +static int getLastNamedIndex ( void ) +{ + int i; + + for (i = stackIndex - 1; i >= 0; --i) + { + if (vStringLength (stack[i].contextName) > 0) + { + return i; + } + } + + return -1; +} + +static int contextDescription (contextType t) +{ + switch (t) + { + case ContextFunction: + return K_FUNCTION; + case ContextMethod: + return K_METHOD; + case ContextValue: + return K_VAL; + case ContextModule: + return K_MODULE; + case ContextType: + return K_TYPE; + case ContextClass: + return K_CLASS; + default: + AssertNotReached(); + return KIND_GHOST_INDEX; + } +} + +static char contextTypeSuffix (contextType t) +{ + switch (t) + { + case ContextFunction: + case ContextMethod: + case ContextValue: + case ContextModule: + return '/'; + case ContextType: + return '.'; + case ContextClass: + return '#'; + case ContextBlock: + return ' '; + case ContextMatch: + return '|'; + default: + return '$'; + } +} + +/* Push a new context, handle null string */ +static void pushContext (contextKind kind, contextType type, parseNext after, + vString const *contextName) +{ + int parentIndex; + + if (stackIndex >= OCAML_MAX_STACK_SIZE) + { + verbose ("OCaml Maximum depth reached"); + return; + } + + stack[stackIndex].kind = kind; + stack[stackIndex].type = type; + stack[stackIndex].callback = after; + + parentIndex = getLastNamedIndex (); + if (contextName == NULL) + { + vStringClear (stack[stackIndex++].contextName); + return; + } + + if (parentIndex >= 0) + { + vStringCopy (stack[stackIndex].contextName, + stack[parentIndex].contextName); + vStringPut (stack[stackIndex].contextName, + contextTypeSuffix (stack[parentIndex].type)); + + vStringCat (stack[stackIndex].contextName, contextName); + } + else + vStringCopy (stack[stackIndex].contextName, contextName); + + stackIndex++; +} + +static void pushStrongContext (vString * name, contextType type) +{ + pushContext (ContextStrong, type, &globalScope, name); +} + +static void pushSoftContext (parseNext continuation, + vString * name, contextType type) +{ + pushContext (ContextSoft, type, continuation, name); +} + +static void pushEmptyContext (parseNext continuation) +{ + pushContext (ContextSoft, ContextValue, continuation, NULL); +} + +/* unroll the stack until the last named context. + * then discard it. Used to handle the : + * let f x y = ... + * in ... + * where the context is reseted after the in. Context may have + * been really nested before that. */ +static void popLastNamed ( void ) +{ + int i = getLastNamedIndex (); + + if (i >= 0) + { + stackIndex = i; + toDoNext = stack[i].callback; + vStringClear (stack[i].contextName); + } + else + { + /* ok, no named context found... + * (should not happen). */ + stackIndex = 0; + toDoNext = &globalScope; + } +} + +/* pop a context without regarding it's content + * (beside handling empty stack case) */ +static void popSoftContext ( void ) +{ + if (stackIndex <= 0) + { + toDoNext = &globalScope; + } + else + { + stackIndex--; + toDoNext = stack[stackIndex].callback; + vStringClear (stack[stackIndex].contextName); + } +} + +/* Reset everything until the last global space. + * a strong context can be : + * - module + * - class definition + * - the initial global space + * - a _global_ declaration (let at global scope or in a module). + * Created to exit quickly deeply nested context */ +static contextType popStrongContext ( void ) +{ + int i; + + for (i = stackIndex - 1; i >= 0; --i) + { + if (stack[i].kind == ContextStrong) + { + stackIndex = i; + toDoNext = stack[i].callback; + vStringClear (stack[i].contextName); + return stack[i].type; + } + } + /* ok, no strong context found... */ + stackIndex = 0; + toDoNext = &globalScope; + return -1; +} + +/* Reset everything before the last match. */ +static void jumpToMatchContext ( void ) +{ + int i; + for (i = stackIndex - 1; i >= 0; --i) + { + if (stack[i].type == ContextMatch) + { + stackIndex = i + 1; + toDoNext = stack[i].callback; // this should always be + // matchPattern + stack[i + 1].callback = NULL; + vStringClear (stack[i + 1].contextName); + return; + } + } +} + +/* Ignore everything till waitedToken and jump to comeAfter. + * If the "end" keyword is encountered break, doesn't remember + * why though. */ +static void tillToken (vString * const ident CTAGS_ATTR_UNUSED, ocaToken what, ocaToken whatNext CTAGS_ATTR_UNUSED) +{ + if (what == waitedToken) + toDoNext = comeAfter; + else if (what == OcaKEYWORD_end) + { + popStrongContext (); + toDoNext = &globalScope; + } +} + +/* Ignore everything till a waitedToken is seen, but + * take care of balanced parentheses/bracket use */ +static void contextualTillToken (vString * const ident, ocaToken what, ocaToken whatNext) +{ + static int parentheses = 0; + static int bracket = 0; + static int curly = 0; + + switch (what) + { + case Tok_PARL: + parentheses--; + break; + case Tok_PARR: + parentheses++; + break; + case Tok_CurlL: + curly--; + break; + case Tok_CurlR: + curly++; + break; + case Tok_BRL: + bracket--; + break; + case Tok_BRR: + bracket++; + break; + + default: /* other token are ignored */ + break; + } + + if (what == waitedToken && parentheses == 0 && bracket == 0 && curly == 0) + toDoNext = comeAfter; + else if (what == OcaKEYWORD_end) + globalScope (ident, what, whatNext); +} + +/* Wait for waitedToken and jump to comeAfter or let + * the globalScope handle declarations */ +static void tillTokenOrFallback (vString * const ident, ocaToken what, ocaToken whatNext) +{ + if (what == waitedToken) + toDoNext = comeAfter; + else + globalScope (ident, what, whatNext); +} + +/* ignore token till waitedToken, or give up if find + * terminatingToken. Use globalScope to handle new + * declarations. */ +static void tillTokenOrTerminatingOrFallback (vString * const ident, ocaToken what, ocaToken whatNext) +{ + if (what == waitedToken) + toDoNext = comeAfter; + else if (what == terminatingToken) + toDoNext = globalScope; + else + globalScope (ident, what, whatNext); +} + +/* ignore the next token in the stream and jump to the + * given comeAfter state */ +static void ignoreToken (vString * const ident CTAGS_ATTR_UNUSED, ocaToken what CTAGS_ATTR_UNUSED, ocaToken whatNext CTAGS_ATTR_UNUSED) +{ + toDoNext = comeAfter; +} + +/********** Grammar */ +/* the purpose of each function is detailed near their + * implementation */ + +static contextType killCurrentState ( void ) +{ + contextType popped = popStrongContext (); + + /* Tracking the kind of previous strong + * context, if it doesn't match with a + * really strong entity, repop */ + switch (popped) + { + case ContextValue: + popped = popStrongContext (); + break; + case ContextFunction: + popped = popStrongContext (); + break; + case ContextMethod: + popped = popStrongContext (); + break; + case ContextType: + popped = popStrongContext (); + break; + case ContextMatch: + popped = popStrongContext (); + break; + case ContextBlock: + break; + case ContextModule: + break; + case ContextClass: + break; + default: + /* nothing more */ + break; + } + return popped; +} + +/* Keep track of our _true_ line number and file pos, + * as the lookahead token gives us false values. */ +static unsigned long ocaLineNumber; +static MIOPos ocaFilePosition; + +/* Used to prepare an OCaml tag, just in case there is a need to + * add additional information to the tag. */ +static void prepareTag (tagEntryInfo * tag, vString const *name, int kind) +{ + int parentIndex; + + initTagEntry (tag, vStringValue (name), kind); + /* Ripped out of read.h initTagEntry, because of line number + * shenanigans. + * Ugh. Lookahead is harder than I expected. */ + tag->lineNumber = ocaLineNumber; + tag->filePosition = ocaFilePosition; + + parentIndex = getLastNamedIndex (); + if (parentIndex >= 0) + { + tag->extensionFields.scopeKindIndex = + contextDescription (stack[parentIndex].type); + tag->extensionFields.scopeName = + vStringValue (stack[parentIndex].contextName); + } +} + +/* Used to centralise tag creation, and be able to add + * more information to it in the future */ +static void addTag (vString * const ident, int kind) +{ + if (OcamlKinds [kind].enabled && ident != NULL && vStringLength (ident) > 0) + { + tagEntryInfo toCreate; + prepareTag (&toCreate, ident, kind); + makeTagEntry (&toCreate); + } +} + +static bool needStrongPoping = false; +static void requestStrongPoping ( void ) +{ + needStrongPoping = true; +} + +static void cleanupPreviousParser ( void ) +{ + if (needStrongPoping) + { + needStrongPoping = false; + popStrongContext (); + } +} + +/* Due to some circular dependencies, the following functions + * must be forward-declared. */ +static void letParam (vString * const ident, ocaToken what, ocaToken whatNext); +static void localScope (vString * const ident, ocaToken what, ocaToken whatNext); +static void mayRedeclare (vString * const ident, ocaToken what, ocaToken whatNext); +static void typeSpecification (vString * const ident, ocaToken what, ocaToken whatNext); + +/* + * Parse a record type + * type ident = // parsed previously + * { + * ident1: type1; + * ident2: type2; + * } + */ +static void typeRecord (vString * const ident, ocaToken what, ocaToken whatNext CTAGS_ATTR_UNUSED) +{ + switch (what) + { + case OcaIDENTIFIER: + addTag (ident, K_RECORDFIELD); + terminatingToken = Tok_CurlR; + waitedToken = Tok_semi; + comeAfter = &typeRecord; + toDoNext = &tillTokenOrTerminatingOrFallback; + break; + + case OcaKEYWORD_mutable: + /* ignore it */ + break; + + case Tok_CurlR: + popStrongContext (); + // don't pop the module context when going to another expression + needStrongPoping = false; + toDoNext = &globalScope; + break; + + default: /* don't care */ + break; + } +} + +/* handle : + * exception ExceptionName of ... */ +static void exceptionDecl (vString * const ident, ocaToken what, ocaToken whatNext) +{ + if (what == OcaIDENTIFIER) + { + addTag (ident, K_EXCEPTION); + } + else /* probably ill-formed, give back to global scope */ + { + globalScope (ident, what, whatNext); + } + toDoNext = &globalScope; +} + +static tagEntryInfo tempTag; +static vString *tempIdent; + +/* Ensure a constructor is not a type path beginning + * with a module */ +static void constructorValidation (vString * const ident, ocaToken what, ocaToken whatNext) +{ + switch (what) + { + case Tok_Op: /* if we got a '.' which is an operator */ + toDoNext = &globalScope; + popStrongContext (); + needStrongPoping = false; + break; + + case OcaKEYWORD_of: /* OK, it must be a constructor :) */ + if (vStringLength (tempIdent) > 0) + { + makeTagEntry (&tempTag); + vStringClear (tempIdent); + } + toDoNext = &tillTokenOrFallback; + comeAfter = &typeSpecification; + waitedToken = Tok_Pipe; + break; + + case Tok_Pipe: /* OK, it was a constructor :) */ + if (vStringLength (tempIdent) > 0) + { + makeTagEntry (&tempTag); + vStringClear (tempIdent); + } + toDoNext = &typeSpecification; + break; + + default: /* and mean that we're not facing a module name */ + if (vStringLength (tempIdent) > 0) + { + makeTagEntry (&tempTag); + vStringClear (tempIdent); + } + toDoNext = &tillTokenOrFallback; + comeAfter = &typeSpecification; + waitedToken = Tok_Pipe; + + popStrongContext (); + + // don't pop the module context when going to another expression + needStrongPoping = false; + + /* to be sure we use this token */ + globalScope (ident, what, whatNext); + } +} + +/* Parse beginning of type definition + * type 'avar ident = + * or + * type ('var1, 'var2) ident = + */ +static void typeDecl (vString * const ident, ocaToken what, ocaToken whatNext) +{ + switch (what) + { + /* parameterized */ + case Tok_Prime: + comeAfter = &typeDecl; + toDoNext = &ignoreToken; + break; + /* LOTS of parameters */ + case Tok_PARL: + comeAfter = &typeDecl; + waitedToken = Tok_PARR; + toDoNext = &tillToken; + break; + + case OcaIDENTIFIER: + addTag (ident, K_TYPE); + // true type declaration + if (whatNext == Tok_EQ) + { + pushStrongContext (ident, ContextType); + requestStrongPoping (); + toDoNext = &typeSpecification; + } + else // we're in a sig + toDoNext = &globalScope; + break; + + default: + globalScope (ident, what, whatNext); + } +} + +/** handle 'val' signatures in sigs and .mli files + * val ident : String.t -> Val.t + * Eventually, this will do cool things to annotate + * functions with their actual signatures. But for now, + * it's basically globalLet */ +static void val (vString * const ident, ocaToken what, ocaToken whatNext CTAGS_ATTR_UNUSED) +{ + switch (what) + { + case Tok_PARL: + case OcaKEYWORD_rec: + break; + + case Tok_Op: + /* we are defining a new operator, it's a + * function definition */ + addTag (ident, K_VAL); + toDoNext = &globalScope; + break; + + case Tok_Val: /* Can be a weiiird binding, or an '_' */ + case OcaIDENTIFIER: + addTag (ident, K_VAL); + toDoNext = &globalScope; // sig parser ? + break; + + default: + toDoNext = &globalScope; + break; + } +} + +/* Parse type of kind + * type bidule = Ctor1 of ... + * | Ctor2 + * | Ctor3 of ... + * or + * type bidule = | Ctor1 of ... | Ctor2 + * + * when type bidule = { ... } is detected, + * let typeRecord handle it. */ +static void typeSpecification (vString * const ident, ocaToken what, ocaToken whatNext CTAGS_ATTR_UNUSED) +{ + switch (what) + { + case OcaIDENTIFIER: + if (isUpperAlpha (vStringChar (ident, 0))) + { + /* here we handle type aliases of type + * type foo = AnotherModule.bar + * AnotherModule can mistakenly be took + * for a constructor. */ + if (! OcamlKinds[K_CONSTRUCTOR].enabled) + vStringClear (tempIdent); + else + { + vStringCopy (tempIdent, ident); + prepareTag (&tempTag, tempIdent, K_CONSTRUCTOR); + } + toDoNext = &constructorValidation; + } + else + { + toDoNext = &tillTokenOrFallback; + comeAfter = &typeSpecification; + waitedToken = Tok_Pipe; + } + break; + + case OcaKEYWORD_and: + toDoNext = &typeDecl; + break; + + case OcaKEYWORD_val: + toDoNext = &val; + break; + + case Tok_BRL: /* the '[' & ']' are ignored to accommodate */ + case Tok_BRR: /* with the revised syntax */ + case Tok_Pipe: + /* just ignore it */ + break; + + case Tok_CurlL: + toDoNext = &typeRecord; + break; + + default: /* don't care */ + break; + } +} + + +static bool dirtySpecialParam = false; + +/* parse the ~label and ~label:type parameter */ +static void parseLabel (vString * const ident, ocaToken what, ocaToken whatNext) +{ + static int parCount = 0; + + switch (what) + { + case OcaIDENTIFIER: + if (!dirtySpecialParam) + { + if (exportLocalInfo) + addTag (ident, K_VARIABLE); + + dirtySpecialParam = true; + } + break; + + case Tok_PARL: + parCount++; + break; + + case Tok_PARR: + parCount--; + if (parCount == 0) + toDoNext = &letParam; + break; + + case Tok_Op: + if (vStringChar(ident, 0) == ':') + { + toDoNext = &ignoreToken; + comeAfter = &letParam; + } + else if (parCount == 0 && dirtySpecialParam) + { + toDoNext = &letParam; + letParam (ident, what, whatNext); + } + break; + + default: + if (parCount == 0 && dirtySpecialParam) + { + toDoNext = &letParam; + letParam (ident, what, whatNext); + } + break; + } +} + +/* Optional argument with syntax like this : + * ?(foo = value) */ +static void parseOptionnal (vString * const ident, ocaToken what, ocaToken whatNext CTAGS_ATTR_UNUSED) +{ + static int parCount = 0; + + switch (what) + { + case OcaIDENTIFIER: + if (!dirtySpecialParam) + { + if (exportLocalInfo) + addTag (ident, K_VARIABLE); + + dirtySpecialParam = true; + + if (parCount == 0) + toDoNext = &letParam; + } + break; + + case Tok_PARL: + parCount++; + break; + + case Tok_PARR: + parCount--; + if (parCount == 0) + toDoNext = &letParam; + break; + + default: /* don't care */ + break; + } +} + +/** handle let inside functions (so like it's name + * say : local let */ +static void localLet (vString * const ident, ocaToken what, ocaToken whatNext) +{ + switch (what) + { + case Tok_PARL: + /* We ignore this token to be able to parse such + * declarations : + * let (ident : type) = ... + */ + break; + + case OcaKEYWORD_rec: + /* just ignore to be able to parse such declarations: + * let rec ident = ... */ + break; + + case Tok_Op: + /* we are defining a new operator, it's a + * function definition */ + if (exportLocalInfo) + addTag (ident, K_FUNCTION); + pushSoftContext (mayRedeclare, ident, ContextFunction); + toDoNext = &letParam; + break; + + case Tok_Val: /* Can be a weiiird binding, or an '_' */ + case OcaIDENTIFIER: + // if we're an identifier, and the next token is too, then + // we're definitely a function. + if (whatNext == OcaIDENTIFIER || whatNext == Tok_PARL) + { + if (exportLocalInfo) + addTag (ident, K_FUNCTION); + pushSoftContext (mayRedeclare, ident, ContextFunction); + } + else + { + if (exportLocalInfo) + addTag (ident, K_VARIABLE); + pushSoftContext (mayRedeclare, ident, ContextValue); + } + toDoNext = &letParam; + break; + + case OcaKEYWORD_end: + localScope (ident, what, whatNext); + break; + + default: + toDoNext = &localScope; + break; + } +} + +/* parse : + * | pattern pattern -> ... + * or + * pattern apttern apttern -> ... + * we ignore all identifiers declared in the pattern, + * because their scope is likely to be even more limited + * than the let definitions. + * Used after a match ... with, or a function ... + * because their syntax is similar. */ +static void matchPattern (vString * const ident, ocaToken what, ocaToken whatNext) +{ + /* keep track of [], as it + * can be used in patterns and can + * mean the end of match expression in + * revised syntax */ + static int braceCount = 0; + + switch (what) + { + case Tok_To: + pushEmptyContext (&matchPattern); + toDoNext = &mayRedeclare; + break; + + case Tok_BRL: + braceCount++; + break; + + case OcaKEYWORD_value: + popLastNamed (); + case OcaKEYWORD_and: + case OcaKEYWORD_end: + // why was this global? matches only make sense in local scope + localScope (ident, what, whatNext); + break; + + case OcaKEYWORD_in: + popLastNamed (); + break; + + default: + break; + } +} + +/* Used at the beginning of a new scope (begin of a + * definition, parenthesis...) to catch inner let + * definition that may be in. */ +static void mayRedeclare (vString * const ident, ocaToken what, ocaToken whatNext) +{ + switch (what) + { + case OcaKEYWORD_value: + /* let globalScope handle it */ + globalScope (ident, what, whatNext); + + case OcaKEYWORD_let: + toDoNext = &localLet; + break; + + case OcaKEYWORD_val: + toDoNext = &val; + break; + + case OcaKEYWORD_object: + vStringClear (lastClass); + pushContext (ContextStrong, ContextClass, + &localScope, NULL); + needStrongPoping = false; + toDoNext = &globalScope; + break; + + case OcaKEYWORD_for: + case OcaKEYWORD_while: + toDoNext = &tillToken; + waitedToken = OcaKEYWORD_do; + comeAfter = &mayRedeclare; + break; + + case OcaKEYWORD_try: + toDoNext = &mayRedeclare; + pushSoftContext (&matchPattern, ident, ContextFunction); + break; + + case OcaKEYWORD_function: + toDoNext = &matchPattern; + pushSoftContext (&matchPattern, NULL, ContextMatch); + break; + + case OcaKEYWORD_fun: + toDoNext = &letParam; + break; + + /* Handle the special ;; from the OCaml + * Top level */ + case Tok_semi: + default: + toDoNext = &localScope; + localScope (ident, what, whatNext); + } +} + +/* parse : + * p1 p2 ... pn = ... + * or + * ?(p1=v) p2 ~p3 ~pn:ja ... = ... */ +static void letParam (vString * const ident, ocaToken what, ocaToken whatNext CTAGS_ATTR_UNUSED) +{ + switch (what) + { + case Tok_To: + case Tok_EQ: + toDoNext = &mayRedeclare; + break; + + case OcaIDENTIFIER: + if (exportLocalInfo) + addTag (ident, K_VARIABLE); + break; + + case Tok_Op: + switch (vStringChar (ident, 0)) + { + case ':': + /*popSoftContext(); */ + /* we got a type signature */ + comeAfter = &mayRedeclare; + toDoNext = &tillTokenOrFallback; + waitedToken = Tok_EQ; + break; + + /* parse something like + * ~varname:type + * or + * ~varname + * or + * ~(varname: long type) */ + case '~': + toDoNext = &parseLabel; + dirtySpecialParam = false; + break; + + /* Optional argument with syntax like this : + * ?(bla = value) + * or + * ?bla */ + case '?': + toDoNext = &parseOptionnal; + dirtySpecialParam = false; + break; + + default: + break; + } + break; + + default: /* don't care */ + break; + } +} + +/* parse object ... + * used to be sure the class definition is not a type + * alias */ +static void classSpecif (vString * const ident CTAGS_ATTR_UNUSED, ocaToken what, ocaToken whatNext CTAGS_ATTR_UNUSED) +{ + switch (what) + { + case OcaKEYWORD_object: + pushStrongContext (lastClass, ContextClass); + toDoNext = &globalScope; + break; + + default: + vStringClear (lastClass); + toDoNext = &globalScope; + } +} + +/* Handle a method ... class declaration. + * nearly a copy/paste of globalLet. */ +static void methodDecl (vString * const ident, ocaToken what, ocaToken whatNext) +{ + switch (what) + { + case Tok_PARL: + /* We ignore this token to be able to parse such + * declarations : + * let (ident : type) = ... */ + break; + + case OcaKEYWORD_mutable: + case OcaKEYWORD_virtual: + case OcaKEYWORD_rec: + /* just ignore to be able to parse such declarations: + * let rec ident = ... */ + break; + + case OcaIDENTIFIER: + addTag (ident, K_METHOD); + /* Normal pushing to get good subs */ + pushStrongContext (ident, ContextMethod); + /*pushSoftContext( globalScope, ident, ContextMethod ); */ + toDoNext = &letParam; + break; + + case OcaKEYWORD_end: + localScope (ident, what, whatNext); + break; + + default: + toDoNext = &globalScope; + break; + } +} + +/* name of the last module, used for + * context stacking. */ +static vString *lastModule; + +/* parse + * ... struct (* new global scope *) end + * or + * ... sig (* new global scope *) end + * or + * functor ... -> moduleSpecif + */ +static void moduleSpecif (vString * const ident, ocaToken what, ocaToken whatNext) +{ + switch (what) + { + case OcaKEYWORD_functor: + toDoNext = &contextualTillToken; + waitedToken = Tok_To; + comeAfter = &moduleSpecif; + break; + + case OcaKEYWORD_struct: + case OcaKEYWORD_sig: + pushStrongContext (lastModule, ContextModule); + toDoNext = &globalScope; + needStrongPoping = false; + break; + + case Tok_PARL: /* ( */ + toDoNext = &contextualTillToken; + comeAfter = &globalScope; + waitedToken = Tok_PARR; + contextualTillToken (ident, what, whatNext); + break; + + case Tok_Of: + case Tok_EQ: + break; + + default: + vStringClear (lastModule); + toDoNext = &globalScope; + break; + } +} + +/* parse : + * module name = ... + * then pass the token stream to moduleSpecif */ +static void moduleDecl (vString * const ident, ocaToken what, ocaToken whatNext) +{ + switch (what) + { + case OcaKEYWORD_rec: + /* recursive modules are _weird_, but they happen */ + case OcaKEYWORD_type: + /* this is technically a special type, but whatever */ + break; + + case OcaIDENTIFIER: + addTag (ident, K_MODULE); + vStringCopy (lastModule, ident); + if (whatNext == Tok_Of || whatNext == Tok_EQ) + toDoNext = &moduleSpecif; + else + { + // default to waiting on a '=' since + // module M : sig ... end = struct ... end + // is rarer + waitedToken = Tok_EQ; + comeAfter = &moduleSpecif; + toDoNext = &contextualTillToken; + } + break; + + default: /* don't care */ + break; + } +} + +/* parse : + * class name = ... + * or + * class virtual ['a,'b] classname = ... */ +static void classDecl (vString * const ident, ocaToken what, ocaToken whatNext CTAGS_ATTR_UNUSED) +{ + switch (what) + { + case OcaIDENTIFIER: + addTag (ident, K_CLASS); + vStringCopy (lastClass, ident); + toDoNext = &contextualTillToken; + waitedToken = Tok_EQ; + comeAfter = &classSpecif; + break; + + case Tok_BRL: + toDoNext = &tillToken; + waitedToken = Tok_BRR; + comeAfter = &classDecl; + break; + + default: + break; + } +} + +/* Handle a global + * let ident ... + * or + * let rec ident ... */ +static void globalLet (vString * const ident, ocaToken what, ocaToken whatNext) +{ + switch (what) + { + case Tok_PARL: + /* We ignore this token to be able to parse such + * declarations : + * let (ident : type) = ... + * but () is the toplevel function name, so fake ourselves + * as an ident and make a new function */ + if (whatNext == Tok_PARR) + { + vString *fakeIdent = vStringNewInit ("()"); + addTag (fakeIdent, K_FUNCTION); + pushStrongContext (fakeIdent, ContextFunction); + vStringDelete (fakeIdent); + requestStrongPoping (); + toDoNext = &letParam; + } + break; + + case OcaKEYWORD_mutable: + case OcaKEYWORD_virtual: + case OcaKEYWORD_rec: + /* just ignore to be able to parse such declarations: + * let rec ident = ... */ + break; + + case Tok_Op: + /* we are defining a new operator, it's a + * function definition */ + addTag (ident, K_FUNCTION); + pushStrongContext (ident, ContextFunction); + toDoNext = &letParam; + break; + + case Tok_Val: + if (vStringValue (ident)[0] == '_') + addTag (ident, K_FUNCTION); + pushStrongContext (ident, ContextFunction); + requestStrongPoping (); + toDoNext = &letParam; + break; + + case OcaIDENTIFIER: + // if we're an identifier, and the next token is too, then + // we're definitely a function. + if (whatNext == OcaIDENTIFIER || whatNext == Tok_PARL) + { + addTag (ident, K_FUNCTION); + pushStrongContext (ident, ContextFunction); + } + else + { + addTag (ident, K_VARIABLE); + pushStrongContext (ident, ContextValue); + } + requestStrongPoping (); + toDoNext = &letParam; + break; + + case OcaKEYWORD_end: + globalScope (ident, what, whatNext); + break; + + default: + toDoNext = &globalScope; + break; + } +} + +/* Handle the "strong" top levels, all 'big' declarations + * happen here */ +static void globalScope (vString * const ident CTAGS_ATTR_UNUSED, ocaToken what, ocaToken whatNext) +{ + /* Do not touch, this is used only by the global scope + * to handle an 'and' */ + static parseNext previousParser = &globalScope; + + switch (what) + { + case OcaKEYWORD_and: + cleanupPreviousParser (); + // deal with module M = struct ... end _and_ N = struct ... end + toDoNext = previousParser; + break; + + case OcaKEYWORD_type: + cleanupPreviousParser (); + toDoNext = &typeDecl; + previousParser = &typeDecl; + break; + + case OcaKEYWORD_class: + cleanupPreviousParser (); + toDoNext = &classDecl; + previousParser = &classDecl; + break; + + case OcaKEYWORD_module: + cleanupPreviousParser (); + toDoNext = &moduleDecl; + previousParser = &moduleDecl; + break; + + case OcaKEYWORD_end:; + contextType popped = killCurrentState (); + + /** so here, end can legally be followed by = or and in the + * situation of + * module M : sig ... end = struct ... end and + * module M struct ... end and N = struct ... end + * and we need to make sure we know we're still inside of a + * struct */ + if (whatNext == Tok_EQ && popped == ContextModule) + { + previousParser = &moduleDecl; + toDoNext = &moduleSpecif; + } + else if (whatNext == OcaKEYWORD_and && popped == ContextModule) + toDoNext = &moduleDecl; + needStrongPoping = false; + break; + + case OcaKEYWORD_method: + cleanupPreviousParser (); + toDoNext = &methodDecl; + /* and is not allowed in methods */ + break; + + case OcaKEYWORD_val: + toDoNext = &val; + /* and is not allowed in sigs */ + break; + + case OcaKEYWORD_let: + cleanupPreviousParser (); + toDoNext = &globalLet; + previousParser = &globalLet; + break; + + case OcaKEYWORD_exception: + cleanupPreviousParser (); + toDoNext = &exceptionDecl; + previousParser = &globalScope; + break; + + /* must be a #line directive, discard the + * whole line. */ + case Tok_Sharp: + /* ignore */ + break; + + default: + /* we don't care */ + break; + } +} + +/* Parse expression. Well ignore it is more the case, + * ignore all tokens except "shocking" keywords */ +static void localScope (vString * const ident, ocaToken what, ocaToken whatNext) +{ + switch (what) + { + + // we're probably in a match, so let's go to the last one + case Tok_Pipe: + jumpToMatchContext (); + break; + + case Tok_PARR: + case Tok_BRR: + case Tok_CurlR: + popSoftContext (); + break; + + /* Everything that `begin` has an `end` + * as end is overloaded and signal many end + * of things, we add an empty strong context to + * avoid problem with the end. + */ + case OcaKEYWORD_begin: + pushContext (ContextStrong, ContextBlock, &mayRedeclare, NULL); + toDoNext = &mayRedeclare; + break; + + /* An in keyword signals the end of the previous context and the + * start of a new one. */ + case OcaKEYWORD_in: + popLastNamed (); + pushEmptyContext (&localScope); + toDoNext = &mayRedeclare; + break; + + /* Ok, we got a '{', which is much likely to create + * a record. We cannot treat it like other [ && (, + * because it may contain the 'with' keyword and screw + * everything else. */ + case Tok_CurlL: + toDoNext = &contextualTillToken; + waitedToken = Tok_CurlR; + comeAfter = &localScope; + contextualTillToken (ident, what, whatNext); + break; + + /* Yeah imperative feature of OCaml, + * a ';' like in C */ + case Tok_semi: + /* ';;' case should end all scopes */ + if (whatNext == Tok_semi) + { + popStrongContext (); + toDoNext = &globalScope; + break; + } /* else fallthrough */ + + /* Every standard operator has very high precedence + * e.g. expr * expr needs no parentheses */ + case Tok_Op: + toDoNext = &mayRedeclare; + break; + + case Tok_PARL: + case Tok_BRL: + pushEmptyContext (&localScope); + toDoNext = &mayRedeclare; + break; + + case OcaKEYWORD_and: + if (toDoNext == &mayRedeclare) + { + popSoftContext (); + pushEmptyContext (localScope); + toDoNext = &localLet; + } + else + { + /* a local 'and' keyword jumps up a context to the last + * named. For ex + * in `with let IDENT ... and IDENT2 ...` ident and + * ident2 are on + * same level, the same as `let IDENT ... in let IDENT2 + * ...` + * a 'let' is the only 'and'-chainable construct allowed + * locally + * (thus we had to be one to get here), so we either go + * to + * globalLet or localLet depending on our scope. */ + popLastNamed (); + toDoNext = stackIndex == 0 ? &globalLet : &localLet; + } + break; + + case OcaKEYWORD_else: + case OcaKEYWORD_then: + popSoftContext (); + pushEmptyContext (&localScope); + toDoNext = &mayRedeclare; + break; + + case OcaKEYWORD_if: + pushEmptyContext (&localScope); + toDoNext = &mayRedeclare; + break; + + case OcaKEYWORD_match: + pushEmptyContext (&localScope); + toDoNext = &mayRedeclare; + break; + + case OcaKEYWORD_with: + popSoftContext (); + toDoNext = &matchPattern; + pushSoftContext (&matchPattern, NULL, ContextMatch); + break; + + case OcaKEYWORD_fun: + toDoNext = &letParam; + break; + + case OcaKEYWORD_done: + /* doesn't care */ + break; + + default: + requestStrongPoping (); + globalScope (ident, what, whatNext); + break; + } +} + +/*//////////////////////////////////////////////////////////////// +//// Deal with the system */ +/* in OCaml the file name is the module name used in the language + * with it first letter put in upper case */ +static void computeModuleName ( void ) +{ + /* in OCaml the file name define a module. + * so we define a module if the file has + * things in it. =) + */ + const char *filename = getInputFileName (); + + int beginIndex = 0; + int endIndex = strlen (filename) - 1; + vString *moduleName = vStringNew (); + + while (filename[endIndex] != '.' && endIndex > 0) + endIndex--; + + /* avoid problem with path in front of filename */ + beginIndex = endIndex; + while (beginIndex > 0) + { + if (filename[beginIndex] == '\' || filename[beginIndex] == '/') + { + beginIndex++; + break; + } + + beginIndex--; + } + + vStringNCopyS (moduleName, &filename[beginIndex], endIndex - beginIndex); + + if (isLowerAlpha (vStringChar (moduleName, 0))) + vStringChar (moduleName, 0) += ('A' - 'a'); + + addTag (moduleName, K_MODULE); + vStringDelete (moduleName); +} + +/* Allocate all string of the context stack */ +static void initStack ( void ) +{ + int i; + for (i = 0; i < OCAML_MAX_STACK_SIZE; ++i) + stack[i].contextName = vStringNew (); + stackIndex = 0; +} + +static void clearStack ( void ) +{ + int i; + for (i = 0; i < OCAML_MAX_STACK_SIZE; ++i) + vStringDelete (stack[i].contextName); +} + +static void findOcamlTags (void) +{ + lexingState st; + ocaToken tok; + + /* One-token lookahead gives us the ability to + * do much more accurate analysis */ + lexingState nextSt; + ocaToken nextTok; + + initStack (); + + tempIdent = vStringNew (); + lastModule = vStringNew (); + lastClass = vStringNew (); + vString *temp_cp = vStringNew (); + + nextSt.name = vStringNew (); + nextSt.cp = readLineFromInputFile (); + ocaLineNumber = getInputLineNumber(); + ocaFilePosition = getInputFilePosition(); + toDoNext = &globalScope; + nextTok = lex (&nextSt); + + if (nextTok != Tok_EOF) + computeModuleName (); + + /* prime the lookahead token */ + st = nextSt; // preserve the old state for our first token + st.name = vStringNewCopy (st.name); + st.cp = (const unsigned char *) vStringValue (temp_cp); + tok = nextTok; + ocaLineNumber = getInputLineNumber(); /* ??? getSourceLineNumber() */ + ocaFilePosition = getInputFilePosition(); + nextTok = lex (&nextSt); + + /* main loop */ + while (tok != Tok_EOF) + { + (*toDoNext) (st.name, tok, nextTok); + + tok = nextTok; + ocaLineNumber = getInputLineNumber(); /* ??? */ + ocaFilePosition = getInputFilePosition(); + + if (nextTok != Tok_EOF) + { + vStringCopyS (temp_cp, (const char *) nextSt.cp); + st.cp = (const unsigned char *) vStringValue (temp_cp); + vStringCopy (st.name, nextSt.name); + nextTok = lex (&nextSt); + } + else + break; + } + + vStringDelete (st.name); + vStringDelete (nextSt.name); + vStringDelete (temp_cp); + vStringDelete (tempIdent); + vStringDelete (lastModule); + vStringDelete (lastClass); + clearStack (); +} + +static void ocamlInitialize (const langType language) +{ + Lang_Ocaml = language; + + initOperatorTable (); +} + +extern parserDefinition *OcamlParser (void) +{ + static const char *const extensions[] = { "ml", "mli", "aug", NULL }; + static const char *const aliases[] = { "tuareg", /* mode name of emacs */ + "caml", /* mode name of emacs */ + NULL }; + parserDefinition *def = parserNew ("OCaml"); + def->kindTable = OcamlKinds; + def->kindCount = ARRAY_SIZE (OcamlKinds); + def->extensions = extensions; + def->aliases = aliases; + def->parser = findOcamlTags; + def->initialize = ocamlInitialize; + def->keywordTable = OcamlKeywordTable; + def->keywordCount = ARRAY_SIZE (OcamlKeywordTable); + return def; +}
Modified: meson.build 1 lines changed, 1 insertions(+), 0 deletions(-) =================================================================== @@ -660,6 +660,7 @@ ctags = static_library('ctags', 'ctags/parsers/markdown.h', 'ctags/parsers/nsis.c', 'ctags/parsers/objc.c', + 'ctags/parsers/ocaml.c', 'ctags/parsers/pascal.c', 'ctags/parsers/perl.c', 'ctags/parsers/perl.h',
Modified: src/filetypes.c 2 lines changed, 1 insertions(+), 1 deletions(-) =================================================================== @@ -138,7 +138,7 @@ static void init_builtin_filetypes(void) FT_INIT( FORTRAN, FORTRAN, "Fortran", "Fortran (F90)", SOURCE_FILE, COMPILED ); FT_INIT( F77, FORTRAN, "F77", "Fortran (F77)", SOURCE_FILE, COMPILED ); FT_INIT( GLSL, C, "GLSL", NULL, SOURCE_FILE, COMPILED ); - FT_INIT( CAML, NONE, "CAML", "(O)Caml", SOURCE_FILE, COMPILED ); + FT_INIT( CAML, OCAML, "CAML", "(O)Caml", SOURCE_FILE, COMPILED ); FT_INIT( PERL, PERL, "Perl", NULL, SOURCE_FILE, SCRIPT ); FT_INIT( PHP, PHP, "PHP", NULL, SOURCE_FILE, SCRIPT ); FT_INIT( JS, JAVASCRIPT, "Javascript", NULL, SOURCE_FILE, SCRIPT );
Modified: src/tagmanager/tm_parser.c 22 lines changed, 22 insertions(+), 0 deletions(-) =================================================================== @@ -1114,6 +1114,26 @@ static TMParserMapGroup group_RAKU[] = { {N_("Rules / Tokens"), TM_ICON_VAR, tm_tag_variable_t}, };
+static TMParserMapEntry map_OCAML[] = { + {'c', tm_tag_class_t}, // class + {'m', tm_tag_method_t}, // method + {'M', tm_tag_package_t}, // module + {'v', tm_tag_variable_t}, // var + {'p', tm_tag_undef_t}, // val + {'t', tm_tag_typedef_t}, // type + {'f', tm_tag_function_t}, // function + {'C', tm_tag_undef_t}, // Constructor + {'r', tm_tag_undef_t}, // RecordField + {'e', tm_tag_undef_t}, // Exception +}; +static TMParserMapGroup group_OCAML[] = { + {N_("Modules"), TM_ICON_NAMESPACE, tm_tag_package_t}, + {N_("Classes"), TM_ICON_CLASS, tm_tag_class_t}, + {N_("Types"), TM_ICON_STRUCT, tm_tag_typedef_t}, + {N_("Functions"), TM_ICON_METHOD, tm_tag_method_t | tm_tag_function_t}, + {N_("Variables"), TM_ICON_VAR, tm_tag_variable_t}, +}; + typedef struct { TMParserMapEntry *entries; @@ -1187,6 +1207,7 @@ static TMParserMap parser_map[] = { MAP_ENTRY(BATCH), MAP_ENTRY(AUTOIT), MAP_ENTRY(RAKU), + MAP_ENTRY(OCAML), }; /* make sure the parser map is consistent and complete */ G_STATIC_ASSERT(G_N_ELEMENTS(parser_map) == TM_PARSER_COUNT); @@ -1728,6 +1749,7 @@ gboolean tm_parser_has_full_scope(TMParserType lang) case TM_PARSER_ERLANG: case TM_PARSER_FORTRAN: case TM_PARSER_OBJC: + case TM_PARSER_OCAML: case TM_PARSER_REST: /* Other parsers don't use scope at all (or should be somewhere above) */ default:
Modified: src/tagmanager/tm_parser.h 1 lines changed, 1 insertions(+), 0 deletions(-) =================================================================== @@ -120,6 +120,7 @@ enum TM_PARSER_BATCH, TM_PARSER_AUTOIT, TM_PARSER_RAKU, + TM_PARSER_OCAML, TM_PARSER_COUNT };
Modified: src/tagmanager/tm_parsers.h 3 lines changed, 2 insertions(+), 1 deletions(-) =================================================================== @@ -74,6 +74,7 @@ TypeScriptParser, \ DosBatchParser, \ AutoItParser, \ - Perl6Parser + Perl6Parser, \ + OcamlParser
#endif
Modified: tests/ctags/Makefile.am 1 lines changed, 1 insertions(+), 0 deletions(-) =================================================================== @@ -313,6 +313,7 @@ test_sources = \ simple.lua \ simple.mak \ simple.md \ + simple.ml \ simple.php \ simple.pl \ simple.ps1 \
Modified: tests/ctags/simple.ml 35 lines changed, 35 insertions(+), 0 deletions(-) =================================================================== @@ -0,0 +1,35 @@ +module ModuleFoo = struct + type foobar = + ConstructorFoo + | ConstructorBar of int * char list +end + +type 'a foorecord = + { foofield : 'a; + barfield : int; + mutable foobarfield : list char -> int -> unit } + +(* op redif *) +let (+-) a b = + let aplus = a + b + and aminus = a - b + in + (aplus, aminus) + +let shall_appear () = + let sub_not 1 = 2 + and shall_not_either fu = () in + let nope = 3 +and must_appear_also 4 = () + +let y = 4 + +let foo_function a b = (a, b) + +class fooClass = +object (self) + val x = () + method fooMethod = x +end + +exception ConnectionNotReachable
Modified: tests/ctags/simple.ml.tags 20 lines changed, 20 insertions(+), 0 deletions(-) =================================================================== @@ -0,0 +1,20 @@ ++-�16�0 +function: +- +ModuleFoo�512�0 +package: ModuleFoo +Simple�512�0 +package: Simple +fooClass�1�0 +class: fooClass +fooMethod�128�fooClass�0 +method: fooClass :: fooMethod +foo_function�16�0 +function: foo_function +foobar�4096�ModuleFoo�0 +typedef: ModuleFoo :: foobar +foorecord�4096�0 +typedef: foorecord +shall_appear�16�0 +function: shall_appear +y�16384�0 +variable: y
Modified: tests/meson.build 1 lines changed, 1 insertions(+), 0 deletions(-) =================================================================== @@ -310,6 +310,7 @@ ctags_tests = files([ 'ctags/simple.lua.tags', 'ctags/simple.mak.tags', 'ctags/simple.md.tags', + 'ctags/simple.ml.tags', 'ctags/simple.php.tags', 'ctags/simple.pl.tags', 'ctags/simple.ps1.tags',
-------------- This E-Mail was brought to you by github_commit_mail.py (Source: https://github.com/geany/infrastructure).