diff -w -u -r id-utils-3.2d/doc/id-utils.texi id-utils-3.2d_ada/doc/id-utils.texi --- id-utils-3.2d/doc/id-utils.texi Mon Apr 5 12:10:26 1999 +++ id-utils-3.2d_ada/doc/id-utils.texi Thu Oct 11 00:06:51 2001 @@ -426,6 +426,7 @@ * Language map:: Mapping file names to source languages. * C/C++ scanner:: For the C and C++ programming language. * Assembler scanner:: For assembly language. +* Ada scanner:: For the Ada programming language. * Text scanner:: For documents or other non-source code. * Defining scanners:: Defining new scanners in the source code. @end menu @@ -511,6 +512,11 @@ *.texi texinfo *.texinfo texinfo +# Ada +*.adb Ada +*.ads Ada +*.ada Ada + @end example @c ************* gkm ********************************************************* @@ -662,6 +668,31 @@ Do not recognize C preprocessor directives. By default, such lines are handled in the same way as they are by the C language scanner. + +@end table + +@c ************* gkm ********************************************************* +@node Ada scanner +@subsection Ada Scanner + +@cindex ada scanner +@cindex ada language scanner + +The Ada scanner is very simple. Tokens are all words, Ada keywords included. +Comments are ignored as well as Ada strings declarations. Numbers can be +normalized before indexation, all alphabetic characters will be lowercased +and the extra '_' characters removed. + +@table @samp + +@item -n +@itemx --normalize-numbers +@opindex -n +@opindex --normalize-numbers +@opindex --lang-option=Ada:-n +@opindex --lang-option=Ada:--normalize-numbers + +Lowercase alphabetic characters and remove '_' characters present in numbers. @end table diff -w -u -r id-utils-3.2d/libidu/id-lang.map id-utils-3.2d_ada/libidu/id-lang.map --- id-utils-3.2d/libidu/id-lang.map Fri Apr 18 08:43:30 1997 +++ id-utils-3.2d_ada/libidu/id-lang.map Thu Oct 11 00:06:40 2001 @@ -86,3 +86,7 @@ *.gz FILTER gzip -d < *.Z FILTER gzip -d < + +*.adb Ada +*.ads Ada +*.ada Ada diff -w -u -r id-utils-3.2d/libidu/scanners.c id-utils-3.2d_ada/libidu/scanners.c --- id-utils-3.2d/libidu/scanners.c Mon Apr 5 11:08:44 1999 +++ id-utils-3.2d_ada/libidu/scanners.c Thu Oct 11 00:06:35 2001 @@ -63,12 +63,17 @@ static void *parse_args_text __P((char **argv, int argc)); static void help_me_text __P((void)); +static struct token *get_token_ada __P((FILE *in_FILE, void const *args, int *flags)); +static void *parse_args_ada __P((char **argv, int argc)); +static void help_me_ada __P((void)); + struct language languages_0[] = { { "C", parse_args_c, get_token_c, help_me_c }, { "C++", parse_args_c, get_token_c, help_me_c }, { "asm", parse_args_asm, get_token_asm, help_me_asm }, { "text", parse_args_text, get_token_text, help_me_text }, + { "Ada", parse_args_ada, get_token_ada, help_me_ada }, }; struct language const *languages_N = &languages_0[cardinalityof (languages_0)]; @@ -1194,3 +1199,284 @@ #undef ISEOF #undef ISBORING #undef ISIDSQUEEZE + +/*************** Ada ****************************************************/ + +#define I1 0x0001 /* 1st char of an identifier [a-zA-Z_] */ +#define DG 0x0002 /* decimal digit [0-9] */ +#define NM 0x0004 /* extra chars in a hex or long number [a-fA-F] */ +#define Q1 0x0020 /* single quote: ' */ +#define Q2 0x0040 /* double quote: " */ +#define ES 0x0080 /* escape char: \ */ +#define NL 0x0100 /* newline: \n */ +#define EF 0x0200 /* EOF */ +#define SK 0x0400 /* Make these chars valid for names within strings */ +#define VH 0x0800 /* VHIL comment introduction char: # */ +#define WS 0x1000 /* White space characters */ + +/* character class membership macros: */ + +#define ISDIGIT(c) ((rct)[c] & (DG)) /* digit */ +#define ISNUMBER(c) ((rct)[c] & (DG|NM)) /* legal in a number */ +#define ISEOF(c) ((rct)[c] & (EF)) /* EOF */ +#define ISID1ST(c) ((rct)[c] & (I1)) /* 1st char of an identifier */ +#define ISIDREST(c) ((rct)[c] & (I1|DG)) /* rest of an identifier */ +#define ISSTRKEEP(c) ((rct)[c] & (I1|DG|SK)) /* keep contents of string */ +#define ISSPACE(c) ((rct)[c] & (WS)) /* white space character */ + +/* The `BORING' classes should be skipped over until something + interesting comes along... */ + +#define ISBORING(c) (!((rct)[c] & (EF|NL|I1|DG|Q1|Q2|VH))) /* fluff */ +#define ISADABORING(c) (!((rct)[c] & (EF|NL))) /* Ada -- comment fluff */ +#define ISQ1BORING(c) (!((rct)[c] & (EF|NL|Q1|ES))) /* char const fluff */ +#define ISQ2BORING(c) (!((rct)[c] & (EF|NL|Q2|ES))) /* quoted str fluff */ + +static unsigned short ctype_ada[257] = +{ + EF, +/* 0 1 2 3 4 5 6 7 */ +/* ----- ----- ----- ----- ----- ----- ----- ----- */ +/*000*/ 0, 0, 0, 0, 0, 0, 0, 0, +/*010*/ 0, 0, NL, 0, 0, 0, 0, 0, +/*020*/ 0, 0, 0, 0, 0, 0, 0, 0, +/*030*/ 0, 0, 0, 0, 0, 0, 0, 0, +/*040*/ 0, 0, Q2, NM, 0, 0, 0, Q1, +/*050*/ 0, 0, 0, NM, 0, VH|NM, NM, 0, +/*060*/ DG, DG, DG, DG, DG, DG, DG, DG, +/*070*/ DG, DG, 0, 0, 0, 0, 0, 0, +/*100*/ 0, I1|NM, I1|NM, I1|NM, I1|NM, I1|NM, I1|NM, I1, +/*110*/ I1, I1, I1, I1, I1, I1, I1, I1, +/*120*/ I1, I1, I1, I1, I1, I1, I1, I1, +/*130*/ I1, I1, I1, 0, ES, 0, 0, I1|NM, +/*140*/ 0, I1|NM, I1|NM, I1|NM, I1|NM, I1|NM, I1|NM, I1, +/*150*/ I1, I1, I1, I1, I1, I1, I1, I1, +/*160*/ I1, I1, I1, I1, I1, I1, I1, I1, +/*170*/ I1, I1, I1, 0, 0, 0, 0, 0, + /* FIXME: latin-1 */ +}; + +struct args_ada +{ + int normalize_numbers; + unsigned short *ctype; +}; + +static struct args_ada args_ada = { 0, ctype_ada }; + +static struct option const long_options_ada[] = +{ + { "normalize-numbers", required_argument, 0, 'n' }, + { 0 } +}; + +static void +help_me_ada (void) +{ + printf (_("\ +Ada language:\n\ + -n,--normalize-numbers When indexing numbers, use a normalized notation\n\ + For example 1_23.45E+5 will be indexed as 123.45e+5\n\ +")); +} + +static void * +parse_args_ada (char **argv, int argc) +{ + char *tmp_string = 0; + struct args_ada *args; + + if (argv == 0 || *argv == 0) + return &args_ada; + + if (argc) + args = &args_ada; + else + { + tmp_string = strdup (*argv); + tokenize_args_string (tmp_string, &argc, &argv); + args = MALLOC (struct args_ada, 1); + args->ctype = ctype_ada; + } + + optind = 0; + for (;;) + { + int optc = getopt_long (argc, argv, "n", + long_options_ada, (int *) 0); + if (optc < 0) + break; + switch (optc) + { + case 'n': + args->normalize_numbers = 1; + break; + + default: + usage (); + } + } + if (tmp_string) + { + free (argv); + free (tmp_string); + } + return args; +} + + +unsigned char +normalize_number_char(int c) +{ + if (c == '_') + return 0; + else + return tolower(c); +} + +/* Grab the next identifier from the Ada source file. This state + machine is built for speed, not elegance. */ + +static struct token * +get_token_ada (FILE *in_FILE, void const *args, int *flags) +{ +#define ARGS ((struct args_ada const *) args) + unsigned short const *rct = &ARGS->ctype[1]; + int c; + unsigned char *id = scanner_buffer; + + obstack_blank (&tokens_obstack, OFFSETOF_TOKEN_NAME); + +top: + c = getc (in_FILE); + while (ISBORING (c)) + c = getc (in_FILE); + + switch (c) + { + case '"': + id = scanner_buffer; + *id++ = c = getc (in_FILE); + for (;;) + { + while (ISQ2BORING (c)) + *id++ = c = getc (in_FILE); + if (c != '"') + goto top; + break; + } + *--id = '\0'; + id = scanner_buffer; + while (ISSTRKEEP (*id)) + id++; + if (*id || id == scanner_buffer) + { + c = getc (in_FILE); + goto top; + } + *flags = TOK_STRING; + obstack_grow0 (&tokens_obstack, scanner_buffer, id - scanner_buffer); + return (struct token *) obstack_finish (&tokens_obstack); + + case '\'': + c = getc (in_FILE); + for (;;) + { + while (ISQ1BORING (c)) + c = getc (in_FILE); + if (c == '\'') + c = getc (in_FILE); + goto top; + } + + case '-': + c = getc (in_FILE); + if (c == '-') + { /* Cope with Ada comment */ + while (ISADABORING (c)) + c = getc (in_FILE); + goto top; + } + else + goto top; + + case '\n': + goto top; + + default: + if (ISEOF (c)) + { + obstack_free (&tokens_obstack, obstack_finish (&tokens_obstack)); + return 0; + } + id = scanner_buffer; + *id++ = c; + if (ISID1ST (c)) + { + *flags = TOK_NAME; + while (ISIDREST (c = getc (in_FILE))) + *id++ = c; + } + else if (ISDIGIT (c)) + { + *flags = TOK_NUMBER; + while (ISNUMBER (c = getc (in_FILE))) + { + if ((c == '.') && (*(id - 1) == '.')) + { + /* We're in a ".." belonging to an interval definition, let's skip it */ + id--; + break; + } + else + if (ARGS->normalize_numbers == 1) + { + if ((c = normalize_number_char(c)) != 0) + *id++ = c; + } + else + { + *id++ = c; + } + } + } + else + { + if (isprint (c)) + fprintf (stderr, _("junk: `'"), c); + else + fprintf (stderr, _("junk: `\\000'"), c); + } + ungetc (c, in_FILE); + *flags |= TOK_LITERAL; + obstack_grow0 (&tokens_obstack, scanner_buffer, id - scanner_buffer); + return (struct token *) obstack_finish (&tokens_obstack); + } +#undef ARGS +} + +#undef I1 +#undef DG +#undef NM +#undef C1 +#undef C2 +#undef Q1 +#undef Q2 +#undef ES +#undef NL +#undef EF +#undef SK +#undef VH +#undef WS +#undef ISDIGIT +#undef ISNUMBER +#undef ISEOF +#undef ISID1ST +#undef ISIDREST +#undef ISSTRKEEP +#undef ISSPACE +#undef ISBORING +#undef ISCBORING +#undef ISCCBORING +#undef ISQ1BORING +#undef ISQ2BORING