# Usage: perl rule2parsec.pl GrammarFile.grammar [out-dir/] # The .grammar file is in Perl 6 syntax # The .hs file is automatically generated under the out-dir/ (./ by default) package Pugs::Compiler::Grammar; use Pugs::Compiler::Rule; use Pugs::Compiler::Token; use Pugs::Compiler::Regex; use base 'Pugs::Grammar::Base'; *pod = Pugs::Compiler::Token->compile(q( \= <'cut'> \N* [\n|$] | \N* [ $ | \n ] ))->code; # space, comments or pod *ws = Pugs::Compiler::Token->compile(q( [ \# \N* [\n|$] | [^|\n] \= \N* [\n|$] | \s ]* ))->code; *grammar_name = Pugs::Compiler::Token->compile(q( [ \w | \d | \: ]+ ))->code; *rule_name = Pugs::Compiler::Token->compile(q( \w+ ))->code; *block = Pugs::Compiler::Token->compile(q( \{ [ | <-[}]> | \\\\\} ]* \} ))->code; *mod = Pugs::Compiler::Token->compile(q# \: [ $ $ := (<-[)]>+) $ ]? { if($[0]){ return { $ => $[0] }; }else{ return { $ => 1 }; } } #)->code; *definition = Pugs::Compiler::Rule->compile(q($:=[<'rule'>|<'token'>|<'regex'>] * { my $kind = "$"; my $body = substr($, 1, -1); my %opt; map{ @opt{keys %$_} = values %$_ }@{$} if($[0]); $opt{'sigspace'} = 1 if $kind eq 'rule'; return { 'kind' => $kind, 'name' => "$", 'body' => $body, 'options' => \%opt }; } ))->code; *using = Pugs::Compiler::Rule->compile(q(<'use'> \;{ return { 'module' => "$" }; }))->code; *ending = Pugs::Compiler::Rule->compile(q(<'use'> <'Haskell'> \; $:=[.*]{ return "$" }))->code; *grammar = Pugs::Compiler::Rule->compile(q(<'grammar'> \;[ [||]]*{ return { 'name' => "$", 'definitions' => \@{$}, 'uses' => \@{$}, 'ending' => $[0] ? "$[0]" : '' }; }))->code; package main; use strict; use warnings; use IO::File; use File::Path; use File::Spec; use Pugs::Grammar::Rule; use Pugs::Runtime::Match::Ratchet; use Pugs::Emitter::Rule::Parsec qw( emit rule_rename ); use Data::Dumper; my $source_file = shift(@ARGV); my $out_dir = $ARGV[0] ? shift : '.'; my $source = slurp($source_file); my $match = Pugs::Compiler::Grammar->grammar($source); die $0 . ': grammar file cannot be parsed' unless $match; my $ret = $match->(); my $fh = create_haskell_file($ret->{name}); foreach(@{$ret->{uses}}){ my $uses = $_->(); print $fh 'import ' . perl_module_to_haskell($uses->{module}) . "\n"; } print $fh "\n"; foreach(@{$ret->{definitions}}){ my $def = $_->(); my $tree = Pugs::Grammar::Rule->rule($def->{body}); print $fh Pugs::Emitter::Rule::Parsec::rule_rename($def->{name}) . ' = ' . Pugs::Emitter::Rule::Parsec::emit({ }, $tree->{capture}, $def->{options}) . "\n"; } print $fh "-- Begin of copied functions\n"; print $fh $ret->{ending}; close $fh; sub perl_module_to_haskell { local $_ = shift; s/::/./g; return $_; } sub slurp { my $fh = IO::File->new(shift) || return; return join('', $fh->getlines); } sub create_haskell_file { my $module = perl_module_to_haskell shift; my($path, $dir); $path = $module; $path =~ s/\./\//g; $dir = File::Spec->catdir($out_dir, substr $path, 0, 1 + rindex($path, '/')); mkpath $dir if $dir ne ''; open FH, '>', ($path . '.hs'); # XXX print FH <

perl6-compiler@perl.orgE. =head1 SEE ALSO The Perl 6 Rules Spec: L The Parsec homepage: L =head1 COPYRIGHT Copyright 2006 by Shu-Chun Weng. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L =cut