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