Parse::Flex::Generate - Internal driver routines for makelexer.pl

Parse-Flex documentation Contained in the Parse-Flex distribution.

Index

Code Index:

NAME

Top

Parse::Flex::Generate - Internal driver routines for makelexer.pl

SYNOPSIS

Top

 use Parse::Flex::Generate;

DESCRIPTION

Top

This module is not intended to be used directly. It provides function definitions for the makelexer.pl script.

EXPORT

Top

All exported methods are of little value to the user: they are all internal fuctions: pm_content, makefile_content, xs_content , Usage , check_argv

AUTHOR

Top

Ioannis Tambouras, <ioannis@earthlink.net>

SEE ALSO

Top

None

Parse-Flex documentation Contained in the Parse-Flex distribution. 
# Copyright (C) 2003 Ioannis Tambouras <ioannis@earthlink.net> . All rights reserved.
# LICENSE:  Latest version of GPL. Read licensing terms at  http://www.fsf.org .
 
package Parse::Flex::Generate;

use 5.006;
use warnings;
use strict;
use base 'Exporter';


our $VERSION  = '0.03';
our @EXPORT   =  qw( pm_content   makefile_content   xs_content 
		     Usage        check_argv
);


sub  check_argv {
	my ( $package, $grammar) = ($_[0], $_[1]||return) ;
	-f  $grammar       or   die  "did not find $grammar \n" ;
	-f "${package}.xs" and  warn "overiding $package}.xs  \n" ;
	-f "${package}.pm" and  warn "overiding ${package}.pm  \n" ;
}

sub Usage {
	my $package = shift;
	(my $tmp = <<"EOM" ) =~ s/^\t//m ;  $tmp;
	Usage: $0 [ hrn ]  grammar.l
		-n    module name.  [Currently set to $package]
                -k    keep compilation directory
                -l    command options passed to flex(1) [ defaults to -Cf ]
                -v    verbose
		-h    This help	
EOM
}


sub pm_content  {  
	my $p = shift || die;
	my $msg = <<"EOM" ;
	package $p;
	use XSLoader;
	XSLoader::load $p;
	use Parse::Flex;
	use base 'Exporter';

EOM
	($msg .= <<'EOM') =~  s/^\t//gm ;	
	our @EXPORT_OK = qw(
				yypop_buffer_state            make_yp
				yyset_debug    yyget_debug
				yyget_leng     yy_scan_bytes  create_push
	);


	our @EXPORT = qw( 
				yyout          yyin           yylex
				yyget_lineno   yyset_lineno   yyset_in
				walkthrough    gen_walker     yy_scan_string
				yyrestart      yapp_new       yapp_parse
	);
		
	sub  create_push {
		# need to move create_push for Flex.pm to here
		# we assume $fd is either glob or filename
		our  $fd    =  shift || return;
		open $fd, $fd   if ( 'SCALAR' eq typeme $fd);
		create_push_buffer( $fd, 16384 );
	}

	sub walkthrough {
		for (@_) {
			my ($iter, @a) = gen_walker( shift);
			print "@a"    while  @a = $iter->() ;
		}
	}

	sub control_yyin {
	     my $param = shift || return;
	     ({'SCALAR'    =>sub{ yyin($param)             },
	       'GLOB'      =>sub{ yyset_in($param)         },
	       'REF_SCALAR'=>sub{ yy_scan_string( $$param) },
	     }->{typeme($param)})->();
	}
	
	sub gen_walker {
		control_yyin( shift );
		sub  { wantarray ? yylex() : [yylex()] }
	}
	
	sub make_yp {
		my $grammar =  shift || 'grammar.yp' ;
		grep { -e "$_/yapp" }  split /:/, $ENV{PATH}
			or die q(You need yapp(1) in your $PATH.) ;
		-f $grammar  or die qq("$grammar". $!);
		
		(my $makefile = <<"EOM") =~ s/^\t//gm ;
		MyYapp.pm:  $grammar 
			yapp -m MyYapp  \$<
	EOM
		open my ($o),  "| make -s -f -";
		print $o $makefile;
	}
	
	
	sub yapp_new {
		my $parser = shift || 'MyYapp' ;
		$parser =~   s/\.pm$//;
		eval "use $parser" ;
		die qq(Did not find "$parser") if $@;
		bless \ $parser -> new();
	}
	
	sub yapp_parse {
		my ($p, $rc, $debug) =  @_ ;
		defined $rc and  -f $rc      || die qq("$rc". $!);
		my $walker = gen_walker ( $rc );
		my $err = sub{ printf qq(Error: got '%s' \n), $_[0]->YYCurval}; 
		print $$p->YYParse ( yylex => $walker, 
			 	     yyerror => $err,  debug=> $debug||0 ) ;
	}
	

	sub pbyacc_new {
		my ($rc, $parser, $debug) = @_ ;
		open my ($fd), $rc;
		($parser = $parser || 'MyByacc')   =~   s/\.pm$// ;
		eval "use $parser" ;
		die qq(Did not find "$parser") if $@;
		
		my $walker =  gen_walker( $rc);
		my $err    =  sub{ print qq(Error)  };
		
		# you can also enable debuging via $ENV{YYDEBUG} = 1
		bless \ $parser -> new( $walker, $err, $debug||0 );
	}
	
	sub pbyacc_parse {
		${$_[0]}->yyparse ;
	}
	
	
	1;

EOM
	$msg;
}



	sub makefile_content {
		my ($package, $grammar ) =  ( $_[0], $_[1]||return ) ;
		my ($lflags, $verbose)   =  ( $_[2], $_[3] ) ;
		$grammar =~ s{^.*/}{};
		(my $msg  = <<'EOM') =~ s/^\t//gm ;
	.PHONY:  try.pl
	.SILENT:

	OPTS  =  -lw  -MData::Dumper
	fopt  =  -Cf 
	ifdef n
	noerr = 2>/dev/null
	endif


	PFLAGS =  -I. -D_REENTRANT -D_GNU_SOURCE -DTHREADS_HAVE_PIDS -DDEBIAN -fno-strict-aliasing -pipe -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64 -O2   -DVERSION=\"0.01\" -DXS_VERSION=\"0.01\" -fPIC "-I/usr/lib/perl/5.8/CORE"

	PACK= Flexer

	OBJ = $(PACK).o  lex.yy.o

	#all: try.pl
	all: $(OBJ)  $(PACK).so  mv #clean
		
	try.pl:
		perl $(OPTS)  $@

	lex.yy.c: custom.l
		flex  $(fopt)  $^


	$(PACK).c: $(PACK).xs
		/usr/bin/perl /usr/share/perl/5.8/ExtUtils/xsubpp  -typemap /usr/share/perl/5.8/ExtUtils/typemap  $(PACK).xs $(noerr) > $(PACK).xsc && mv $(PACK).xsc $(PACK).c  


	$(PACK).o: $(PACK).c
		gcc -c -o $@  $(PFLAGS)  $^

	$(PACK).so: $(OBJ)
		gcc  -s -shared -L/usr/local/lib   -o $@  $^


	clean:
		rm -f $(OBJ)   *.o *.a  $(PACK).c  *.xs lex.yy.[co]

	mv:
		mv $(PACK).pm  $(PACK).so ..

	realclean: clean
		rm -f  $(PACK).so  $(PACK).pm



	$(PACK).pm: $(PACK).so
		echo $(PM_DATA)  > $@
EOM
	($msg =~ s/Flexer/$package/g) ; 
	($msg =~ s/custom[.]l/$grammar/g) ; 
	 $msg =~ s/fopt  =  -Cf /fopt  =  $lflags/   if $lflags;
	 $msg =~ s/ifdef n/ifndef n/                 if $verbose;
         $msg;
}

