clownfish/lib/Clownfish/Parser.pm - lucy - Git at Google

 # Licensed to the Apache Software Foundation (ASF) under one or more
 # contributor license agreements.  See the NOTICE file distributed with
 # this work for additional information regarding copyright ownership.
 # The ASF licenses this file to You under the Apache License, Version 2.0
 # (the "License"); you may not use this file except in compliance with
 # the License.  You may obtain a copy of the License at
 #
 #     http://www.apache.org/licenses/LICENSE-2.0
 #
 # Unless required by applicable law or agreed to in writing, software
 # distributed under the License is distributed on an "AS IS" BASIS,
 # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 # See the License for the specific language governing permissions and
 # limitations under the License.

 use strict;
 use warnings;

 package Clownfish::Parser;
 use base qw( Parse::RecDescent );

 use Clownfish::Parcel;
 use Clownfish::Type;
 use Clownfish::Variable;
 use Clownfish::DocuComment;
 use Clownfish::Function;
 use Clownfish::Method;
 use Clownfish::Class;
 use Clownfish::CBlock;
 use Clownfish::File;
 use Carp;

 our $grammar = <<'END_GRAMMAR';

 file:
     { Clownfish::Parser->set_parcel(undef); 0; }
     major_block[%arg](s) eofile
     { Clownfish::Parser->new_file( \%item, \%arg ) }

 major_block:
       class_declaration[%arg]
     | embed_c
     | parcel_definition

 parcel_definition:
     'parcel' class_name cnick(?) ';'
     {
         my $parcel = Clownfish::Parser->new_parcel( \%item );
         Clownfish::Parser->set_parcel($parcel);
         $parcel;
     }

 embed_c:
     '__C__'
     /.*?(?=__END_C__)/s
     '__END_C__'
     { Clownfish::CBlock->new( contents => $item[2] ) }

 class_declaration:
     docucomment(?)
     exposure_specifier(?) class_modifier(s?) 'class' class_name
         cnick(?)
         class_inheritance(?)
         class_attribute(s?)
     '{'
         declaration_statement[
             class  => $item{class_name},
             cnick  => $item{'cnick(?)'}[0],
             parent => $item{'class_inheritance(?)'}[0],
         ](s?)
     '}'
     { Clownfish::Parser->new_class( \%item, \%arg ) }

 class_modifier:
       'inert'
     | 'abstract'
     | 'final'
     { $item[1] }

 class_inheritance:
     'inherits' class_name
     { $item[2] }

 class_attribute:
     ':' /[a-z]+(?!\w)/
     { $item[2] }

 class_name:
     object_type_specifier ( "::" object_type_specifier )(s?)
     { join('::', $item[1], @{ $item[2] } ) }

 cnick:
     'cnick'
     /([A-Z][A-Za-z0-9]+)(?!\w)/
     { $1 }

 declaration_statement:
       var_declaration_statement[%arg]
     | subroutine_declaration_statement[%arg]
     | <error>

 var_declaration_statement:
     exposure_specifier(?) variable_modifier(s?) type declarator ';'
     {
         $return = {
             exposure  => $item[1][0] || 'parcel',
             modifiers => $item[2],
             declared  => Clownfish::Parser->new_var( \%item, \%arg ),
         };
     }

 subroutine_declaration_statement:
     docucomment(?)
     exposure_specifier(?)
     subroutine_modifier(s?)
     type
     declarator
     param_list
     ';'
     {
         $return = {
             exposure  => $item[2],
             modifiers => $item[3],
             declared  => Clownfish::Parser->new_sub( \%item, \%arg ),
         };
     }

 param_list:
     '('
     param_list_elem(s? /,/)
     (/,\s*.../)(?)
     ')'
     {
         Clownfish::Parser->new_param_list( $item[2], $item[3][0] ? 1 : 0 );
     }

 param_list_elem:
     param_variable assignment(?)
     { [ $item[1], $item[2][0] ] }

 param_variable:
     type declarator
     { Clownfish::Parser->new_var(\%item); }

 assignment:
     '=' scalar_constant
     { $item[2] }

 type:
     nullable(?) simple_type type_postfix(s?)
     { Clownfish::Parser->simple_or_composite_type(\%item) }

 nullable:
     'nullable'

 simple_type:
       object_type
     | primitive_type
     | void_type
     | va_list_type
     | arbitrary_type
     { $item[1] }

 object_type:
     type_qualifier(s?) object_type_specifier '*'
     { Clownfish::Parser->new_object_type(\%item); }

 primitive_type:
       c_integer_type
     | chy_integer_type
     | float_type
     { $item[1] }

 c_integer_type:
     type_qualifier(s?) c_integer_specifier
     { Clownfish::Parser->new_integer_type(\%item) }

 chy_integer_type:
     type_qualifier(s?) chy_integer_specifier
     { Clownfish::Parser->new_integer_type(\%item) }

 float_type:
     type_qualifier(s?) c_float_specifier
     { Clownfish::Parser->new_float_type(\%item) }

 void_type:
     type_qualifier(s?) void_type_specifier
     { Clownfish::Parser->new_void_type(\%item) }

 va_list_type:
     va_list_type_specifier
     { Clownfish::Type->new_va_list }

 arbitrary_type:
     arbitrary_type_specifier
     { Clownfish::Parser->new_arbitrary_type(\%item); }

 type_qualifier:
       'const'
     | 'incremented'
     | 'decremented'
     | 'nullable'

 subroutine_modifier:
       'inert'
     | 'inline'
     | 'abstract'
     | 'final'
     { $item[1] }

 exposure_specifier:
       'public'
     | 'private'
     | 'parcel'
     | 'local'

 variable_modifier:
       'inert'
     { $item[1] }

 type_specifier:
     (    object_type_specifier
        | primitive_type_specifier
        | void_type_specifier
        | va_list_type_specifier
        | arbitrary_type_specifier
     )
     { $item[1] }

 primitive_type_specifier:
       chy_integer_specifier
     | c_integer_specifier
     | c_float_specifier
     { $item[1] }

 chy_integer_specifier:
     /(?:chy_)?(bool)_t(?!\w)/

 c_integer_specifier:
     /(?:(?:u?int(?:8|16|32|64)_t)|(?:char|int|short|long|size_t))(?!\w)/

 c_float_specifier:
     /(?:float|double)(?!\w)/

 void_type_specifier:
     /void(?!\w)/

 va_list_type_specifier:
     /va_list(?!\w)/

 arbitrary_type_specifier:
     /\w+_t(?!\w)/

 object_type_specifier:
     /([a-z]+[a-z0-9]*_)?[A-Z]+[A-Z0-9]*[a-z]+[A-Za-z0-9]*(?!\w)/

 declarator:
     identifier
     { $item[1] }

 type_postfix:
       '*'
       { '*' }
     | '[' ']'
       { '[]' }
     | '[' constant_expression ']'
       { "[$item[2]]" }

 identifier:
     ...!reserved_word /[a-zA-Z_]\w*/x
     { $item[2] }

 docucomment:
     /\/\*\*.*?\*\//s
     { Clownfish::DocuComment->parse($item[1]) }

 constant_expression:
       /\d+/
     | /[A-Z_]+/

 scalar_constant:
       hex_constant
     | float_constant
     | integer_constant
     | string_literal
     | 'NULL'
     | 'true'
     | 'false'

 integer_constant:
     /(?:-\s*)?\d+/
     { $item[1] }

 hex_constant:
     /0x[a-fA-F0-9]+/
     { $item[1] }

 float_constant:
     /(?:-\s*)?\d+\.\d+/
     { $item[1] }

 string_literal:
     /"(?:[^"\\]|\\.)*"/
     { $item[1] }

 reserved_word:
     /(const|double|enum|extern|float|register|signed|sizeof
        |inert|struct|typedef|union|unsigned|void)(?!\w)/x
     | chy_integer_specifier
     | c_integer_specifier

 eofile:
     /^\Z/

 END_GRAMMAR

 sub new { return shift->SUPER::new($grammar) }

 sub strip_plain_comments {
     my ( $self, $text ) = @_;
     while ( $text =~ m#(/\*[^*].*?\*/)#ms ) {
         my $blanked = $1;
         $blanked =~ s/\S/ /g;
         $text    =~ s#/\*[^*].*?\*/#$blanked#ms;
     }
     return $text;
 }

 our $parcel = undef;
 sub set_parcel { $parcel = $_[1] }

 sub new_integer_type {
     my ( undef, $item ) = @_;
     my $specifier = $item->{c_integer_specifier}
         || $item->{chy_integer_specifier};
     my %args = ( specifier => $specifier );
     $args{$_} = 1 for @{ $item->{'type_qualifier(s?)'} };
     return Clownfish::Type->new_integer(%args);
 }

 sub new_float_type {
     my ( undef, $item ) = @_;
     my %args = ( specifier => $item->{c_float_specifier} );
     $args{$_} = 1 for @{ $item->{'type_qualifier(s?)'} };
     return Clownfish::Type->new_float(%args);
 }

 sub new_void_type {
     my ( undef, $item ) = @_;
     my %args;
     $args{$_} = 1 for @{ $item->{'type_qualifier(s?)'} };
     return Clownfish::Type->new_void(%args);
 }

 sub new_arbitrary_type {
     my ( undef, $item ) = @_;
     return Clownfish::Type->new_arbitrary(
         specifier => $item->{arbitrary_type_specifier},
         parcel    => $parcel,
     );
 }

 sub new_object_type {
     my ( undef, $item ) = @_;
     my %args = (
         specifier => $item->{object_type_specifier},
         parcel    => $parcel,
     );
     $args{$_} = 1 for @{ $item->{'type_qualifier(s?)'} };
     return Clownfish::Type->new_object(%args);
 }

 sub simple_or_composite_type {
     my ( undef, $item ) = @_;
     my $simple_type = $item->{simple_type};
     my $postfixes   = $item->{'type_postfix(s?)'};
     my $nullable    = scalar @{ $item->{'nullable(?)'} } ? 1 : undef;
     my $type;

     if ( !@$postfixes ) {
         if ($nullable) {
             my $type_class = ref($simple_type);
             confess "$type_class can't be 'nullable'"
                 unless $simple_type->is_object;
             $simple_type->set_nullable($nullable);
         }
         return $simple_type;
     }
     else {
         my %args = (
             child       => $simple_type,
             indirection => 0,
             nullable    => $nullable,
         );
         for my $postfix (@$postfixes) {
             if ( $postfix =~ /\[/ ) {
                 $args{array} ||= '';
                 $args{array} .= $postfix;
             }
             elsif ( $postfix eq '*' ) {
                 $args{indirection}++;
             }
         }
         return Clownfish::Type->new_composite(%args);
     }
 }

 sub new_var {
     my ( undef, $item, $arg ) = @_;
     my $exposure = $item->{'exposure_specifier(?)'}[0];
     my %args = $exposure ? ( exposure => $exposure ) : ();
     if ($arg) {
         $args{class_name}  = $arg->{class} if $arg->{class};
         $args{class_cnick} = $arg->{cnick} if $arg->{cnick};
     }
     return Clownfish::Variable->new(
         parcel    => $parcel,
         type      => $item->{type},
         micro_sym => $item->{declarator},
         %args,
     );
 }

 sub new_param_list {
     my ( undef, $param_list_elems, $variadic ) = @_;
     my $param_list = Clownfish::ParamList->new( variadic => $variadic, );
     for my $param (@$param_list_elems) {
         $param_list->add_param( $param->[0], $param->[1] );
     }
     return $param_list;
 }

 sub new_sub {
     my ( undef, $item, $arg ) = @_;
     my $class;
     my $modifiers  = $item->{'subroutine_modifier(s?)'};
     my $docucom    = $item->{'docucomment(?)'}[0];
     my $exposure   = $item->{'exposure_specifier(?)'}[0];
     my $inert      = scalar grep { $_ eq 'inert' } @$modifiers;
     my %extra_args = $exposure ? ( exposure => $exposure ) : ();

     if ($inert) {
         $class = 'Clownfish::Function';
         $extra_args{micro_sym} = $item->{declarator};
         $extra_args{inline} = scalar grep { $_ eq 'inline' } @$modifiers;
     }
     else {
         $class = 'Clownfish::Method';
         $extra_args{macro_sym} = $item->{declarator};
         $extra_args{abstract} = scalar grep { $_ eq 'abstract' } @$modifiers;
         $extra_args{final}    = scalar grep { $_ eq 'final' } @$modifiers;
     }

     return $class->new(
         parcel      => $parcel,
         docucomment => $docucom,
         class_name  => $arg->{class},
         class_cnick => $arg->{cnick},
         return_type => $item->{type},
         param_list  => $item->{param_list},
         %extra_args,
     );
 }

 sub new_class {
     my ( undef, $item, $arg ) = @_;
     my ( @member_vars, @inert_vars, @functions, @methods );
     my $source_class = $arg->{source_class} || $item->{class_name};
     my %class_modifiers
         = map { ( $_ => 1 ) } @{ $item->{'class_modifier(s?)'} };
     my %class_attributes
         = map { ( $_ => 1 ) } @{ $item->{'class_attribute(s?)'} };

     for my $declaration ( @{ $item->{'declaration_statement(s?)'} } ) {
         my $declared  = $declaration->{declared};
         my $exposure  = $declaration->{exposure};
         my $modifiers = $declaration->{modifiers};
         my $inert     = ( scalar grep {/inert/} @$modifiers ) ? 1 : 0;
         my $subs      = $inert ? \@functions : \@methods;
         my $vars      = $inert ? \@inert_vars : \@member_vars;

         if ( $declared->isa('Clownfish::Variable') ) {
             push @$vars, $declared;
         }
         else {
             push @$subs, $declared;
         }
     }

     my $class = Clownfish::Class->create(
         parcel            => $parcel,
         class_name        => $item->{class_name},
         cnick             => $item->{'cnick(?)'}[0],
         parent_class_name => $item->{'class_inheritance(?)'}[0],
         docucomment       => $item->{'docucomment(?)'}[0],
         source_class      => $source_class,
         inert             => $class_modifiers{inert},
         final             => $class_modifiers{final},
     );
     $class->add_method($_)     for @methods;
     $class->add_function($_)   for @functions;
     $class->add_member_var($_) for @member_vars;
     $class->add_inert_var($_)  for @inert_vars;
     while ( my ( $var, $val ) = each %class_attributes ) {
         $class->add_attribute( $var, $val );
     }
     return $class;
 }

 sub new_file {
     my ( undef, $item, $arg ) = @_;
     my $file = Clownfish::File->new( source_class => $arg->{source_class}, );
     for my $block ( @{ $item->{'major_block(s)'} } ) {
         $file->add_block($block);
     }
     return $file;
 }

 sub new_parcel {
     my ( undef, $item ) = @_;
     Clownfish::Parcel->singleton(
         name  => $item->{class_name},
         cnick => $item->{'cnick(?)'}[0],
     );
 }

 1;

 __END__

 __POD__

 =head1 NAME

 Clownfish::Parser - Parse Clownfish header files.

 =head1 SYNOPSIS

      my $class_def = $parser->class($class_text);

 =head1 DESCRIPTION

 Clownfish::Parser is a combined lexer/parser which parses Clownfish header
 files.  It is not at all strict, as it relies heavily on the C parser to pick
 up errors such as misspelled type names.

 =head1 METHODS

 =head2 new

 Constructor, takes no arguments.

 =head2 strip_plain_comments

     my $stripped = $parser->strip_plain_comments($code_with_comments);

 Remove plain C comments from supplied code.  All non-whitespace characters are
 turned to spaces; all whitespace characters are preserved, so that the number
 of lines is consistent between before and after.

 JavaDoc-syntax "DocuComments", which begin with "/**" are left alone.

 This is a sloppy implementation which will mangle quoted comments and such.

 =cut
	# Licensed to the Apache Software Foundation (ASF) under one or more
	# contributor license agreements. See the NOTICE file distributed with
	# this work for additional information regarding copyright ownership.
	# The ASF licenses this file to You under the Apache License, Version 2.0
	# (the "License"); you may not use this file except in compliance with
	# the License. You may obtain a copy of the License at
	#
	# http://www.apache.org/licenses/LICENSE-2.0
	#
	# Unless required by applicable law or agreed to in writing, software
	# distributed under the License is distributed on an "AS IS" BASIS,
	# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
	# See the License for the specific language governing permissions and
	# limitations under the License.

	use strict;
	use warnings;

	package Clownfish::Parser;
	use base qw( Parse::RecDescent );

	use Clownfish::Parcel;
	use Clownfish::Type;
	use Clownfish::Variable;
	use Clownfish::DocuComment;
	use Clownfish::Function;
	use Clownfish::Method;
	use Clownfish::Class;
	use Clownfish::CBlock;
	use Clownfish::File;
	use Carp;

	our $grammar = <<'END_GRAMMAR';

	file:
	{ Clownfish::Parser->set_parcel(undef); 0; }
	major_block[%arg](s) eofile
	{ Clownfish::Parser->new_file( \%item, \%arg ) }

	major_block:
	class_declaration[%arg]
	\| embed_c
	\| parcel_definition

	parcel_definition:
	'parcel' class_name cnick(?) ';'
	{
	my $parcel = Clownfish::Parser->new_parcel( \%item );
	Clownfish::Parser->set_parcel($parcel);
	$parcel;
	}

	embed_c:
	'__C__'
	/.*?(?=__END_C__)/s
	'__END_C__'
	{ Clownfish::CBlock->new( contents => $item[2] ) }

	class_declaration:
	docucomment(?)
	exposure_specifier(?) class_modifier(s?) 'class' class_name
	cnick(?)
	class_inheritance(?)
	class_attribute(s?)
	'{'
	declaration_statement[
	class => $item{class_name},
	cnick => $item{'cnick(?)'}[0],
	parent => $item{'class_inheritance(?)'}[0],
	](s?)
	'}'
	{ Clownfish::Parser->new_class( \%item, \%arg ) }

	class_modifier:
	'inert'
	\| 'abstract'
	\| 'final'
	{ $item[1] }

	class_inheritance:
	'inherits' class_name
	{ $item[2] }

	class_attribute:
	':' /[a-z]+(?!\w)/
	{ $item[2] }

	class_name:
	object_type_specifier ( "::" object_type_specifier )(s?)
	{ join('::', $item[1], @{ $item[2] } ) }

	cnick:
	'cnick'
	/([A-Z][A-Za-z0-9]+)(?!\w)/
	{ $1 }

	declaration_statement:
	var_declaration_statement[%arg]
	\| subroutine_declaration_statement[%arg]
	\| <error>

	var_declaration_statement:
	exposure_specifier(?) variable_modifier(s?) type declarator ';'
	{
	$return = {
	exposure => $item[1][0] \|\| 'parcel',
	modifiers => $item[2],
	declared => Clownfish::Parser->new_var( \%item, \%arg ),
	};
	}

	subroutine_declaration_statement:
	docucomment(?)
	exposure_specifier(?)
	subroutine_modifier(s?)
	type
	declarator
	param_list
	';'
	{
	$return = {
	exposure => $item[2],
	modifiers => $item[3],
	declared => Clownfish::Parser->new_sub( \%item, \%arg ),
	};
	}

	param_list:
	'('
	param_list_elem(s? /,/)
	(/,\s*.../)(?)
	')'
	{
	Clownfish::Parser->new_param_list( $item[2], $item[3][0] ? 1 : 0 );
	}

	param_list_elem:
	param_variable assignment(?)
	{ [ $item[1], $item[2][0] ] }

	param_variable:
	type declarator
	{ Clownfish::Parser->new_var(\%item); }

	assignment:
	'=' scalar_constant
	{ $item[2] }

	type:
	nullable(?) simple_type type_postfix(s?)
	{ Clownfish::Parser->simple_or_composite_type(\%item) }

	nullable:
	'nullable'

	simple_type:
	object_type
	\| primitive_type
	\| void_type
	\| va_list_type
	\| arbitrary_type
	{ $item[1] }

	object_type:
	type_qualifier(s?) object_type_specifier '*'
	{ Clownfish::Parser->new_object_type(\%item); }

	primitive_type:
	c_integer_type
	\| chy_integer_type
	\| float_type
	{ $item[1] }

	c_integer_type:
	type_qualifier(s?) c_integer_specifier
	{ Clownfish::Parser->new_integer_type(\%item) }

	chy_integer_type:
	type_qualifier(s?) chy_integer_specifier
	{ Clownfish::Parser->new_integer_type(\%item) }

	float_type:
	type_qualifier(s?) c_float_specifier
	{ Clownfish::Parser->new_float_type(\%item) }

	void_type:
	type_qualifier(s?) void_type_specifier
	{ Clownfish::Parser->new_void_type(\%item) }

	va_list_type:
	va_list_type_specifier
	{ Clownfish::Type->new_va_list }

	arbitrary_type:
	arbitrary_type_specifier
	{ Clownfish::Parser->new_arbitrary_type(\%item); }

	type_qualifier:
	'const'
	\| 'incremented'
	\| 'decremented'
	\| 'nullable'

	subroutine_modifier:
	'inert'
	\| 'inline'
	\| 'abstract'
	\| 'final'
	{ $item[1] }

	exposure_specifier:
	'public'
	\| 'private'
	\| 'parcel'
	\| 'local'

	variable_modifier:
	'inert'
	{ $item[1] }

	type_specifier:
	( object_type_specifier
	\| primitive_type_specifier
	\| void_type_specifier
	\| va_list_type_specifier
	\| arbitrary_type_specifier
	)
	{ $item[1] }

	primitive_type_specifier:
	chy_integer_specifier
	\| c_integer_specifier
	\| c_float_specifier
	{ $item[1] }

	chy_integer_specifier:
	/(?:chy_)?(bool)_t(?!\w)/

	c_integer_specifier:
	/(?:(?:u?int(?:8\|16\|32\|64)_t)\|(?:char\|int\|short\|long\|size_t))(?!\w)/

	c_float_specifier:
	/(?:float\|double)(?!\w)/

	void_type_specifier:
	/void(?!\w)/

	va_list_type_specifier:
	/va_list(?!\w)/

	arbitrary_type_specifier:
	/\w+_t(?!\w)/

	object_type_specifier:
	/([a-z]+[a-z0-9]_)?[A-Z]+[A-Z0-9][a-z]+[A-Za-z0-9]*(?!\w)/

	declarator:
	identifier
	{ $item[1] }

	type_postfix:
	'*'
	{ '*' }
	\| '[' ']'
	{ '[]' }
	\| '[' constant_expression ']'
	{ "[$item[2]]" }

	identifier:
	...!reserved_word /[a-zA-Z_]\w*/x
	{ $item[2] }

	docucomment:
	/\/\\.?\\//s
	{ Clownfish::DocuComment->parse($item[1]) }

	constant_expression:
	/\d+/
	\| /[A-Z_]+/

	scalar_constant:
	hex_constant
	\| float_constant
	\| integer_constant
	\| string_literal
	\| 'NULL'
	\| 'true'
	\| 'false'

	integer_constant:
	/(?:-\s*)?\d+/
	{ $item[1] }

	hex_constant:
	/0x[a-fA-F0-9]+/
	{ $item[1] }

	float_constant:
	/(?:-\s*)?\d+\.\d+/
	{ $item[1] }

	string_literal:
	/"(?:[^"\\]\|\\.)*"/
	{ $item[1] }

	reserved_word:
	/(const\|double\|enum\|extern\|float\|register\|signed\|sizeof
	\|inert\|struct\|typedef\|union\|unsigned\|void)(?!\w)/x
	\| chy_integer_specifier
	\| c_integer_specifier

	eofile:
	/^\Z/

	END_GRAMMAR

	sub new { return shift->SUPER::new($grammar) }

	sub strip_plain_comments {
	my ( $self, $text ) = @_;
	while ( $text =~ m#(/\[^].?\/)#ms ) {
	my $blanked = $1;
	$blanked =~ s/\S/ /g;
	$text =~ s#/\[^].?\/#$blanked#ms;
	}
	return $text;
	}

	our $parcel = undef;
	sub set_parcel { $parcel = $_[1] }

	sub new_integer_type {
	my ( undef, $item ) = @_;
	my $specifier = $item->{c_integer_specifier}
	\|\| $item->{chy_integer_specifier};
	my %args = ( specifier => $specifier );
	$args{$_} = 1 for @{ $item->{'type_qualifier(s?)'} };
	return Clownfish::Type->new_integer(%args);
	}

	sub new_float_type {
	my ( undef, $item ) = @_;
	my %args = ( specifier => $item->{c_float_specifier} );
	$args{$_} = 1 for @{ $item->{'type_qualifier(s?)'} };
	return Clownfish::Type->new_float(%args);
	}

	sub new_void_type {
	my ( undef, $item ) = @_;
	my %args;
	$args{$_} = 1 for @{ $item->{'type_qualifier(s?)'} };
	return Clownfish::Type->new_void(%args);
	}

	sub new_arbitrary_type {
	my ( undef, $item ) = @_;
	return Clownfish::Type->new_arbitrary(
	specifier => $item->{arbitrary_type_specifier},
	parcel => $parcel,
	);
	}

	sub new_object_type {
	my ( undef, $item ) = @_;
	my %args = (
	specifier => $item->{object_type_specifier},
	parcel => $parcel,
	);
	$args{$_} = 1 for @{ $item->{'type_qualifier(s?)'} };
	return Clownfish::Type->new_object(%args);
	}

	sub simple_or_composite_type {
	my ( undef, $item ) = @_;
	my $simple_type = $item->{simple_type};
	my $postfixes = $item->{'type_postfix(s?)'};
	my $nullable = scalar @{ $item->{'nullable(?)'} } ? 1 : undef;
	my $type;

	if ( !@$postfixes ) {
	if ($nullable) {
	my $type_class = ref($simple_type);
	confess "$type_class can't be 'nullable'"
	unless $simple_type->is_object;
	$simple_type->set_nullable($nullable);
	}
	return $simple_type;
	}
	else {
	my %args = (
	child => $simple_type,
	indirection => 0,
	nullable => $nullable,
	);
	for my $postfix (@$postfixes) {
	if ( $postfix =~ /\[/ ) {
	$args{array} \|\|= '';
	$args{array} .= $postfix;
	}
	elsif ( $postfix eq '*' ) {
	$args{indirection}++;
	}
	}
	return Clownfish::Type->new_composite(%args);
	}
	}

	sub new_var {
	my ( undef, $item, $arg ) = @_;
	my $exposure = $item->{'exposure_specifier(?)'}[0];
	my %args = $exposure ? ( exposure => $exposure ) : ();
	if ($arg) {
	$args{class_name} = $arg->{class} if $arg->{class};
	$args{class_cnick} = $arg->{cnick} if $arg->{cnick};
	}
	return Clownfish::Variable->new(
	parcel => $parcel,
	type => $item->{type},
	micro_sym => $item->{declarator},
	%args,
	);
	}

	sub new_param_list {
	my ( undef, $param_list_elems, $variadic ) = @_;
	my $param_list = Clownfish::ParamList->new( variadic => $variadic, );
	for my $param (@$param_list_elems) {
	$param_list->add_param( $param->[0], $param->[1] );
	}
	return $param_list;
	}

	sub new_sub {
	my ( undef, $item, $arg ) = @_;
	my $class;
	my $modifiers = $item->{'subroutine_modifier(s?)'};
	my $docucom = $item->{'docucomment(?)'}[0];
	my $exposure = $item->{'exposure_specifier(?)'}[0];
	my $inert = scalar grep { $_ eq 'inert' } @$modifiers;
	my %extra_args = $exposure ? ( exposure => $exposure ) : ();

	if ($inert) {
	$class = 'Clownfish::Function';
	$extra_args{micro_sym} = $item->{declarator};
	$extra_args{inline} = scalar grep { $_ eq 'inline' } @$modifiers;
	}
	else {
	$class = 'Clownfish::Method';
	$extra_args{macro_sym} = $item->{declarator};
	$extra_args{abstract} = scalar grep { $_ eq 'abstract' } @$modifiers;
	$extra_args{final} = scalar grep { $_ eq 'final' } @$modifiers;
	}

	return $class->new(
	parcel => $parcel,
	docucomment => $docucom,
	class_name => $arg->{class},
	class_cnick => $arg->{cnick},
	return_type => $item->{type},
	param_list => $item->{param_list},
	%extra_args,
	);
	}

	sub new_class {
	my ( undef, $item, $arg ) = @_;
	my ( @member_vars, @inert_vars, @functions, @methods );
	my $source_class = $arg->{source_class} \|\| $item->{class_name};
	my %class_modifiers
	= map { ( $_ => 1 ) } @{ $item->{'class_modifier(s?)'} };
	my %class_attributes
	= map { ( $_ => 1 ) } @{ $item->{'class_attribute(s?)'} };

	for my $declaration ( @{ $item->{'declaration_statement(s?)'} } ) {
	my $declared = $declaration->{declared};
	my $exposure = $declaration->{exposure};
	my $modifiers = $declaration->{modifiers};
	my $inert = ( scalar grep {/inert/} @$modifiers ) ? 1 : 0;
	my $subs = $inert ? \@functions : \@methods;
	my $vars = $inert ? \@inert_vars : \@member_vars;

	if ( $declared->isa('Clownfish::Variable') ) {
	push @$vars, $declared;
	}
	else {
	push @$subs, $declared;
	}
	}

	my $class = Clownfish::Class->create(
	parcel => $parcel,
	class_name => $item->{class_name},
	cnick => $item->{'cnick(?)'}[0],
	parent_class_name => $item->{'class_inheritance(?)'}[0],
	docucomment => $item->{'docucomment(?)'}[0],
	source_class => $source_class,
	inert => $class_modifiers{inert},
	final => $class_modifiers{final},
	);
	$class->add_method($_) for @methods;
	$class->add_function($_) for @functions;
	$class->add_member_var($_) for @member_vars;
	$class->add_inert_var($_) for @inert_vars;
	while ( my ( $var, $val ) = each %class_attributes ) {
	$class->add_attribute( $var, $val );
	}
	return $class;
	}

	sub new_file {
	my ( undef, $item, $arg ) = @_;
	my $file = Clownfish::File->new( source_class => $arg->{source_class}, );
	for my $block ( @{ $item->{'major_block(s)'} } ) {
	$file->add_block($block);
	}
	return $file;
	}

	sub new_parcel {
	my ( undef, $item ) = @_;
	Clownfish::Parcel->singleton(
	name => $item->{class_name},
	cnick => $item->{'cnick(?)'}[0],
	);
	}

	1;

	__END__

	__POD__

	=head1 NAME

	Clownfish::Parser - Parse Clownfish header files.

	=head1 SYNOPSIS

	my $class_def = $parser->class($class_text);

	=head1 DESCRIPTION

	Clownfish::Parser is a combined lexer/parser which parses Clownfish header
	files. It is not at all strict, as it relies heavily on the C parser to pick
	up errors such as misspelled type names.

	=head1 METHODS

	=head2 new

	Constructor, takes no arguments.

	=head2 strip_plain_comments

	my $stripped = $parser->strip_plain_comments($code_with_comments);

	Remove plain C comments from supplied code. All non-whitespace characters are
	turned to spaces; all whitespace characters are preserved, so that the number
	of lines is consistent between before and after.

	JavaDoc-syntax "DocuComments", which begin with "/**" are left alone.

	This is a sloppy implementation which will mangle quoted comments and such.

	=cut