Perl6-Pugs

 view release on metacpan or  search on metacpan

misc/old_pugs_perl5_backend/Perl6-Value/t/code.t  view on Meta::CPAN

#!/usr/bin/perl

use strict;
use warnings;

use Perl6::Code;
# use Data::Dumper;
use PadWalker;

use Test::More tests => 21;

%Perl6::MultiSub::SUBS = ();
%Perl6::NamedSub::SUBS = ();

sub body (&) { @_ }
sub params {
    [ map { Perl6::Param->new( 'type' => undef, 'name' => $_ ) } @_ ]  
}

misc/pX/pmurias/ruby_quotes.pl  view on Meta::CPAN

#!?usr/bin/perl
use PadWalker qw(peek_my peek_our);
use warnings;
use strict;
sub ruby_quote($) {
	my ($string) = @_;
	my %hash = (%{peek_our(1)},%{peek_my(1)});
	$string =~ s!(\#\{  (.*?)  \})!${$hash{$2}||\$1}!xg;

	#XXX: LexAlias is required to make it work properly
	$string =~ s!\#\{  (.*?)  \}!eval($1)!exg;
	return $string;

perl5/Pugs-Compiler-Perl6/lib/Pugs/Runtime/Perl6.pm  view on Meta::CPAN

package Pugs::Runtime::Perl6;

use strict;
use warnings;

use Data::Dumper;
use Data::Bind;
#use Lexical::Alias;
use Sub::Multi;
use PadWalker;
use IO::File ();
use Pugs::Compiler::Regex ();
use List::Util; # 'reduce'

$::_V6_BACKEND = 'BACKEND_PERL5';

# TODO - see Pugs::Runtime::Grammar for metaclass stuff

use constant Inf => 100**100**100;
use constant NaN => Inf - Inf;
    
    sub pad_depth {
        local $@;
        my $idx = 0;
        $idx++ while eval { PadWalker::peek_my($idx) };
        $idx;
    }
    
    sub eval_preprocess {
        my ($string, $lang);
        Data::Bind->arg_bind(\@_);
        $lang ||= 'perl6';
        my $eval_string;
        Data::Bind::bind_op2(\$eval_string, \$string);
        # print "LANG: $lang\n";

perl5/Pugs-Compiler-Rule/Makefile.PL  view on Meta::CPAN

use Cwd qw< abs_path cwd >;

my $pmc  = abs_path('lib/Pugs/Grammar/Rule.pmc');

my $mtime = time;
utime $mtime, $mtime, $pmc;

    name('Pugs-Compiler-Rule');
all_from('lib/Pugs/Compiler/Rule.pm');
requires('Parse::Yapp' => '0');
requires('PadWalker' => '1.0');
requires('Cache::Cache' => '1.05');
recommends('YAML::Syck' => '0.60');

&WriteAll;

sub MY::postamble {
    # my $blib_pmc = $pmc;
    # $blib_pmc =~ s!(.*)lib!$1blib/lib!;
    << ".";
config ::

perl5/Pugs-Compiler-Rule/RuleInline-more.pl  view on Meta::CPAN

package Pugs::Runtime::RuleInline;

# - fglock
#
use strict;
use warnings;
use Data::Dumper;
use PadWalker qw( peek_my );  # peek_our ); ???

sub alternation {
    return '( ' . join( ' || ', @_ ) . ' )';
}

sub concat {    
    return '( ' . join( ' && ', @_ ) . ' )';
}

# 2 versions - match anywhere; match at $pos

perl5/Pugs-Compiler-Rule/TODO  view on Meta::CPAN

- add rollback for [ x <!before k> ]+
  - should 'unmatch' last 'x' if there is a 'k' after it

- add 'negate' node to Regex
- add tests for 'negate'
- finish remaining metasyntax in <!...> Grammar

- static signature for '$^a' 

- add 'inlined' switch to disable PadWalker lookups

- fix the <ws> rule

Unicode:

- \v \h \V \H

Sigspace switch:

- 'doubled' <ws> doesn't work

perl5/Pugs-Compiler-Rule/TODO  view on Meta::CPAN

  each language generate entries for the tokenizer hash
  <%statement_control|%prefix|%term>
- implement the main tokenizer using the minilanguages as terms

Priorities:

- features used in PGE P6 Grammar
- <after ...> in non-ratchet
- char classes

- make PadWalker optional, as most distros don't hold PW 1.0

- '%var := xxx'; '@var := xxx'; %<var> := ; @<var> :=

- rule parameters 

- add placeholder 'not implemented' messages in the right places

- make Emitter::Rule::Perl5 subclassable - such that closures can be 
  parsed/compiled by a custom parser
- make the 'return' block functionally detectable (instead of regex)

perl5/Pugs-Compiler-Rule/lib/Pugs/Runtime/Regex.pm  view on Meta::CPAN

}

# not a 'rule node'
# gets a variable from the user's pad
# this is used by the <$var> rule
sub get_variable {
    my $name = shift;
    
    local $@;
    my($idx, $pad) = 0;
    while(eval { require PadWalker; $pad = PadWalker::peek_my($idx) }) {
        $idx++, next
          unless exists $pad->{$name};

        #print "NAME $name $pad->{$name}\n";
        return ${ $pad->{$name} } if $name =~ /^\$/;
        return $pad->{$name};  # arrayref/hashref
    }
    die "Couldn't find '$name' in surrounding lexical scope.";
}

perl5/Pugs-Compiler-Rule/t/04-rule.t  view on Meta::CPAN

}

{
    # calling unnamed subrules
    my $match;
    eval {
    my $rule2 = Pugs::Compiler::Regex->compile( '.' );
    *test::rule_method6 = Pugs::Compiler::Regex->compile( '<$rule2>' )->code;
    $match = test->rule_method6( "xyzw" );
    };
    warn "# *** Please check if CPAN module 'PadWalker' is properly installed\n",
         "# *** This is the resulting error: $@"
        if $@;
    is( "$match", "x", 'a named subrule calls a lexical unnamed subrule' );
}

{
    my $rule = Pugs::Compiler::Regex->compile( '^x' );
    my $match = $rule->match( "\nx\n" );
    #print "Source: ", do{use Data::Dumper; Dumper($rule->{perl5})};
    #print "Match: ", $match->perl;

perl5/Pugs-Compiler-Rule/t/09-ratchet.t  view on Meta::CPAN

{
    # calling unnamed subrules
    my $match;
    my $rule2 = Pugs::Compiler::Token->compile( '.', { ratchet => 1 } );
    #print "Source: ", do{use Data::Dumper; Dumper( $rule2->perl5 )};
    eval {
    *test::rule_method6 = Pugs::Compiler::Token->compile( '<$rule2>', { ratchet => 1 } )->code;
    $match = test->rule_method6( "xyzw" );
    };
    warn "# *** Please check if CPAN module 'PadWalker' is properly installed\n",
         "# *** This is the resulting error: $@"
        if $@;
    #print "Source: ", do{use Data::Dumper; Dumper( Pugs::Compiler::Token->compile( '<$rule2>', { ratchet => 1 } )->perl5 )};
    #print "Match: ", do{use Data::Dumper; Dumper($match)};
    is( "$match", "x", 'a named subrule calls a lexical unnamed subrule' );
}

{
    # generated rules
    my $rule = Pugs::Compiler::Token->compile( '<alpha>+', { ratchet => 1 } );

perl5/Pugs-Compiler-Rule/temp/lib/Pugs/Runtime/Rule.pm  view on Meta::CPAN

- Quantified matches could use less stack space.

- Simplify arg list - the functions currently take 8 arguments.

=cut

use strict;
use warnings;
#use Smart::Comments; #for debugging, look also at Filtered-Comments.pm
use Data::Dumper;
use PadWalker qw( peek_my );  # peek_our ); ???

# note: alternation is first match (not longest). 
# note: the list in @$nodes can be modified at runtime
sub alternation {
    my $nodes = shift;
    return sub {
        my @state = $_[1] ? @{$_[1]} : ( 0, 0 );
        $_[3] = bless \{ bool => \0 }, 'Pugs::Runtime::Match::Ratchet';
        while ( $state[0] <= $#$nodes ) {
            $state[1] = $nodes->[ $state[0] ]->( $_[0], $state[1], @_[2,3,4,5,6,7] );