xref: /Universal-ctags/misc/optlib2c (revision af10eb0b814559bac24ecb5abaaaffd981226601) 
1#!/usr/bin/env perl
2#
3# optlib2c - a tool translating ctags option file to C
4#
5# Copyright (C) 2016 Masatake YAMATO
6# Copyright (C) 2016 Red Hat Inc.
7#
8# This program is free software; you can redistribute it and/or modify
9# it under the terms of the GNU General Public License as published by
10# the Free Software Foundation; either version 2 of the License, or
11# (at your option) any later version.
12#
13# This program is distributed in the hope that it will be useful,
14# but WITHOUT ANY WARRANTY; without even the implied warranty of
15# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
16# GNU General Public License for more details.
17#
18# You should have received a copy of the GNU General Public License
19# along with this program.  If not, see <http://www.gnu.org/licenses/>.
20#
21
22use strict;
23use warnings;
24#use Data::Dumper;
25#print Dumper(X);
26
27sub show_help {
28    print<<EOF;
29Usage:
30	$0 --help
31	$0 FILE.ctags > FILE.c
32EOF
33}
34
35
36########################################################################
37#
38# PARSE
39#
40########################################################################
41my $options =
42    [
43     [ qr/^--options=(.*)/, sub {
44	   parse_optlib ($1, $_[0]);
45	   return 1;
46       } ],
47     [ qr/^--__selector-(.*)=(.*)/, sub {
48	 die "Don't use --__selector-<LANG>= option before defining the language"
49	     if (! defined $_[0]->{'langdef'});
50	 $_[0]->{'selector'} = $2;
51	 return 1;
52       } ],
53     #
54     # TODO: We should not assume the order of flags.
55     #
56     [ qr/^--langdef=([^\{]+)(((\{base=([^\{]+)\})(\{(dedicated|shared|bidirectional)\})?)?)(\{_autoFQTag\})?/, sub {
57	   die "LANG is already defined as $_[0]->{'langdef'}: $1"
58	       if (defined $_[0]->{'langdef'});
59	   die "Don't use \"all\" as a language name. It is reserved word."
60	       if ($1 eq "all");
61
62	   $_[0]->{'langdef'} = $1;
63	   $_[0]->{'base'} = $5 if defined $5;
64	   $_[0]->{'direction'} = $7 if defined $7;
65	   $_[0]->{'autoFQTag'} = (defined $8)? 1: 0;
66
67	   die "Don't use a character as a language name other than alphanumeric, # and +: "
68	       . $_[0]->{'langdef'} unless ($_[0]->{'langdef'} =~ /^[a-zA-Z0-9#+]+$/);
69	   return 1;
70       } ],
71     [ qr/^--kinddef-(.*)=([^,]),([^,]+),([^\{]+)(\{_refonly\})?/, sub {
72	 die "Don't use --kinddef-<LANG>=+ option before defining the language"
73	     if (! defined $_[0]->{'langdef'});
74	 die "Adding a kind is allowed only to the language specified with --langdef: $1"
75	     unless ($_[0]->{'langdef'} eq $1);
76
77	 my $letter = $2;
78	 my $name = $3;
79	 my $desc = $4;
80	 my $refonly = 0;
81	 $refonly = 1 if defined $5;
82
83	 die "'F' as a kind letter is reserved for file kind."
84	     if ($letter eq 'F');
85	 die "unacceptable character is used for kind letter: $letter"
86	     unless ($letter =~ /^[a-zA-EG-Z]$/);
87
88	 die "'file' as a kind name is reserved"
89	     if ($name eq 'file');
90	 die "The initial letter of kind name must be alphabetic character: $name"
91	     unless (substr ($name, 0, 1) =~ /[a-zA-Z]/);
92	 die "Letters used in kind name other than initial letter must be alphanumeric characters: $name"
93	     unless (substr ($name, 1) =~ /^[a-zA-Z0-9]+$/);
94
95	 push @{$_[0]->{'kinddefs'}}, { enabled => 1, letter => $letter, name => $name, desc => $desc,
96					refonly => $refonly, roles => [], seps => [] };
97	 return 1;
98       } ],
99     [ qr/^--_extradef-(.*)=([^,]+),([^\{]+)/, sub {
100	 die "Don't use --_extradef-<LANG>=+ option before defining the language"
101	     if (! defined $_[0]->{'langdef'});
102	 die "Adding an extra is allowed only to the language specified with --langdef: $1"
103	     unless ($_[0]->{'langdef'} eq $1);
104
105	 my $name = $2;
106	 my $desc = $3;
107
108	 die "unacceptable character is used for extra name: $name"
109	     unless ($name =~ /^[a-zA-Z0-9]+$/);
110
111	 push @{$_[0]->{'extradefs'}}, { name => $name, desc => $desc };
112	 return 1;
113       } ],
114     [ qr/^--_fielddef-(.*)=([^,]+),([^\{]+)/, sub {
115	 die "Don't use --_fielddef-<LANG>=+ option before defining the language"
116	     if (! defined $_[0]->{'langdef'});
117	 die "Adding a field is allowed only to the language specified with --langdef: $1"
118	     unless ($_[0]->{'langdef'} eq $1);
119
120	 my $name = $2;
121	 my $desc = $3;
122	 die "unacceptable character is used for field name: $name"
123	     unless ($name =~ /^[a-zA-Z]+$/);
124
125	 push @{$_[0]->{'fielddefs'}}, { name => $name, desc => $desc };
126	 return 1;
127       } ],
128     [ qr/^--_roledef-([^.]*)\.(?:([a-zA-Z])|\{([a-zA-Z][a-zA-Z0-9]*)\})=([a-zA-Z0-9]+),([^\{]+)/, sub {
129	   die "Don't use --_roledef-<LANG>.<KNID>=+ option before defining the language"
130	     if (! defined $_[0]->{'langdef'});
131	   die "Adding a field is allowed only to the language specified with --langdef: $1"
132	     unless ($_[0]->{'langdef'} eq $1);
133
134	   my $kind_found = 0;
135	   for (@{$_[0]->{'kinddefs'}}) {
136	       if ((defined $2 && $_->{'letter'} eq $2)
137		   || (defined $3 && $_->{'name'} eq $3)) {
138		   my $role = { name => $4, desc => $5, owner => $_ };
139		   push @{$_->{'roles'}}, $role;
140		   $kind_found = 1;
141		   last;
142	       }
143	   }
144	   die "no such kind, \"$2\" where role \"$3\" is attached to" if (! $kind_found);
145	   return 1;
146       } ],
147     [ qr/^--languages=-(.*)/, sub {
148	   die "Don't use --languages=- option before defining the language"
149	       if (! defined $_[0]->{'langdef'});
150	   die "Only language specified with --langdef can be disabled: $1"
151	       unless ($_[0]->{'langdef'} eq $1);
152	   $_[0]->{'disabled'} = 1;
153	   return 1;
154       } ],
155     [ qr/^--language=(.*)/, sub {
156	   die "--languages can be used only for disabling a language defined with --langdef: $1";
157       } ],
158     [ qr/^--map-([^=]*)=\+(.*)/, sub {
159	   die "Don't use --map-<LANG>=+ option before defining the language"
160	       if (! defined $_[0]->{'langdef'});
161	   die "Adding a map is allowed only to the language specified with --langdef: $1"
162	       unless ($_[0]->{'langdef'} eq $1);
163	   my $spec = $2;
164	   if ($spec =~ /\((.*)\)/) {
165	       push @{$_[0]->{'patterns'}}, $1;
166	   } elsif ($spec =~ /\.(.*)/) {
167	       push @{$_[0]->{'extensions'}}, $1;
168	   } else {
169	       die "Unexpected notation is used in the argument for --map-$1= option";
170	   }
171	   return 1;
172       } ],
173     [ qr/^--map-([^=]*)=[^+].*/, sub {
174	   die "map manipulation other than the appending(--map-<LANG>=+...) is not supported";
175       } ],
176     [ qr /^--alias-([^=]*)=\+(.*)/, sub {
177	   die "Don't use --alias-<LANG>=+ option before defining the language"
178	       if (! defined $_[0]->{'langdef'});
179	   die "Adding an alias is allowed only to the language specified with --langdef: $1"
180	       unless ($_[0]->{'langdef'} eq $1);
181	   push @{$_[0]->{'aliases'}}, $2;
182	   return 1;
183       } ],
184     [ qr/^--alias-([^=]*)=[^+].*/, sub {
185	   die "alias manipulation other than the appending(--alias-<LANG>=+...) is not supported";
186       } ],
187     [ qr/^--regex-([^=]*)=(.*)/, sub {
188	   die "Don't use --regex-<LANG>= option before defining the language"
189	       if (! defined $_[0]->{'langdef'});
190	   die "Adding a regex is allowed only to the language specified with --langdef: $1"
191	       unless ($_[0]->{'langdef'} eq $1);
192	   return parse_regex ($2, $_[0], 0);
193       } ],
194     [ qr/^--mline-regex-([^=]*)=(.*)/, sub {
195	   die "Don't use --mline-regex-<LANG>= option before defining the language"
196	       if (! defined $_[0]->{'langdef'});
197	   die "Adding a multiline regex is allowed only to the language specified with --langdef: $1"
198	       unless ($_[0]->{'langdef'} eq $1);
199	   return parse_regex ($2, $_[0], 1);
200       } ],
201     [ qr/^--kinds-([^=]*)=-(.*)/, sub {
202	   die "Don't use --kinds-<LANG>= option before defining the language"
203	       if (! defined $_[0]->{'langdef'});
204	   parse_kinds ($2, $_[0]);
205	   return 1;
206       } ],
207     [ qr/^--kinds-([^=]*)=(.*)/, sub {
208	   die "--kinds-<LANG>= can be used only for disabling a kind: $1";
209       } ],
210     [ qr/^--extras-([^=]*)=([-+])\{(.+)\}$/, sub {
211	   die "Don't use --extras-<LANG>= option before defining the language"
212	       if (! defined $_[0]->{'langdef'});
213	   die "Enabling/disabling an extra is allowed only to the language specified with --langdef: $1"
214	       unless ($_[0]->{'langdef'} eq $1);
215	   die "Specifing multiple extras in one --extras-... is not handled: {$3}"
216	       if ( index ($3, '{') != -1 );
217	   parse_extras ($2, $3, $_[0]);
218	   return 1;
219       } ],
220     [ qr/^--extras-([^=]*)=\{/, sub {
221	 die "--extras-<LANG>= can be used only for enabling or disabling an extra: $1";
222       } ],
223     [ qr/^--extras-([^=]*)=(.)\{/, sub {
224	 die "Unknown flag($2) is passed to --extras-<LANG>= option";
225       } ],
226     [ qr/^--fields-([^=]*)=([-+])\{(.+)\}$/, sub {
227	   die "Don't use --fields-<LANG>= option before defining the language"
228	       if (! defined $_[0]->{'langdef'});
229	   die "Enabling/disabling a field is allowed only to the language specified with --langdef: $1"
230	       unless ($_[0]->{'langdef'} eq $1);
231	   die "Specifing multiple fields in one --fields-... is not handled: {$3}"
232	       if ( index ($3, '{') != -1 );
233	   parse_fields ($2, $3, $_[0]);
234	   return 1;
235       } ],
236     [ qr/^--fields-([^=]*)=\{/, sub {
237	 die "--fields-<LANG>= can be used only for enabling or disabling a field: $1";
238       } ],
239     [ qr/^--fields-([^=]*)=(.)\{/, sub {
240	 die "Unknown flag($2) is passed to --fields-<LANG>= option";
241       } ],
242     [ qr/^--langmap=.*/, sub {
243	 die "Use --map-<LANG> option instead of --langmap";
244       } ],
245     [ qr/^--_tabledef-([^=]*)=(.*)/, sub {
246	 die "Don't use --_tabledef-<LANG>= option before defining the language"
247	   if (! defined $_[0]->{'langdef'});
248	 die "Adding a table is allowed only to the language specified with --langdef: $1"
249	   unless ($_[0]->{'langdef'} eq $1);
250	 $_[0]->{'tabledefs'}->{$2} = [];
251	 push @{$_[0]->{'tablenames'}}, "$2";
252	 return 1;
253       } ],
254     [ qr/^--_mtable-regex-([^=]*)=([^\/]+)(\/.*)/, sub {
255	 die "Don't use --_mtable-regex-<LANG>= option before defining the language"
256	   if (! defined $_[0]->{'langdef'});
257	 die "Adding a multitable regex is allowed only to the language specified with --langdef: $1"
258	   unless ($_[0]->{'langdef'} eq $1);
259	 return parse_regex ($3, $_[0], 1, $2);
260       } ],
261     [ qr/^--_mtable-extend-([^=]*)=(.*)\+(.*)/, sub {
262	 die "Don't use --_mline-extend-<LANG>= option before defining the language"
263	   if (! defined $_[0]->{'langdef'});
264	 die "Extending a multitable regex is allowed only to the language specified with --langdef: $1"
265	   unless ($_[0]->{'langdef'} eq $1);
266	 extend_table($_[0], $2, $3);
267	 return 1;
268     } ],
269     [ qr/^--_(prelude|sequel)-([^=]*)=(\{\{)$/, sub {
270	 die "Don't use --_mtable-regex-<LANG>= option before defining the language"
271	   if (! defined $_[0]->{'langdef'});
272
273	 my $hook = $_[0]->{$1};
274	 my $slot = @$hook;
275	 push @$hook, $3;
276	 return sub {
277	   $hook->[$slot] = $hook->[$slot] . $_[0];
278	 }
279       }],
280     [ qr/^--_(prelude|sequel)-([^=]*)=(\{\{.*\}\})$/, sub {
281	 die "Don't use --_mtable-regex-<LANG>= option before defining the language"
282	   if (! defined $_[0]->{'langdef'});
283
284	 my $hook = $_[0]->{$1};
285	 my $slot = @$hook;
286	 push @$hook, $3;
287	 return 1;
288       }],
289     [ qr/^--_scopesep-([^=]*)=([^,]?)\/([^:]+):(.+)/, sub {
290	 die "Don't use --_scopesep-<LANG>= option before defining the language"
291	   if (! defined $_[0]->{'langdef'});
292	 die "Specifying a scope separator is allowed only to the language specified with --langdef: $1"
293	   unless ($_[0]->{'langdef'} eq $1);
294	 scopesep($_[0], $2, $3, $4);
295	 return 1;
296       } ],
297     [ qr/^-.*/, sub {
298	 die "Unhandled option: \"$&\"";
299       } ],
300     [ qr/.*/, sub {
301	 die "Unhandled argument: \"$&\"";
302       } ],
303    ];
304
305sub parse_line {
306    my ($line, $opts) = @_;
307    my $r = 0;
308
309    for (@{$options}) {
310	my ($pat, $action) = @{$_};
311	if ($line =~ $pat) {
312	    $r = $action -> ($opts);
313	    last;
314	}
315    }
316    $r;
317}
318
319sub gather_chars {
320    my $input = shift;
321    my $output = "";
322
323    my $escape = 0;
324    my $c;
325
326    # See scanSeparators() of lregex.c.
327    while (defined ($c = shift @{$input})) {
328	if ($escape) {
329	    if ($c eq '/') {
330		$output = $output . $c;
331	    } elsif ($c eq 't') {
332		$output = $output . '\\' . 't';
333	    } elsif ($c eq 'n') {
334		$output = $output . '\\' . 'n';
335	    } elsif ($c eq '\\') {
336		$output = $output . '\\\\' . '\\\\';
337	    } else {
338		$output = $output . '\\\\' . $c;
339	    }
340	    $escape = 0;
341	} elsif ($c eq '"') {
342	    $output = $output . '\\' . $c;
343	} elsif ($c eq '\\') {
344	    $escape = 1;
345	} elsif ($c eq '/') {
346	    last;
347	} else {
348	    $output = $output . $c;
349	}
350    }
351
352    return ($output, (defined $c)? $c: "");
353}
354
355sub parse_regex {
356    my ($regspec, $opts, $mline, $table) = @_;
357
358    my @chars = split //, $regspec;
359
360    # TODO:
361    #	ctags allows using a char other than '/'
362    #
363    if (! ($chars[0] eq '/')) {
364	if (!$mline) {
365	    die "--regex-<LANG>= option is not started from /: $regspec";
366	} else {
367	    die "--mline-regex-<LANG>= option is not started from /: $regspec";
368	}
369    }
370
371    shift @chars;
372    my $last_char;
373
374    my $regex;
375    ($regex, $last_char) = gather_chars (\@chars);
376    if (! ($last_char eq '/')) {
377	if (!$mline) {
378	    die "The pattern in --regex-<LANG>= option is not ended with /: $regspec";
379	} else {
380	    die "The pattern in --mline-regex-<LANG>= option is not ended with /: $regspec";
381	}
382    }
383
384    my $name;
385    ($name, $last_char) = gather_chars (\@chars);
386    if (! ($last_char eq '/')) {
387	die "Wrong kind/flags syntax: $regspec";
388    }
389
390    my $tmp;
391    ($tmp, $last_char) = gather_chars (\@chars);
392    my $kind = "";
393    my $flags;
394
395    if ( (! @chars) && (! ($last_char eq '/'))) {
396	$flags = $tmp;
397
398    } else {
399	$kind = $tmp;
400    }
401
402    if ($last_char eq '/') {
403	($flags, $last_char) = gather_chars (\@chars);
404    }
405
406    my $optscript = '';
407    if ($flags =~ /(.*)\{\{$/) {
408	$flags = $1;
409	$optscript = "{{\n";
410    }
411
412    my $entry;
413    if (defined $table) {
414
415      if (! (substr ($regex, 0, 1) eq '^')) {
416	$regex = '^' . $regex;
417      }
418      $entry = { 'regex' => $regex,
419		 'name'  => $name,
420		 'kind'  => $kind,
421		 'flags' => $flags,
422		 'mline' => $mline,
423		 'optscript' => $optscript,
424	       };
425      push @{$opts->{'tabledefs'}->{"$table"}}, $entry;
426    } else {
427      $entry = { 'regex' => $regex,
428		 'name'  => $name,
429		 'kind'  => $kind,
430		 'flags' => $flags,
431		 'mline' => $mline,
432		 'optscript' => $optscript,
433	       };
434      push @{$opts->{'regexs'}}, $entry;
435    }
436
437    if ($flags =~ '{scope=' || $optscript) {
438	$opts->{'useCork'} = 1;
439    }
440
441    return $optscript
442	? sub {
443	    $entry->{'optscript'} = $entry->{'optscript'} . $_[0];
444	}
445	: 1;
446}
447
448sub extend_table {
449  my ($opts, $dist, $src) = @_;
450
451  for (@{$opts->{'tabledefs'}->{$src}}) {
452    push @{$opts->{'tabledefs'}->{$dist}}, $_;
453  }
454}
455
456sub parse_kinds {
457    my ($kinds, $opts) = @_;
458    for my $letter (split //, $kinds) {
459	for (@{$opts->{'kinddefs'}}) {
460	    if ($_->{'letter'} eq $letter) {
461		$_->{'enabled'} = 0;
462	    }
463	}
464    }
465}
466
467sub parse_optlib {
468    my ($optlib, $opts) = @_;
469
470    open(my $optlibfh, "<", $optlib)
471	or die "cannot open the optlib file: \"$optlib\"";
472
473    my $receiver = 0;
474    while (<$optlibfh>) {
475	chomp;
476
477	if (/^\}\}$/ && $receiver && ($receiver != 1)) {
478	    $receiver->('}}');
479	    $receiver = 1;
480	}
481	elsif ($receiver && $receiver != 1) {
482	    my $str = escape_as_cstr ($_);
483	    $receiver->($str);
484	    $receiver->("\n");
485	} elsif ( /^[[:blank:]]*#.*/ ) {
486	    next;
487	} else {
488	    s/^\s*//;
489	    next if ( /^\s*$/ );
490	    $receiver = parse_line ($_, $opts);
491	    if (! $receiver) {
492		return undef;
493	    }
494	}
495    }
496    return $opts;
497}
498
499sub parse_extras {
500    my ($flag, $extra, $opts) = @_;
501
502    $flag = ( $flag eq '+' )?1: 0;
503
504    # TODO: Hash table should be used for manage 'extradefs'.
505    for (@{$opts->{'extradefs'}}) {
506	if ($_->{'name'} eq $extra)
507	{
508	    $_->{'enabled'} = $flag;
509	}
510    }
511}
512
513sub parse_fields {
514    my ($flag, $field, $opts) = @_;
515
516    $flag = ( $flag eq '+' )?1: 0;
517
518    # TODO: Hash table should be used for manage 'fielddefs'.
519    for (@{$opts->{'fielddefs'}}) {
520	if ($_->{'name'} eq $field)
521	{
522	    $_->{'enabled'} = $flag;
523	}
524    }
525}
526
527sub scopesep {
528    my ($opts, $parent_kletter, $kletter, $sep) = @_;
529
530    if ($kletter eq '*') {
531	if ($parent_kletter eq '*') {
532	    $opts->{'defaultScopeSeparator'} = $sep;
533	} elsif (!$parent_kletter) {
534	    $opts->{'defaultRootScopeSeparator'} = $sep;
535	} else {
536	    die "Unhandled kind letter during parsing --_scopsesep option: $parent_kletter";
537	}
538    } elsif ($kletter =~ /[a-zA-Z]/) {
539	my $kind;
540	for (@{$opts->{'kinddefs'}}) {
541	    if ($_->{'letter'} eq $kletter) {
542		$kind = $_;
543		last;
544	    }
545	}
546	die "Unknown kind letter in --_scopsesep option: $kletter"
547	  unless defined $kind;
548
549	if ($parent_kletter eq '*') {
550	    push @{$kind->{'seps'}}, { parentKindIndex => 'KIND_WILDCARD_INDEX',
551				       sep => $sep };
552	} elsif (!$parent_kletter) {
553	    push @{$kind->{'seps'}}, { parentKindIndex => 'KIND_GHOST_INDEX',
554				       sep => $sep };
555	} elsif ($parent_kletter =~ /[a-zA-Z]/) {
556	    my $parent_kind;
557	    for (@{$opts->{'kinddefs'}}) {
558		if ($_->{'letter'} == $parent_kletter) {
559		    $parent_kind = $_;
560		    last;
561		}
562	    }
563	    die "Unknown kind letter in --_scopsesep option: $parent_kletter"
564	      unless defined $parent_kind;
565	    push @{$kind->{'seps'}}, { parentKindIndex => 'K_' . (uc $parent_kind->{'name'}),
566				       sep => $sep };
567	}
568    } else {
569	die "Unhandled kind letter during parsing --_scopsesep option: $kletter";
570    }
571
572    $opts->{'hasSepSpeicifer'} = 1;
573}
574
575
576########################################################################
577#
578# EMIT
579#
580########################################################################
581
582sub emit_header {
583    my ($optlib, $opts) = @_;
584
585    print <<EOF;
586/*
587 * Generated by $0 from ${optlib}, Don't edit this manually.
588 */
589#include "general.h"
590#include "parse.h"
591#include "routines.h"
592#include "field.h"
593#include "xtag.h"
594EOF
595
596    if (defined $opts->{'base'}) {
597	print <<EOF;
598#include "subparser.h"
599EOF
600    }
601    if (defined $opts->{'selector'}) {
602	print <<EOF;
603#include "selectors.h"
604EOF
605    }
606    print <<EOF;
607
608
609EOF
610}
611
612sub emit_initializer {
613    my $opts = shift;
614    my $may_unused = $opts->{'tablenames'} ? "": " CTAGS_ATTR_UNUSED";
615
616    print <<EOF;
617static void initialize$opts->{'Clangdef'}Parser (const langType language$may_unused)
618{
619EOF
620    for (@{$opts->{'prelude'}}) {
621	my $prelude = "";
622	for my $frag (split /\n/, $_) {
623	    $prelude = $prelude . "\n\t\t\"" . $frag . ($frag =~ /.*\}\}$/
624							? '"'
625							: '\n"');
626	}
627	print <<EOF;
628	addLanguageOptscriptToHook (language, SCRIPT_HOOK_PRELUDE,$prelude);
629EOF
630    }
631    for (@{$opts->{'sequel'}}) {
632	my $sequel = "";
633	for my $frag (split /\n/, $_) {
634	    $sequel = $sequel . "\n\t\t\"" . $frag . ($frag =~ /.*\}\}$/
635							? '"'
636							: '\n"');
637	}
638	print <<EOF;
639	addLanguageOptscriptToHook (language, SCRIPT_HOOK_SEQUEL,$sequel);
640EOF
641    }
642    if ($opts->{'tablenames'}) {
643      print "\n";
644
645      for (@{$opts->{'tablenames'}}) {
646	print <<EOF;
647	addLanguageRegexTable (language, "$_");
648EOF
649      }
650
651      print "\n";
652
653      for my $table (@{$opts->{'tablenames'}}) {
654	for (@{$opts->{'tabledefs'}->{"$table"}}) {
655	  my $optscript = "";
656	  if ($_-> {'optscript'}) {
657	    for my $frag (split /\n/, $_-> {'optscript'}) {
658	      $optscript = $optscript . "\n\t\t\"" . $frag . ($frag =~ /.*\}\}$/
659							      ? '"'
660							      : '\n"');
661	    }
662	  }
663	  print <<EOF;
664	addLanguageTagMultiTableRegex (language, "$table",
665	                               "$_->{'regex'}",
666	                               "$_->{'name'}", "$_->{'kind'}", "$_->{'flags'}"$optscript, NULL);
667EOF
668	}
669      }
670    }
671    print <<EOF;
672}
673
674EOF
675    0;
676}
677
678sub emit_list {
679    my ($opts, $key) = @_;
680
681    print <<EOF;
682	static const char *const $key [] = {
683EOF
684    for (@{$opts->{$key}}) {
685	print <<EOF;
686		\"$_\",
687EOF
688    }
689
690    print <<EOF;
691		NULL
692	};
693
694EOF
695}
696
697sub emit_aliases {
698    emit_list $_[0], "aliases";
699}
700
701sub emit_extensions {
702    emit_list $_[0], "extensions";
703}
704
705sub emit_patterns {
706    emit_list $_[0], "patterns";
707}
708
709# TODO: handling '\'
710sub escape_as_cstr {
711    my $input = shift;
712    my $output = "";
713
714    for my $c (split //, $input) {
715	if ($c eq '"') {
716	    $output = $output . '\\' . '"';
717	} elsif ($c eq '\\') {
718	    $output = $output . '\\' . '\\';
719	} else {
720	    $output = $output . $c;
721	}
722    }
723
724    return $output;
725}
726
727sub emit_roledefs {
728    my $opts = shift;
729
730
731    for (@{$opts->{'kinddefs'}}) {
732	next unless @{$_->{'roles'}};
733	my $Kind = capitalize($_->{'name'});
734	print <<EOF;
735	static roleDefinition $opts->{'Clangdef'}${Kind}RoleTable [] = {
736EOF
737	for (@{$_->{'roles'}}) {
738	    my $desc = escape_as_cstr $_->{'desc'};
739	    print <<EOF;
740		{ true, "$_->{'name'}", "$desc" },
741EOF
742	}
743
744	print <<EOF;
745	};
746EOF
747    }
748    print <<EOF;
749EOF
750}
751
752sub emit_kinddef_enums {
753    my $opts = shift;
754
755    return if (! @{$opts->{'kinddefs'}});
756
757    print <<EOF;
758typedef enum {
759EOF
760    for (@{$opts->{'kinddefs'}}) {
761	my $e = uc($_->{'name'});
762	print <<EOF;
763	K_$e,
764EOF
765    }
766    print <<EOF;
767} $opts->{'Clangdef'}Kind;
768
769
770EOF
771}
772
773sub emit_scopeseps {
774    my $opts = shift;
775
776    return if (! @{$opts->{'kinddefs'}});
777
778    for (@{$opts->{'kinddefs'}}) {
779	my $seps = $_->{'seps'};
780	if (@{$seps}) {
781	    my $Kind = capitalize ($_->{'name'});
782	    print <<EOF;
783	static scopeSeparator $opts->{'Clangdef'}${Kind}Separators [] = {
784EOF
785	    for (@{$seps}) {
786	    print <<EOF;
787		{ $_->{'parentKindIndex'}, "$_->{'sep'}" },
788EOF
789	    }
790	    print <<EOF;
791	};
792
793EOF
794	}
795    }
796}
797
798sub emit_kinddefs {
799    my $opts = shift;
800
801    return if (! @{$opts->{'kinddefs'}});
802
803    print <<EOF;
804	static kindDefinition $opts->{'Clangdef'}KindTable [] = {
805EOF
806    for (@{$opts->{'kinddefs'}}) {
807      my $enabled = $_->{"enabled"}? "true": "false";
808      print <<EOF;
809		{
810EOF
811      my $desc = escape_as_cstr $_->{'desc'};
812      print <<EOF;
813		  $enabled, \'$_->{'letter'}\', "$_->{'name'}", "$desc",
814EOF
815      if ($_->{'refonly'}) {
816	  print <<EOF;
817		  .referenceOnly = true,
818EOF
819      }
820      my $Kind = capitalize($_->{'name'});
821      if (@{$_->{'roles'}}) {
822	  print <<EOF;
823		  ATTACH_ROLES($opts->{'Clangdef'}${Kind}RoleTable),
824EOF
825      }
826      if (@{$_->{'seps'}}) {
827	  print <<EOF;
828		  ATTACH_SEPARATORS($opts->{'Clangdef'}${Kind}Separators),
829EOF
830      }
831      print <<EOF;
832		},
833EOF
834    }
835    print <<EOF;
836	};
837EOF
838}
839
840sub emit_regexs {
841    my $opts = shift;
842
843    return if (! @{$opts->{'regexs'}});
844
845    print <<EOF;
846	static tagRegexTable $opts->{'Clangdef'}TagRegexTable [] = {
847EOF
848    for (@{$opts->{'regexs'}}) {
849	my $flags;
850	if ($_-> {'flags'}) {
851	    $flags = '"' . $_-> {'flags'} . '"';
852	    if ($_-> {'optscript'}) {
853		for my $frag (split /\n/, $_-> {'optscript'}) {
854		    $flags = $flags . "\n\t\t\"" . $frag . ($frag =~ /.*\}\}$/
855							    ? '"'
856							    : '\n"');
857		}
858	    }
859	} else {
860	    if ($_-> {'optscript'}) {
861		$flags = '""';
862		for my $frag (split /\n/, $_-> {'optscript'}) {
863		    $flags = $flags . "\n\t\t\"" . $frag . ($frag =~ /.*\}\}$/
864							    ? '"'
865							    : '\n"');
866		}
867	    } else {
868		$flags = 'NULL';
869	    }
870	}
871	my $mline = $_-> {'mline'}? "true": "false";
872	print <<EOF;
873		{"$_->{'regex'}", "$_->{'name'}",
874		"$_->{'kind'}", $flags, NULL, $mline},
875EOF
876    }
877    print <<EOF;
878	};
879
880EOF
881}
882
883sub emit_dependencies {
884    my $opts = shift;
885
886    return if (! defined $opts->{'base'});
887
888    my $direction = "SUBPARSER_BASE_RUNS_SUB";
889
890    if (defined $opts->{'direction'})
891    {
892	if ($opts->{'direction'} eq 'shared')
893	{
894	    $direction = "SUBPARSER_BASE_RUNS_SUB";
895	} elsif ($opts->{'direction'} eq 'dedicated')
896	{
897	    $direction = "SUBPARSER_SUB_RUNS_BASE";
898	} elsif ($opts->{'direction'} eq 'bidirectional')
899	{
900	    $direction = "SUBPARSER_BI_DIRECTION";
901	}
902    }
903
904    print <<EOF;
905	static subparser $opts->{'Clangdef'}Subparser = {
906		.direction = $direction,
907	};
908	static parserDependency $opts->{'Clangdef'}Dependencies [] = {
909		[0] = { DEPTYPE_SUBPARSER, "$opts->{'base'}", &$opts->{'Clangdef'}Subparser },
910	};
911EOF
912
913}
914
915sub emit_xtags {
916    my $opts = shift;
917
918    return if (! @{$opts->{'extradefs'}});
919
920    print <<EOF;
921	static xtagDefinition $opts->{'Clangdef'}XtagTable [] = {
922EOF
923    for (@{$opts->{'extradefs'}}) {
924      my $enabled = $_->{"enabled"}? "true": "false";
925      my $desc = escape_as_cstr $_->{'desc'};
926      print <<EOF;
927		{
928		  .enabled     = $enabled,
929		  .name        = "$_->{'name'}",
930		  .description = "$desc",
931		},
932EOF
933    }
934    print <<EOF;
935	};
936EOF
937}
938
939sub emit_fields {
940    my $opts = shift;
941
942    return if (! @{$opts->{'fielddefs'}});
943
944    print <<EOF;
945	static fieldDefinition $opts->{'Clangdef'}FieldTable [] = {
946EOF
947    for (@{$opts->{'fielddefs'}}) {
948      my $enabled = $_->{"enabled"}? "true": "false";
949      my $desc = escape_as_cstr $_->{'desc'};
950      print <<EOF;
951		{
952		  .enabled     = $enabled,
953		  .name        = "$_->{'name'}",
954		  .description = "$desc",
955		},
956EOF
957    }
958    print <<EOF;
959	};
960EOF
961}
962
963sub emit_selector {
964    my $opts = shift;
965
966    if (defined $opts->{'selector'}) {
967	print <<EOF;
968	static selectLanguage selectors[] = { $opts->{'selector'}, NULL };
969EOF
970    }
971}
972
973sub emit_fields_initialization {
974    my $opts = shift;
975    my $enabled = $opts->{"disabled"} ? "false": "true";
976    my $method;
977    my $sep;
978
979    $method  = "METHOD_NOT_CRAFTED";
980    if (@{$opts->{"regexs"}} || $opts->{'tablenames'}) {
981	$method = "${method}|METHOD_REGEX";
982    }
983
984    print <<EOF;
985	def->enabled       = ${enabled};
986	def->extensions    = extensions;
987	def->patterns      = patterns;
988	def->aliases       = aliases;
989EOF
990    if (defined $opts->{'selector'}) {
991	print <<EOF;
992	def->selectLanguage= selectors;
993EOF
994    }
995print <<EOF;
996	def->method        = ${method};
997EOF
998
999    if ($opts->{'useCork'}) {
1000	print <<EOF;
1001	def->useCork       = CORK_QUEUE;
1002EOF
1003    }
1004    if (@{$opts->{'kinddefs'}}) {
1005	print <<EOF;
1006	def->kindTable     = $opts->{'Clangdef'}KindTable;
1007	def->kindCount     = ARRAY_SIZE($opts->{'Clangdef'}KindTable);
1008EOF
1009    }
1010
1011    if (@{$opts->{'fielddefs'}}) {
1012	print <<EOF;
1013	def->fieldTable    = $opts->{'Clangdef'}FieldTable;
1014	def->fieldCount    = ARRAY_SIZE($opts->{'Clangdef'}FieldTable);
1015EOF
1016    }
1017
1018    if (@{$opts->{'extradefs'}}) {
1019	print <<EOF;
1020	def->xtagTable     = $opts->{'Clangdef'}XtagTable;
1021	def->xtagCount     = ARRAY_SIZE($opts->{'Clangdef'}XtagTable);
1022EOF
1023    }
1024
1025    if (@{$opts->{'regexs'}}) {
1026	print <<EOF;
1027	def->tagRegexTable = $opts->{'Clangdef'}TagRegexTable;
1028	def->tagRegexCount = ARRAY_SIZE($opts->{'Clangdef'}TagRegexTable);
1029EOF
1030    }
1031
1032    if (defined $opts->{'base'}) {
1033	print <<EOF;
1034	def->dependencies    = $opts->{'Clangdef'}Dependencies;
1035	def->dependencyCount = ARRAY_SIZE($opts->{'Clangdef'}Dependencies);
1036EOF
1037    }
1038
1039    if ($opts->{'autoFQTag'}) {
1040	print <<EOF;
1041	def->requestAutomaticFQTag = true;
1042EOF
1043    }
1044
1045    if ($opts->{'defaultScopeSeparator'}) {
1046	$sep = "$opts->{'defaultScopeSeparator'}";
1047	$sep = escape_as_cstr "$sep";
1048	print <<EOF;
1049	def->defaultScopeSeparator = "$sep";
1050EOF
1051    }
1052    if ($opts->{'defaultRootScopeSeparator'}) {
1053	$sep = $opts->{'defaultRootScopeSeparator'};
1054	$sep = escape_as_cstr "$sep";
1055	print <<EOF;
1056	def->defaultRootScopeSeparator = "$sep";
1057EOF
1058    }
1059    print <<EOF;
1060	def->initialize    = initialize$opts->{'Clangdef'}Parser;
1061
1062EOF
1063}
1064
1065sub emit {
1066    my ($optlib, $opts) = @_;
1067
1068    emit_header ($optlib, $opts);
1069
1070    if ($opts->{'hasSepSpeicifer'}) {
1071	emit_kinddef_enums   $opts;
1072    };
1073    emit_initializer $opts;
1074
1075    print <<EOF;
1076extern parserDefinition* $opts->{'Clangdef'}Parser (void)
1077{
1078EOF
1079
1080    emit_extensions      $opts;
1081    emit_aliases         $opts;
1082    emit_patterns        $opts;
1083    emit_roledefs        $opts;
1084    emit_scopeseps       $opts;
1085    emit_kinddefs        $opts;
1086    emit_fields          $opts;
1087    emit_xtags           $opts;
1088    emit_regexs          $opts;
1089    emit_dependencies    $opts;
1090    emit_selector         $opts;
1091
1092    print "\n";
1093
1094    print <<EOF;
1095	parserDefinition* const def = parserNew ("$opts->{'langdef'}");
1096
1097EOF
1098
1099    emit_fields_initialization $opts;
1100
1101    print <<EOF;
1102	return def;
1103}
1104EOF
1105}
1106
1107########################################################################
1108#
1109# REARRANGE
1110#
1111########################################################################
1112
1113sub capitalize {
1114    my ($str) = $_[0];
1115    my $c = substr ($str, 0, 1);
1116
1117    $c =~ tr/a-z/A-Z/;
1118
1119    return $c . substr($str, 1);
1120}
1121
1122sub rearrange {
1123    my ($opts) = @_;
1124    my $langdef = $opts -> {'langdef'};
1125    $opts -> {'Clangdef'} = capitalize ($langdef);
1126}
1127
1128
1129########################################################################
1130#
1131# MAIN
1132#
1133########################################################################
1134
1135sub main {
1136    my $optlib;
1137    my %opts = (langdef  => undef,
1138		Clangdef => undef,
1139		disabled => 0,
1140		patterns => [],
1141		extensions => [],
1142		aliases => [],
1143		regexs => [# { regex => "", name => "", kind => "", flags => "", mline => 1|0, optscript => "" },
1144			  ],
1145		kinddefs => [# { letter => '', name => "", desc => "",
1146			     #   seps => [ {parentKindIndex => "", sep => "" } ]
1147			     # },
1148			    ],
1149		extradefs => [ # { name => "", desc => "", enabled => 1|0 },
1150			     ],
1151		fielddefs => [ # { name => "", desc => "", enabled => 1|0 },
1152			      ],
1153		base => undef,
1154		tableNames => [ # ""
1155			       ],
1156		tabledefs => { # "" => [{ regex => "", name => "", kind => "", flags => "" }...],
1157			     },
1158		useCork   => 0,
1159		defaultScopeSeparator => undef,
1160		defaultRootScopeSeparator => undef,
1161		hasSepSpeicifer => 0,
1162		prelude => [ # ""
1163			   ],
1164		sequel =>  [ # ""
1165			   ],
1166		selector => undef,
1167	       );
1168
1169    for (@_) {
1170	if ( ($_ eq '-h') || ($_ eq '--help') ) {
1171	    show_help;
1172	    exit 0;
1173	} elsif ( /^-.*/ ) {
1174	    die "unrecongnized option: $_";
1175	} else {
1176	    if ($optlib) {
1177		die "Too man input files: @_";
1178	    }
1179	    $optlib=$_;
1180	}
1181    }
1182
1183    if (! $optlib) {
1184	die "No optlib file name is given";
1185    }
1186
1187    if (! parse_optlib ($optlib, \%opts)) {
1188	exit 1;
1189    }
1190
1191    rearrange (\%opts);
1192
1193    if (! emit ($optlib, \%opts) ) {
1194	exit 1;
1195    }
1196    0;
1197}
1198
1199main @ARGV;
1200
1201# optlib2c ends here.
1202