# 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__
=head1 NAME
Parse::Flex::Generate - Internal driver routines for makelexer.pl
=head1 SYNOPSIS
use Parse::Flex::Generate;
=head1 DESCRIPTION
This module is not intended to be used directly. It provides function
definitions for the makelexer.pl script.
=head1 EXPORT
All exported methods are of little value to the user: they are
all internal fuctions:
pm_content, makefile_content, xs_content , Usage , check_argv
=head1 AUTHOR
Ioannis Tambouras, E<lt>ioannis@earthlink.netE<gt>
=head1 SEE ALSO
None
=cut