gistfile1.txt

#!/usr/bin/perl
use strict; use warnings;
use Data::Dumper;

use Sub::Curried;
use Carp qw(croak cluck);

my @stream = split /\n/, <<'EOF';
method foo { say $x }
EOF

my $state = {
    stream   => \@stream,
    line     => 1,
    offset   => 0,
    selected => 0,
  };

curry scan_lit ($lit, %state) {
    my ($line) = @{ $state{stream} }
        or return;
    my $len = length $lit;
    my $offset_match = substr $line, $state{offset}, $len;
    if ($offset_match eq $lit) {
        return { %state, 
                 offset   => $state{offset}  +$len,
                 selected => $state{selected}+$len,
               }, 
               $offset_match;
    } else {
        return;
    }
}

curry scan_re ($re, %state) {
    my ($line) = @{ $state{stream} }
        or return;
    my $offset_line = substr $line, $state{offset};
    if ($offset_line=~/$re/) {
        my $len = $+[0] - $-[0];
        my $match  = substr $offset_line, 0, $len;
        return { %state, 
                 offset   => $state{offset}  +$len,
                 selected => $state{selected}+$len,
               }, 
               $match;
    } else {
        return;
    }
}

curry get (%state) {
    my ($line)  = @{ $state{stream} };
    my $len   = $state{selected};
    my $start = $state{offset} - $len;
    return \%state, substr $line, $start, $len;
}
curry const ($const, $ignore) { $const }

curry skip (%state) {
    return { %state,
             selected => 0 };
}

{
curry replace ($text, %state) {
    my ($line, @rest)  = @{ $state{stream} };
    my $len   = $state{selected};
    my $start = $state{offset} - $len;
    substr $line, $start, $len, $text;
    return { %state,
        selected => 0,
        offset   => $start+length $text,
        stream   => [ $line, @rest ],
        };
}
no warnings 'once';
*insert = replace; # synonym
}

curry get_skip (%state, $what) {
    return skip(\%state), $what;
}
curry debug_line (%state) {
    my ($line) = @{ $state{stream} };
    substr $line, $state{offset}, 0, '<-- HERE';
    if (my $selected = $state{selected}) {
        substr $line, $state{offset}, 0, ']';
        substr $line, $state{offset}-$selected, 0, 'SEL-->[';
    }
        
    return \%state, $line;
}

curry try (@parsers, %state) {
    my $state = { %state };
    my @ret;
    for (@parsers) {
        ($state, @ret) = $_->($state) or return \%state;
    }
    return $state, @ret;
}
curry alt (@parsers, %state) {
    my $state = { %state };
    my @ret;
    for (@parsers) {
        if (($state, @ret) = $_->(\%state)) {
            return $state, @ret;
        }
    }
    return;
}
curry fail ($error, %state) {
    my (undef, $line) = debug_line \%state;
    croak "Parser error: $line";
}
curry debug ($error, %state) {
    my (undef, $line) = debug_line \%state;
    cluck "Parser state: $line";
}

{
    # Set up some test parsers
    my $get_token      = scan_re(qr/\w+/);
    my $get_skip_token = get_skip() << $get_token;
    my $skip_space     = skip() << const() << scan_re(qr/\s*/);

    # parse declarator and name
    ($state, my $decl) = $get_skip_token->($state);
    $state = $skip_space->($state);
    ($state, my $name) = $get_token->($state);
    $state = replace('', $state);

    # try a (succeeding) chain of parsers
    $state = try  [ $skip_space,
                    scan_lit('{'),
                    skip(),
                    replace('do_injected_stuffs;') ],
                  $state;

    # try a (failing) chain of parsers
    $state = try  [ scan_lit('DUMMY'),
                    replace('This should not be seen;') ],
                  $state;

    # Show state, including currently "selected" stuff
    $state = try [ $skip_space,
                   $get_token, ], # token is currently selected
                $state;
    debug("Ending", $state);
}