Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Added support for Objective Caml (OCaml) language, provided by Vincen…

…t Berthoux [Patch #2738723].
  • Loading branch information...
commit 1df2284f7e26090458b8eea4807172c5afc28f16 1 parent 1c54fbc
Darren Hiebert authored
View
2  NEWS
@@ -1,6 +1,8 @@
Current Version: @VERSION@
ctags-@VERSION@ (@DATE@)
+* Removed ".ml" as a Lisp extension (now OCaml) [Lisp].
+* Added support for Objective Camel (OCaml), provided by Vincent Berthoux [OCaml, Patch #2738723].
* Added support for Pyrex/Cython declarations [Python].
* Added support for "v" kind for variables [Python].
* Added support for new language: VHDL, contributed by Nicolas Vincent [VHDL, Bug #1943306].
View
26 Test/ocamlAllKinds.ml
@@ -0,0 +1,26 @@
+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 foo_function a b = (a, b)
+
+class fooClass =
+object (self)
+ val x = ()
+ method fooMethod = x
+end
+
View
2  lisp.c
@@ -126,7 +126,7 @@ static void findLispTags (void)
extern parserDefinition* LispParser (void)
{
static const char *const extensions [] = {
- "cl", "clisp", "el", "l", "lisp", "lsp", "ml", NULL
+ "cl", "clisp", "el", "l", "lisp", "lsp", NULL
};
parserDefinition* def = parserNew ("Lisp");
def->kinds = LispKinds;
View
1,842 ocaml.c
@@ -0,0 +1,1842 @@
+/*
+* Copyright (c) 2009, Vincent Berthoux
+*
+* This source code is released for free distribution under the terms of the
+* GNU General Public License.
+*
+* 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 "keyword.h"
+#include "entry.h"
+#include "options.h"
+#include "read.h"
+#include "routines.h"
+#include "vstring.h"
+
+/* To get rid of unused parameter warning in
+ * -Wextra */
+#ifdef UNUSED
+#elif defined(__GNUC__)
+# define UNUSED(x) UNUSED_ ## x __attribute__((unused))
+#elif defined(__LCLINT__)
+# define UNUSED(x) /*@unused@*/ x
+#else
+# define UNUSED(x) x
+#endif
+#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_VAR,
+ K_TYPE, /* name of an OCaml type */
+ K_FUNCTION,
+ K_CONSTRUCTOR, /* Constructor of a sum type */
+ K_RECORDFIELD,
+ K_EXCEPTION
+} ocamlKind;
+
+static kindOption OcamlKinds[] = {
+ {TRUE, 'c', "class", "classes"},
+ {TRUE, 'm', "method", "Object's method"},
+ {TRUE, 'M', "module", "Module or functor"},
+ {TRUE, 'v', "var", "Global variable"},
+ {TRUE, 't', "type", "Type name"},
+ {TRUE, 'f', "function", "A function"},
+ {TRUE, 'C', "Constructor", "A constructor"},
+ {TRUE, 'r', "Record field", "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_if,
+ OcaKEYWORD_in,
+ OcaKEYWORD_let,
+ 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_Sharp, /* '#' */
+ Tok_Backslash, /* '\\' */
+
+ Tok_EOF /* END of file */
+} ocamlKeyword;
+
+typedef struct sOcaKeywordDesc {
+ const char *name;
+ ocamlKeyword id;
+} ocaKeywordDesc;
+
+typedef ocamlKeyword ocaToken;
+
+static const ocaKeywordDesc 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 },
+ { "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_let }, /* 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 },
+ { "true" , Tok_Val },
+ { "false" , Tok_Val }
+};
+
+static langType Lang_Ocaml;
+
+boolean 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 */
+boolean isOperator[1 << (8 * sizeof (char))] = { FALSE };
+
+static void initKeywordHash ( void )
+{
+ const size_t count = sizeof (OcamlKeywordTable) / sizeof (ocaKeywordDesc);
+ size_t i;
+
+ for (i = 0; i < count; ++i)
+ {
+ addKeyword (OcamlKeywordTable[i].name, Lang_Ocaml,
+ (int) OcamlKeywordTable[i].id);
+ }
+}
+
+/* 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 boolean isNum (char c)
+{
+ return c >= '0' && c <= '9';
+}
+static boolean isLowerAlpha (char c)
+{
+ return c >= 'a' && c <= 'z';
+}
+
+static boolean isUpperAlpha (char c)
+{
+ return c >= 'A' && c <= 'Z';
+}
+
+static boolean isAlpha (char c)
+{
+ return isLowerAlpha (c) || isUpperAlpha (c);
+}
+
+static boolean isIdent (char c)
+{
+ return isNum (c) || isAlpha (c) || c == '_' || c == '\'';
+}
+
+static boolean 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)
+{
+ boolean lastIsBackSlash = FALSE;
+ boolean 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)
+{
+ boolean unfinished = TRUE;
+ boolean 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 = fileReadLine ();
+ /* WOOPS... no more input...
+ * we return, next lexing read
+ * will be null and ok */
+ if (st->cp == NULL)
+ return;
+ c = st->cp;
+ continue;
+ }
+ /* we've reached the end of the comment */
+ else if (*c == ')' && lastIsStar)
+ unfinished = FALSE;
+ /* 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;
+ lastIsStar = FALSE;
+ }
+ 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;
+
+ vStringTerminate (st->name);
+}
+
+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++;
+ }
+
+ vStringTerminate (st->name);
+
+ st->cp += count;
+ if (count <= 1)
+ {
+ switch (root[0])
+ {
+ case '|':
+ return Tok_Pipe;
+ case '=':
+ return Tok_EQ;
+ default:
+ return Tok_Op;
+ }
+ }
+ else if (count == 2 && root[0] == '-' && root[1] == '>')
+ return Tok_To;
+ 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 = fileReadLine ();
+ 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);
+ }
+ /* OCaml permit the definition of our own operators
+ * so here we check all the consecuting 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_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);
+
+/********** Helpers */
+/* This variable hold the 'parser' which is going to
+ * handle the next token */
+parseNext toDoNext;
+
+/* Special variable used by parser eater to
+ * determine which action to put after their
+ * job is finished. */
+parseNext comeAfter;
+
+/* If a token put an end to current delcaration/
+ * statement */
+ocaToken terminatingToken;
+
+/* Token to be searched by the different
+ * parser eater. */
+ocaToken waitedToken;
+
+/* name of the last class, used for
+ * context stacking. */
+vString *lastClass;
+
+vString *voidName;
+
+typedef enum _sContextKind {
+ ContextStrong,
+ ContextSoft
+} contextKind;
+
+typedef enum _sContextType {
+ ContextType,
+ ContextModule,
+ ContextClass,
+ ContextValue,
+ ContextFunction,
+ ContextMethod,
+ ContextBlock
+} 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. */
+ocamlContext stack[OCAML_MAX_STACK_SIZE];
+/* current position in the tag */
+int stackIndex;
+
+/* special function, often recalled, so putting it here */
+static void globalScope (vString * const ident, ocaToken what);
+
+/* 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 (stack[i].contextName->buffer &&
+ strlen (stack[i].contextName->buffer) > 0)
+ {
+ return i;
+ }
+ }
+
+ return -1;
+}
+
+static const char *contextDescription (contextType t)
+{
+ switch (t)
+ {
+ case ContextFunction:
+ return "function";
+ case ContextMethod:
+ return "method";
+ case ContextValue:
+ return "value";
+ case ContextModule:
+ return "Module";
+ case ContextType:
+ return "type";
+ case ContextClass:
+ return "class";
+ case ContextBlock:
+ return "begin/end";
+ }
+
+ return NULL;
+}
+
+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 ' ';
+ }
+
+ 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_ delcaration (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;
+}
+
+/* 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 UNUSED (ident), ocaToken what)
+{
+ 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 UNUSED (ident), ocaToken what)
+{
+ 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)
+ {
+ popStrongContext ();
+ toDoNext = &globalScope;
+ }
+}
+
+/* Wait for waitedToken and jump to comeAfter or let
+ * the globalScope handle declarations */
+static void tillTokenOrFallback (vString * const ident, ocaToken what)
+{
+ if (what == waitedToken)
+ toDoNext = comeAfter;
+ else
+ globalScope (ident, what);
+}
+
+/* ignore token till waitedToken, or give up if find
+ * terminatingToken. Use globalScope to handle new
+ * declarations. */
+static void tillTokenOrTerminatingOrFallback (vString * const ident,
+ ocaToken what)
+{
+ if (what == waitedToken)
+ toDoNext = comeAfter;
+ else if (what == terminatingToken)
+ toDoNext = globalScope;
+ else
+ globalScope (ident, what);
+}
+
+/* ignore the next token in the stream and jump to the
+ * given comeAfter state */
+static void ignoreToken (vString * const UNUSED (ident), ocaToken UNUSED (what))
+{
+ toDoNext = comeAfter;
+}
+
+/********** Grammar */
+/* the purpose of each function is detailled near their
+ * implementation */
+
+static void killCurrentState ( void )
+{
+
+ /* Tracking the kind of previous strong
+ * context, if it doesn't match with a
+ * really strong entity, repop */
+ switch (popStrongContext ())
+ {
+
+ case ContextValue:
+ popStrongContext ();
+ break;
+ case ContextFunction:
+ popStrongContext ();
+ break;
+ case ContextMethod:
+ popStrongContext ();
+ break;
+
+ case ContextType:
+ popStrongContext();
+ break;
+ case ContextBlock:
+ break;
+ case ContextModule:
+ break;
+ case ContextClass:
+ break;
+ default:
+ /* nothing more */
+ break;
+ }
+}
+
+/* used to prepare tag for OCaml, just in case their is a need to
+ * add additional information to the tag. */
+static void prepareTag (tagEntryInfo * tag, vString const *name, ocamlKind kind)
+{
+ int parentIndex;
+
+ initTagEntry (tag, vStringValue (name));
+ tag->kindName = OcamlKinds[kind].name;
+ tag->kind = OcamlKinds[kind].letter;
+
+ parentIndex = getLastNamedIndex ();
+ if (parentIndex >= 0)
+ {
+ tag->extensionFields.scope[0] =
+ contextDescription (stack[parentIndex].type);
+ tag->extensionFields.scope[1] =
+ 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)
+{
+ tagEntryInfo toCreate;
+ prepareTag (&toCreate, ident, kind);
+ makeTagEntry (&toCreate);
+}
+
+boolean 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);
+static void localScope (vString * const ident, ocaToken what);
+static void mayRedeclare (vString * const ident, ocaToken what);
+static void typeSpecification (vString * const ident, ocaToken what);
+
+/*
+ * Parse a record type
+ * type ident = // parsed previously
+ * {
+ * ident1: type1;
+ * ident2: type2;
+ * }
+ */
+static void typeRecord (vString * const ident, ocaToken what)
+{
+ 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 ();
+ toDoNext = &globalScope;
+ break;
+
+ default: /* don't care */
+ break;
+ }
+}
+
+/* handle :
+ * exception ExceptionName ... */
+static void exceptionDecl (vString * const ident, ocaToken what)
+{
+ if (what == OcaIDENTIFIER)
+ {
+ addTag (ident, K_EXCEPTION);
+ }
+ /* don't know what to do on else... */
+
+ toDoNext = &globalScope;
+}
+
+tagEntryInfo tempTag;
+vString *tempIdent;
+
+/* Ensure a constructor is not a type path beginning
+ * with a module */
+static void constructorValidation (vString * const ident, ocaToken what)
+{
+ 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 :) */
+ makeTagEntry (&tempTag);
+ vStringClear (tempIdent);
+ toDoNext = &tillTokenOrFallback;
+ comeAfter = &typeSpecification;
+ waitedToken = Tok_Pipe;
+ break;
+
+ case Tok_Pipe: /* OK, it was a constructor :) */
+ makeTagEntry (&tempTag);
+ vStringClear (tempIdent);
+ toDoNext = &typeSpecification;
+ break;
+
+ default: /* and mean that we're not facing a module name */
+ makeTagEntry (&tempTag);
+ vStringClear (tempIdent);
+ toDoNext = &tillTokenOrFallback;
+ comeAfter = &typeSpecification;
+ waitedToken = Tok_Pipe;
+
+ /* nothing in the context, discard it */
+ popStrongContext ();
+
+ /* to be sure we use this token */
+ globalScope (ident, what);
+ }
+}
+
+
+/* Parse beginning of type definition
+ * type 'avar ident =
+ * or
+ * type ('var1, 'var2) ident =
+ */
+static void typeDecl (vString * const ident, ocaToken what)
+{
+
+ 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);
+ pushStrongContext (ident, ContextType);
+ requestStrongPoping ();
+ waitedToken = Tok_EQ;
+ comeAfter = &typeSpecification;
+ toDoNext = &tillTokenOrFallback;
+ break;
+
+ default:
+ globalScope (ident, what);
+ }
+}
+
+/* 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)
+{
+
+ switch (what)
+ {
+ case OcaIDENTIFIER:
+ if (isUpperAlpha (ident->buffer[0]))
+ {
+ /* here we handle type aliases of type
+ * type foo = AnotherModule.bar
+ * AnotherModule can mistakenly be took
+ * for a constructor. */
+ 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 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 boolean dirtySpecialParam = FALSE;
+
+
+/* parse the ~label and ~label:type parameter */
+static void parseLabel (vString * const ident, ocaToken what)
+{
+ static int parCount = 0;
+
+ switch (what)
+ {
+ case OcaIDENTIFIER:
+ if (!dirtySpecialParam)
+ {
+
+ if (exportLocalInfo)
+ addTag (ident, K_VAR);
+
+ dirtySpecialParam = TRUE;
+ }
+ break;
+
+ case Tok_PARL:
+ parCount++;
+ break;
+
+ case Tok_PARR:
+ parCount--;
+ if (parCount == 0)
+ toDoNext = &letParam;
+ break;
+
+ case Tok_Op:
+ if (ident->buffer[0] == ':')
+ {
+ toDoNext = &ignoreToken;
+ comeAfter = &letParam;
+ }
+ else if (parCount == 0 && dirtySpecialParam)
+ {
+ toDoNext = &letParam;
+ letParam (ident, what);
+ }
+ break;
+
+ default:
+ if (parCount == 0 && dirtySpecialParam)
+ {
+ toDoNext = &letParam;
+ letParam (ident, what);
+ }
+ break;
+ }
+}
+
+
+/* Optional argument with syntax like this :
+ * ?(foo = value) */
+static void parseOptionnal (vString * const ident, ocaToken what)
+{
+ static int parCount = 0;
+
+
+ switch (what)
+ {
+ case OcaIDENTIFIER:
+ if (!dirtySpecialParam)
+ {
+ if (exportLocalInfo)
+ addTag (ident, K_VAR);
+
+ 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)
+{
+ 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;
+
+ /* Can be a weiiird binding, or an '_' */
+ case Tok_Val:
+ if (exportLocalInfo)
+ addTag (ident, K_VAR);
+ pushSoftContext (mayRedeclare, ident, ContextValue);
+ toDoNext = &letParam;
+ break;
+
+ case OcaIDENTIFIER:
+ if (exportLocalInfo)
+ addTag (ident, K_VAR);
+ pushSoftContext (mayRedeclare, ident, ContextValue);
+ toDoNext = &letParam;
+ break;
+
+ case OcaKEYWORD_end:
+ popStrongContext ();
+ 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 ... or fun ...
+ * because their syntax is similar. */
+static void matchPattern (vString * const UNUSED (ident), ocaToken what)
+{
+ switch (what)
+ {
+ case Tok_To:
+ pushEmptyContext (&matchPattern);
+ toDoNext = &mayRedeclare;
+ 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)
+{
+ switch (what)
+ {
+ case OcaKEYWORD_let:
+ case OcaKEYWORD_val:
+ toDoNext = localLet;
+ break;
+
+ case OcaKEYWORD_object:
+ vStringClear (lastClass);
+ pushContext (ContextStrong, ContextClass,
+ &localScope, NULL /*voidName */ );
+ 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_fun:
+ toDoNext = &matchPattern;
+ break;
+
+ /* Handle the special ;; from the OCaml
+ * Top level */
+ case Tok_semi:
+ default:
+ toDoNext = &localScope;
+ localScope (ident, what);
+ }
+}
+
+/* parse :
+ * p1 p2 ... pn = ...
+ * or
+ * ?(p1=v) p2 ~p3 ~pn:ja ... = ... */
+static void letParam (vString * const ident, ocaToken what)
+{
+ switch (what)
+ {
+ case Tok_EQ:
+ toDoNext = &mayRedeclare;
+ break;
+
+ case OcaIDENTIFIER:
+ if (exportLocalInfo)
+ addTag (ident, K_VAR);
+ break;
+
+ case Tok_Op:
+ switch (ident->buffer[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 UNUSED (ident), ocaToken what)
+{
+ 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)
+{
+ 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:
+ popStrongContext ();
+ break;
+
+ default:
+ toDoNext = &globalScope;
+ break;
+ }
+}
+
+/* name of the last module, used for
+ * context stacking. */
+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)
+{
+ switch (what)
+ {
+ case OcaKEYWORD_functor:
+ toDoNext = &contextualTillToken;
+ waitedToken = Tok_To;
+ comeAfter = &moduleSpecif;
+ break;
+
+ case OcaKEYWORD_struct:
+ case OcaKEYWORD_sig:
+ pushStrongContext (lastModule, ContextModule);
+ toDoNext = &globalScope;
+ break;
+
+ case Tok_PARL: /* ( */
+ toDoNext = &contextualTillToken;
+ comeAfter = &globalScope;
+ waitedToken = Tok_PARR;
+ contextualTillToken (ident, what);
+ break;
+
+ default:
+ vStringClear (lastModule);
+ toDoNext = &globalScope;
+ }
+}
+
+/* parse :
+ * module name = ...
+ * then pass the token stream to moduleSpecif */
+static void moduleDecl (vString * const ident, ocaToken what)
+{
+ switch (what)
+ {
+ case OcaKEYWORD_type:
+ /* just ignore it, name come after */
+ break;
+
+ case OcaIDENTIFIER:
+ addTag (ident, K_MODULE);
+ vStringCopy (lastModule, ident);
+ 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)
+{
+ 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)
+{
+ 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 Tok_Op:
+ /* we are defining a new operator, it's a
+ * function definition */
+ addTag (ident, K_FUNCTION);
+ pushStrongContext (ident, ContextFunction);
+ toDoNext = &letParam;
+ break;
+
+ case OcaIDENTIFIER:
+ addTag (ident, K_VAR);
+ pushStrongContext (ident, ContextValue);
+ requestStrongPoping ();
+ toDoNext = &letParam;
+ break;
+
+ case OcaKEYWORD_end:
+ popStrongContext ();
+ break;
+
+ default:
+ toDoNext = &globalScope;
+ break;
+ }
+}
+
+/* Handle the "strong" top levels, all 'big' declarations
+ * happen here */
+static void globalScope (vString * const UNUSED (ident), ocaToken what)
+{
+ /* Do not touch, this is used only by the global scope
+ * to handle an 'and' */
+ static parseNext previousParser = NULL;
+
+ switch (what)
+ {
+ case OcaKEYWORD_and:
+ cleanupPreviousParser ();
+ 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:
+ needStrongPoping = FALSE;
+ killCurrentState ();
+ /*popStrongContext(); */
+ break;
+
+ case OcaKEYWORD_method:
+ cleanupPreviousParser ();
+ toDoNext = &methodDecl;
+ /* and is not allowed in methods */
+ break;
+
+ /* val is mixed with let as global
+ * to be able to handle mli & new syntax */
+ case OcaKEYWORD_val:
+ case OcaKEYWORD_let:
+ cleanupPreviousParser ();
+ toDoNext = &globalLet;
+ previousParser = &globalLet;
+ break;
+
+ case OcaKEYWORD_exception:
+ cleanupPreviousParser ();
+ toDoNext = &exceptionDecl;
+ previousParser = NULL;
+ 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)
+{
+ switch (what)
+ {
+ case Tok_Pipe:
+ 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;
+
+ case OcaKEYWORD_in:
+ popLastNamed ();
+ 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);
+ break;
+
+ /* Yeah imperative feature of OCaml,
+ * a ';' like in C */
+ case Tok_semi:
+ toDoNext = &mayRedeclare;
+ break;
+
+ case Tok_PARL:
+ case Tok_BRL:
+ pushEmptyContext (&localScope);
+ toDoNext = &mayRedeclare;
+ break;
+
+ case OcaKEYWORD_and:
+ popLastNamed ();
+ toDoNext = &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;
+ pushEmptyContext (&matchPattern);
+ break;
+
+ case OcaKEYWORD_end:
+ killCurrentState ();
+ break;
+
+
+ case OcaKEYWORD_fun:
+ comeAfter = &mayRedeclare;
+ toDoNext = &tillToken;
+ waitedToken = Tok_To;
+ break;
+
+ case OcaKEYWORD_done:
+ case OcaKEYWORD_val:
+ /* doesn't care */
+ break;
+
+ default:
+ requestStrongPoping ();
+ globalScope (ident, what);
+ 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 =)
+ */
+ const char *filename = getSourceFileName ();
+ 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);
+ vStringTerminate (moduleName);
+
+ if (isLowerAlpha (moduleName->buffer[0]))
+ moduleName->buffer[0] += ('A' - 'a');
+
+ makeSimpleTag (moduleName, OcamlKinds, 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 ();
+}
+
+static void clearStack ( void )
+{
+ int i;
+ for (i = 0; i < OCAML_MAX_STACK_SIZE; ++i)
+ vStringDelete (stack[i].contextName);
+}
+
+static void findOcamlTags (void)
+{
+ vString *name = vStringNew ();
+ lexingState st;
+ ocaToken tok;
+
+ computeModuleName ();
+ initStack ();
+ tempIdent = vStringNew ();
+ lastModule = vStringNew ();
+ lastClass = vStringNew ();
+ voidName = vStringNew ();
+ vStringCopyS (voidName, "_");
+
+ st.name = vStringNew ();
+ st.cp = fileReadLine ();
+ toDoNext = &globalScope;
+ tok = lex (&st);
+ while (tok != Tok_EOF)
+ {
+ (*toDoNext) (st.name, tok);
+ tok = lex (&st);
+ }
+
+ vStringDelete (name);
+ vStringDelete (voidName);
+ vStringDelete (tempIdent);
+ vStringDelete (lastModule);
+ vStringDelete (lastClass);
+ clearStack ();
+}
+
+static void ocamlInitialize (const langType language)
+{
+ Lang_Ocaml = language;
+
+ initOperatorTable ();
+ initKeywordHash ();
+}
+
+extern parserDefinition *OcamlParser (void)
+{
+ static const char *const extensions[] = { "ml", "mli", NULL };
+ parserDefinition *def = parserNew ("OCaml");
+ def->kinds = OcamlKinds;
+ def->kindCount = KIND_COUNT (OcamlKinds);
+ def->extensions = extensions;
+ def->parser = findOcamlTags;
+ def->initialize = ocamlInitialize;
+
+ return def;
+}
View
1  parsers.h
@@ -38,6 +38,7 @@
LuaParser, \
MakefileParser, \
MatLabParser, \
+ OcamlParser, \
PascalParser, \
PerlParser, \
PhpParser, \
View
3  source.mak
@@ -34,6 +34,7 @@ SOURCES = \
make.c \
matlab.c \
nestlevel.c \
+ ocaml.c \
options.c \
parse.c \
pascal.c \
@@ -96,6 +97,7 @@ OBJECTS = \
make.$(OBJEXT) \
matlab.$(OBJEXT) \
nestlevel.$(OBJEXT) \
+ ocaml.$(OBJEXT) \
options.$(OBJEXT) \
parse.$(OBJEXT) \
pascal.$(OBJEXT) \
@@ -120,4 +122,3 @@ OBJECTS = \
vim.$(OBJEXT) \
yacc.$(OBJEXT) \
vstring.$(OBJEXT)
-
View
2  website/languages.html
@@ -27,6 +27,8 @@
<li>Lisp</li>
<li>Lua</li>
<li>Make</li>
+ <li>MATLAB</li>
+ <li>Objective Caml</li>
<li>Pascal</li>
<li>Perl</li>
<li>PHP</li>
Please sign in to comment.
Something went wrong with that request. Please try again.