xref: /Universal-ctags/misc/optlib2c (revision af10eb0b814559bac24ecb5abaaaffd981226601)

#!/usr/bin/env perl
#
# optlib2c - a tool translating ctags option file to C
#
# Copyright (C) 2016 Masatake YAMATO
# Copyright (C) 2016 Red Hat Inc.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.
#

use strict;
use warnings;
#use Data::Dumper;
#print Dumper(X);

sub show_help {
    print<<EOF;
Usage:
	$0 --help
	$0 FILE.ctags > FILE.c
EOF
}


########################################################################
#
# PARSE
#
########################################################################
my $options =
    [
     [ qr/^--options=(.*)/, sub {
	   parse_optlib ($1, $_[0]);
	   return 1;
       } ],
     [ qr/^--__selector-(.*)=(.*)/, sub {
	 die "Don't use --__selector-<LANG>= option before defining the language"
	     if (! defined $_[0]->{'langdef'});
	 $_[0]->{'selector'} = $2;
	 return 1;
       } ],
     #
     # TODO: We should not assume the order of flags.
     #
     [ qr/^--langdef=([^\{]+)(((\{base=([^\{]+)\})(\{(dedicated|shared|bidirectional)\})?)?)(\{_autoFQTag\})?/, sub {
	   die "LANG is already defined as $_[0]->{'langdef'}: $1"
	       if (defined $_[0]->{'langdef'});
	   die "Don't use \"all\" as a language name. It is reserved word."
	       if ($1 eq "all");

	   $_[0]->{'langdef'} = $1;
	   $_[0]->{'base'} = $5 if defined $5;
	   $_[0]->{'direction'} = $7 if defined $7;
	   $_[0]->{'autoFQTag'} = (defined $8)? 1: 0;

	   die "Don't use a character as a language name other than alphanumeric, # and +: "
	       . $_[0]->{'langdef'} unless ($_[0]->{'langdef'} =~ /^[a-zA-Z0-9#+]+$/);
	   return 1;
       } ],
     [ qr/^--kinddef-(.*)=([^,]),([^,]+),([^\{]+)(\{_refonly\})?/, sub {
	 die "Don't use --kinddef-<LANG>=+ option before defining the language"
	     if (! defined $_[0]->{'langdef'});
	 die "Adding a kind is allowed only to the language specified with --langdef: $1"
	     unless ($_[0]->{'langdef'} eq $1);

	 my $letter = $2;
	 my $name = $3;
	 my $desc = $4;
	 my $refonly = 0;
	 $refonly = 1 if defined $5;

	 die "'F' as a kind letter is reserved for file kind."
	     if ($letter eq 'F');
	 die "unacceptable character is used for kind letter: $letter"
	     unless ($letter =~ /^[a-zA-EG-Z]$/);

	 die "'file' as a kind name is reserved"
	     if ($name eq 'file');
	 die "The initial letter of kind name must be alphabetic character: $name"
	     unless (substr ($name, 0, 1) =~ /[a-zA-Z]/);
	 die "Letters used in kind name other than initial letter must be alphanumeric characters: $name"
	     unless (substr ($name, 1) =~ /^[a-zA-Z0-9]+$/);

	 push @{$_[0]->{'kinddefs'}}, { enabled => 1, letter => $letter, name => $name, desc => $desc,
					refonly => $refonly, roles => [], seps => [] };
	 return 1;
       } ],
     [ qr/^--_extradef-(.*)=([^,]+),([^\{]+)/, sub {
	 die "Don't use --_extradef-<LANG>=+ option before defining the language"
	     if (! defined $_[0]->{'langdef'});
	 die "Adding an extra is allowed only to the language specified with --langdef: $1"
	     unless ($_[0]->{'langdef'} eq $1);

	 my $name = $2;
	 my $desc = $3;

	 die "unacceptable character is used for extra name: $name"
	     unless ($name =~ /^[a-zA-Z0-9]+$/);

	 push @{$_[0]->{'extradefs'}}, { name => $name, desc => $desc };
	 return 1;
       } ],
     [ qr/^--_fielddef-(.*)=([^,]+),([^\{]+)/, sub {
	 die "Don't use --_fielddef-<LANG>=+ option before defining the language"
	     if (! defined $_[0]->{'langdef'});
	 die "Adding a field is allowed only to the language specified with --langdef: $1"
	     unless ($_[0]->{'langdef'} eq $1);

	 my $name = $2;
	 my $desc = $3;
	 die "unacceptable character is used for field name: $name"
	     unless ($name =~ /^[a-zA-Z]+$/);

	 push @{$_[0]->{'fielddefs'}}, { name => $name, desc => $desc };
	 return 1;
       } ],
     [ qr/^--_roledef-([^.]*)\.(?:([a-zA-Z])|\{([a-zA-Z][a-zA-Z0-9]*)\})=([a-zA-Z0-9]+),([^\{]+)/, sub {
	   die "Don't use --_roledef-<LANG>.<KNID>=+ option before defining the language"
	     if (! defined $_[0]->{'langdef'});
	   die "Adding a field is allowed only to the language specified with --langdef: $1"
	     unless ($_[0]->{'langdef'} eq $1);

	   my $kind_found = 0;
	   for (@{$_[0]->{'kinddefs'}}) {
	       if ((defined $2 && $_->{'letter'} eq $2)
		   || (defined $3 && $_->{'name'} eq $3)) {
		   my $role = { name => $4, desc => $5, owner => $_ };
		   push @{$_->{'roles'}}, $role;
		   $kind_found = 1;
		   last;
	       }
	   }
	   die "no such kind, \"$2\" where role \"$3\" is attached to" if (! $kind_found);
	   return 1;
       } ],
     [ qr/^--languages=-(.*)/, sub {
	   die "Don't use --languages=- option before defining the language"
	       if (! defined $_[0]->{'langdef'});
	   die "Only language specified with --langdef can be disabled: $1"
	       unless ($_[0]->{'langdef'} eq $1);
	   $_[0]->{'disabled'} = 1;
	   return 1;
       } ],
     [ qr/^--language=(.*)/, sub {
	   die "--languages can be used only for disabling a language defined with --langdef: $1";
       } ],
     [ qr/^--map-([^=]*)=\+(.*)/, sub {
	   die "Don't use --map-<LANG>=+ option before defining the language"
	       if (! defined $_[0]->{'langdef'});
	   die "Adding a map is allowed only to the language specified with --langdef: $1"
	       unless ($_[0]->{'langdef'} eq $1);
	   my $spec = $2;
	   if ($spec =~ /\((.*)\)/) {
	       push @{$_[0]->{'patterns'}}, $1;
	   } elsif ($spec =~ /\.(.*)/) {
	       push @{$_[0]->{'extensions'}}, $1;
	   } else {
	       die "Unexpected notation is used in the argument for --map-$1= option";
	   }
	   return 1;
       } ],
     [ qr/^--map-([^=]*)=[^+].*/, sub {
	   die "map manipulation other than the appending(--map-<LANG>=+...) is not supported";
       } ],
     [ qr /^--alias-([^=]*)=\+(.*)/, sub {
	   die "Don't use --alias-<LANG>=+ option before defining the language"
	       if (! defined $_[0]->{'langdef'});
	   die "Adding an alias is allowed only to the language specified with --langdef: $1"
	       unless ($_[0]->{'langdef'} eq $1);
	   push @{$_[0]->{'aliases'}}, $2;
	   return 1;
       } ],
     [ qr/^--alias-([^=]*)=[^+].*/, sub {
	   die "alias manipulation other than the appending(--alias-<LANG>=+...) is not supported";
       } ],
     [ qr/^--regex-([^=]*)=(.*)/, sub {
	   die "Don't use --regex-<LANG>= option before defining the language"
	       if (! defined $_[0]->{'langdef'});
	   die "Adding a regex is allowed only to the language specified with --langdef: $1"
	       unless ($_[0]->{'langdef'} eq $1);
	   return parse_regex ($2, $_[0], 0);
       } ],
     [ qr/^--mline-regex-([^=]*)=(.*)/, sub {
	   die "Don't use --mline-regex-<LANG>= option before defining the language"
	       if (! defined $_[0]->{'langdef'});
	   die "Adding a multiline regex is allowed only to the language specified with --langdef: $1"
	       unless ($_[0]->{'langdef'} eq $1);
	   return parse_regex ($2, $_[0], 1);
       } ],
     [ qr/^--kinds-([^=]*)=-(.*)/, sub {
	   die "Don't use --kinds-<LANG>= option before defining the language"
	       if (! defined $_[0]->{'langdef'});
	   parse_kinds ($2, $_[0]);
	   return 1;
       } ],
     [ qr/^--kinds-([^=]*)=(.*)/, sub {
	   die "--kinds-<LANG>= can be used only for disabling a kind: $1";
       } ],
     [ qr/^--extras-([^=]*)=([-+])\{(.+)\}$/, sub {
	   die "Don't use --extras-<LANG>= option before defining the language"
	       if (! defined $_[0]->{'langdef'});
	   die "Enabling/disabling an extra is allowed only to the language specified with --langdef: $1"
	       unless ($_[0]->{'langdef'} eq $1);
	   die "Specifing multiple extras in one --extras-... is not handled: {$3}"
	       if ( index ($3, '{') != -1 );
	   parse_extras ($2, $3, $_[0]);
	   return 1;
       } ],
     [ qr/^--extras-([^=]*)=\{/, sub {
	 die "--extras-<LANG>= can be used only for enabling or disabling an extra: $1";
       } ],
     [ qr/^--extras-([^=]*)=(.)\{/, sub {
	 die "Unknown flag($2) is passed to --extras-<LANG>= option";
       } ],
     [ qr/^--fields-([^=]*)=([-+])\{(.+)\}$/, sub {
	   die "Don't use --fields-<LANG>= option before defining the language"
	       if (! defined $_[0]->{'langdef'});
	   die "Enabling/disabling a field is allowed only to the language specified with --langdef: $1"
	       unless ($_[0]->{'langdef'} eq $1);
	   die "Specifing multiple fields in one --fields-... is not handled: {$3}"
	       if ( index ($3, '{') != -1 );
	   parse_fields ($2, $3, $_[0]);
	   return 1;
       } ],
     [ qr/^--fields-([^=]*)=\{/, sub {
	 die "--fields-<LANG>= can be used only for enabling or disabling a field: $1";
       } ],
     [ qr/^--fields-([^=]*)=(.)\{/, sub {
	 die "Unknown flag($2) is passed to --fields-<LANG>= option";
       } ],
     [ qr/^--langmap=.*/, sub {
	 die "Use --map-<LANG> option instead of --langmap";
       } ],
     [ qr/^--_tabledef-([^=]*)=(.*)/, sub {
	 die "Don't use --_tabledef-<LANG>= option before defining the language"
	   if (! defined $_[0]->{'langdef'});
	 die "Adding a table is allowed only to the language specified with --langdef: $1"
	   unless ($_[0]->{'langdef'} eq $1);
	 $_[0]->{'tabledefs'}->{$2} = [];
	 push @{$_[0]->{'tablenames'}}, "$2";
	 return 1;
       } ],
     [ qr/^--_mtable-regex-([^=]*)=([^\/]+)(\/.*)/, sub {
	 die "Don't use --_mtable-regex-<LANG>= option before defining the language"
	   if (! defined $_[0]->{'langdef'});
	 die "Adding a multitable regex is allowed only to the language specified with --langdef: $1"
	   unless ($_[0]->{'langdef'} eq $1);
	 return parse_regex ($3, $_[0], 1, $2);
       } ],
     [ qr/^--_mtable-extend-([^=]*)=(.*)\+(.*)/, sub {
	 die "Don't use --_mline-extend-<LANG>= option before defining the language"
	   if (! defined $_[0]->{'langdef'});
	 die "Extending a multitable regex is allowed only to the language specified with --langdef: $1"
	   unless ($_[0]->{'langdef'} eq $1);
	 extend_table($_[0], $2, $3);
	 return 1;
     } ],
     [ qr/^--_(prelude|sequel)-([^=]*)=(\{\{)$/, sub {
	 die "Don't use --_mtable-regex-<LANG>= option before defining the language"
	   if (! defined $_[0]->{'langdef'});

	 my $hook = $_[0]->{$1};
	 my $slot = @$hook;
	 push @$hook, $3;
	 return sub {
	   $hook->[$slot] = $hook->[$slot] . $_[0];
	 }
       }],
     [ qr/^--_(prelude|sequel)-([^=]*)=(\{\{.*\}\})$/, sub {
	 die "Don't use --_mtable-regex-<LANG>= option before defining the language"
	   if (! defined $_[0]->{'langdef'});

	 my $hook = $_[0]->{$1};
	 my $slot = @$hook;
	 push @$hook, $3;
	 return 1;
       }],
     [ qr/^--_scopesep-([^=]*)=([^,]?)\/([^:]+):(.+)/, sub {
	 die "Don't use --_scopesep-<LANG>= option before defining the language"
	   if (! defined $_[0]->{'langdef'});
	 die "Specifying a scope separator is allowed only to the language specified with --langdef: $1"
	   unless ($_[0]->{'langdef'} eq $1);
	 scopesep($_[0], $2, $3, $4);
	 return 1;
       } ],
     [ qr/^-.*/, sub {
	 die "Unhandled option: \"$&\"";
       } ],
     [ qr/.*/, sub {
	 die "Unhandled argument: \"$&\"";
       } ],
    ];

sub parse_line {
    my ($line, $opts) = @_;
    my $r = 0;

    for (@{$options}) {
	my ($pat, $action) = @{$_};
	if ($line =~ $pat) {
	    $r = $action -> ($opts);
	    last;
	}
    }
    $r;
}

sub gather_chars {
    my $input = shift;
    my $output = "";

    my $escape = 0;
    my $c;

    # See scanSeparators() of lregex.c.
    while (defined ($c = shift @{$input})) {
	if ($escape) {
	    if ($c eq '/') {
		$output = $output . $c;
	    } elsif ($c eq 't') {
		$output = $output . '\\' . 't';
	    } elsif ($c eq 'n') {
		$output = $output . '\\' . 'n';
	    } elsif ($c eq '\\') {
		$output = $output . '\\\\' . '\\\\';
	    } else {
		$output = $output . '\\\\' . $c;
	    }
	    $escape = 0;
	} elsif ($c eq '"') {
	    $output = $output . '\\' . $c;
	} elsif ($c eq '\\') {
	    $escape = 1;
	} elsif ($c eq '/') {
	    last;
	} else {
	    $output = $output . $c;
	}
    }

    return ($output, (defined $c)? $c: "");
}

sub parse_regex {
    my ($regspec, $opts, $mline, $table) = @_;

    my @chars = split //, $regspec;

    # TODO:
    #	ctags allows using a char other than '/'
    #
    if (! ($chars[0] eq '/')) {
	if (!$mline) {
	    die "--regex-<LANG>= option is not started from /: $regspec";
	} else {
	    die "--mline-regex-<LANG>= option is not started from /: $regspec";
	}
    }

    shift @chars;
    my $last_char;

    my $regex;
    ($regex, $last_char) = gather_chars (\@chars);
    if (! ($last_char eq '/')) {
	if (!$mline) {
	    die "The pattern in --regex-<LANG>= option is not ended with /: $regspec";
	} else {
	    die "The pattern in --mline-regex-<LANG>= option is not ended with /: $regspec";
	}
    }

    my $name;
    ($name, $last_char) = gather_chars (\@chars);
    if (! ($last_char eq '/')) {
	die "Wrong kind/flags syntax: $regspec";
    }

    my $tmp;
    ($tmp, $last_char) = gather_chars (\@chars);
    my $kind = "";
    my $flags;

    if ( (! @chars) && (! ($last_char eq '/'))) {
	$flags = $tmp;

    } else {
	$kind = $tmp;
    }

    if ($last_char eq '/') {
	($flags, $last_char) = gather_chars (\@chars);
    }

    my $optscript = '';
    if ($flags =~ /(.*)\{\{$/) {
	$flags = $1;
	$optscript = "{{\n";
    }

    my $entry;
    if (defined $table) {

      if (! (substr ($regex, 0, 1) eq '^')) {
	$regex = '^' . $regex;
      }
      $entry = { 'regex' => $regex,
		 'name'  => $name,
		 'kind'  => $kind,
		 'flags' => $flags,
		 'mline' => $mline,
		 'optscript' => $optscript,
	       };
      push @{$opts->{'tabledefs'}->{"$table"}}, $entry;
    } else {
      $entry = { 'regex' => $regex,
		 'name'  => $name,
		 'kind'  => $kind,
		 'flags' => $flags,
		 'mline' => $mline,
		 'optscript' => $optscript,
	       };
      push @{$opts->{'regexs'}}, $entry;
    }

    if ($flags =~ '{scope=' || $optscript) {
	$opts->{'useCork'} = 1;
    }

    return $optscript
	? sub {
	    $entry->{'optscript'} = $entry->{'optscript'} . $_[0];
	}
	: 1;
}

sub extend_table {
  my ($opts, $dist, $src) = @_;

  for (@{$opts->{'tabledefs'}->{$src}}) {
    push @{$opts->{'tabledefs'}->{$dist}}, $_;
  }
}

sub parse_kinds {
    my ($kinds, $opts) = @_;
    for my $letter (split //, $kinds) {
	for (@{$opts->{'kinddefs'}}) {
	    if ($_->{'letter'} eq $letter) {
		$_->{'enabled'} = 0;
	    }
	}
    }
}

sub parse_optlib {
    my ($optlib, $opts) = @_;

    open(my $optlibfh, "<", $optlib)
	or die "cannot open the optlib file: \"$optlib\"";

    my $receiver = 0;
    while (<$optlibfh>) {
	chomp;

	if (/^\}\}$/ && $receiver && ($receiver != 1)) {
	    $receiver->('}}');
	    $receiver = 1;
	}
	elsif ($receiver && $receiver != 1) {
	    my $str = escape_as_cstr ($_);
	    $receiver->($str);
	    $receiver->("\n");
	} elsif ( /^[[:blank:]]*#.*/ ) {
	    next;
	} else {
	    s/^\s*//;
	    next if ( /^\s*$/ );
	    $receiver = parse_line ($_, $opts);
	    if (! $receiver) {
		return undef;
	    }
	}
    }
    return $opts;
}

sub parse_extras {
    my ($flag, $extra, $opts) = @_;

    $flag = ( $flag eq '+' )?1: 0;

    # TODO: Hash table should be used for manage 'extradefs'.
    for (@{$opts->{'extradefs'}}) {
	if ($_->{'name'} eq $extra)
	{
	    $_->{'enabled'} = $flag;
	}
    }
}

sub parse_fields {
    my ($flag, $field, $opts) = @_;

    $flag = ( $flag eq '+' )?1: 0;

    # TODO: Hash table should be used for manage 'fielddefs'.
    for (@{$opts->{'fielddefs'}}) {
	if ($_->{'name'} eq $field)
	{
	    $_->{'enabled'} = $flag;
	}
    }
}

sub scopesep {
    my ($opts, $parent_kletter, $kletter, $sep) = @_;

    if ($kletter eq '*') {
	if ($parent_kletter eq '*') {
	    $opts->{'defaultScopeSeparator'} = $sep;
	} elsif (!$parent_kletter) {
	    $opts->{'defaultRootScopeSeparator'} = $sep;
	} else {
	    die "Unhandled kind letter during parsing --_scopsesep option: $parent_kletter";
	}
    } elsif ($kletter =~ /[a-zA-Z]/) {
	my $kind;
	for (@{$opts->{'kinddefs'}}) {
	    if ($_->{'letter'} eq $kletter) {
		$kind = $_;
		last;
	    }
	}
	die "Unknown kind letter in --_scopsesep option: $kletter"
	  unless defined $kind;

	if ($parent_kletter eq '*') {
	    push @{$kind->{'seps'}}, { parentKindIndex => 'KIND_WILDCARD_INDEX',
				       sep => $sep };
	} elsif (!$parent_kletter) {
	    push @{$kind->{'seps'}}, { parentKindIndex => 'KIND_GHOST_INDEX',
				       sep => $sep };
	} elsif ($parent_kletter =~ /[a-zA-Z]/) {
	    my $parent_kind;
	    for (@{$opts->{'kinddefs'}}) {
		if ($_->{'letter'} == $parent_kletter) {
		    $parent_kind = $_;
		    last;
		}
	    }
	    die "Unknown kind letter in --_scopsesep option: $parent_kletter"
	      unless defined $parent_kind;
	    push @{$kind->{'seps'}}, { parentKindIndex => 'K_' . (uc $parent_kind->{'name'}),
				       sep => $sep };
	}
    } else {
	die "Unhandled kind letter during parsing --_scopsesep option: $kletter";
    }

    $opts->{'hasSepSpeicifer'} = 1;
}


########################################################################
#
# EMIT
#
########################################################################

sub emit_header {
    my ($optlib, $opts) = @_;

    print <<EOF;
/*
 * Generated by $0 from ${optlib}, Don't edit this manually.
 */
#include "general.h"
#include "parse.h"
#include "routines.h"
#include "field.h"
#include "xtag.h"
EOF

    if (defined $opts->{'base'}) {
	print <<EOF;
#include "subparser.h"
EOF
    }
    if (defined $opts->{'selector'}) {
	print <<EOF;
#include "selectors.h"
EOF
    }
    print <<EOF;


EOF
}

sub emit_initializer {
    my $opts = shift;
    my $may_unused = $opts->{'tablenames'} ? "": " CTAGS_ATTR_UNUSED";

    print <<EOF;
static void initialize$opts->{'Clangdef'}Parser (const langType language$may_unused)
{
EOF
    for (@{$opts->{'prelude'}}) {
	my $prelude = "";
	for my $frag (split /\n/, $_) {
	    $prelude = $prelude . "\n\t\t\"" . $frag . ($frag =~ /.*\}\}$/
							? '"'
							: '\n"');
	}
	print <<EOF;
	addLanguageOptscriptToHook (language, SCRIPT_HOOK_PRELUDE,$prelude);
EOF
    }
    for (@{$opts->{'sequel'}}) {
	my $sequel = "";
	for my $frag (split /\n/, $_) {
	    $sequel = $sequel . "\n\t\t\"" . $frag . ($frag =~ /.*\}\}$/
							? '"'
							: '\n"');
	}
	print <<EOF;
	addLanguageOptscriptToHook (language, SCRIPT_HOOK_SEQUEL,$sequel);
EOF
    }
    if ($opts->{'tablenames'}) {
      print "\n";

      for (@{$opts->{'tablenames'}}) {
	print <<EOF;
	addLanguageRegexTable (language, "$_");
EOF
      }

      print "\n";

      for my $table (@{$opts->{'tablenames'}}) {
	for (@{$opts->{'tabledefs'}->{"$table"}}) {
	  my $optscript = "";
	  if ($_-> {'optscript'}) {
	    for my $frag (split /\n/, $_-> {'optscript'}) {
	      $optscript = $optscript . "\n\t\t\"" . $frag . ($frag =~ /.*\}\}$/
							      ? '"'
							      : '\n"');
	    }
	  }
	  print <<EOF;
	addLanguageTagMultiTableRegex (language, "$table",
	                               "$_->{'regex'}",
	                               "$_->{'name'}", "$_->{'kind'}", "$_->{'flags'}"$optscript, NULL);
EOF
	}
      }
    }
    print <<EOF;
}

EOF
    0;
}

sub emit_list {
    my ($opts, $key) = @_;

    print <<EOF;
	static const char *const $key [] = {
EOF
    for (@{$opts->{$key}}) {
	print <<EOF;
		\"$_\",
EOF
    }

    print <<EOF;
		NULL
	};

EOF
}

sub emit_aliases {
    emit_list $_[0], "aliases";
}

sub emit_extensions {
    emit_list $_[0], "extensions";
}

sub emit_patterns {
    emit_list $_[0], "patterns";
}

# TODO: handling '\'
sub escape_as_cstr {
    my $input = shift;
    my $output = "";

    for my $c (split //, $input) {
	if ($c eq '"') {
	    $output = $output . '\\' . '"';
	} elsif ($c eq '\\') {
	    $output = $output . '\\' . '\\';
	} else {
	    $output = $output . $c;
	}
    }

    return $output;
}

sub emit_roledefs {
    my $opts = shift;


    for (@{$opts->{'kinddefs'}}) {
	next unless @{$_->{'roles'}};
	my $Kind = capitalize($_->{'name'});
	print <<EOF;
	static roleDefinition $opts->{'Clangdef'}${Kind}RoleTable [] = {
EOF
	for (@{$_->{'roles'}}) {
	    my $desc = escape_as_cstr $_->{'desc'};
	    print <<EOF;
		{ true, "$_->{'name'}", "$desc" },
EOF
	}

	print <<EOF;
	};
EOF
    }
    print <<EOF;
EOF
}

sub emit_kinddef_enums {
    my $opts = shift;

    return if (! @{$opts->{'kinddefs'}});

    print <<EOF;
typedef enum {
EOF
    for (@{$opts->{'kinddefs'}}) {
	my $e = uc($_->{'name'});
	print <<EOF;
	K_$e,
EOF
    }
    print <<EOF;
} $opts->{'Clangdef'}Kind;


EOF
}

sub emit_scopeseps {
    my $opts = shift;

    return if (! @{$opts->{'kinddefs'}});

    for (@{$opts->{'kinddefs'}}) {
	my $seps = $_->{'seps'};
	if (@{$seps}) {
	    my $Kind = capitalize ($_->{'name'});
	    print <<EOF;
	static scopeSeparator $opts->{'Clangdef'}${Kind}Separators [] = {
EOF
	    for (@{$seps}) {
	    print <<EOF;
		{ $_->{'parentKindIndex'}, "$_->{'sep'}" },
EOF
	    }
	    print <<EOF;
	};

EOF
	}
    }
}

sub emit_kinddefs {
    my $opts = shift;

    return if (! @{$opts->{'kinddefs'}});

    print <<EOF;
	static kindDefinition $opts->{'Clangdef'}KindTable [] = {
EOF
    for (@{$opts->{'kinddefs'}}) {
      my $enabled = $_->{"enabled"}? "true": "false";
      print <<EOF;
		{
EOF
      my $desc = escape_as_cstr $_->{'desc'};
      print <<EOF;
		  $enabled, \'$_->{'letter'}\', "$_->{'name'}", "$desc",
EOF
      if ($_->{'refonly'}) {
	  print <<EOF;
		  .referenceOnly = true,
EOF
      }
      my $Kind = capitalize($_->{'name'});
      if (@{$_->{'roles'}}) {
	  print <<EOF;
		  ATTACH_ROLES($opts->{'Clangdef'}${Kind}RoleTable),
EOF
      }
      if (@{$_->{'seps'}}) {
	  print <<EOF;
		  ATTACH_SEPARATORS($opts->{'Clangdef'}${Kind}Separators),
EOF
      }
      print <<EOF;
		},
EOF
    }
    print <<EOF;
	};
EOF
}

sub emit_regexs {
    my $opts = shift;

    return if (! @{$opts->{'regexs'}});

    print <<EOF;
	static tagRegexTable $opts->{'Clangdef'}TagRegexTable [] = {
EOF
    for (@{$opts->{'regexs'}}) {
	my $flags;
	if ($_-> {'flags'}) {
	    $flags = '"' . $_-> {'flags'} . '"';
	    if ($_-> {'optscript'}) {
		for my $frag (split /\n/, $_-> {'optscript'}) {
		    $flags = $flags . "\n\t\t\"" . $frag . ($frag =~ /.*\}\}$/
							    ? '"'
							    : '\n"');
		}
	    }
	} else {
	    if ($_-> {'optscript'}) {
		$flags = '""';
		for my $frag (split /\n/, $_-> {'optscript'}) {
		    $flags = $flags . "\n\t\t\"" . $frag . ($frag =~ /.*\}\}$/
							    ? '"'
							    : '\n"');
		}
	    } else {
		$flags = 'NULL';
	    }
	}
	my $mline = $_-> {'mline'}? "true": "false";
	print <<EOF;
		{"$_->{'regex'}", "$_->{'name'}",
		"$_->{'kind'}", $flags, NULL, $mline},
EOF
    }
    print <<EOF;
	};

EOF
}

sub emit_dependencies {
    my $opts = shift;

    return if (! defined $opts->{'base'});

    my $direction = "SUBPARSER_BASE_RUNS_SUB";

    if (defined $opts->{'direction'})
    {
	if ($opts->{'direction'} eq 'shared')
	{
	    $direction = "SUBPARSER_BASE_RUNS_SUB";
	} elsif ($opts->{'direction'} eq 'dedicated')
	{
	    $direction = "SUBPARSER_SUB_RUNS_BASE";
	} elsif ($opts->{'direction'} eq 'bidirectional')
	{
	    $direction = "SUBPARSER_BI_DIRECTION";
	}
    }

    print <<EOF;
	static subparser $opts->{'Clangdef'}Subparser = {
		.direction = $direction,
	};
	static parserDependency $opts->{'Clangdef'}Dependencies [] = {
		[0] = { DEPTYPE_SUBPARSER, "$opts->{'base'}", &$opts->{'Clangdef'}Subparser },
	};
EOF

}

sub emit_xtags {
    my $opts = shift;

    return if (! @{$opts->{'extradefs'}});

    print <<EOF;
	static xtagDefinition $opts->{'Clangdef'}XtagTable [] = {
EOF
    for (@{$opts->{'extradefs'}}) {
      my $enabled = $_->{"enabled"}? "true": "false";
      my $desc = escape_as_cstr $_->{'desc'};
      print <<EOF;
		{
		  .enabled     = $enabled,
		  .name        = "$_->{'name'}",
		  .description = "$desc",
		},
EOF
    }
    print <<EOF;
	};
EOF
}

sub emit_fields {
    my $opts = shift;

    return if (! @{$opts->{'fielddefs'}});

    print <<EOF;
	static fieldDefinition $opts->{'Clangdef'}FieldTable [] = {
EOF
    for (@{$opts->{'fielddefs'}}) {
      my $enabled = $_->{"enabled"}? "true": "false";
      my $desc = escape_as_cstr $_->{'desc'};
      print <<EOF;
		{
		  .enabled     = $enabled,
		  .name        = "$_->{'name'}",
		  .description = "$desc",
		},
EOF
    }
    print <<EOF;
	};
EOF
}

sub emit_selector {
    my $opts = shift;

    if (defined $opts->{'selector'}) {
	print <<EOF;
	static selectLanguage selectors[] = { $opts->{'selector'}, NULL };
EOF
    }
}

sub emit_fields_initialization {
    my $opts = shift;
    my $enabled = $opts->{"disabled"} ? "false": "true";
    my $method;
    my $sep;

    $method  = "METHOD_NOT_CRAFTED";
    if (@{$opts->{"regexs"}} || $opts->{'tablenames'}) {
	$method = "${method}|METHOD_REGEX";
    }

    print <<EOF;
	def->enabled       = ${enabled};
	def->extensions    = extensions;
	def->patterns      = patterns;
	def->aliases       = aliases;
EOF
    if (defined $opts->{'selector'}) {
	print <<EOF;
	def->selectLanguage= selectors;
EOF
    }
print <<EOF;
	def->method        = ${method};
EOF

    if ($opts->{'useCork'}) {
	print <<EOF;
	def->useCork       = CORK_QUEUE;
EOF
    }
    if (@{$opts->{'kinddefs'}}) {
	print <<EOF;
	def->kindTable     = $opts->{'Clangdef'}KindTable;
	def->kindCount     = ARRAY_SIZE($opts->{'Clangdef'}KindTable);
EOF
    }

    if (@{$opts->{'fielddefs'}}) {
	print <<EOF;
	def->fieldTable    = $opts->{'Clangdef'}FieldTable;
	def->fieldCount    = ARRAY_SIZE($opts->{'Clangdef'}FieldTable);
EOF
    }

    if (@{$opts->{'extradefs'}}) {
	print <<EOF;
	def->xtagTable     = $opts->{'Clangdef'}XtagTable;
	def->xtagCount     = ARRAY_SIZE($opts->{'Clangdef'}XtagTable);
EOF
    }

    if (@{$opts->{'regexs'}}) {
	print <<EOF;
	def->tagRegexTable = $opts->{'Clangdef'}TagRegexTable;
	def->tagRegexCount = ARRAY_SIZE($opts->{'Clangdef'}TagRegexTable);
EOF
    }

    if (defined $opts->{'base'}) {
	print <<EOF;
	def->dependencies    = $opts->{'Clangdef'}Dependencies;
	def->dependencyCount = ARRAY_SIZE($opts->{'Clangdef'}Dependencies);
EOF
    }

    if ($opts->{'autoFQTag'}) {
	print <<EOF;
	def->requestAutomaticFQTag = true;
EOF
    }

    if ($opts->{'defaultScopeSeparator'}) {
	$sep = "$opts->{'defaultScopeSeparator'}";
	$sep = escape_as_cstr "$sep";
	print <<EOF;
	def->defaultScopeSeparator = "$sep";
EOF
    }
    if ($opts->{'defaultRootScopeSeparator'}) {
	$sep = $opts->{'defaultRootScopeSeparator'};
	$sep = escape_as_cstr "$sep";
	print <<EOF;
	def->defaultRootScopeSeparator = "$sep";
EOF
    }
    print <<EOF;
	def->initialize    = initialize$opts->{'Clangdef'}Parser;

EOF
}

sub emit {
    my ($optlib, $opts) = @_;

    emit_header ($optlib, $opts);

    if ($opts->{'hasSepSpeicifer'}) {
	emit_kinddef_enums   $opts;
    };
    emit_initializer $opts;

    print <<EOF;
extern parserDefinition* $opts->{'Clangdef'}Parser (void)
{
EOF

    emit_extensions      $opts;
    emit_aliases         $opts;
    emit_patterns        $opts;
    emit_roledefs        $opts;
    emit_scopeseps       $opts;
    emit_kinddefs        $opts;
    emit_fields          $opts;
    emit_xtags           $opts;
    emit_regexs          $opts;
    emit_dependencies    $opts;
    emit_selector         $opts;

    print "\n";

    print <<EOF;
	parserDefinition* const def = parserNew ("$opts->{'langdef'}");

EOF

    emit_fields_initialization $opts;

    print <<EOF;
	return def;
}
EOF
}

########################################################################
#
# REARRANGE
#
########################################################################

sub capitalize {
    my ($str) = $_[0];
    my $c = substr ($str, 0, 1);

    $c =~ tr/a-z/A-Z/;

    return $c . substr($str, 1);
}

sub rearrange {
    my ($opts) = @_;
    my $langdef = $opts -> {'langdef'};
    $opts -> {'Clangdef'} = capitalize ($langdef);
}


########################################################################
#
# MAIN
#
########################################################################

sub main {
    my $optlib;
    my %opts = (langdef  => undef,
		Clangdef => undef,
		disabled => 0,
		patterns => [],
		extensions => [],
		aliases => [],
		regexs => [# { regex => "", name => "", kind => "", flags => "", mline => 1|0, optscript => "" },
			  ],
		kinddefs => [# { letter => '', name => "", desc => "",
			     #   seps => [ {parentKindIndex => "", sep => "" } ]
			     # },
			    ],
		extradefs => [ # { name => "", desc => "", enabled => 1|0 },
			     ],
		fielddefs => [ # { name => "", desc => "", enabled => 1|0 },
			      ],
		base => undef,
		tableNames => [ # ""
			       ],
		tabledefs => { # "" => [{ regex => "", name => "", kind => "", flags => "" }...],
			     },
		useCork   => 0,
		defaultScopeSeparator => undef,
		defaultRootScopeSeparator => undef,
		hasSepSpeicifer => 0,
		prelude => [ # ""
			   ],
		sequel =>  [ # ""
			   ],
		selector => undef,
	       );

    for (@_) {
	if ( ($_ eq '-h') || ($_ eq '--help') ) {
	    show_help;
	    exit 0;
	} elsif ( /^-.*/ ) {
	    die "unrecongnized option: $_";
	} else {
	    if ($optlib) {
		die "Too man input files: @_";
	    }
	    $optlib=$_;
	}
    }

    if (! $optlib) {
	die "No optlib file name is given";
    }

    if (! parse_optlib ($optlib, \%opts)) {
	exit 1;
    }

    rearrange (\%opts);

    if (! emit ($optlib, \%opts) ) {
	exit 1;
    }
    0;
}

main @ARGV;

# optlib2c ends here.