sub  xs_content {

	my $package = shift || die;
	(my $msg = <<'EOM' ) =~ s/Flexer/$package/g; 
	#include "EXTERN.h"
	#include "perl.h"
	#include "XSUB.h"
	
	extern  char    *yytext;
	extern  int     yy_flex_debug, yylineno, yyleng;
	extern  FILE   *yyin, *yyout ;
	extern  int     maxwrap;
	extern  char*  wrap[];
	
	
	
	MODULE = Flexer            PACKAGE = Flexer

	void
	yylex()
	   PPCODE:
	      char* id = 0;
	      if (id = (char*) yylex() ) {
		      XPUSHs (sv_2mortal(newSVpv(id,0)));
		      XPUSHs (sv_2mortal(newSVpv( yytext, 0)));
		      XSRETURN(2);
	      }
	      XSRETURN_EMPTY;

	void
	yylex_int()
	   PPCODE:
	      int id; 
	      if (id = (int) yylex() ) {
		      XPUSHs (sv_2mortal(newSViv(id)));
		      XPUSHs (sv_2mortal(newSVpv( yytext, 0)));
		      XSRETURN(2);
	      }
	      XSRETURN_EMPTY;


	void
	yyin( file )
	   char* file
	   CODE:
	     if ( (yyin=fopen(file,"r")) == NULL ) {
	     	     perror("yyin");
	     }


	void
	yyout( file )
	   char* file
	   CODE:
	     if ( (yyout=fopen(file,"w")) == NULL ) {
	            perror("yyout");
	     }


	void
	yyset_in( fd )
	   FILE  *fd
	   CODE:
	      yyin = fd;
	
	void
	yyset_out( fd )
	   FILE  *fd
	   CODE:
	      yyout = fd;
	 	
	FILE*
	yyget_in( )
	   CODE:
	      RETVAL = yyin;
	   OUTPUT:
	      RETVAL
	
	FILE*
	yyget_out( )
	   CODE:
	      RETVAL = yyout;
	   OUTPUT:
	      RETVAL
	
	int
	yyget_lineno()
	   CODE:
		RETVAL = yylineno ;
	   OUTPUT:
		RETVAL

	void
	yyset_lineno ( val )
	   int val
	   CODE:
	      yylineno = val;

	int
	yyget_leng()
	   CODE:
		RETVAL = yyleng ;
	   OUTPUT:
		RETVAL

	void
	yyset_debug ( flag )
	   int flag
	   CODE:
	      yy_flex_debug = flag;  
	
	int
	yyget_debug()
	   CODE:
	        RETVAL = yy_flex_debug ;
	   OUTPUT:
	       RETVAL

	char*
	yyget_text()
	   CODE:
	       RETVAL = yytext;
	   OUTPUT:
	       RETVAL
	
	void
	yy_scan_string( str )
	   char *str
	   CODE:
	      yy_scan_string( str );
	
	void
	yy_scan_bytes( str, len )
	   char *str
	   int  len
	   CODE:
	      yy_scan_bytes( str, len );
	
	void
	yyrestart( fd )
	   FILE *fd
	   CODE:
	        yyrestart( fd );
	
	void
	create_push_buffer( fd, size)
	   FILE *fd
	   int   size
	   CODE:
	      yypush_buffer_state( yy_create_buffer(fd,size) ) ;
	
	void
	yypop_buffer_state()
	   CODE:
	      yypop_buffer_state();


EOM
$msg =~ s/^\t//gm;  
$msg;
}

1;
__END__