view release on metacpan or  search on metacpan

lib/Asm/Preproc/Lexer.pm  view on Meta::CPAN

=item transform (optional)

The optional code reference is a transform subroutine. It receives 
the C<type> and C<value> of the recognized token, and returns one of:

=over 4

=item 1

An array ref with two elements C<[$type, $value]>, 
the new C<type> and C<value> to be 
returned in the L<Asm::Preproc::Token|Asm::Preproc::Token> object.

=item 2

An empty array C<()> to signal that this token shall be dicarded.

=back

As an optimization, the transform subroutine code reference may be
set to C<undef>, to signal that the token will be dicarded 
and there is no use in accumulating it while matching. 
This is usefull to discard comments upfront, instead of
collecting the whole comment, and then pass it to the transform subroutine
just to be discarded afterwards.
See see C<COMMENT> above for an example of usage.

=back

=head2 clone

Creates a copy of this tokenizer object without compiling a new 
lexing subroutine. The copied object has all pending input cleared.

=cut

#------------------------------------------------------------------------------
use base 'Iterator::Simple::Lookahead', 'Class::Accessor';
__PACKAGE__->mk_accessors(
		'_lexer',				# lexer iterator
		'_input',				# input iterator		
		'_line',				# current line being processed
		'_text',				# text being parsed
);

sub new { 
	my($class) = @_;
	return $class->_new( sub { return } );		# dummy lexer
}

sub clone {
	my($self) = @_;
	return ref($self)->_new( $self->_lexer );
}

# used by new and clone
sub _new { 
	my($class, $lexer) = @_;
	
	my $self = $class->SUPER::new;		# init iterator
	$self->_lexer( $lexer );
	$self->_input( Iterator::Simple::Lookahead->new );
	$self->_line( undef );
	$self->_text( "" );
	
	return $self;
};

#------------------------------------------------------------------------------
# compile the lexing subroutine
sub make_lexer {
	my($self, @tokens) = @_;
	@tokens or croak "tokens expected";
	
	# closure for each token attributes, indexed by token sequence nr
	my @type;			# token type
	my @start_re;		# match start of token
	my @end_re;			# match end of token
	my @transform;		# transform subroutine
	my @discard;		# true to discard multi-line token
	my @comment;		# comment to show all options of each token branch
	
	# parse the @tokens list
	for (my $id = 0; @tokens; $id++) {
		# read type
		$type[$id] = shift @tokens;
		
		# read regexp
		my $re = shift @tokens or croak "regexp expected";
		
		if (ref $re eq 'Regexp') {
			$start_re[$id] = $re;
		}
		elsif (ref $re eq 'ARRAY') {
			@$re == 1 and push @$re, $re->[0];
			@$re == 2 or croak "invalid regexp list";
			($start_re[$id], $end_re[$id]) = @$re;
		}
		else {
			croak "invalid regexp";
		}

		# read transform, define discard
		if (@tokens) {
			if (! defined($tokens[0])) {
				$discard[$id] = 1;
				shift @tokens;
			}
			elsif (ref($tokens[0]) eq 'CODE') {
				$transform[$id] = shift @tokens;
			}
		}
	
		# comment
		$comment[$id] = join('  ', map {defined($_) ? $_ : ''}
								$id, 
								$type[$id], 
								$start_re[$id], 
								$end_re[$id],
								$transform[$id],