xref: /Universal-ctags/parsers/ocaml.c (revision e852ee0e939802331dc3117fd85a31b243c3d04f)
13ae02089SMasatake YAMATO /*
23ae02089SMasatake YAMATO *   Copyright (c) 2009, Vincent Berthoux
33ae02089SMasatake YAMATO *
43ae02089SMasatake YAMATO *   This source code is released for free distribution under the terms of the
50ce38835Sviccuad *   GNU General Public License version 2 or (at your option) any later version.
63ae02089SMasatake YAMATO *
73ae02089SMasatake YAMATO *   This module contains functions for generating tags for Objective Caml
83ae02089SMasatake YAMATO *   language files.
93ae02089SMasatake YAMATO */
103ae02089SMasatake YAMATO /*
113ae02089SMasatake YAMATO *   INCLUDE FILES
123ae02089SMasatake YAMATO */
133ae02089SMasatake YAMATO #include "general.h"	/* must always come first */
143ae02089SMasatake YAMATO 
153ae02089SMasatake YAMATO #include <string.h>
163ae02089SMasatake YAMATO 
179e289adfSMasatake YAMATO #include "debug.h"
183ae02089SMasatake YAMATO #include "entry.h"
199e289adfSMasatake YAMATO #include "keyword.h"
203ae02089SMasatake YAMATO #include "options.h"
210d502ef0SMasatake YAMATO #include "parse.h"
223ae02089SMasatake YAMATO #include "read.h"
233ae02089SMasatake YAMATO #include "routines.h"
243ae02089SMasatake YAMATO #include "vstring.h"
253ae02089SMasatake YAMATO 
263ae02089SMasatake YAMATO #define OCAML_MAX_STACK_SIZE 256
273ae02089SMasatake YAMATO 
283ae02089SMasatake YAMATO typedef enum {
29759d281dSK.Takata 	K_CLASS,        /* OCaml class, relatively rare */
303ae02089SMasatake YAMATO 	K_METHOD,       /* class method */
31759d281dSK.Takata 	K_MODULE,       /* OCaml module OR functor */
32c08a5479SMasatake YAMATO 	K_VARIABLE,
337782d34aSMasatake YAMATO 	K_VAL,
343ae02089SMasatake YAMATO 	K_TYPE,         /* name of an OCaml type */
353ae02089SMasatake YAMATO 	K_FUNCTION,
363ae02089SMasatake YAMATO 	K_CONSTRUCTOR,  /* Constructor of a sum type */
373ae02089SMasatake YAMATO 	K_RECORDFIELD,
38015ab54cSMasatake YAMATO 	K_EXCEPTION,
393ae02089SMasatake YAMATO } ocamlKind;
403ae02089SMasatake YAMATO 
41e112e8abSMasatake YAMATO static kindDefinition OcamlKinds[] = {
42ce990805SThomas Braun 	{true, 'c', "class", "classes"},
43ce990805SThomas Braun 	{true, 'm', "method", "Object's method"},
44ce990805SThomas Braun 	{true, 'M', "module", "Module or functor"},
45ce990805SThomas Braun 	{true, 'v', "var", "Global variable"},
46c7f29897SKatherine Whitlock 	{true, 'p', "val", "Signature item"},
47ce990805SThomas Braun 	{true, 't', "type", "Type name"},
48ce990805SThomas Braun 	{true, 'f', "function", "A function"},
49ce990805SThomas Braun 	{true, 'C', "Constructor", "A constructor"},
50ce990805SThomas Braun 	{true, 'r', "RecordField", "A 'structure' field"},
51ce990805SThomas Braun 	{true, 'e', "Exception", "An exception"},
523ae02089SMasatake YAMATO };
533ae02089SMasatake YAMATO 
543ae02089SMasatake YAMATO typedef enum {
553ae02089SMasatake YAMATO 	OcaKEYWORD_and,
563ae02089SMasatake YAMATO 	OcaKEYWORD_begin,
573ae02089SMasatake YAMATO 	OcaKEYWORD_class,
583ae02089SMasatake YAMATO 	OcaKEYWORD_do,
593ae02089SMasatake YAMATO 	OcaKEYWORD_done,
603ae02089SMasatake YAMATO 	OcaKEYWORD_else,
613ae02089SMasatake YAMATO 	OcaKEYWORD_end,
623ae02089SMasatake YAMATO 	OcaKEYWORD_exception,
633ae02089SMasatake YAMATO 	OcaKEYWORD_for,
643ae02089SMasatake YAMATO 	OcaKEYWORD_functor,
653ae02089SMasatake YAMATO 	OcaKEYWORD_fun,
66c7f29897SKatherine Whitlock 	OcaKEYWORD_function,
673ae02089SMasatake YAMATO 	OcaKEYWORD_if,
683ae02089SMasatake YAMATO 	OcaKEYWORD_in,
693ae02089SMasatake YAMATO 	OcaKEYWORD_let,
703ae02089SMasatake YAMATO 	OcaKEYWORD_value,
713ae02089SMasatake YAMATO 	OcaKEYWORD_match,
723ae02089SMasatake YAMATO 	OcaKEYWORD_method,
733ae02089SMasatake YAMATO 	OcaKEYWORD_module,
743ae02089SMasatake YAMATO 	OcaKEYWORD_mutable,
753ae02089SMasatake YAMATO 	OcaKEYWORD_object,
763ae02089SMasatake YAMATO 	OcaKEYWORD_of,
773ae02089SMasatake YAMATO 	OcaKEYWORD_rec,
783ae02089SMasatake YAMATO 	OcaKEYWORD_sig,
793ae02089SMasatake YAMATO 	OcaKEYWORD_struct,
803ae02089SMasatake YAMATO 	OcaKEYWORD_then,
813ae02089SMasatake YAMATO 	OcaKEYWORD_try,
823ae02089SMasatake YAMATO 	OcaKEYWORD_type,
833ae02089SMasatake YAMATO 	OcaKEYWORD_val,
843ae02089SMasatake YAMATO 	OcaKEYWORD_virtual,
853ae02089SMasatake YAMATO 	OcaKEYWORD_while,
863ae02089SMasatake YAMATO 	OcaKEYWORD_with,
873ae02089SMasatake YAMATO 
883ae02089SMasatake YAMATO 	OcaIDENTIFIER,
893ae02089SMasatake YAMATO 	Tok_PARL,       /* '(' */
903ae02089SMasatake YAMATO 	Tok_PARR,       /* ')' */
913ae02089SMasatake YAMATO 	Tok_BRL,        /* '[' */
923ae02089SMasatake YAMATO 	Tok_BRR,        /* ']' */
933ae02089SMasatake YAMATO 	Tok_CurlL,      /* '{' */
943ae02089SMasatake YAMATO 	Tok_CurlR,      /* '}' */
953ae02089SMasatake YAMATO 	Tok_Prime,      /* '\'' */
963ae02089SMasatake YAMATO 	Tok_Pipe,       /* '|' */
973ae02089SMasatake YAMATO 	Tok_EQ,         /* '=' */
983ae02089SMasatake YAMATO 	Tok_Val,        /* string/number/poo */
993ae02089SMasatake YAMATO 	Tok_Op,         /* any operator recognized by the language */
1003ae02089SMasatake YAMATO 	Tok_semi,       /* ';' */
1013ae02089SMasatake YAMATO 	Tok_comma,      /* ',' */
1023ae02089SMasatake YAMATO 	Tok_To,         /* '->' */
103c7f29897SKatherine Whitlock 	Tok_Of,         /* ':' */
1043ae02089SMasatake YAMATO 	Tok_Sharp,      /* '#' */
1053ae02089SMasatake YAMATO 	Tok_Backslash,  /* '\\' */
1063ae02089SMasatake YAMATO 
1073ae02089SMasatake YAMATO 	Tok_EOF         /* END of file */
1083ae02089SMasatake YAMATO } ocamlKeyword;
1093ae02089SMasatake YAMATO 
1103ae02089SMasatake YAMATO typedef struct sOcaKeywordDesc {
1113ae02089SMasatake YAMATO 	const char *name;
1123ae02089SMasatake YAMATO 	ocamlKeyword id;
1133ae02089SMasatake YAMATO } ocaKeywordDesc;
1143ae02089SMasatake YAMATO 
1153ae02089SMasatake YAMATO typedef ocamlKeyword ocaToken;
1163ae02089SMasatake YAMATO 
11782c11d8cSRich Siegel static const keywordTable OcamlKeywordTable[] = {
1183ae02089SMasatake YAMATO 	{ "and"       , OcaKEYWORD_and       },
1193ae02089SMasatake YAMATO 	{ "begin"     , OcaKEYWORD_begin     },
1203ae02089SMasatake YAMATO 	{ "class"     , OcaKEYWORD_class     },
1213ae02089SMasatake YAMATO 	{ "do"        , OcaKEYWORD_do        },
1223ae02089SMasatake YAMATO 	{ "done"      , OcaKEYWORD_done      },
1233ae02089SMasatake YAMATO 	{ "else"      , OcaKEYWORD_else      },
1243ae02089SMasatake YAMATO 	{ "end"       , OcaKEYWORD_end       },
1253ae02089SMasatake YAMATO 	{ "exception" , OcaKEYWORD_exception },
1263ae02089SMasatake YAMATO 	{ "for"       , OcaKEYWORD_for       },
1273ae02089SMasatake YAMATO 	{ "fun"       , OcaKEYWORD_fun       },
1283ae02089SMasatake YAMATO 	{ "function"  , OcaKEYWORD_fun       },
1293ae02089SMasatake YAMATO 	{ "functor"   , OcaKEYWORD_functor   },
130c7f29897SKatherine Whitlock 	{ "if"        , OcaKEYWORD_if        },
1313ae02089SMasatake YAMATO 	{ "in"        , OcaKEYWORD_in        },
1323ae02089SMasatake YAMATO 	{ "let"       , OcaKEYWORD_let       },
1333ae02089SMasatake YAMATO 	{ "match"     , OcaKEYWORD_match     },
1343ae02089SMasatake YAMATO 	{ "method"    , OcaKEYWORD_method    },
1353ae02089SMasatake YAMATO 	{ "module"    , OcaKEYWORD_module    },
1363ae02089SMasatake YAMATO 	{ "mutable"   , OcaKEYWORD_mutable   },
1373ae02089SMasatake YAMATO 	{ "object"    , OcaKEYWORD_object    },
1383ae02089SMasatake YAMATO 	{ "of"        , OcaKEYWORD_of        },
1393ae02089SMasatake YAMATO 	{ "rec"       , OcaKEYWORD_rec       },
1403ae02089SMasatake YAMATO 	{ "sig"       , OcaKEYWORD_sig       },
1413ae02089SMasatake YAMATO 	{ "struct"    , OcaKEYWORD_struct    },
1423ae02089SMasatake YAMATO 	{ "then"      , OcaKEYWORD_then      },
1433ae02089SMasatake YAMATO 	{ "try"       , OcaKEYWORD_try       },
1443ae02089SMasatake YAMATO 	{ "type"      , OcaKEYWORD_type      },
1453ae02089SMasatake YAMATO 	{ "val"       , OcaKEYWORD_val       },
1463ae02089SMasatake YAMATO 	{ "value"     , OcaKEYWORD_value     }, /* just to handle revised syntax */
1473ae02089SMasatake YAMATO 	{ "virtual"   , OcaKEYWORD_virtual   },
1483ae02089SMasatake YAMATO 	{ "while"     , OcaKEYWORD_while     },
1493ae02089SMasatake YAMATO 	{ "with"      , OcaKEYWORD_with      },
1503ae02089SMasatake YAMATO 
1513ae02089SMasatake YAMATO 	{ "or"        , Tok_Op               },
1523ae02089SMasatake YAMATO 	{ "mod "      , Tok_Op               },
1533ae02089SMasatake YAMATO 	{ "land "     , Tok_Op               },
1543ae02089SMasatake YAMATO 	{ "lor "      , Tok_Op               },
1553ae02089SMasatake YAMATO 	{ "lxor "     , Tok_Op               },
1563ae02089SMasatake YAMATO 	{ "lsl "      , Tok_Op               },
1573ae02089SMasatake YAMATO 	{ "lsr "      , Tok_Op               },
1583ae02089SMasatake YAMATO 	{ "asr"       , Tok_Op               },
1593ae02089SMasatake YAMATO 	{ "->"        , Tok_To               },
160c7f29897SKatherine Whitlock 	{ ":"         , Tok_Of               },
1613ae02089SMasatake YAMATO 	{ "true"      , Tok_Val              },
1623ae02089SMasatake YAMATO 	{ "false"     , Tok_Val              }
1633ae02089SMasatake YAMATO };
1643ae02089SMasatake YAMATO 
1653ae02089SMasatake YAMATO static langType Lang_Ocaml;
1663ae02089SMasatake YAMATO 
167ce990805SThomas Braun static bool exportLocalInfo = false;
1683ae02089SMasatake YAMATO 
1693ae02089SMasatake YAMATO /*//////////////////////////////////////////////////////////////////
1703ae02089SMasatake YAMATO //// lexingInit             */
1713ae02089SMasatake YAMATO typedef struct _lexingState {
1723ae02089SMasatake YAMATO 	vString *name;	/* current parsed identifier/operator */
1733ae02089SMasatake YAMATO 	const unsigned char *cp;	/* position in stream */
1743ae02089SMasatake YAMATO } lexingState;
1753ae02089SMasatake YAMATO 
1763ae02089SMasatake YAMATO /* array of the size of all possible value for a char */
177ce990805SThomas Braun static bool isOperator[1 << (8 * sizeof (char))] = { false };
1783ae02089SMasatake YAMATO 
1793ae02089SMasatake YAMATO /* definition of all the operator in OCaml,
1803ae02089SMasatake YAMATO  * /!\ certain operator get special treatment
1813ae02089SMasatake YAMATO  * in regards of their role in OCaml grammar :
1823ae02089SMasatake YAMATO  * '|' ':' '=' '~' and '?' */
initOperatorTable(void)1833ae02089SMasatake YAMATO static void initOperatorTable ( void )
1843ae02089SMasatake YAMATO {
185ce990805SThomas Braun 	isOperator['!'] = true;
186ce990805SThomas Braun 	isOperator['$'] = true;
187ce990805SThomas Braun 	isOperator['%'] = true;
188ce990805SThomas Braun 	isOperator['&'] = true;
189ce990805SThomas Braun 	isOperator['*'] = true;
190ce990805SThomas Braun 	isOperator['+'] = true;
191ce990805SThomas Braun 	isOperator['-'] = true;
192ce990805SThomas Braun 	isOperator['.'] = true;
193ce990805SThomas Braun 	isOperator['/'] = true;
194ce990805SThomas Braun 	isOperator[':'] = true;
195ce990805SThomas Braun 	isOperator['<'] = true;
196ce990805SThomas Braun 	isOperator['='] = true;
197ce990805SThomas Braun 	isOperator['>'] = true;
198ce990805SThomas Braun 	isOperator['?'] = true;
199ce990805SThomas Braun 	isOperator['@'] = true;
200ce990805SThomas Braun 	isOperator['^'] = true;
201ce990805SThomas Braun 	isOperator['~'] = true;
202ce990805SThomas Braun 	isOperator['|'] = true;
2033ae02089SMasatake YAMATO }
2043ae02089SMasatake YAMATO 
2053ae02089SMasatake YAMATO /*//////////////////////////////////////////////////////////////////////
2063ae02089SMasatake YAMATO //// Lexing                                     */
isNum(char c)207ce990805SThomas Braun static bool isNum (char c)
2083ae02089SMasatake YAMATO {
2093ae02089SMasatake YAMATO 	return c >= '0' && c <= '9';
2103ae02089SMasatake YAMATO }
21189625e02SMasatake YAMATO 
isLowerAlpha(char c)212ce990805SThomas Braun static bool isLowerAlpha (char c)
2133ae02089SMasatake YAMATO {
2143ae02089SMasatake YAMATO 	return c >= 'a' && c <= 'z';
2153ae02089SMasatake YAMATO }
2163ae02089SMasatake YAMATO 
isUpperAlpha(char c)217ce990805SThomas Braun static bool isUpperAlpha (char c)
2183ae02089SMasatake YAMATO {
2193ae02089SMasatake YAMATO 	return c >= 'A' && c <= 'Z';
2203ae02089SMasatake YAMATO }
2213ae02089SMasatake YAMATO 
isAlpha(char c)222ce990805SThomas Braun static bool isAlpha (char c)
2233ae02089SMasatake YAMATO {
2243ae02089SMasatake YAMATO 	return isLowerAlpha (c) || isUpperAlpha (c);
2253ae02089SMasatake YAMATO }
2263ae02089SMasatake YAMATO 
isIdent(char c)227ce990805SThomas Braun static bool isIdent (char c)
2283ae02089SMasatake YAMATO {
2293ae02089SMasatake YAMATO 	return isNum (c) || isAlpha (c) || c == '_' || c == '\'';
2303ae02089SMasatake YAMATO }
2313ae02089SMasatake YAMATO 
isSpace(char c)232ce990805SThomas Braun static bool isSpace (char c)
2333ae02089SMasatake YAMATO {
2343ae02089SMasatake YAMATO 	return c == ' ' || c == '\t' || c == '\r' || c == '\n';
2353ae02089SMasatake YAMATO }
2363ae02089SMasatake YAMATO 
eatWhiteSpace(lexingState * st)2373ae02089SMasatake YAMATO static void eatWhiteSpace (lexingState * st)
2383ae02089SMasatake YAMATO {
2393ae02089SMasatake YAMATO 	const unsigned char *cp = st->cp;
2403ae02089SMasatake YAMATO 	while (isSpace (*cp))
2413ae02089SMasatake YAMATO 		cp++;
2423ae02089SMasatake YAMATO 
2433ae02089SMasatake YAMATO 	st->cp = cp;
2443ae02089SMasatake YAMATO }
2453ae02089SMasatake YAMATO 
eatString(lexingState * st)2463ae02089SMasatake YAMATO static void eatString (lexingState * st)
2473ae02089SMasatake YAMATO {
248ce990805SThomas Braun 	bool lastIsBackSlash = false;
249ce990805SThomas Braun 	bool unfinished = true;
2503ae02089SMasatake YAMATO 	const unsigned char *c = st->cp + 1;
2513ae02089SMasatake YAMATO 
2523ae02089SMasatake YAMATO 	while (unfinished)
2533ae02089SMasatake YAMATO 	{
2543ae02089SMasatake YAMATO 		/* end of line should never happen.
2553ae02089SMasatake YAMATO 		 * we tolerate it */
2563ae02089SMasatake YAMATO 		if (c == NULL || c[0] == '\0')
2573ae02089SMasatake YAMATO 			break;
2583ae02089SMasatake YAMATO 		else if (*c == '"' && !lastIsBackSlash)
259ce990805SThomas Braun 			unfinished = false;
2603ae02089SMasatake YAMATO 		else
2613ae02089SMasatake YAMATO 			lastIsBackSlash = *c == '\\';
2623ae02089SMasatake YAMATO 
2633ae02089SMasatake YAMATO 		c++;
2643ae02089SMasatake YAMATO 	}
2653ae02089SMasatake YAMATO 
2663ae02089SMasatake YAMATO 	st->cp = c;
2673ae02089SMasatake YAMATO }
2683ae02089SMasatake YAMATO 
eatComment(lexingState * st)2693ae02089SMasatake YAMATO static void eatComment (lexingState * st)
2703ae02089SMasatake YAMATO {
271ce990805SThomas Braun 	bool unfinished = true;
272ce990805SThomas Braun 	bool lastIsStar = false;
2733ae02089SMasatake YAMATO 	const unsigned char *c = st->cp + 2;
2743ae02089SMasatake YAMATO 
2753ae02089SMasatake YAMATO 	while (unfinished)
2763ae02089SMasatake YAMATO 	{
2773ae02089SMasatake YAMATO 		/* we've reached the end of the line..
2783ae02089SMasatake YAMATO 		 * so we have to reload a line... */
2793ae02089SMasatake YAMATO 		if (c == NULL || *c == '\0')
2803ae02089SMasatake YAMATO 		{
2811b312fe7SMasatake YAMATO 			st->cp = readLineFromInputFile ();
2823ae02089SMasatake YAMATO 			/* WOOPS... no more input...
2833ae02089SMasatake YAMATO 			 * we return, next lexing read
2843ae02089SMasatake YAMATO 			 * will be null and ok */
2853ae02089SMasatake YAMATO 			if (st->cp == NULL)
2863ae02089SMasatake YAMATO 				return;
2873ae02089SMasatake YAMATO 			c = st->cp;
2883ae02089SMasatake YAMATO 		}
2893ae02089SMasatake YAMATO 		/* we've reached the end of the comment */
2903ae02089SMasatake YAMATO 		else if (*c == ')' && lastIsStar)
291c7f29897SKatherine Whitlock 		{
292ce990805SThomas Braun 			unfinished = false;
293c7f29897SKatherine Whitlock 			c++;
294c7f29897SKatherine Whitlock 		}
2953ae02089SMasatake YAMATO 		/* here we deal with imbricated comment, which
2963ae02089SMasatake YAMATO 		 * are allowed in OCaml */
2973ae02089SMasatake YAMATO 		else if (c[0] == '(' && c[1] == '*')
2983ae02089SMasatake YAMATO 		{
2993ae02089SMasatake YAMATO 			st->cp = c;
3003ae02089SMasatake YAMATO 			eatComment (st);
3013ae02089SMasatake YAMATO 
3023ae02089SMasatake YAMATO 			c = st->cp;
3033ae02089SMasatake YAMATO 			if (c == NULL)
3043ae02089SMasatake YAMATO 				return;
3053ae02089SMasatake YAMATO 
306ce990805SThomas Braun 			lastIsStar = false;
3073ae02089SMasatake YAMATO 			c++;
3083ae02089SMasatake YAMATO 		}
3093ae02089SMasatake YAMATO 		/* OCaml has a rule which says :
3103ae02089SMasatake YAMATO 		 *
3113ae02089SMasatake YAMATO 		 *   "Comments do not occur inside string or character literals.
3123ae02089SMasatake YAMATO 		 *    Nested comments are handled correctly."
3133ae02089SMasatake YAMATO 		 *
3143ae02089SMasatake YAMATO 		 * So if we encounter a string beginning, we must parse it to
3153ae02089SMasatake YAMATO 		 * get a good comment nesting (bug ID: 3117537)
3163ae02089SMasatake YAMATO 		 */
3173ae02089SMasatake YAMATO 		else if (*c == '"')
3183ae02089SMasatake YAMATO 		{
3193ae02089SMasatake YAMATO 			st->cp = c;
3203ae02089SMasatake YAMATO 			eatString (st);
3213ae02089SMasatake YAMATO 			c = st->cp;
3223ae02089SMasatake YAMATO 		}
3233ae02089SMasatake YAMATO 		else
3243ae02089SMasatake YAMATO 		{
3253ae02089SMasatake YAMATO 			lastIsStar = '*' == *c;
3263ae02089SMasatake YAMATO 			c++;
3273ae02089SMasatake YAMATO 		}
3283ae02089SMasatake YAMATO 	}
3293ae02089SMasatake YAMATO 
3303ae02089SMasatake YAMATO 	st->cp = c;
3313ae02089SMasatake YAMATO }
3323ae02089SMasatake YAMATO 
readIdentifier(lexingState * st)3333ae02089SMasatake YAMATO static void readIdentifier (lexingState * st)
3343ae02089SMasatake YAMATO {
3353ae02089SMasatake YAMATO 	const unsigned char *p;
3363ae02089SMasatake YAMATO 	vStringClear (st->name);
3373ae02089SMasatake YAMATO 
3383ae02089SMasatake YAMATO 	/* first char is a simple letter */
3393ae02089SMasatake YAMATO 	if (isAlpha (*st->cp) || *st->cp == '_')
3403ae02089SMasatake YAMATO 		vStringPut (st->name, (int) *st->cp);
3413ae02089SMasatake YAMATO 
3423ae02089SMasatake YAMATO 	/* Go till you get identifier chars */
3433ae02089SMasatake YAMATO 	for (p = st->cp + 1; isIdent (*p); p++)
3443ae02089SMasatake YAMATO 		vStringPut (st->name, (int) *p);
3453ae02089SMasatake YAMATO 
3463ae02089SMasatake YAMATO 	st->cp = p;
3473ae02089SMasatake YAMATO }
3483ae02089SMasatake YAMATO 
eatNumber(lexingState * st)3493ae02089SMasatake YAMATO static ocamlKeyword eatNumber (lexingState * st)
3503ae02089SMasatake YAMATO {
3513ae02089SMasatake YAMATO 	while (isNum (*st->cp))
3523ae02089SMasatake YAMATO 		st->cp++;
3533ae02089SMasatake YAMATO 	return Tok_Val;
3543ae02089SMasatake YAMATO }
3553ae02089SMasatake YAMATO 
3563ae02089SMasatake YAMATO /* Operator can be defined in OCaml as a function
3573ae02089SMasatake YAMATO  * so we must be ample enough to parse them normally */
eatOperator(lexingState * st)3583ae02089SMasatake YAMATO static ocamlKeyword eatOperator (lexingState * st)
3593ae02089SMasatake YAMATO {
3603ae02089SMasatake YAMATO 	int count = 0;
3613ae02089SMasatake YAMATO 	const unsigned char *root = st->cp;
3623ae02089SMasatake YAMATO 
3633ae02089SMasatake YAMATO 	vStringClear (st->name);
3643ae02089SMasatake YAMATO 
3653ae02089SMasatake YAMATO 	while (isOperator[st->cp[count]])
3663ae02089SMasatake YAMATO 	{
3673ae02089SMasatake YAMATO 		vStringPut (st->name, st->cp[count]);
3683ae02089SMasatake YAMATO 		count++;
3693ae02089SMasatake YAMATO 	}
3703ae02089SMasatake YAMATO 
3713ae02089SMasatake YAMATO 	st->cp += count;
3723ae02089SMasatake YAMATO 	if (count <= 1)
3733ae02089SMasatake YAMATO 	{
3743ae02089SMasatake YAMATO 		switch (root[0])
3753ae02089SMasatake YAMATO 		{
3763ae02089SMasatake YAMATO 		case '|':
3773ae02089SMasatake YAMATO 			return Tok_Pipe;
3783ae02089SMasatake YAMATO 		case '=':
3793ae02089SMasatake YAMATO 			return Tok_EQ;
380c7f29897SKatherine Whitlock 		case ':':
381c7f29897SKatherine Whitlock 			return Tok_Of;
3823ae02089SMasatake YAMATO 		default:
3833ae02089SMasatake YAMATO 			return Tok_Op;
3843ae02089SMasatake YAMATO 		}
3853ae02089SMasatake YAMATO 	}
3863ae02089SMasatake YAMATO 	else if (count == 2 && root[0] == '-' && root[1] == '>')
3873ae02089SMasatake YAMATO 		return Tok_To;
388c7f29897SKatherine Whitlock 	else if (count == 2 && root[0] == '|' && root[1] == '>')
389c7f29897SKatherine Whitlock 		return Tok_Op;
3903ae02089SMasatake YAMATO 	else
3913ae02089SMasatake YAMATO 		return Tok_Op;
3923ae02089SMasatake YAMATO }
3933ae02089SMasatake YAMATO 
3943ae02089SMasatake YAMATO /* The lexer is in charge of reading the file.
3953ae02089SMasatake YAMATO  * Some of sub-lexer (like eatComment) also read file.
3963ae02089SMasatake YAMATO  * lexing is finished when the lexer return Tok_EOF */
lex(lexingState * st)3973ae02089SMasatake YAMATO static ocamlKeyword lex (lexingState * st)
3983ae02089SMasatake YAMATO {
3993ae02089SMasatake YAMATO 	int retType;
4003ae02089SMasatake YAMATO 	/* handling data input here */
4013ae02089SMasatake YAMATO 	while (st->cp == NULL || st->cp[0] == '\0')
4023ae02089SMasatake YAMATO 	{
4031b312fe7SMasatake YAMATO 		st->cp = readLineFromInputFile ();
4043ae02089SMasatake YAMATO 		if (st->cp == NULL)
4053ae02089SMasatake YAMATO 			return Tok_EOF;
4063ae02089SMasatake YAMATO 	}
4073ae02089SMasatake YAMATO 
4083ae02089SMasatake YAMATO 	if (isAlpha (*st->cp))
4093ae02089SMasatake YAMATO 	{
4103ae02089SMasatake YAMATO 		readIdentifier (st);
4113ae02089SMasatake YAMATO 		retType = lookupKeyword (vStringValue (st->name), Lang_Ocaml);
4123ae02089SMasatake YAMATO 
4133ae02089SMasatake YAMATO 		if (retType == -1)	/* If it's not a keyword */
4143ae02089SMasatake YAMATO 		{
4153ae02089SMasatake YAMATO 			return OcaIDENTIFIER;
4163ae02089SMasatake YAMATO 		}
4173ae02089SMasatake YAMATO 		else
4183ae02089SMasatake YAMATO 		{
4193ae02089SMasatake YAMATO 			return retType;
4203ae02089SMasatake YAMATO 		}
4213ae02089SMasatake YAMATO 	}
4223ae02089SMasatake YAMATO 	else if (isNum (*st->cp))
4233ae02089SMasatake YAMATO 		return eatNumber (st);
4243ae02089SMasatake YAMATO 	else if (isSpace (*st->cp))
4253ae02089SMasatake YAMATO 	{
4263ae02089SMasatake YAMATO 		eatWhiteSpace (st);
4273ae02089SMasatake YAMATO 		return lex (st);
4283ae02089SMasatake YAMATO 	}
429c7f29897SKatherine Whitlock 	else if (*st->cp == '_')
430c7f29897SKatherine Whitlock 	{	// special
431c7f29897SKatherine Whitlock 		readIdentifier (st);
432c7f29897SKatherine Whitlock 		return Tok_Val;
433c7f29897SKatherine Whitlock 	}
434c7f29897SKatherine Whitlock 
4353ae02089SMasatake YAMATO 	/* OCaml permit the definition of our own operators
4368e3923d2SK.Takata 	 * so here we check all the consecutive chars which
4373ae02089SMasatake YAMATO 	 * are operators to discard them. */
4383ae02089SMasatake YAMATO 	else if (isOperator[*st->cp])
4393ae02089SMasatake YAMATO 		return eatOperator (st);
4403ae02089SMasatake YAMATO 	else
4410d554b56SMasatake YAMATO 	{
4423ae02089SMasatake YAMATO 		switch (*st->cp)
4433ae02089SMasatake YAMATO 		{
4443ae02089SMasatake YAMATO 		case '(':
4453ae02089SMasatake YAMATO 			if (st->cp[1] == '*')	/* ergl, a comment */
4463ae02089SMasatake YAMATO 			{
4473ae02089SMasatake YAMATO 				eatComment (st);
4483ae02089SMasatake YAMATO 				return lex (st);
4493ae02089SMasatake YAMATO 			}
4503ae02089SMasatake YAMATO 			else
4513ae02089SMasatake YAMATO 			{
4523ae02089SMasatake YAMATO 				st->cp++;
4533ae02089SMasatake YAMATO 				return Tok_PARL;
4543ae02089SMasatake YAMATO 			}
4553ae02089SMasatake YAMATO 
4563ae02089SMasatake YAMATO 		case ')':
4573ae02089SMasatake YAMATO 			st->cp++;
4583ae02089SMasatake YAMATO 			return Tok_PARR;
4593ae02089SMasatake YAMATO 		case '[':
4603ae02089SMasatake YAMATO 			st->cp++;
4613ae02089SMasatake YAMATO 			return Tok_BRL;
4623ae02089SMasatake YAMATO 		case ']':
4633ae02089SMasatake YAMATO 			st->cp++;
4643ae02089SMasatake YAMATO 			return Tok_BRR;
4653ae02089SMasatake YAMATO 		case '{':
4663ae02089SMasatake YAMATO 			st->cp++;
4673ae02089SMasatake YAMATO 			return Tok_CurlL;
4683ae02089SMasatake YAMATO 		case '}':
4693ae02089SMasatake YAMATO 			st->cp++;
4703ae02089SMasatake YAMATO 			return Tok_CurlR;
4713ae02089SMasatake YAMATO 		case '\'':
4723ae02089SMasatake YAMATO 			st->cp++;
4733ae02089SMasatake YAMATO 			return Tok_Prime;
4743ae02089SMasatake YAMATO 		case ',':
4753ae02089SMasatake YAMATO 			st->cp++;
4763ae02089SMasatake YAMATO 			return Tok_comma;
4773ae02089SMasatake YAMATO 		case '=':
4783ae02089SMasatake YAMATO 			st->cp++;
4793ae02089SMasatake YAMATO 			return Tok_EQ;
4803ae02089SMasatake YAMATO 		case ';':
4813ae02089SMasatake YAMATO 			st->cp++;
4823ae02089SMasatake YAMATO 			return Tok_semi;
4833ae02089SMasatake YAMATO 		case '"':
4843ae02089SMasatake YAMATO 			eatString (st);
4853ae02089SMasatake YAMATO 			return Tok_Val;
4863ae02089SMasatake YAMATO 		case '#':
4873ae02089SMasatake YAMATO 			st->cp++;
4883ae02089SMasatake YAMATO 			return Tok_Sharp;
4893ae02089SMasatake YAMATO 		case '\\':
4903ae02089SMasatake YAMATO 			st->cp++;
4913ae02089SMasatake YAMATO 			return Tok_Backslash;
4923ae02089SMasatake YAMATO 		default:
4933ae02089SMasatake YAMATO 			st->cp++;
4943ae02089SMasatake YAMATO 			break;
4953ae02089SMasatake YAMATO 		}
4960d554b56SMasatake YAMATO 	}
4973ae02089SMasatake YAMATO 	/* default return if nothing is recognized,
4983ae02089SMasatake YAMATO 	 * shouldn't happen, but at least, it will
4993ae02089SMasatake YAMATO 	 * be handled without destroying the parsing. */
5003ae02089SMasatake YAMATO 	return Tok_Val;
5013ae02089SMasatake YAMATO }
5023ae02089SMasatake YAMATO 
5033ae02089SMasatake YAMATO /*//////////////////////////////////////////////////////////////////////
5043ae02089SMasatake YAMATO //// Parsing                                    */
505c7f29897SKatherine Whitlock typedef void (*parseNext) (vString * const ident, ocaToken what, ocaToken whatNext);
5063ae02089SMasatake YAMATO 
5073ae02089SMasatake YAMATO /********** Helpers */
5083ae02089SMasatake YAMATO /* This variable hold the 'parser' which is going to
5093ae02089SMasatake YAMATO  * handle the next token */
5103ae02089SMasatake YAMATO static parseNext toDoNext;
5113ae02089SMasatake YAMATO 
5123ae02089SMasatake YAMATO /* Special variable used by parser eater to
5133ae02089SMasatake YAMATO  * determine which action to put after their
5143ae02089SMasatake YAMATO  * job is finished. */
5153ae02089SMasatake YAMATO static parseNext comeAfter;
5163ae02089SMasatake YAMATO 
5179f084dcaSK.Takata /* If a token put an end to current declaration/
5183ae02089SMasatake YAMATO  * statement */
5193ae02089SMasatake YAMATO static ocaToken terminatingToken;
5203ae02089SMasatake YAMATO 
5213ae02089SMasatake YAMATO /* Token to be searched by the different
5223ae02089SMasatake YAMATO  * parser eater. */
5233ae02089SMasatake YAMATO static ocaToken waitedToken;
5243ae02089SMasatake YAMATO 
5253ae02089SMasatake YAMATO /* name of the last class, used for
5263ae02089SMasatake YAMATO  * context stacking. */
5273ae02089SMasatake YAMATO static vString *lastClass;
5283ae02089SMasatake YAMATO 
5293ae02089SMasatake YAMATO typedef enum _sContextKind {
5303ae02089SMasatake YAMATO 	ContextStrong,
5313ae02089SMasatake YAMATO 	ContextSoft
5323ae02089SMasatake YAMATO } contextKind;
5333ae02089SMasatake YAMATO 
5343ae02089SMasatake YAMATO typedef enum _sContextType {
5353ae02089SMasatake YAMATO 	ContextType,
5363ae02089SMasatake YAMATO 	ContextModule,
5373ae02089SMasatake YAMATO 	ContextClass,
5383ae02089SMasatake YAMATO 	ContextValue,
5393ae02089SMasatake YAMATO 	ContextFunction,
5403ae02089SMasatake YAMATO 	ContextMethod,
541c7f29897SKatherine Whitlock 	ContextBlock,
542c7f29897SKatherine Whitlock 	ContextMatch
5433ae02089SMasatake YAMATO } contextType;
5443ae02089SMasatake YAMATO 
5453ae02089SMasatake YAMATO typedef struct _sOcamlContext {
5463ae02089SMasatake YAMATO 	contextKind kind;	/* well if the context is strong or not */
5473ae02089SMasatake YAMATO 	contextType type;
5483ae02089SMasatake YAMATO 	parseNext callback;	/* what to do when a context is pop'd */
5493ae02089SMasatake YAMATO 	vString *contextName;	/* name, if any, of the surrounding context */
5503ae02089SMasatake YAMATO } ocamlContext;
5513ae02089SMasatake YAMATO 
5523ae02089SMasatake YAMATO /* context stack, can be used to output scope information
5533ae02089SMasatake YAMATO  * into the tag file. */
5543ae02089SMasatake YAMATO static ocamlContext stack[OCAML_MAX_STACK_SIZE];
5553ae02089SMasatake YAMATO /* current position in the tag */
5563ae02089SMasatake YAMATO static int stackIndex;
5573ae02089SMasatake YAMATO 
5583ae02089SMasatake YAMATO /* special function, often recalled, so putting it here */
559c7f29897SKatherine Whitlock static void globalScope (vString * const ident, ocaToken what, ocaToken whatNext);
5603ae02089SMasatake YAMATO 
5613ae02089SMasatake YAMATO /* Return : index of the last named context if one
5623ae02089SMasatake YAMATO  *          is found, -1 otherwise */
getLastNamedIndex(void)5633ae02089SMasatake YAMATO static int getLastNamedIndex ( void )
5643ae02089SMasatake YAMATO {
5653ae02089SMasatake YAMATO 	int i;
5663ae02089SMasatake YAMATO 
5673ae02089SMasatake YAMATO 	for (i = stackIndex - 1; i >= 0; --i)
5683ae02089SMasatake YAMATO 	{
5693ae02089SMasatake YAMATO 		if (vStringLength (stack[i].contextName) > 0)
5703ae02089SMasatake YAMATO 		{
5713ae02089SMasatake YAMATO 			return i;
5723ae02089SMasatake YAMATO 		}
5733ae02089SMasatake YAMATO 	}
5743ae02089SMasatake YAMATO 
5753ae02089SMasatake YAMATO 	return -1;
5763ae02089SMasatake YAMATO }
5773ae02089SMasatake YAMATO 
contextDescription(contextType t)578f92e6bf2SMasatake YAMATO static int contextDescription (contextType t)
5793ae02089SMasatake YAMATO {
5803ae02089SMasatake YAMATO 	switch (t)
5813ae02089SMasatake YAMATO 	{
5823ae02089SMasatake YAMATO 	case ContextFunction:
583f92e6bf2SMasatake YAMATO 		return K_FUNCTION;
5843ae02089SMasatake YAMATO 	case ContextMethod:
585f92e6bf2SMasatake YAMATO 		return K_METHOD;
5863ae02089SMasatake YAMATO 	case ContextValue:
587f92e6bf2SMasatake YAMATO 		return K_VAL;
5883ae02089SMasatake YAMATO 	case ContextModule:
589f92e6bf2SMasatake YAMATO 		return K_MODULE;
5903ae02089SMasatake YAMATO 	case ContextType:
591f92e6bf2SMasatake YAMATO 		return K_TYPE;
5923ae02089SMasatake YAMATO 	case ContextClass:
593f92e6bf2SMasatake YAMATO 		return K_CLASS;
5949e289adfSMasatake YAMATO 	default:
5959e289adfSMasatake YAMATO 		AssertNotReached();
596f92e6bf2SMasatake YAMATO 		return KIND_GHOST_INDEX;
5973ae02089SMasatake YAMATO 	}
5989e289adfSMasatake YAMATO }
5993ae02089SMasatake YAMATO 
contextTypeSuffix(contextType t)6003ae02089SMasatake YAMATO static char contextTypeSuffix (contextType t)
6013ae02089SMasatake YAMATO {
6023ae02089SMasatake YAMATO 	switch (t)
6033ae02089SMasatake YAMATO 	{
6043ae02089SMasatake YAMATO 	case ContextFunction:
6053ae02089SMasatake YAMATO 	case ContextMethod:
6063ae02089SMasatake YAMATO 	case ContextValue:
6073ae02089SMasatake YAMATO 	case ContextModule:
6083ae02089SMasatake YAMATO 		return '/';
6093ae02089SMasatake YAMATO 	case ContextType:
6103ae02089SMasatake YAMATO 		return '.';
6113ae02089SMasatake YAMATO 	case ContextClass:
6123ae02089SMasatake YAMATO 		return '#';
6133ae02089SMasatake YAMATO 	case ContextBlock:
6143ae02089SMasatake YAMATO 		return ' ';
615c7f29897SKatherine Whitlock 	case ContextMatch:
616c7f29897SKatherine Whitlock 		return '|';
617c7f29897SKatherine Whitlock 	default:
6183ae02089SMasatake YAMATO 		return '$';
6193ae02089SMasatake YAMATO 	}
620c7f29897SKatherine Whitlock }
6213ae02089SMasatake YAMATO 
6223ae02089SMasatake YAMATO /* Push a new context, handle null string */
pushContext(contextKind kind,contextType type,parseNext after,vString const * contextName)6233ae02089SMasatake YAMATO static void pushContext (contextKind kind, contextType type, parseNext after,
6243ae02089SMasatake YAMATO 	vString const *contextName)
6253ae02089SMasatake YAMATO {
6263ae02089SMasatake YAMATO 	int parentIndex;
6273ae02089SMasatake YAMATO 
6283ae02089SMasatake YAMATO 	if (stackIndex >= OCAML_MAX_STACK_SIZE)
6293ae02089SMasatake YAMATO 	{
6303ae02089SMasatake YAMATO 		verbose ("OCaml Maximum depth reached");
6313ae02089SMasatake YAMATO 		return;
6323ae02089SMasatake YAMATO 	}
6333ae02089SMasatake YAMATO 
6343ae02089SMasatake YAMATO 	stack[stackIndex].kind = kind;
6353ae02089SMasatake YAMATO 	stack[stackIndex].type = type;
6363ae02089SMasatake YAMATO 	stack[stackIndex].callback = after;
6373ae02089SMasatake YAMATO 
6383ae02089SMasatake YAMATO 	parentIndex = getLastNamedIndex ();
6393ae02089SMasatake YAMATO 	if (contextName == NULL)
6403ae02089SMasatake YAMATO 	{
6413ae02089SMasatake YAMATO 		vStringClear (stack[stackIndex++].contextName);
6423ae02089SMasatake YAMATO 		return;
6433ae02089SMasatake YAMATO 	}
6443ae02089SMasatake YAMATO 
6453ae02089SMasatake YAMATO 	if (parentIndex >= 0)
6463ae02089SMasatake YAMATO 	{
6473ae02089SMasatake YAMATO 		vStringCopy (stack[stackIndex].contextName,
6483ae02089SMasatake YAMATO 			stack[parentIndex].contextName);
6493ae02089SMasatake YAMATO 		vStringPut (stack[stackIndex].contextName,
6503ae02089SMasatake YAMATO 			contextTypeSuffix (stack[parentIndex].type));
6513ae02089SMasatake YAMATO 
6523ae02089SMasatake YAMATO 		vStringCat (stack[stackIndex].contextName, contextName);
6533ae02089SMasatake YAMATO 	}
6543ae02089SMasatake YAMATO 	else
6553ae02089SMasatake YAMATO 		vStringCopy (stack[stackIndex].contextName, contextName);
6563ae02089SMasatake YAMATO 
6573ae02089SMasatake YAMATO 	stackIndex++;
6583ae02089SMasatake YAMATO }
6593ae02089SMasatake YAMATO 
pushStrongContext(vString * name,contextType type)6603ae02089SMasatake YAMATO static void pushStrongContext (vString * name, contextType type)
6613ae02089SMasatake YAMATO {
6623ae02089SMasatake YAMATO 	pushContext (ContextStrong, type, &globalScope, name);
6633ae02089SMasatake YAMATO }
6643ae02089SMasatake YAMATO 
pushSoftContext(parseNext continuation,vString * name,contextType type)6653ae02089SMasatake YAMATO static void pushSoftContext (parseNext continuation,
6663ae02089SMasatake YAMATO 	vString * name, contextType type)
6673ae02089SMasatake YAMATO {
6683ae02089SMasatake YAMATO 	pushContext (ContextSoft, type, continuation, name);
6693ae02089SMasatake YAMATO }
6703ae02089SMasatake YAMATO 
pushEmptyContext(parseNext continuation)6713ae02089SMasatake YAMATO static void pushEmptyContext (parseNext continuation)
6723ae02089SMasatake YAMATO {
6733ae02089SMasatake YAMATO 	pushContext (ContextSoft, ContextValue, continuation, NULL);
6743ae02089SMasatake YAMATO }
6753ae02089SMasatake YAMATO 
6763ae02089SMasatake YAMATO /* unroll the stack until the last named context.
6773ae02089SMasatake YAMATO  * then discard it. Used to handle the :
6783ae02089SMasatake YAMATO  * let f x y = ...
6793ae02089SMasatake YAMATO  * in ...
6803ae02089SMasatake YAMATO  * where the context is reseted after the in. Context may have
6813ae02089SMasatake YAMATO  * been really nested before that. */
popLastNamed(void)6823ae02089SMasatake YAMATO static void popLastNamed ( void )
6833ae02089SMasatake YAMATO {
6843ae02089SMasatake YAMATO 	int i = getLastNamedIndex ();
6853ae02089SMasatake YAMATO 
6863ae02089SMasatake YAMATO 	if (i >= 0)
6873ae02089SMasatake YAMATO 	{
6883ae02089SMasatake YAMATO 		stackIndex = i;
6893ae02089SMasatake YAMATO 		toDoNext = stack[i].callback;
6903ae02089SMasatake YAMATO 		vStringClear (stack[i].contextName);
6913ae02089SMasatake YAMATO 	}
6923ae02089SMasatake YAMATO 	else
6933ae02089SMasatake YAMATO 	{
6943ae02089SMasatake YAMATO 		/* ok, no named context found...
6953ae02089SMasatake YAMATO 		 * (should not happen). */
6963ae02089SMasatake YAMATO 		stackIndex = 0;
6973ae02089SMasatake YAMATO 		toDoNext = &globalScope;
6983ae02089SMasatake YAMATO 	}
6993ae02089SMasatake YAMATO }
7003ae02089SMasatake YAMATO 
7013ae02089SMasatake YAMATO /* pop a context without regarding it's content
7023ae02089SMasatake YAMATO  * (beside handling empty stack case) */
popSoftContext(void)7033ae02089SMasatake YAMATO static void popSoftContext ( void )
7043ae02089SMasatake YAMATO {
7053ae02089SMasatake YAMATO 	if (stackIndex <= 0)
7063ae02089SMasatake YAMATO 	{
7073ae02089SMasatake YAMATO 		toDoNext = &globalScope;
7083ae02089SMasatake YAMATO 	}
7093ae02089SMasatake YAMATO 	else
7103ae02089SMasatake YAMATO 	{
7113ae02089SMasatake YAMATO 		stackIndex--;
7123ae02089SMasatake YAMATO 		toDoNext = stack[stackIndex].callback;
7133ae02089SMasatake YAMATO 		vStringClear (stack[stackIndex].contextName);
7143ae02089SMasatake YAMATO 	}
7153ae02089SMasatake YAMATO }
7163ae02089SMasatake YAMATO 
7173ae02089SMasatake YAMATO /* Reset everything until the last global space.
7183ae02089SMasatake YAMATO  * a strong context can be :
7193ae02089SMasatake YAMATO  * - module
7203ae02089SMasatake YAMATO  * - class definition
7213ae02089SMasatake YAMATO  * - the initial global space
7229f084dcaSK.Takata  * - a _global_ declaration (let at global scope or in a module).
7233ae02089SMasatake YAMATO  * Created to exit quickly deeply nested context */
popStrongContext(void)7243ae02089SMasatake YAMATO static contextType popStrongContext ( void )
7253ae02089SMasatake YAMATO {
7263ae02089SMasatake YAMATO 	int i;
7273ae02089SMasatake YAMATO 
7283ae02089SMasatake YAMATO 	for (i = stackIndex - 1; i >= 0; --i)
7293ae02089SMasatake YAMATO 	{
7303ae02089SMasatake YAMATO 		if (stack[i].kind == ContextStrong)
7313ae02089SMasatake YAMATO 		{
7323ae02089SMasatake YAMATO 			stackIndex = i;
7333ae02089SMasatake YAMATO 			toDoNext = stack[i].callback;
7343ae02089SMasatake YAMATO 			vStringClear (stack[i].contextName);
7353ae02089SMasatake YAMATO 			return stack[i].type;
7363ae02089SMasatake YAMATO 		}
7373ae02089SMasatake YAMATO 	}
7383ae02089SMasatake YAMATO 	/* ok, no strong context found... */
7393ae02089SMasatake YAMATO 	stackIndex = 0;
7403ae02089SMasatake YAMATO 	toDoNext = &globalScope;
7413ae02089SMasatake YAMATO 	return -1;
7423ae02089SMasatake YAMATO }
7433ae02089SMasatake YAMATO 
744c7f29897SKatherine Whitlock /* Reset everything before the last match. */
jumpToMatchContext(void)745c7f29897SKatherine Whitlock static void jumpToMatchContext ( void )
746c7f29897SKatherine Whitlock {
747c7f29897SKatherine Whitlock 	int i;
74892d8be1bSLemonBoy 	for (i = stackIndex - 1; i >= 0; --i)
749c7f29897SKatherine Whitlock 	{
750c7f29897SKatherine Whitlock 		if (stack[i].type == ContextMatch)
751c7f29897SKatherine Whitlock 		{
752c7f29897SKatherine Whitlock 			stackIndex = i + 1;
753c7f29897SKatherine Whitlock 			toDoNext = stack[i].callback;	// this should always be
754c7f29897SKatherine Whitlock 							// matchPattern
755c7f29897SKatherine Whitlock 			stack[i + 1].callback = NULL;
756c7f29897SKatherine Whitlock 			vStringClear (stack[i + 1].contextName);
757c7f29897SKatherine Whitlock 			return;
758c7f29897SKatherine Whitlock 		}
759c7f29897SKatherine Whitlock 	}
760c7f29897SKatherine Whitlock }
761c7f29897SKatherine Whitlock 
7623ae02089SMasatake YAMATO /* Ignore everything till waitedToken and jump to comeAfter.
7633ae02089SMasatake YAMATO  * If the "end" keyword is encountered break, doesn't remember
7643ae02089SMasatake YAMATO  * why though. */
tillToken(vString * const ident CTAGS_ATTR_UNUSED,ocaToken what,ocaToken whatNext CTAGS_ATTR_UNUSED)765c7f29897SKatherine Whitlock static void tillToken (vString * const ident CTAGS_ATTR_UNUSED, ocaToken what, ocaToken whatNext CTAGS_ATTR_UNUSED)
7663ae02089SMasatake YAMATO {
7673ae02089SMasatake YAMATO 	if (what == waitedToken)
7683ae02089SMasatake YAMATO 		toDoNext = comeAfter;
7693ae02089SMasatake YAMATO 	else if (what == OcaKEYWORD_end)
7703ae02089SMasatake YAMATO 	{
7713ae02089SMasatake YAMATO 		popStrongContext ();
7723ae02089SMasatake YAMATO 		toDoNext = &globalScope;
7733ae02089SMasatake YAMATO 	}
7743ae02089SMasatake YAMATO }
7753ae02089SMasatake YAMATO 
7763ae02089SMasatake YAMATO /* Ignore everything till a waitedToken is seen, but
7773ae02089SMasatake YAMATO  * take care of balanced parentheses/bracket use */
contextualTillToken(vString * const ident,ocaToken what,ocaToken whatNext)778c7f29897SKatherine Whitlock static void contextualTillToken (vString * const ident, ocaToken what, ocaToken whatNext)
7793ae02089SMasatake YAMATO {
7803ae02089SMasatake YAMATO 	static int parentheses = 0;
7813ae02089SMasatake YAMATO 	static int bracket = 0;
7823ae02089SMasatake YAMATO 	static int curly = 0;
7833ae02089SMasatake YAMATO 
7843ae02089SMasatake YAMATO 	switch (what)
7853ae02089SMasatake YAMATO 	{
7863ae02089SMasatake YAMATO 	case Tok_PARL:
7873ae02089SMasatake YAMATO 		parentheses--;
7883ae02089SMasatake YAMATO 		break;
7893ae02089SMasatake YAMATO 	case Tok_PARR:
7903ae02089SMasatake YAMATO 		parentheses++;
7913ae02089SMasatake YAMATO 		break;
7923ae02089SMasatake YAMATO 	case Tok_CurlL:
7933ae02089SMasatake YAMATO 		curly--;
7943ae02089SMasatake YAMATO 		break;
7953ae02089SMasatake YAMATO 	case Tok_CurlR:
7963ae02089SMasatake YAMATO 		curly++;
7973ae02089SMasatake YAMATO 		break;
7983ae02089SMasatake YAMATO 	case Tok_BRL:
7993ae02089SMasatake YAMATO 		bracket--;
8003ae02089SMasatake YAMATO 		break;
8013ae02089SMasatake YAMATO 	case Tok_BRR:
8023ae02089SMasatake YAMATO 		bracket++;
8033ae02089SMasatake YAMATO 		break;
8043ae02089SMasatake YAMATO 
8053ae02089SMasatake YAMATO 	default:	/* other token are ignored */
8063ae02089SMasatake YAMATO 		break;
8073ae02089SMasatake YAMATO 	}
8083ae02089SMasatake YAMATO 
8093ae02089SMasatake YAMATO 	if (what == waitedToken && parentheses == 0 && bracket == 0 && curly == 0)
8103ae02089SMasatake YAMATO 		toDoNext = comeAfter;
8113ae02089SMasatake YAMATO 	else if (what == OcaKEYWORD_end)
812c7f29897SKatherine Whitlock 		globalScope (ident, what, whatNext);
8133ae02089SMasatake YAMATO }
8143ae02089SMasatake YAMATO 
8153ae02089SMasatake YAMATO /* Wait for waitedToken and jump to comeAfter or let
8163ae02089SMasatake YAMATO  * the globalScope handle declarations */
tillTokenOrFallback(vString * const ident,ocaToken what,ocaToken whatNext)817c7f29897SKatherine Whitlock static void tillTokenOrFallback (vString * const ident, ocaToken what, ocaToken whatNext)
8183ae02089SMasatake YAMATO {
8193ae02089SMasatake YAMATO 	if (what == waitedToken)
8203ae02089SMasatake YAMATO 		toDoNext = comeAfter;
8213ae02089SMasatake YAMATO 	else
822c7f29897SKatherine Whitlock 		globalScope (ident, what, whatNext);
8233ae02089SMasatake YAMATO }
8243ae02089SMasatake YAMATO 
8253ae02089SMasatake YAMATO /* ignore token till waitedToken, or give up if find
8263ae02089SMasatake YAMATO  * terminatingToken. Use globalScope to handle new
8273ae02089SMasatake YAMATO  * declarations. */
tillTokenOrTerminatingOrFallback(vString * const ident,ocaToken what,ocaToken whatNext)828c7f29897SKatherine Whitlock static void tillTokenOrTerminatingOrFallback (vString * const ident, ocaToken what, ocaToken whatNext)
8293ae02089SMasatake YAMATO {
8303ae02089SMasatake YAMATO 	if (what == waitedToken)
8313ae02089SMasatake YAMATO 		toDoNext = comeAfter;
8323ae02089SMasatake YAMATO 	else if (what == terminatingToken)
8333ae02089SMasatake YAMATO 		toDoNext = globalScope;
8343ae02089SMasatake YAMATO 	else
835c7f29897SKatherine Whitlock 		globalScope (ident, what, whatNext);
8363ae02089SMasatake YAMATO }
8373ae02089SMasatake YAMATO 
8383ae02089SMasatake YAMATO /* ignore the next token in the stream and jump to the
8393ae02089SMasatake YAMATO  * given comeAfter state */
ignoreToken(vString * const ident CTAGS_ATTR_UNUSED,ocaToken what CTAGS_ATTR_UNUSED,ocaToken whatNext CTAGS_ATTR_UNUSED)840c7f29897SKatherine Whitlock static void ignoreToken (vString * const ident CTAGS_ATTR_UNUSED, ocaToken what CTAGS_ATTR_UNUSED, ocaToken whatNext CTAGS_ATTR_UNUSED)
8413ae02089SMasatake YAMATO {
8423ae02089SMasatake YAMATO 	toDoNext = comeAfter;
8433ae02089SMasatake YAMATO }
8443ae02089SMasatake YAMATO 
8453ae02089SMasatake YAMATO /********** Grammar */
8469f084dcaSK.Takata /* the purpose of each function is detailed near their
8473ae02089SMasatake YAMATO  * implementation */
8483ae02089SMasatake YAMATO 
killCurrentState(void)849c7f29897SKatherine Whitlock static contextType killCurrentState ( void )
8503ae02089SMasatake YAMATO {
851c7f29897SKatherine Whitlock 	contextType popped = popStrongContext ();
8523ae02089SMasatake YAMATO 
8533ae02089SMasatake YAMATO 	/* Tracking the kind of previous strong
8543ae02089SMasatake YAMATO 	 * context, if it doesn't match with a
8553ae02089SMasatake YAMATO 	 * really strong entity, repop */
856c7f29897SKatherine Whitlock 	switch (popped)
8573ae02089SMasatake YAMATO 	{
8583ae02089SMasatake YAMATO 	case ContextValue:
859c7f29897SKatherine Whitlock 		popped = popStrongContext ();
8603ae02089SMasatake YAMATO 		break;
8613ae02089SMasatake YAMATO 	case ContextFunction:
862c7f29897SKatherine Whitlock 		popped = popStrongContext ();
8633ae02089SMasatake YAMATO 		break;
8643ae02089SMasatake YAMATO 	case ContextMethod:
865c7f29897SKatherine Whitlock 		popped = popStrongContext ();
8663ae02089SMasatake YAMATO 		break;
8673ae02089SMasatake YAMATO 	case ContextType:
868c7f29897SKatherine Whitlock 		popped = popStrongContext ();
869c7f29897SKatherine Whitlock 		break;
870c7f29897SKatherine Whitlock 	case ContextMatch:
871c7f29897SKatherine Whitlock 		popped = popStrongContext ();
8723ae02089SMasatake YAMATO 		break;
8733ae02089SMasatake YAMATO 	case ContextBlock:
8743ae02089SMasatake YAMATO 		break;
8753ae02089SMasatake YAMATO 	case ContextModule:
8763ae02089SMasatake YAMATO 		break;
8773ae02089SMasatake YAMATO 	case ContextClass:
8783ae02089SMasatake YAMATO 		break;
8793ae02089SMasatake YAMATO 	default:
8803ae02089SMasatake YAMATO 		/* nothing more */
8813ae02089SMasatake YAMATO 		break;
8823ae02089SMasatake YAMATO 	}
883c7f29897SKatherine Whitlock 	return popped;
8843ae02089SMasatake YAMATO }
8853ae02089SMasatake YAMATO 
886c7f29897SKatherine Whitlock /* Keep track of our _true_ line number and file pos,
887c7f29897SKatherine Whitlock  * as the lookahead token gives us false values. */
888c7f29897SKatherine Whitlock static unsigned long ocaLineNumber;
889c7f29897SKatherine Whitlock static MIOPos ocaFilePosition;
890c7f29897SKatherine Whitlock 
891c7f29897SKatherine Whitlock /* Used to prepare an OCaml tag, just in case there is a need to
8923ae02089SMasatake YAMATO  * add additional information to the tag. */
prepareTag(tagEntryInfo * tag,vString const * name,int kind)89316a2541cSMasatake YAMATO static void prepareTag (tagEntryInfo * tag, vString const *name, int kind)
8943ae02089SMasatake YAMATO {
8953ae02089SMasatake YAMATO 	int parentIndex;
8963ae02089SMasatake YAMATO 
89716a2541cSMasatake YAMATO 	initTagEntry (tag, vStringValue (name), kind);
898c7f29897SKatherine Whitlock 	/* Ripped out of read.h initTagEntry, because of line number
899c7f29897SKatherine Whitlock 	 * shenanigans.
900c7f29897SKatherine Whitlock 	 * Ugh. Lookahead is harder than I expected. */
901c7f29897SKatherine Whitlock 	tag->lineNumber = ocaLineNumber;
902c7f29897SKatherine Whitlock 	tag->filePosition = ocaFilePosition;
9033ae02089SMasatake YAMATO 
9043ae02089SMasatake YAMATO 	parentIndex = getLastNamedIndex ();
9053ae02089SMasatake YAMATO 	if (parentIndex >= 0)
9063ae02089SMasatake YAMATO 	{
907f92e6bf2SMasatake YAMATO 		tag->extensionFields.scopeKindIndex =
9083ae02089SMasatake YAMATO 			contextDescription (stack[parentIndex].type);
909015ab54cSMasatake YAMATO 		tag->extensionFields.scopeName =
9103ae02089SMasatake YAMATO 			vStringValue (stack[parentIndex].contextName);
9113ae02089SMasatake YAMATO 	}
9123ae02089SMasatake YAMATO }
9133ae02089SMasatake YAMATO 
9143ae02089SMasatake YAMATO /* Used to centralise tag creation, and be able to add
9153ae02089SMasatake YAMATO  * more information to it in the future */
addTag(vString * const ident,int kind)9163ae02089SMasatake YAMATO static void addTag (vString * const ident, int kind)
9173ae02089SMasatake YAMATO {
9183ae02089SMasatake YAMATO 	if (OcamlKinds [kind].enabled  &&  ident != NULL  &&  vStringLength (ident) > 0)
9193ae02089SMasatake YAMATO 	{
9203ae02089SMasatake YAMATO 		tagEntryInfo toCreate;
9213ae02089SMasatake YAMATO 		prepareTag (&toCreate, ident, kind);
9223ae02089SMasatake YAMATO 		makeTagEntry (&toCreate);
9233ae02089SMasatake YAMATO 	}
9243ae02089SMasatake YAMATO }
9253ae02089SMasatake YAMATO 
926ce990805SThomas Braun static bool needStrongPoping = false;
requestStrongPoping(void)9273ae02089SMasatake YAMATO static void requestStrongPoping ( void )
9283ae02089SMasatake YAMATO {
929ce990805SThomas Braun 	needStrongPoping = true;
9303ae02089SMasatake YAMATO }
9313ae02089SMasatake YAMATO 
cleanupPreviousParser(void)9323ae02089SMasatake YAMATO static void cleanupPreviousParser ( void )
9333ae02089SMasatake YAMATO {
9343ae02089SMasatake YAMATO 	if (needStrongPoping)
9353ae02089SMasatake YAMATO 	{
936ce990805SThomas Braun 		needStrongPoping = false;
9373ae02089SMasatake YAMATO 		popStrongContext ();
9383ae02089SMasatake YAMATO 	}
9393ae02089SMasatake YAMATO }
9403ae02089SMasatake YAMATO 
9413ae02089SMasatake YAMATO /* Due to some circular dependencies, the following functions
9423ae02089SMasatake YAMATO  * must be forward-declared. */
943c7f29897SKatherine Whitlock static void letParam (vString * const ident, ocaToken what, ocaToken whatNext);
944c7f29897SKatherine Whitlock static void localScope (vString * const ident, ocaToken what, ocaToken whatNext);
945c7f29897SKatherine Whitlock static void mayRedeclare (vString * const ident, ocaToken what, ocaToken whatNext);
946c7f29897SKatherine Whitlock static void typeSpecification (vString * const ident, ocaToken what, ocaToken whatNext);
9473ae02089SMasatake YAMATO 
9483ae02089SMasatake YAMATO /*
9493ae02089SMasatake YAMATO  * Parse a record type
9503ae02089SMasatake YAMATO  * type ident = // parsed previously
9513ae02089SMasatake YAMATO  *  {
9523ae02089SMasatake YAMATO  *      ident1: type1;
9533ae02089SMasatake YAMATO  *      ident2: type2;
9543ae02089SMasatake YAMATO  *  }
9553ae02089SMasatake YAMATO  */
typeRecord(vString * const ident,ocaToken what,ocaToken whatNext CTAGS_ATTR_UNUSED)956c7f29897SKatherine Whitlock static void typeRecord (vString * const ident, ocaToken what, ocaToken whatNext CTAGS_ATTR_UNUSED)
9573ae02089SMasatake YAMATO {
9583ae02089SMasatake YAMATO 	switch (what)
9593ae02089SMasatake YAMATO 	{
9603ae02089SMasatake YAMATO 	case OcaIDENTIFIER:
9613ae02089SMasatake YAMATO 		addTag (ident, K_RECORDFIELD);
9623ae02089SMasatake YAMATO 		terminatingToken = Tok_CurlR;
9633ae02089SMasatake YAMATO 		waitedToken = Tok_semi;
9643ae02089SMasatake YAMATO 		comeAfter = &typeRecord;
9653ae02089SMasatake YAMATO 		toDoNext = &tillTokenOrTerminatingOrFallback;
9663ae02089SMasatake YAMATO 		break;
9673ae02089SMasatake YAMATO 
9683ae02089SMasatake YAMATO 	case OcaKEYWORD_mutable:
9693ae02089SMasatake YAMATO 		/* ignore it */
9703ae02089SMasatake YAMATO 		break;
9713ae02089SMasatake YAMATO 
9723ae02089SMasatake YAMATO 	case Tok_CurlR:
9733ae02089SMasatake YAMATO 		popStrongContext ();
974c7f29897SKatherine Whitlock 		// don't pop the module context when going to another expression
975c7f29897SKatherine Whitlock 		needStrongPoping = false;
9763ae02089SMasatake YAMATO 		toDoNext = &globalScope;
9773ae02089SMasatake YAMATO 		break;
9783ae02089SMasatake YAMATO 
9793ae02089SMasatake YAMATO 	default:	/* don't care */
9803ae02089SMasatake YAMATO 		break;
9813ae02089SMasatake YAMATO 	}
9823ae02089SMasatake YAMATO }
9833ae02089SMasatake YAMATO 
9843ae02089SMasatake YAMATO /* handle :
9853ae02089SMasatake YAMATO  * exception ExceptionName of ... */
exceptionDecl(vString * const ident,ocaToken what,ocaToken whatNext)986c7f29897SKatherine Whitlock static void exceptionDecl (vString * const ident, ocaToken what, ocaToken whatNext)
9873ae02089SMasatake YAMATO {
9883ae02089SMasatake YAMATO 	if (what == OcaIDENTIFIER)
9893ae02089SMasatake YAMATO 	{
9903ae02089SMasatake YAMATO 		addTag (ident, K_EXCEPTION);
9913ae02089SMasatake YAMATO 	}
9923ae02089SMasatake YAMATO 	else /* probably ill-formed, give back to global scope */
9933ae02089SMasatake YAMATO 	{
994c7f29897SKatherine Whitlock 		globalScope (ident, what, whatNext);
9953ae02089SMasatake YAMATO 	}
9963ae02089SMasatake YAMATO 	toDoNext = &globalScope;
9973ae02089SMasatake YAMATO }
9983ae02089SMasatake YAMATO 
9993ae02089SMasatake YAMATO static tagEntryInfo tempTag;
10003ae02089SMasatake YAMATO static vString *tempIdent;
10013ae02089SMasatake YAMATO 
10023ae02089SMasatake YAMATO /* Ensure a constructor is not a type path beginning
10033ae02089SMasatake YAMATO  * with a module */
constructorValidation(vString * const ident,ocaToken what,ocaToken whatNext)1004c7f29897SKatherine Whitlock static void constructorValidation (vString * const ident, ocaToken what, ocaToken whatNext)
10053ae02089SMasatake YAMATO {
10063ae02089SMasatake YAMATO 	switch (what)
10073ae02089SMasatake YAMATO 	{
10083ae02089SMasatake YAMATO 	case Tok_Op:	/* if we got a '.' which is an operator */
10093ae02089SMasatake YAMATO 		toDoNext = &globalScope;
10103ae02089SMasatake YAMATO 		popStrongContext ();
1011ce990805SThomas Braun 		needStrongPoping = false;
10123ae02089SMasatake YAMATO 		break;
10133ae02089SMasatake YAMATO 
10143ae02089SMasatake YAMATO 	case OcaKEYWORD_of:	/* OK, it must be a constructor :) */
10154a95e4a5SColomban Wendling 		if (vStringLength (tempIdent) > 0)
10164a95e4a5SColomban Wendling 		{
10173ae02089SMasatake YAMATO 			makeTagEntry (&tempTag);
10183ae02089SMasatake YAMATO 			vStringClear (tempIdent);
10194a95e4a5SColomban Wendling 		}
10203ae02089SMasatake YAMATO 		toDoNext = &tillTokenOrFallback;
10213ae02089SMasatake YAMATO 		comeAfter = &typeSpecification;
10223ae02089SMasatake YAMATO 		waitedToken = Tok_Pipe;
10233ae02089SMasatake YAMATO 		break;
10243ae02089SMasatake YAMATO 
10253ae02089SMasatake YAMATO 	case Tok_Pipe:	/* OK, it was a constructor :)  */
10264a95e4a5SColomban Wendling 		if (vStringLength (tempIdent) > 0)
10274a95e4a5SColomban Wendling 		{
10283ae02089SMasatake YAMATO 			makeTagEntry (&tempTag);
10293ae02089SMasatake YAMATO 			vStringClear (tempIdent);
10304a95e4a5SColomban Wendling 		}
10313ae02089SMasatake YAMATO 		toDoNext = &typeSpecification;
10323ae02089SMasatake YAMATO 		break;
10333ae02089SMasatake YAMATO 
10343ae02089SMasatake YAMATO 	default:	/* and mean that we're not facing a module name */
10354a95e4a5SColomban Wendling 		if (vStringLength (tempIdent) > 0)
10364a95e4a5SColomban Wendling 		{
10373ae02089SMasatake YAMATO 			makeTagEntry (&tempTag);
10383ae02089SMasatake YAMATO 			vStringClear (tempIdent);
10394a95e4a5SColomban Wendling 		}
10403ae02089SMasatake YAMATO 		toDoNext = &tillTokenOrFallback;
10413ae02089SMasatake YAMATO 		comeAfter = &typeSpecification;
10423ae02089SMasatake YAMATO 		waitedToken = Tok_Pipe;
10433ae02089SMasatake YAMATO 
10443ae02089SMasatake YAMATO 		popStrongContext ();
10453ae02089SMasatake YAMATO 
1046c7f29897SKatherine Whitlock 		// don't pop the module context when going to another expression
1047c7f29897SKatherine Whitlock 		needStrongPoping = false;
1048c7f29897SKatherine Whitlock 
10493ae02089SMasatake YAMATO 		/* to be sure we use this token */
1050c7f29897SKatherine Whitlock 		globalScope (ident, what, whatNext);
10513ae02089SMasatake YAMATO 	}
10523ae02089SMasatake YAMATO }
10533ae02089SMasatake YAMATO 
10543ae02089SMasatake YAMATO /* Parse beginning of type definition
10553ae02089SMasatake YAMATO  * type 'avar ident =
10563ae02089SMasatake YAMATO  * or
10573ae02089SMasatake YAMATO  * type ('var1, 'var2) ident =
10583ae02089SMasatake YAMATO  */
typeDecl(vString * const ident,ocaToken what,ocaToken whatNext)1059c7f29897SKatherine Whitlock static void typeDecl (vString * const ident, ocaToken what, ocaToken whatNext)
10603ae02089SMasatake YAMATO {
10613ae02089SMasatake YAMATO 	switch (what)
10623ae02089SMasatake YAMATO 	{
10633ae02089SMasatake YAMATO 		/* parameterized */
10643ae02089SMasatake YAMATO 	case Tok_Prime:
10653ae02089SMasatake YAMATO 		comeAfter = &typeDecl;
10663ae02089SMasatake YAMATO 		toDoNext = &ignoreToken;
10673ae02089SMasatake YAMATO 		break;
10683ae02089SMasatake YAMATO 		/* LOTS of parameters */
10693ae02089SMasatake YAMATO 	case Tok_PARL:
10703ae02089SMasatake YAMATO 		comeAfter = &typeDecl;
10713ae02089SMasatake YAMATO 		waitedToken = Tok_PARR;
10723ae02089SMasatake YAMATO 		toDoNext = &tillToken;
10733ae02089SMasatake YAMATO 		break;
10743ae02089SMasatake YAMATO 
10753ae02089SMasatake YAMATO 	case OcaIDENTIFIER:
10763ae02089SMasatake YAMATO 		addTag (ident, K_TYPE);
1077c7f29897SKatherine Whitlock 		// true type declaration
1078c7f29897SKatherine Whitlock 		if (whatNext == Tok_EQ)
1079c7f29897SKatherine Whitlock 		{
10803ae02089SMasatake YAMATO 			pushStrongContext (ident, ContextType);
10813ae02089SMasatake YAMATO 			requestStrongPoping ();
1082c7f29897SKatherine Whitlock 			toDoNext = &typeSpecification;
1083c7f29897SKatherine Whitlock 		}
1084c7f29897SKatherine Whitlock 		else // we're in a sig
1085c7f29897SKatherine Whitlock 			toDoNext = &globalScope;
10863ae02089SMasatake YAMATO 		break;
10873ae02089SMasatake YAMATO 
10883ae02089SMasatake YAMATO 	default:
1089c7f29897SKatherine Whitlock 		globalScope (ident, what, whatNext);
1090c7f29897SKatherine Whitlock 	}
1091c7f29897SKatherine Whitlock }
1092c7f29897SKatherine Whitlock 
1093c7f29897SKatherine Whitlock /** handle 'val' signatures in sigs and .mli files
1094c7f29897SKatherine Whitlock   * val ident : String.t -> Val.t
1095c7f29897SKatherine Whitlock   * Eventually, this will do cool things to annotate
1096c7f29897SKatherine Whitlock   * functions with their actual signatures. But for now,
1097c7f29897SKatherine Whitlock   * it's basically globalLet */
val(vString * const ident,ocaToken what,ocaToken whatNext CTAGS_ATTR_UNUSED)1098c7f29897SKatherine Whitlock static void val (vString * const ident, ocaToken what, ocaToken whatNext CTAGS_ATTR_UNUSED)
1099c7f29897SKatherine Whitlock {
1100c7f29897SKatherine Whitlock 	switch (what)
1101c7f29897SKatherine Whitlock 	{
1102c7f29897SKatherine Whitlock 	case Tok_PARL:
1103c7f29897SKatherine Whitlock 	case OcaKEYWORD_rec:
1104c7f29897SKatherine Whitlock 		break;
1105c7f29897SKatherine Whitlock 
1106c7f29897SKatherine Whitlock 	case Tok_Op:
1107c7f29897SKatherine Whitlock 		/* we are defining a new operator, it's a
1108c7f29897SKatherine Whitlock 		 * function definition */
1109c7f29897SKatherine Whitlock 		addTag (ident, K_VAL);
1110c7f29897SKatherine Whitlock 		toDoNext = &globalScope;
1111c7f29897SKatherine Whitlock 		break;
1112c7f29897SKatherine Whitlock 
1113c7f29897SKatherine Whitlock 	case Tok_Val:	/* Can be a weiiird binding, or an '_' */
1114c7f29897SKatherine Whitlock 	case OcaIDENTIFIER:
1115c7f29897SKatherine Whitlock 		addTag (ident, K_VAL);
1116c7f29897SKatherine Whitlock 		toDoNext = &globalScope;	// sig parser ?
1117c7f29897SKatherine Whitlock 		break;
1118c7f29897SKatherine Whitlock 
1119c7f29897SKatherine Whitlock 	default:
1120c7f29897SKatherine Whitlock 		toDoNext = &globalScope;
1121c7f29897SKatherine Whitlock 		break;
11223ae02089SMasatake YAMATO 	}
11233ae02089SMasatake YAMATO }
11243ae02089SMasatake YAMATO 
11253ae02089SMasatake YAMATO /* Parse type of kind
11263ae02089SMasatake YAMATO  * type bidule = Ctor1 of ...
11273ae02089SMasatake YAMATO  *             | Ctor2
11283ae02089SMasatake YAMATO  *             | Ctor3 of ...
11293ae02089SMasatake YAMATO  * or
11303ae02089SMasatake YAMATO  * type bidule = | Ctor1 of ... | Ctor2
11313ae02089SMasatake YAMATO  *
11323ae02089SMasatake YAMATO  * when type bidule = { ... } is detected,
11333ae02089SMasatake YAMATO  * let typeRecord handle it. */
typeSpecification(vString * const ident,ocaToken what,ocaToken whatNext CTAGS_ATTR_UNUSED)1134c7f29897SKatherine Whitlock static void typeSpecification (vString * const ident, ocaToken what, ocaToken whatNext CTAGS_ATTR_UNUSED)
11353ae02089SMasatake YAMATO {
11363ae02089SMasatake YAMATO 	switch (what)
11373ae02089SMasatake YAMATO 	{
11383ae02089SMasatake YAMATO 	case OcaIDENTIFIER:
1139*e852ee0eSMasatake YAMATO 		if (isUpperAlpha (vStringChar (ident, 0)))
11403ae02089SMasatake YAMATO 		{
11413ae02089SMasatake YAMATO 			/* here we handle type aliases of type
11423ae02089SMasatake YAMATO 			 * type foo = AnotherModule.bar
11433ae02089SMasatake YAMATO 			 * AnotherModule can mistakenly be took
11443ae02089SMasatake YAMATO 			 * for a constructor. */
11454a95e4a5SColomban Wendling 			if (! OcamlKinds[K_CONSTRUCTOR].enabled)
11464a95e4a5SColomban Wendling 				vStringClear (tempIdent);
11474a95e4a5SColomban Wendling 			else
11484a95e4a5SColomban Wendling 			{
11493ae02089SMasatake YAMATO 				vStringCopy (tempIdent, ident);
11503ae02089SMasatake YAMATO 				prepareTag (&tempTag, tempIdent, K_CONSTRUCTOR);
11514a95e4a5SColomban Wendling 			}
11523ae02089SMasatake YAMATO 			toDoNext = &constructorValidation;
11533ae02089SMasatake YAMATO 		}
11543ae02089SMasatake YAMATO 		else
11553ae02089SMasatake YAMATO 		{
11563ae02089SMasatake YAMATO 			toDoNext = &tillTokenOrFallback;
11573ae02089SMasatake YAMATO 			comeAfter = &typeSpecification;
11583ae02089SMasatake YAMATO 			waitedToken = Tok_Pipe;
11593ae02089SMasatake YAMATO 		}
11603ae02089SMasatake YAMATO 		break;
11613ae02089SMasatake YAMATO 
11623ae02089SMasatake YAMATO 	case OcaKEYWORD_and:
11633ae02089SMasatake YAMATO 		toDoNext = &typeDecl;
11643ae02089SMasatake YAMATO 		break;
11653ae02089SMasatake YAMATO 
1166c7f29897SKatherine Whitlock 	case OcaKEYWORD_val:
1167c7f29897SKatherine Whitlock 		toDoNext = &val;
1168c7f29897SKatherine Whitlock 		break;
1169c7f29897SKatherine Whitlock 
11703ae02089SMasatake YAMATO 	case Tok_BRL:	/* the '[' & ']' are ignored to accommodate */
11713ae02089SMasatake YAMATO 	case Tok_BRR:	/* with the revised syntax */
11723ae02089SMasatake YAMATO 	case Tok_Pipe:
11733ae02089SMasatake YAMATO 		/* just ignore it */
11743ae02089SMasatake YAMATO 		break;
11753ae02089SMasatake YAMATO 
11763ae02089SMasatake YAMATO 	case Tok_CurlL:
11773ae02089SMasatake YAMATO 		toDoNext = &typeRecord;
11783ae02089SMasatake YAMATO 		break;
11793ae02089SMasatake YAMATO 
11803ae02089SMasatake YAMATO 	default:	/* don't care */
11813ae02089SMasatake YAMATO 		break;
11823ae02089SMasatake YAMATO 	}
11833ae02089SMasatake YAMATO }
11843ae02089SMasatake YAMATO 
11853ae02089SMasatake YAMATO 
1186ce990805SThomas Braun static bool dirtySpecialParam = false;
11873ae02089SMasatake YAMATO 
11883ae02089SMasatake YAMATO /* parse the ~label and ~label:type parameter */
parseLabel(vString * const ident,ocaToken what,ocaToken whatNext)1189c7f29897SKatherine Whitlock static void parseLabel (vString * const ident, ocaToken what, ocaToken whatNext)
11903ae02089SMasatake YAMATO {
11913ae02089SMasatake YAMATO 	static int parCount = 0;
11923ae02089SMasatake YAMATO 
11933ae02089SMasatake YAMATO 	switch (what)
11943ae02089SMasatake YAMATO 	{
11953ae02089SMasatake YAMATO 	case OcaIDENTIFIER:
11963ae02089SMasatake YAMATO 		if (!dirtySpecialParam)
11973ae02089SMasatake YAMATO 		{
11983ae02089SMasatake YAMATO 			if (exportLocalInfo)
1199c08a5479SMasatake YAMATO 				addTag (ident, K_VARIABLE);
12003ae02089SMasatake YAMATO 
1201ce990805SThomas Braun 			dirtySpecialParam = true;
12023ae02089SMasatake YAMATO 		}
12033ae02089SMasatake YAMATO 		break;
12043ae02089SMasatake YAMATO 
12053ae02089SMasatake YAMATO 	case Tok_PARL:
12063ae02089SMasatake YAMATO 		parCount++;
12073ae02089SMasatake YAMATO 		break;
12083ae02089SMasatake YAMATO 
12093ae02089SMasatake YAMATO 	case Tok_PARR:
12103ae02089SMasatake YAMATO 		parCount--;
12113ae02089SMasatake YAMATO 		if (parCount == 0)
12123ae02089SMasatake YAMATO 			toDoNext = &letParam;
12133ae02089SMasatake YAMATO 		break;
12143ae02089SMasatake YAMATO 
12153ae02089SMasatake YAMATO 	case Tok_Op:
1216*e852ee0eSMasatake YAMATO 		if (vStringChar(ident, 0) == ':')
12173ae02089SMasatake YAMATO 		{
12183ae02089SMasatake YAMATO 			toDoNext = &ignoreToken;
12193ae02089SMasatake YAMATO 			comeAfter = &letParam;
12203ae02089SMasatake YAMATO 		}
12213ae02089SMasatake YAMATO 		else if (parCount == 0 && dirtySpecialParam)
12223ae02089SMasatake YAMATO 		{
12233ae02089SMasatake YAMATO 			toDoNext = &letParam;
1224c7f29897SKatherine Whitlock 			letParam (ident, what, whatNext);
12253ae02089SMasatake YAMATO 		}
12263ae02089SMasatake YAMATO 		break;
12273ae02089SMasatake YAMATO 
12283ae02089SMasatake YAMATO 	default:
12293ae02089SMasatake YAMATO 		if (parCount == 0 && dirtySpecialParam)
12303ae02089SMasatake YAMATO 		{
12313ae02089SMasatake YAMATO 			toDoNext = &letParam;
1232c7f29897SKatherine Whitlock 			letParam (ident, what, whatNext);
12333ae02089SMasatake YAMATO 		}
12343ae02089SMasatake YAMATO 		break;
12353ae02089SMasatake YAMATO 	}
12363ae02089SMasatake YAMATO }
12373ae02089SMasatake YAMATO 
12383ae02089SMasatake YAMATO /* Optional argument with syntax like this :
12393ae02089SMasatake YAMATO  * ?(foo = value) */
parseOptionnal(vString * const ident,ocaToken what,ocaToken whatNext CTAGS_ATTR_UNUSED)1240c7f29897SKatherine Whitlock static void parseOptionnal (vString * const ident, ocaToken what, ocaToken whatNext CTAGS_ATTR_UNUSED)
12413ae02089SMasatake YAMATO {
12423ae02089SMasatake YAMATO 	static int parCount = 0;
12433ae02089SMasatake YAMATO 
12443ae02089SMasatake YAMATO 	switch (what)
12453ae02089SMasatake YAMATO 	{
12463ae02089SMasatake YAMATO 	case OcaIDENTIFIER:
12473ae02089SMasatake YAMATO 		if (!dirtySpecialParam)
12483ae02089SMasatake YAMATO 		{
12493ae02089SMasatake YAMATO 			if (exportLocalInfo)
1250c08a5479SMasatake YAMATO 				addTag (ident, K_VARIABLE);
12513ae02089SMasatake YAMATO 
1252ce990805SThomas Braun 			dirtySpecialParam = true;
12533ae02089SMasatake YAMATO 
12543ae02089SMasatake YAMATO 			if (parCount == 0)
12553ae02089SMasatake YAMATO 				toDoNext = &letParam;
12563ae02089SMasatake YAMATO 		}
12573ae02089SMasatake YAMATO 		break;
12583ae02089SMasatake YAMATO 
12593ae02089SMasatake YAMATO 	case Tok_PARL:
12603ae02089SMasatake YAMATO 		parCount++;
12613ae02089SMasatake YAMATO 		break;
12623ae02089SMasatake YAMATO 
12633ae02089SMasatake YAMATO 	case Tok_PARR:
12643ae02089SMasatake YAMATO 		parCount--;
12653ae02089SMasatake YAMATO 		if (parCount == 0)
12663ae02089SMasatake YAMATO 			toDoNext = &letParam;
12673ae02089SMasatake YAMATO 		break;
12683ae02089SMasatake YAMATO 
12693ae02089SMasatake YAMATO 	default:	/* don't care */
12703ae02089SMasatake YAMATO 		break;
12713ae02089SMasatake YAMATO 	}
12723ae02089SMasatake YAMATO }
12733ae02089SMasatake YAMATO 
12743ae02089SMasatake YAMATO /** handle let inside functions (so like it's name
12753ae02089SMasatake YAMATO  * say : local let */
localLet(vString * const ident,ocaToken what,ocaToken whatNext)1276c7f29897SKatherine Whitlock static void localLet (vString * const ident, ocaToken what, ocaToken whatNext)
12773ae02089SMasatake YAMATO {
12783ae02089SMasatake YAMATO 	switch (what)
12793ae02089SMasatake YAMATO 	{
12803ae02089SMasatake YAMATO 	case Tok_PARL:
12813ae02089SMasatake YAMATO 		/* We ignore this token to be able to parse such
12823ae02089SMasatake YAMATO 		 * declarations :
12833ae02089SMasatake YAMATO 		 * let (ident : type) = ...
12843ae02089SMasatake YAMATO 		 */
12853ae02089SMasatake YAMATO 		break;
12863ae02089SMasatake YAMATO 
12873ae02089SMasatake YAMATO 	case OcaKEYWORD_rec:
12883ae02089SMasatake YAMATO 		/* just ignore to be able to parse such declarations:
12893ae02089SMasatake YAMATO 		 * let rec ident = ... */
12903ae02089SMasatake YAMATO 		break;
12913ae02089SMasatake YAMATO 
12923ae02089SMasatake YAMATO 	case Tok_Op:
12933ae02089SMasatake YAMATO 		/* we are defining a new operator, it's a
12943ae02089SMasatake YAMATO 		 * function definition */
12953ae02089SMasatake YAMATO 		if (exportLocalInfo)
12963ae02089SMasatake YAMATO 			addTag (ident, K_FUNCTION);
12973ae02089SMasatake YAMATO 		pushSoftContext (mayRedeclare, ident, ContextFunction);
12983ae02089SMasatake YAMATO 		toDoNext = &letParam;
12993ae02089SMasatake YAMATO 		break;
13003ae02089SMasatake YAMATO 
1301c7f29897SKatherine Whitlock 	case Tok_Val:	/* Can be a weiiird binding, or an '_' */
13023ae02089SMasatake YAMATO 	case OcaIDENTIFIER:
1303c7f29897SKatherine Whitlock 		// if we're an identifier, and the next token is too, then
1304c7f29897SKatherine Whitlock 		// we're definitely a function.
1305c7f29897SKatherine Whitlock 		if (whatNext == OcaIDENTIFIER || whatNext == Tok_PARL)
1306c7f29897SKatherine Whitlock 		{
1307c7f29897SKatherine Whitlock 			if (exportLocalInfo)
1308c7f29897SKatherine Whitlock 				addTag (ident, K_FUNCTION);
1309c7f29897SKatherine Whitlock 			pushSoftContext (mayRedeclare, ident, ContextFunction);
1310c7f29897SKatherine Whitlock 		}
1311c7f29897SKatherine Whitlock 		else
1312c7f29897SKatherine Whitlock 		{
13133ae02089SMasatake YAMATO 			if (exportLocalInfo)
1314c08a5479SMasatake YAMATO 				addTag (ident, K_VARIABLE);
13153ae02089SMasatake YAMATO 			pushSoftContext (mayRedeclare, ident, ContextValue);
1316c7f29897SKatherine Whitlock 		}
13173ae02089SMasatake YAMATO 		toDoNext = &letParam;
13183ae02089SMasatake YAMATO 		break;
13193ae02089SMasatake YAMATO 
13203ae02089SMasatake YAMATO 	case OcaKEYWORD_end:
1321c7f29897SKatherine Whitlock 		localScope (ident, what, whatNext);
13223ae02089SMasatake YAMATO 		break;
13233ae02089SMasatake YAMATO 
13243ae02089SMasatake YAMATO 	default:
13253ae02089SMasatake YAMATO 		toDoNext = &localScope;
13263ae02089SMasatake YAMATO 		break;
13273ae02089SMasatake YAMATO 	}
13283ae02089SMasatake YAMATO }
13293ae02089SMasatake YAMATO 
13303ae02089SMasatake YAMATO /* parse :
13313ae02089SMasatake YAMATO  * | pattern pattern -> ...
13323ae02089SMasatake YAMATO  * or
13333ae02089SMasatake YAMATO  * pattern apttern apttern -> ...
13343ae02089SMasatake YAMATO  * we ignore all identifiers declared in the pattern,
13353ae02089SMasatake YAMATO  * because their scope is likely to be even more limited
13363ae02089SMasatake YAMATO  * than the let definitions.
1337c7f29897SKatherine Whitlock  * Used after a match ... with, or a function ...
13383ae02089SMasatake YAMATO  * because their syntax is similar.  */
matchPattern(vString * const ident,ocaToken what,ocaToken whatNext)1339c7f29897SKatherine Whitlock static void matchPattern (vString * const ident, ocaToken what, ocaToken whatNext)
13403ae02089SMasatake YAMATO {
13413ae02089SMasatake YAMATO 	/* keep track of [], as it
13423ae02089SMasatake YAMATO 	 * can be used in patterns and can
13433ae02089SMasatake YAMATO 	 * mean the end of match expression in
13443ae02089SMasatake YAMATO 	 * revised syntax */
13453ae02089SMasatake YAMATO 	static int braceCount = 0;
13463ae02089SMasatake YAMATO 
13473ae02089SMasatake YAMATO 	switch (what)
13483ae02089SMasatake YAMATO 	{
13493ae02089SMasatake YAMATO 	case Tok_To:
13503ae02089SMasatake YAMATO 		pushEmptyContext (&matchPattern);
13513ae02089SMasatake YAMATO 		toDoNext = &mayRedeclare;
13523ae02089SMasatake YAMATO 		break;
13533ae02089SMasatake YAMATO 
13543ae02089SMasatake YAMATO 	case Tok_BRL:
13553ae02089SMasatake YAMATO 	braceCount++;
13563ae02089SMasatake YAMATO 	break;
13573ae02089SMasatake YAMATO 
13583ae02089SMasatake YAMATO 	case OcaKEYWORD_value:
13593ae02089SMasatake YAMATO 		popLastNamed ();
1360c7f29897SKatherine Whitlock 	case OcaKEYWORD_and:
1361c7f29897SKatherine Whitlock 	case OcaKEYWORD_end:
1362c7f29897SKatherine Whitlock 		// why was this global? matches only make sense in local scope
1363c7f29897SKatherine Whitlock 		localScope (ident, what, whatNext);
13643ae02089SMasatake YAMATO 		break;
13653ae02089SMasatake YAMATO 
13663ae02089SMasatake YAMATO 	case OcaKEYWORD_in:
13673ae02089SMasatake YAMATO 		popLastNamed ();
13683ae02089SMasatake YAMATO 		break;
13693ae02089SMasatake YAMATO 
13703ae02089SMasatake YAMATO 	default:
13713ae02089SMasatake YAMATO 		break;
13723ae02089SMasatake YAMATO 	}
13733ae02089SMasatake YAMATO }
13743ae02089SMasatake YAMATO 
13753ae02089SMasatake YAMATO /* Used at the beginning of a new scope (begin of a
13763ae02089SMasatake YAMATO  * definition, parenthesis...) to catch inner let
13773ae02089SMasatake YAMATO  * definition that may be in. */
mayRedeclare(vString * const ident,ocaToken what,ocaToken whatNext)1378c7f29897SKatherine Whitlock static void mayRedeclare (vString * const ident, ocaToken what, ocaToken whatNext)
13793ae02089SMasatake YAMATO {
13803ae02089SMasatake YAMATO 	switch (what)
13813ae02089SMasatake YAMATO 	{
13823ae02089SMasatake YAMATO 	case OcaKEYWORD_value:
13833ae02089SMasatake YAMATO 	/* let globalScope handle it */
1384c7f29897SKatherine Whitlock 	globalScope (ident, what, whatNext);
13853ae02089SMasatake YAMATO 
13863ae02089SMasatake YAMATO 	case OcaKEYWORD_let:
1387c7f29897SKatherine Whitlock 		toDoNext = &localLet;
1388c7f29897SKatherine Whitlock 		break;
1389c7f29897SKatherine Whitlock 
13903ae02089SMasatake YAMATO 	case OcaKEYWORD_val:
1391c7f29897SKatherine Whitlock 		toDoNext = &val;
13923ae02089SMasatake YAMATO 		break;
13933ae02089SMasatake YAMATO 
13943ae02089SMasatake YAMATO 	case OcaKEYWORD_object:
13953ae02089SMasatake YAMATO 		vStringClear (lastClass);
13963ae02089SMasatake YAMATO 		pushContext (ContextStrong, ContextClass,
1397cb62bb88SMasatake YAMATO 			&localScope, NULL);
1398ce990805SThomas Braun 		needStrongPoping = false;
13993ae02089SMasatake YAMATO 		toDoNext = &globalScope;
14003ae02089SMasatake YAMATO 		break;
14013ae02089SMasatake YAMATO 
14023ae02089SMasatake YAMATO 	case OcaKEYWORD_for:
14033ae02089SMasatake YAMATO 	case OcaKEYWORD_while:
14043ae02089SMasatake YAMATO 		toDoNext = &tillToken;
14053ae02089SMasatake YAMATO 		waitedToken = OcaKEYWORD_do;
14063ae02089SMasatake YAMATO 		comeAfter = &mayRedeclare;
14073ae02089SMasatake YAMATO 		break;
14083ae02089SMasatake YAMATO 
14093ae02089SMasatake YAMATO 	case OcaKEYWORD_try:
14103ae02089SMasatake YAMATO 		toDoNext = &mayRedeclare;
1411c7f29897SKatherine Whitlock 		pushSoftContext (&matchPattern, ident, ContextFunction);
1412c7f29897SKatherine Whitlock 		break;
1413c7f29897SKatherine Whitlock 
1414c7f29897SKatherine Whitlock 	case OcaKEYWORD_function:
1415c7f29897SKatherine Whitlock 		toDoNext = &matchPattern;
1416c7f29897SKatherine Whitlock 		pushSoftContext (&matchPattern, NULL, ContextMatch);
14173ae02089SMasatake YAMATO 		break;
14183ae02089SMasatake YAMATO 
14193ae02089SMasatake YAMATO 	case OcaKEYWORD_fun:
1420c7f29897SKatherine Whitlock 		toDoNext = &letParam;
14213ae02089SMasatake YAMATO 		break;
14223ae02089SMasatake YAMATO 
14233ae02089SMasatake YAMATO 		/* Handle the special ;; from the OCaml
14243ae02089SMasatake YAMATO 		 * Top level */
14253ae02089SMasatake YAMATO 	case Tok_semi:
14263ae02089SMasatake YAMATO 	default:
14273ae02089SMasatake YAMATO 		toDoNext = &localScope;
1428c7f29897SKatherine Whitlock 		localScope (ident, what, whatNext);
14293ae02089SMasatake YAMATO 	}
14303ae02089SMasatake YAMATO }
14313ae02089SMasatake YAMATO 
14323ae02089SMasatake YAMATO /* parse :
14333ae02089SMasatake YAMATO  * p1 p2 ... pn = ...
14343ae02089SMasatake YAMATO  * or
14353ae02089SMasatake YAMATO  * ?(p1=v) p2 ~p3 ~pn:ja ... = ... */
letParam(vString * const ident,ocaToken what,ocaToken whatNext CTAGS_ATTR_UNUSED)1436c7f29897SKatherine Whitlock static void letParam (vString * const ident, ocaToken what, ocaToken whatNext CTAGS_ATTR_UNUSED)
14373ae02089SMasatake YAMATO {
14383ae02089SMasatake YAMATO 	switch (what)
14393ae02089SMasatake YAMATO 	{
1440c7f29897SKatherine Whitlock 	case Tok_To:
14413ae02089SMasatake YAMATO 	case Tok_EQ:
14423ae02089SMasatake YAMATO 		toDoNext = &mayRedeclare;
14433ae02089SMasatake YAMATO 		break;
14443ae02089SMasatake YAMATO 
14453ae02089SMasatake YAMATO 	case OcaIDENTIFIER:
14463ae02089SMasatake YAMATO 		if (exportLocalInfo)
1447c08a5479SMasatake YAMATO 			addTag (ident, K_VARIABLE);
14483ae02089SMasatake YAMATO 		break;
14493ae02089SMasatake YAMATO 
14503ae02089SMasatake YAMATO 	case Tok_Op:
1451*e852ee0eSMasatake YAMATO 		switch (vStringChar (ident, 0))
14523ae02089SMasatake YAMATO 		{
14533ae02089SMasatake YAMATO 		case ':':
14543ae02089SMasatake YAMATO 			/*popSoftContext(); */
14553ae02089SMasatake YAMATO 			/* we got a type signature */
14563ae02089SMasatake YAMATO 			comeAfter = &mayRedeclare;
14573ae02089SMasatake YAMATO 			toDoNext = &tillTokenOrFallback;
14583ae02089SMasatake YAMATO 			waitedToken = Tok_EQ;
14593ae02089SMasatake YAMATO 			break;
14603ae02089SMasatake YAMATO 
14613ae02089SMasatake YAMATO 			/* parse something like
14623ae02089SMasatake YAMATO 			 * ~varname:type
14633ae02089SMasatake YAMATO 			 * or
14643ae02089SMasatake YAMATO 			 * ~varname
14653ae02089SMasatake YAMATO 			 * or
14663ae02089SMasatake YAMATO 			 * ~(varname: long type) */
14673ae02089SMasatake YAMATO 		case '~':
14683ae02089SMasatake YAMATO 			toDoNext = &parseLabel;
1469ce990805SThomas Braun 			dirtySpecialParam = false;
14703ae02089SMasatake YAMATO 			break;
14713ae02089SMasatake YAMATO 
14723ae02089SMasatake YAMATO 			/* Optional argument with syntax like this :
14733ae02089SMasatake YAMATO 			 * ?(bla = value)
14743ae02089SMasatake YAMATO 			 * or
14753ae02089SMasatake YAMATO 			 * ?bla */
14763ae02089SMasatake YAMATO 		case '?':
14773ae02089SMasatake YAMATO 			toDoNext = &parseOptionnal;
1478ce990805SThomas Braun 			dirtySpecialParam = false;
14793ae02089SMasatake YAMATO 			break;
14803ae02089SMasatake YAMATO 
14813ae02089SMasatake YAMATO 		default:
14823ae02089SMasatake YAMATO 			break;
14833ae02089SMasatake YAMATO 		}
14843ae02089SMasatake YAMATO 		break;
14853ae02089SMasatake YAMATO 
14863ae02089SMasatake YAMATO 	default:	/* don't care */
14873ae02089SMasatake YAMATO 		break;
14883ae02089SMasatake YAMATO 	}
14893ae02089SMasatake YAMATO }
14903ae02089SMasatake YAMATO 
14913ae02089SMasatake YAMATO /* parse object ...
14923ae02089SMasatake YAMATO  * used to be sure the class definition is not a type
14933ae02089SMasatake YAMATO  * alias */
classSpecif(vString * const ident CTAGS_ATTR_UNUSED,ocaToken what,ocaToken whatNext CTAGS_ATTR_UNUSED)1494c7f29897SKatherine Whitlock static void classSpecif (vString * const ident CTAGS_ATTR_UNUSED, ocaToken what, ocaToken whatNext CTAGS_ATTR_UNUSED)
14953ae02089SMasatake YAMATO {
14963ae02089SMasatake YAMATO 	switch (what)
14973ae02089SMasatake YAMATO 	{
14983ae02089SMasatake YAMATO 	case OcaKEYWORD_object:
14993ae02089SMasatake YAMATO 		pushStrongContext (lastClass, ContextClass);
15003ae02089SMasatake YAMATO 		toDoNext = &globalScope;
15013ae02089SMasatake YAMATO 		break;
15023ae02089SMasatake YAMATO 
15033ae02089SMasatake YAMATO 	default:
15043ae02089SMasatake YAMATO 		vStringClear (lastClass);
15053ae02089SMasatake YAMATO 		toDoNext = &globalScope;
15063ae02089SMasatake YAMATO 	}
15073ae02089SMasatake YAMATO }
15083ae02089SMasatake YAMATO 
15093ae02089SMasatake YAMATO /* Handle a method ... class declaration.
15103ae02089SMasatake YAMATO  * nearly a copy/paste of globalLet. */
methodDecl(vString * const ident,ocaToken what,ocaToken whatNext)1511c7f29897SKatherine Whitlock static void methodDecl (vString * const ident, ocaToken what, ocaToken whatNext)
15123ae02089SMasatake YAMATO {
15133ae02089SMasatake YAMATO 	switch (what)
15143ae02089SMasatake YAMATO 	{
15153ae02089SMasatake YAMATO 	case Tok_PARL:
15163ae02089SMasatake YAMATO 		/* We ignore this token to be able to parse such
15173ae02089SMasatake YAMATO 		 * declarations :
15183ae02089SMasatake YAMATO 		 * let (ident : type) = ...  */
15193ae02089SMasatake YAMATO 		break;
15203ae02089SMasatake YAMATO 
15213ae02089SMasatake YAMATO 	case OcaKEYWORD_mutable:
15223ae02089SMasatake YAMATO 	case OcaKEYWORD_virtual:
15233ae02089SMasatake YAMATO 	case OcaKEYWORD_rec:
15243ae02089SMasatake YAMATO 		/* just ignore to be able to parse such declarations:
15253ae02089SMasatake YAMATO 		 * let rec ident = ... */
15263ae02089SMasatake YAMATO 		break;
15273ae02089SMasatake YAMATO 
15283ae02089SMasatake YAMATO 	case OcaIDENTIFIER:
15293ae02089SMasatake YAMATO 		addTag (ident, K_METHOD);
15303ae02089SMasatake YAMATO 		/* Normal pushing to get good subs */
15313ae02089SMasatake YAMATO 		pushStrongContext (ident, ContextMethod);
15323ae02089SMasatake YAMATO 		/*pushSoftContext( globalScope, ident, ContextMethod ); */
15333ae02089SMasatake YAMATO 		toDoNext = &letParam;
15343ae02089SMasatake YAMATO 		break;
15353ae02089SMasatake YAMATO 
15363ae02089SMasatake YAMATO 	case OcaKEYWORD_end:
1537c7f29897SKatherine Whitlock 		localScope (ident, what, whatNext);
15383ae02089SMasatake YAMATO 		break;
15393ae02089SMasatake YAMATO 
15403ae02089SMasatake YAMATO 	default:
15413ae02089SMasatake YAMATO 		toDoNext = &globalScope;
15423ae02089SMasatake YAMATO 		break;
15433ae02089SMasatake YAMATO 	}
15443ae02089SMasatake YAMATO }
15453ae02089SMasatake YAMATO 
15463ae02089SMasatake YAMATO /* name of the last module, used for
15473ae02089SMasatake YAMATO  * context stacking. */
15483ae02089SMasatake YAMATO static vString *lastModule;
15493ae02089SMasatake YAMATO 
15503ae02089SMasatake YAMATO /* parse
15513ae02089SMasatake YAMATO  * ... struct (* new global scope *) end
15523ae02089SMasatake YAMATO  * or
15533ae02089SMasatake YAMATO  * ... sig (* new global scope *) end
15543ae02089SMasatake YAMATO  * or
15553ae02089SMasatake YAMATO  * functor ... -> moduleSpecif
15563ae02089SMasatake YAMATO  */
moduleSpecif(vString * const ident,ocaToken what,ocaToken whatNext)1557c7f29897SKatherine Whitlock static void moduleSpecif (vString * const ident, ocaToken what, ocaToken whatNext)
15583ae02089SMasatake YAMATO {
15593ae02089SMasatake YAMATO 	switch (what)
15603ae02089SMasatake YAMATO 	{
15613ae02089SMasatake YAMATO 	case OcaKEYWORD_functor:
15623ae02089SMasatake YAMATO 		toDoNext = &contextualTillToken;
15633ae02089SMasatake YAMATO 		waitedToken = Tok_To;
15643ae02089SMasatake YAMATO 		comeAfter = &moduleSpecif;
15653ae02089SMasatake YAMATO 		break;
15663ae02089SMasatake YAMATO 
15673ae02089SMasatake YAMATO 	case OcaKEYWORD_struct:
15683ae02089SMasatake YAMATO 	case OcaKEYWORD_sig:
15693ae02089SMasatake YAMATO 		pushStrongContext (lastModule, ContextModule);
15703ae02089SMasatake YAMATO 		toDoNext = &globalScope;
1571c7f29897SKatherine Whitlock 		needStrongPoping = false;
15723ae02089SMasatake YAMATO 		break;
15733ae02089SMasatake YAMATO 
15743ae02089SMasatake YAMATO 	case Tok_PARL:	/* ( */
15753ae02089SMasatake YAMATO 		toDoNext = &contextualTillToken;
15763ae02089SMasatake YAMATO 		comeAfter = &globalScope;
15773ae02089SMasatake YAMATO 		waitedToken = Tok_PARR;
1578c7f29897SKatherine Whitlock 		contextualTillToken (ident, what, whatNext);
1579c7f29897SKatherine Whitlock 		break;
1580c7f29897SKatherine Whitlock 
1581c7f29897SKatherine Whitlock 	case Tok_Of:
1582c7f29897SKatherine Whitlock 	case Tok_EQ:
15833ae02089SMasatake YAMATO 		break;
15843ae02089SMasatake YAMATO 
15853ae02089SMasatake YAMATO 	default:
15863ae02089SMasatake YAMATO 		vStringClear (lastModule);
15873ae02089SMasatake YAMATO 		toDoNext = &globalScope;
1588c7f29897SKatherine Whitlock 		break;
15893ae02089SMasatake YAMATO 	}
15903ae02089SMasatake YAMATO }
15913ae02089SMasatake YAMATO 
15923ae02089SMasatake YAMATO /* parse :
15933ae02089SMasatake YAMATO  * module name = ...
15943ae02089SMasatake YAMATO  * then pass the token stream to moduleSpecif */
moduleDecl(vString * const ident,ocaToken what,ocaToken whatNext)1595c7f29897SKatherine Whitlock static void moduleDecl (vString * const ident, ocaToken what, ocaToken whatNext)
15963ae02089SMasatake YAMATO {
15973ae02089SMasatake YAMATO 	switch (what)
15983ae02089SMasatake YAMATO 	{
1599c7f29897SKatherine Whitlock 	case OcaKEYWORD_rec:
1600c7f29897SKatherine Whitlock 		/* recursive modules are _weird_, but they happen */
16013ae02089SMasatake YAMATO 	case OcaKEYWORD_type:
1602c7f29897SKatherine Whitlock 		/* this is technically a special type, but whatever */
16033ae02089SMasatake YAMATO 		break;
16043ae02089SMasatake YAMATO 
16053ae02089SMasatake YAMATO 	case OcaIDENTIFIER:
16063ae02089SMasatake YAMATO 		addTag (ident, K_MODULE);
16073ae02089SMasatake YAMATO 		vStringCopy (lastModule, ident);
1608c7f29897SKatherine Whitlock 		if (whatNext == Tok_Of || whatNext == Tok_EQ)
1609c7f29897SKatherine Whitlock 			toDoNext = &moduleSpecif;
1610c7f29897SKatherine Whitlock 		else
1611c7f29897SKatherine Whitlock 		{
1612c7f29897SKatherine Whitlock 			// default to waiting on a '=' since
1613c7f29897SKatherine Whitlock 			// module M : sig ... end = struct ... end
1614c7f29897SKatherine Whitlock 			// is rarer
16153ae02089SMasatake YAMATO 			waitedToken = Tok_EQ;
16163ae02089SMasatake YAMATO 			comeAfter = &moduleSpecif;
16173ae02089SMasatake YAMATO 			toDoNext = &contextualTillToken;
1618c7f29897SKatherine Whitlock 		}
16193ae02089SMasatake YAMATO 		break;
16203ae02089SMasatake YAMATO 
16213ae02089SMasatake YAMATO 	default:	/* don't care */
16223ae02089SMasatake YAMATO 		break;
16233ae02089SMasatake YAMATO 	}
16243ae02089SMasatake YAMATO }
16253ae02089SMasatake YAMATO 
16263ae02089SMasatake YAMATO /* parse :
16273ae02089SMasatake YAMATO  * class name = ...
16283ae02089SMasatake YAMATO  * or
16293ae02089SMasatake YAMATO  * class virtual ['a,'b] classname = ... */
classDecl(vString * const ident,ocaToken what,ocaToken whatNext CTAGS_ATTR_UNUSED)1630c7f29897SKatherine Whitlock static void classDecl (vString * const ident, ocaToken what, ocaToken whatNext CTAGS_ATTR_UNUSED)
16313ae02089SMasatake YAMATO {
16323ae02089SMasatake YAMATO 	switch (what)
16333ae02089SMasatake YAMATO 	{
16343ae02089SMasatake YAMATO 	case OcaIDENTIFIER:
16353ae02089SMasatake YAMATO 		addTag (ident, K_CLASS);
16363ae02089SMasatake YAMATO 		vStringCopy (lastClass, ident);
16373ae02089SMasatake YAMATO 		toDoNext = &contextualTillToken;
16383ae02089SMasatake YAMATO 		waitedToken = Tok_EQ;
16393ae02089SMasatake YAMATO 		comeAfter = &classSpecif;
16403ae02089SMasatake YAMATO 		break;
16413ae02089SMasatake YAMATO 
16423ae02089SMasatake YAMATO 	case Tok_BRL:
16433ae02089SMasatake YAMATO 		toDoNext = &tillToken;
16443ae02089SMasatake YAMATO 		waitedToken = Tok_BRR;
16453ae02089SMasatake YAMATO 		comeAfter = &classDecl;
16463ae02089SMasatake YAMATO 		break;
16473ae02089SMasatake YAMATO 
16483ae02089SMasatake YAMATO 	default:
16493ae02089SMasatake YAMATO 		break;
16503ae02089SMasatake YAMATO 	}
16513ae02089SMasatake YAMATO }
16523ae02089SMasatake YAMATO 
16533ae02089SMasatake YAMATO /* Handle a global
16543ae02089SMasatake YAMATO  * let ident ...
16553ae02089SMasatake YAMATO  * or
16563ae02089SMasatake YAMATO  * let rec ident ... */
globalLet(vString * const ident,ocaToken what,ocaToken whatNext)1657c7f29897SKatherine Whitlock static void globalLet (vString * const ident, ocaToken what, ocaToken whatNext)
16583ae02089SMasatake YAMATO {
16593ae02089SMasatake YAMATO 	switch (what)
16603ae02089SMasatake YAMATO 	{
16613ae02089SMasatake YAMATO 	case Tok_PARL:
16623ae02089SMasatake YAMATO 		/* We ignore this token to be able to parse such
16633ae02089SMasatake YAMATO 		 * declarations :
16643ae02089SMasatake YAMATO 		 * let (ident : type) = ...
1665c7f29897SKatherine Whitlock 		 * but () is the toplevel function name, so fake ourselves
1666c7f29897SKatherine Whitlock 		 * as an ident and make a new function */
1667c7f29897SKatherine Whitlock 		if (whatNext == Tok_PARR)
1668c7f29897SKatherine Whitlock 		{
1669c7f29897SKatherine Whitlock 			vString *fakeIdent = vStringNewInit ("()");
1670c7f29897SKatherine Whitlock 			addTag (fakeIdent, K_FUNCTION);
1671c7f29897SKatherine Whitlock 			pushStrongContext (fakeIdent, ContextFunction);
16725a84876fSMasatake YAMATO 			vStringDelete (fakeIdent);
1673c7f29897SKatherine Whitlock 			requestStrongPoping ();
1674c7f29897SKatherine Whitlock 			toDoNext = &letParam;
1675c7f29897SKatherine Whitlock 		}
16763ae02089SMasatake YAMATO 		break;
16773ae02089SMasatake YAMATO 
16783ae02089SMasatake YAMATO 	case OcaKEYWORD_mutable:
16793ae02089SMasatake YAMATO 	case OcaKEYWORD_virtual:
16803ae02089SMasatake YAMATO 	case OcaKEYWORD_rec:
16813ae02089SMasatake YAMATO 		/* just ignore to be able to parse such declarations:
16823ae02089SMasatake YAMATO 		 * let rec ident = ... */
16833ae02089SMasatake YAMATO 		break;
16843ae02089SMasatake YAMATO 
16853ae02089SMasatake YAMATO 	case Tok_Op:
16863ae02089SMasatake YAMATO 		/* we are defining a new operator, it's a
16873ae02089SMasatake YAMATO 		 * function definition */
16883ae02089SMasatake YAMATO 		addTag (ident, K_FUNCTION);
16893ae02089SMasatake YAMATO 		pushStrongContext (ident, ContextFunction);
16903ae02089SMasatake YAMATO 		toDoNext = &letParam;
16913ae02089SMasatake YAMATO 		break;
16923ae02089SMasatake YAMATO 
1693c7f29897SKatherine Whitlock 	case Tok_Val:
1694c7f29897SKatherine Whitlock 		if (vStringValue (ident)[0] == '_')
1695c7f29897SKatherine Whitlock 			addTag (ident, K_FUNCTION);
1696c7f29897SKatherine Whitlock 		pushStrongContext (ident, ContextFunction);
1697c7f29897SKatherine Whitlock 		requestStrongPoping ();
1698c7f29897SKatherine Whitlock 		toDoNext = &letParam;
1699c7f29897SKatherine Whitlock 		break;
1700c7f29897SKatherine Whitlock 
17013ae02089SMasatake YAMATO 	case OcaIDENTIFIER:
1702c7f29897SKatherine Whitlock 		// if we're an identifier, and the next token is too, then
1703c7f29897SKatherine Whitlock 		// we're definitely a function.
1704c7f29897SKatherine Whitlock 		if (whatNext == OcaIDENTIFIER || whatNext == Tok_PARL)
1705c7f29897SKatherine Whitlock 		{
1706c7f29897SKatherine Whitlock 			addTag (ident, K_FUNCTION);
1707c7f29897SKatherine Whitlock 			pushStrongContext (ident, ContextFunction);
1708c7f29897SKatherine Whitlock 		}
1709c7f29897SKatherine Whitlock 		else
1710c7f29897SKatherine Whitlock 		{
1711c08a5479SMasatake YAMATO 			addTag (ident, K_VARIABLE);
17123ae02089SMasatake YAMATO 			pushStrongContext (ident, ContextValue);
1713c7f29897SKatherine Whitlock 		}
17143ae02089SMasatake YAMATO 		requestStrongPoping ();
17153ae02089SMasatake YAMATO 		toDoNext = &letParam;
17163ae02089SMasatake YAMATO 		break;
17173ae02089SMasatake YAMATO 
17183ae02089SMasatake YAMATO 	case OcaKEYWORD_end:
1719c7f29897SKatherine Whitlock 		globalScope (ident, what, whatNext);
17203ae02089SMasatake YAMATO 		break;
17213ae02089SMasatake YAMATO 
17223ae02089SMasatake YAMATO 	default:
17233ae02089SMasatake YAMATO 		toDoNext = &globalScope;
17243ae02089SMasatake YAMATO 		break;
17253ae02089SMasatake YAMATO 	}
17263ae02089SMasatake YAMATO }
17273ae02089SMasatake YAMATO 
17283ae02089SMasatake YAMATO /* Handle the "strong" top levels, all 'big' declarations
17293ae02089SMasatake YAMATO  * happen here */
globalScope(vString * const ident CTAGS_ATTR_UNUSED,ocaToken what,ocaToken whatNext)1730c7f29897SKatherine Whitlock static void globalScope (vString * const ident CTAGS_ATTR_UNUSED, ocaToken what, ocaToken whatNext)
17313ae02089SMasatake YAMATO {
17323ae02089SMasatake YAMATO 	/* Do not touch, this is used only by the global scope
17333ae02089SMasatake YAMATO 	 * to handle an 'and' */
17343ae02089SMasatake YAMATO 	static parseNext previousParser = &globalScope;
17353ae02089SMasatake YAMATO 
17363ae02089SMasatake YAMATO 	switch (what)
17373ae02089SMasatake YAMATO 	{
17383ae02089SMasatake YAMATO 	case OcaKEYWORD_and:
17393ae02089SMasatake YAMATO 		cleanupPreviousParser ();
1740c7f29897SKatherine Whitlock 		// deal with module M = struct ... end _and_ N = struct ... end
17413ae02089SMasatake YAMATO 		toDoNext = previousParser;
17423ae02089SMasatake YAMATO 		break;
17433ae02089SMasatake YAMATO 
17443ae02089SMasatake YAMATO 	case OcaKEYWORD_type:
17453ae02089SMasatake YAMATO 		cleanupPreviousParser ();
17463ae02089SMasatake YAMATO 		toDoNext = &typeDecl;
17473ae02089SMasatake YAMATO 		previousParser = &typeDecl;
17483ae02089SMasatake YAMATO 		break;
17493ae02089SMasatake YAMATO 
17503ae02089SMasatake YAMATO 	case OcaKEYWORD_class:
17513ae02089SMasatake YAMATO 		cleanupPreviousParser ();
17523ae02089SMasatake YAMATO 		toDoNext = &classDecl;
17533ae02089SMasatake YAMATO 		previousParser = &classDecl;
17543ae02089SMasatake YAMATO 		break;
17553ae02089SMasatake YAMATO 
17563ae02089SMasatake YAMATO 	case OcaKEYWORD_module:
17573ae02089SMasatake YAMATO 		cleanupPreviousParser ();
17583ae02089SMasatake YAMATO 		toDoNext = &moduleDecl;
17593ae02089SMasatake YAMATO 		previousParser = &moduleDecl;
17603ae02089SMasatake YAMATO 		break;
17613ae02089SMasatake YAMATO 
1762c7f29897SKatherine Whitlock 	case OcaKEYWORD_end:;
1763c7f29897SKatherine Whitlock 		contextType popped = killCurrentState ();
1764c7f29897SKatherine Whitlock 
1765c7f29897SKatherine Whitlock 		/** so here, end can legally be followed by = or and in the
1766c7f29897SKatherine Whitlock 		 * situation of
1767c7f29897SKatherine Whitlock 		 * module M : sig ... end = struct ... end  and
1768c7f29897SKatherine Whitlock 		 * module M struct ... end and N = struct ... end
1769c7f29897SKatherine Whitlock 		 * and we need to make sure we know we're still inside of a
1770c7f29897SKatherine Whitlock 		 * struct */
1771c7f29897SKatherine Whitlock 		if (whatNext == Tok_EQ && popped == ContextModule)
1772c7f29897SKatherine Whitlock 		{
1773c7f29897SKatherine Whitlock 			previousParser = &moduleDecl;
1774c7f29897SKatherine Whitlock 			toDoNext = &moduleSpecif;
1775c7f29897SKatherine Whitlock 		}
1776c7f29897SKatherine Whitlock 		else if (whatNext == OcaKEYWORD_and && popped == ContextModule)
1777c7f29897SKatherine Whitlock 			toDoNext = &moduleDecl;
1778ce990805SThomas Braun 		needStrongPoping = false;
17793ae02089SMasatake YAMATO 		break;
17803ae02089SMasatake YAMATO 
17813ae02089SMasatake YAMATO 	case OcaKEYWORD_method:
17823ae02089SMasatake YAMATO 		cleanupPreviousParser ();
17833ae02089SMasatake YAMATO 		toDoNext = &methodDecl;
17843ae02089SMasatake YAMATO 		/* and is not allowed in methods */
17853ae02089SMasatake YAMATO 		break;
17863ae02089SMasatake YAMATO 
17873ae02089SMasatake YAMATO 	case OcaKEYWORD_val:
1788c7f29897SKatherine Whitlock 		toDoNext = &val;
1789c7f29897SKatherine Whitlock 		/* and is not allowed in sigs */
1790c7f29897SKatherine Whitlock 		break;
1791c7f29897SKatherine Whitlock 
17923ae02089SMasatake YAMATO 	case OcaKEYWORD_let:
17933ae02089SMasatake YAMATO 		cleanupPreviousParser ();
17943ae02089SMasatake YAMATO 		toDoNext = &globalLet;
17953ae02089SMasatake YAMATO 		previousParser = &globalLet;
17963ae02089SMasatake YAMATO 		break;
17973ae02089SMasatake YAMATO 
17983ae02089SMasatake YAMATO 	case OcaKEYWORD_exception:
17993ae02089SMasatake YAMATO 		cleanupPreviousParser ();
18003ae02089SMasatake YAMATO 		toDoNext = &exceptionDecl;
18013ae02089SMasatake YAMATO 		previousParser = &globalScope;
18023ae02089SMasatake YAMATO 		break;
18033ae02089SMasatake YAMATO 
18043ae02089SMasatake YAMATO 		/* must be a #line directive, discard the
18053ae02089SMasatake YAMATO 		 * whole line. */
18063ae02089SMasatake YAMATO 	case Tok_Sharp:
18073ae02089SMasatake YAMATO 		/* ignore */
18083ae02089SMasatake YAMATO 		break;
18093ae02089SMasatake YAMATO 
18103ae02089SMasatake YAMATO 	default:
18113ae02089SMasatake YAMATO 		/* we don't care */
18123ae02089SMasatake YAMATO 		break;
18133ae02089SMasatake YAMATO 	}
18143ae02089SMasatake YAMATO }
18153ae02089SMasatake YAMATO 
18163ae02089SMasatake YAMATO /* Parse expression. Well ignore it is more the case,
18173ae02089SMasatake YAMATO  * ignore all tokens except "shocking" keywords */
localScope(vString * const ident,ocaToken what,ocaToken whatNext)1818c7f29897SKatherine Whitlock static void localScope (vString * const ident, ocaToken what, ocaToken whatNext)
18193ae02089SMasatake YAMATO {
18203ae02089SMasatake YAMATO 	switch (what)
18213ae02089SMasatake YAMATO 	{
182289625e02SMasatake YAMATO 
1823c7f29897SKatherine Whitlock 		// we're probably in a match, so let's go to the last one
18243ae02089SMasatake YAMATO 	case Tok_Pipe:
1825c7f29897SKatherine Whitlock 		jumpToMatchContext ();
1826c7f29897SKatherine Whitlock 		break;
182789625e02SMasatake YAMATO 
18283ae02089SMasatake YAMATO 	case Tok_PARR:
18293ae02089SMasatake YAMATO 	case Tok_BRR:
18303ae02089SMasatake YAMATO 	case Tok_CurlR:
18313ae02089SMasatake YAMATO 		popSoftContext ();
18323ae02089SMasatake YAMATO 		break;
18333ae02089SMasatake YAMATO 
18343ae02089SMasatake YAMATO 		/* Everything that `begin` has an `end`
18353ae02089SMasatake YAMATO 		 * as end is overloaded and signal many end
18363ae02089SMasatake YAMATO 		 * of things, we add an empty strong context to
18373ae02089SMasatake YAMATO 		 * avoid problem with the end.
18383ae02089SMasatake YAMATO 		 */
18393ae02089SMasatake YAMATO 	case OcaKEYWORD_begin:
18403ae02089SMasatake YAMATO 		pushContext (ContextStrong, ContextBlock, &mayRedeclare, NULL);
18413ae02089SMasatake YAMATO 		toDoNext = &mayRedeclare;
18423ae02089SMasatake YAMATO 		break;
18433ae02089SMasatake YAMATO 
1844c7f29897SKatherine Whitlock 		/* An in keyword signals the end of the previous context and the
1845c7f29897SKatherine Whitlock 		 * start of a new one. */
18463ae02089SMasatake YAMATO 	case OcaKEYWORD_in:
18473ae02089SMasatake YAMATO 		popLastNamed ();
1848c7f29897SKatherine Whitlock 		pushEmptyContext (&localScope);
1849c7f29897SKatherine Whitlock 		toDoNext = &mayRedeclare;
18503ae02089SMasatake YAMATO 		break;
18513ae02089SMasatake YAMATO 
18523ae02089SMasatake YAMATO 		/* Ok, we got a '{', which is much likely to create
18533ae02089SMasatake YAMATO 		 * a record. We cannot treat it like other [ && (,
18543ae02089SMasatake YAMATO 		 * because it may contain the 'with' keyword and screw
18553ae02089SMasatake YAMATO 		 * everything else. */
18563ae02089SMasatake YAMATO 	case Tok_CurlL:
18573ae02089SMasatake YAMATO 		toDoNext = &contextualTillToken;
18583ae02089SMasatake YAMATO 		waitedToken = Tok_CurlR;
18593ae02089SMasatake YAMATO 		comeAfter = &localScope;
1860c7f29897SKatherine Whitlock 		contextualTillToken (ident, what, whatNext);
18613ae02089SMasatake YAMATO 		break;
18623ae02089SMasatake YAMATO 
18633ae02089SMasatake YAMATO 		/* Yeah imperative feature of OCaml,
18643ae02089SMasatake YAMATO 		 * a ';' like in C */
18653ae02089SMasatake YAMATO 	case Tok_semi:
1866c7f29897SKatherine Whitlock 		/* ';;' case should end all scopes */
1867c7f29897SKatherine Whitlock 		if (whatNext == Tok_semi)
1868c7f29897SKatherine Whitlock 		{
1869c7f29897SKatherine Whitlock 			popStrongContext ();
1870c7f29897SKatherine Whitlock 			toDoNext = &globalScope;
1871c7f29897SKatherine Whitlock 			break;
1872c7f29897SKatherine Whitlock 		}	/* else fallthrough */
1873c7f29897SKatherine Whitlock 
1874c7f29897SKatherine Whitlock 		/* Every standard operator has very high precedence
1875c7f29897SKatherine Whitlock 		 * e.g. expr * expr needs no parentheses */
1876c7f29897SKatherine Whitlock 	case Tok_Op:
18773ae02089SMasatake YAMATO 		toDoNext = &mayRedeclare;
18783ae02089SMasatake YAMATO 		break;
18793ae02089SMasatake YAMATO 
18803ae02089SMasatake YAMATO 	case Tok_PARL:
18813ae02089SMasatake YAMATO 	case Tok_BRL:
18823ae02089SMasatake YAMATO 		pushEmptyContext (&localScope);
18833ae02089SMasatake YAMATO 		toDoNext = &mayRedeclare;
18843ae02089SMasatake YAMATO 		break;
18853ae02089SMasatake YAMATO 
18863ae02089SMasatake YAMATO 	case OcaKEYWORD_and:
1887c7f29897SKatherine Whitlock 		if (toDoNext == &mayRedeclare)
18883ae02089SMasatake YAMATO 		{
1889c7f29897SKatherine Whitlock 			popSoftContext ();
18903ae02089SMasatake YAMATO 			pushEmptyContext (localScope);
18913ae02089SMasatake YAMATO 			toDoNext = &localLet;
18923ae02089SMasatake YAMATO 		}
1893c7f29897SKatherine Whitlock 		else
1894c7f29897SKatherine Whitlock 		{
1895c7f29897SKatherine Whitlock 			/* a local 'and' keyword jumps up a context to the last
1896c7f29897SKatherine Whitlock 			 * named. For ex
1897c7f29897SKatherine Whitlock 			 * in `with let IDENT ... and IDENT2 ...` ident and
1898c7f29897SKatherine Whitlock 			 * ident2 are on
1899c7f29897SKatherine Whitlock 			 * same level, the same as `let IDENT ... in let IDENT2
1900c7f29897SKatherine Whitlock 			 * ...`
1901c7f29897SKatherine Whitlock 			 * a 'let' is the only 'and'-chainable construct allowed
1902c7f29897SKatherine Whitlock 			 * locally
1903c7f29897SKatherine Whitlock 			 * (thus we had to be one to get here), so we either go
1904c7f29897SKatherine Whitlock 			 * to
1905c7f29897SKatherine Whitlock 			 * globalLet or localLet depending on our scope. */
1906c7f29897SKatherine Whitlock 			popLastNamed ();
1907c7f29897SKatherine Whitlock 			toDoNext = stackIndex == 0 ? &globalLet : &localLet;
1908c7f29897SKatherine Whitlock 		}
19093ae02089SMasatake YAMATO 		break;
19103ae02089SMasatake YAMATO 
19113ae02089SMasatake YAMATO 	case OcaKEYWORD_else:
19123ae02089SMasatake YAMATO 	case OcaKEYWORD_then:
19133ae02089SMasatake YAMATO 		popSoftContext ();
19143ae02089SMasatake YAMATO 		pushEmptyContext (&localScope);
19153ae02089SMasatake YAMATO 		toDoNext = &mayRedeclare;
19163ae02089SMasatake YAMATO 		break;
19173ae02089SMasatake YAMATO 
19183ae02089SMasatake YAMATO 	case OcaKEYWORD_if:
19193ae02089SMasatake YAMATO 		pushEmptyContext (&localScope);
19203ae02089SMasatake YAMATO 		toDoNext = &mayRedeclare;
19213ae02089SMasatake YAMATO 		break;
19223ae02089SMasatake YAMATO 
19233ae02089SMasatake YAMATO 	case OcaKEYWORD_match:
19243ae02089SMasatake YAMATO 		pushEmptyContext (&localScope);
19253ae02089SMasatake YAMATO 		toDoNext = &mayRedeclare;
19263ae02089SMasatake YAMATO 		break;
19273ae02089SMasatake YAMATO 
19283ae02089SMasatake YAMATO 	case OcaKEYWORD_with:
19293ae02089SMasatake YAMATO 		popSoftContext ();
19303ae02089SMasatake YAMATO 		toDoNext = &matchPattern;
1931c7f29897SKatherine Whitlock 		pushSoftContext (&matchPattern, NULL, ContextMatch);
19323ae02089SMasatake YAMATO 		break;
19333ae02089SMasatake YAMATO 
19343ae02089SMasatake YAMATO 	case OcaKEYWORD_fun:
1935c7f29897SKatherine Whitlock 		toDoNext = &letParam;
19363ae02089SMasatake YAMATO 		break;
19373ae02089SMasatake YAMATO 
19383ae02089SMasatake YAMATO 	case OcaKEYWORD_done:
19393ae02089SMasatake YAMATO 		/* doesn't care */
19403ae02089SMasatake YAMATO 		break;
19413ae02089SMasatake YAMATO 
19423ae02089SMasatake YAMATO 	default:
19433ae02089SMasatake YAMATO 		requestStrongPoping ();
1944c7f29897SKatherine Whitlock 		globalScope (ident, what, whatNext);
19453ae02089SMasatake YAMATO 		break;
19463ae02089SMasatake YAMATO 	}
19473ae02089SMasatake YAMATO }
19483ae02089SMasatake YAMATO 
19493ae02089SMasatake YAMATO /*////////////////////////////////////////////////////////////////
19503ae02089SMasatake YAMATO //// Deal with the system                                       */
19513ae02089SMasatake YAMATO /* in OCaml the file name is the module name used in the language
19523ae02089SMasatake YAMATO  * with it first letter put in upper case */
computeModuleName(void)19533ae02089SMasatake YAMATO static void computeModuleName ( void )
19543ae02089SMasatake YAMATO {
1955c7f29897SKatherine Whitlock 	/* in OCaml the file name define a module.
1956c7f29897SKatherine Whitlock 	 * so we define a module if the file has
1957c7f29897SKatherine Whitlock 	 * things in it. =)
19583ae02089SMasatake YAMATO 	 */
1959a31b37dcSMasatake YAMATO 	const char *filename = getInputFileName ();
1960c7f29897SKatherine Whitlock 
19613ae02089SMasatake YAMATO 	int beginIndex = 0;
19623ae02089SMasatake YAMATO 	int endIndex = strlen (filename) - 1;
19633ae02089SMasatake YAMATO 	vString *moduleName = vStringNew ();
19643ae02089SMasatake YAMATO 
19653ae02089SMasatake YAMATO 	while (filename[endIndex] != '.' && endIndex > 0)
19663ae02089SMasatake YAMATO 		endIndex--;
19673ae02089SMasatake YAMATO 
19683ae02089SMasatake YAMATO 	/* avoid problem with path in front of filename */
19693ae02089SMasatake YAMATO 	beginIndex = endIndex;
19703ae02089SMasatake YAMATO 	while (beginIndex > 0)
19713ae02089SMasatake YAMATO 	{
19723ae02089SMasatake YAMATO 		if (filename[beginIndex] == '\\' || filename[beginIndex] == '/')
19733ae02089SMasatake YAMATO 		{
19743ae02089SMasatake YAMATO 			beginIndex++;
19753ae02089SMasatake YAMATO 			break;
19763ae02089SMasatake YAMATO 		}
19773ae02089SMasatake YAMATO 
19783ae02089SMasatake YAMATO 		beginIndex--;
19793ae02089SMasatake YAMATO 	}
19803ae02089SMasatake YAMATO 
19813ae02089SMasatake YAMATO 	vStringNCopyS (moduleName, &filename[beginIndex], endIndex - beginIndex);
19823ae02089SMasatake YAMATO 
1983*e852ee0eSMasatake YAMATO 	if (isLowerAlpha (vStringChar (moduleName, 0)))
1984*e852ee0eSMasatake YAMATO 		vStringChar (moduleName, 0) += ('A' - 'a');
19853ae02089SMasatake YAMATO 
19863ae02089SMasatake YAMATO 	addTag (moduleName, K_MODULE);
19873ae02089SMasatake YAMATO 	vStringDelete (moduleName);
19883ae02089SMasatake YAMATO }
19893ae02089SMasatake YAMATO 
19903ae02089SMasatake YAMATO /* Allocate all string of the context stack */
initStack(void)19913ae02089SMasatake YAMATO static void initStack ( void )
19923ae02089SMasatake YAMATO {
19933ae02089SMasatake YAMATO 	int i;
19943ae02089SMasatake YAMATO 	for (i = 0; i < OCAML_MAX_STACK_SIZE; ++i)
19953ae02089SMasatake YAMATO 		stack[i].contextName = vStringNew ();
19963ae02089SMasatake YAMATO 	stackIndex = 0;
19973ae02089SMasatake YAMATO }
19983ae02089SMasatake YAMATO 
clearStack(void)19993ae02089SMasatake YAMATO static void clearStack ( void )
20003ae02089SMasatake YAMATO {
20013ae02089SMasatake YAMATO 	int i;
20023ae02089SMasatake YAMATO 	for (i = 0; i < OCAML_MAX_STACK_SIZE; ++i)
20033ae02089SMasatake YAMATO 		vStringDelete (stack[i].contextName);
20043ae02089SMasatake YAMATO }
20053ae02089SMasatake YAMATO 
findOcamlTags(void)20063ae02089SMasatake YAMATO static void findOcamlTags (void)
20073ae02089SMasatake YAMATO {
20083ae02089SMasatake YAMATO 	lexingState st;
20093ae02089SMasatake YAMATO 	ocaToken tok;
20103ae02089SMasatake YAMATO 
2011c7f29897SKatherine Whitlock 	/* One-token lookahead gives us the ability to
2012c7f29897SKatherine Whitlock 	 * do much more accurate analysis */
2013c7f29897SKatherine Whitlock 	lexingState nextSt;
2014c7f29897SKatherine Whitlock 	ocaToken nextTok;
2015c7f29897SKatherine Whitlock 
20163ae02089SMasatake YAMATO 	initStack ();
201789625e02SMasatake YAMATO 
20183ae02089SMasatake YAMATO 	tempIdent = vStringNew ();
20193ae02089SMasatake YAMATO 	lastModule = vStringNew ();
20203ae02089SMasatake YAMATO 	lastClass = vStringNew ();
2021c7f29897SKatherine Whitlock 	vString *temp_cp = vStringNew ();
20223ae02089SMasatake YAMATO 
2023c7f29897SKatherine Whitlock 	nextSt.name = vStringNew ();
2024c7f29897SKatherine Whitlock 	nextSt.cp = readLineFromInputFile ();
2025b296c2fbSMasatake YAMATO 	ocaLineNumber = getInputLineNumber();
2026b296c2fbSMasatake YAMATO 	ocaFilePosition = getInputFilePosition();
20273ae02089SMasatake YAMATO 	toDoNext = &globalScope;
2028c7f29897SKatherine Whitlock 	nextTok = lex (&nextSt);
2029c7f29897SKatherine Whitlock 
2030c7f29897SKatherine Whitlock 	if (nextTok != Tok_EOF)
2031c7f29897SKatherine Whitlock 		computeModuleName ();
2032c7f29897SKatherine Whitlock 
2033c7f29897SKatherine Whitlock 	/* prime the lookahead token */
2034c7f29897SKatherine Whitlock 	st = nextSt;	// preserve the old state for our first token
2035c7f29897SKatherine Whitlock 	st.name = vStringNewCopy (st.name);
2036*e852ee0eSMasatake YAMATO 	st.cp = (const unsigned char *) vStringValue (temp_cp);
2037c7f29897SKatherine Whitlock 	tok = nextTok;
2038c7f29897SKatherine Whitlock 	ocaLineNumber = getInputLineNumber(); /* ??? getSourceLineNumber() */
2039c7f29897SKatherine Whitlock 	ocaFilePosition = getInputFilePosition();
2040c7f29897SKatherine Whitlock 	nextTok = lex (&nextSt);
2041c7f29897SKatherine Whitlock 
2042c7f29897SKatherine Whitlock 	/* main loop */
20433ae02089SMasatake YAMATO 	while (tok != Tok_EOF)
20443ae02089SMasatake YAMATO 	{
2045c7f29897SKatherine Whitlock 		(*toDoNext) (st.name, tok, nextTok);
2046c7f29897SKatherine Whitlock 
2047c7f29897SKatherine Whitlock 		tok = nextTok;
2048c7f29897SKatherine Whitlock 		ocaLineNumber = getInputLineNumber(); /* ??? */
2049c7f29897SKatherine Whitlock 		ocaFilePosition = getInputFilePosition();
2050c7f29897SKatherine Whitlock 
2051c7f29897SKatherine Whitlock 		if (nextTok != Tok_EOF)
2052c7f29897SKatherine Whitlock 		{
2053c7f29897SKatherine Whitlock 			vStringCopyS (temp_cp, (const char *) nextSt.cp);
2054*e852ee0eSMasatake YAMATO 			st.cp = (const unsigned char *) vStringValue (temp_cp);
2055c7f29897SKatherine Whitlock 			vStringCopy (st.name, nextSt.name);
2056c7f29897SKatherine Whitlock 			nextTok = lex (&nextSt);
2057c7f29897SKatherine Whitlock 		}
2058c7f29897SKatherine Whitlock 		else
2059c7f29897SKatherine Whitlock 			break;
20603ae02089SMasatake YAMATO 	}
20613ae02089SMasatake YAMATO 
20623ae02089SMasatake YAMATO 	vStringDelete (st.name);
2063c7f29897SKatherine Whitlock 	vStringDelete (nextSt.name);
2064c7f29897SKatherine Whitlock 	vStringDelete (temp_cp);
20653ae02089SMasatake YAMATO 	vStringDelete (tempIdent);
20663ae02089SMasatake YAMATO 	vStringDelete (lastModule);
20673ae02089SMasatake YAMATO 	vStringDelete (lastClass);
20683ae02089SMasatake YAMATO 	clearStack ();
20693ae02089SMasatake YAMATO }
20703ae02089SMasatake YAMATO 
ocamlInitialize(const langType language)20713ae02089SMasatake YAMATO static void ocamlInitialize (const langType language)
20723ae02089SMasatake YAMATO {
20733ae02089SMasatake YAMATO 	Lang_Ocaml = language;
20743ae02089SMasatake YAMATO 
20753ae02089SMasatake YAMATO 	initOperatorTable ();
20763ae02089SMasatake YAMATO }
20773ae02089SMasatake YAMATO 
OcamlParser(void)20783ae02089SMasatake YAMATO extern parserDefinition *OcamlParser (void)
20793ae02089SMasatake YAMATO {
20803ae02089SMasatake YAMATO 	static const char *const extensions[] = { "ml", "mli", "aug", NULL };
20813ae02089SMasatake YAMATO 	static const char *const aliases[] = { "tuareg", /* mode name of emacs */
20823ae02089SMasatake YAMATO 										   "caml",	 /* mode name of emacs */
20833ae02089SMasatake YAMATO 										   NULL };
20843ae02089SMasatake YAMATO 	parserDefinition *def = parserNew ("OCaml");
208509ae690fSMasatake YAMATO 	def->kindTable = OcamlKinds;
20863db72c21SMasatake YAMATO 	def->kindCount = ARRAY_SIZE (OcamlKinds);
20873ae02089SMasatake YAMATO 	def->extensions = extensions;
20883ae02089SMasatake YAMATO 	def->aliases = aliases;
20893ae02089SMasatake YAMATO 	def->parser = findOcamlTags;
20903ae02089SMasatake YAMATO 	def->initialize = ocamlInitialize;
2091c379c5d2SMasatake YAMATO 	def->keywordTable = OcamlKeywordTable;
20923db72c21SMasatake YAMATO 	def->keywordCount = ARRAY_SIZE (OcamlKeywordTable);
20933ae02089SMasatake YAMATO 	return def;
20943ae02089SMasatake YAMATO }
2095