gistfile1.txt

class Grammer::Generative {
    my %!generate_cache = ();
    my $.repeatiness is rw = 0.7;
    
    method generate(&start_rule) {
        return generate_rule(&start_rule);
    }

    my method generate_rule(&rule) {
        # Get rule parsed to a tree and put that in the cache, if we didn't already.
        unless %!generate_cache{&rule.name} {
            my $source = &rule.perl;
            if $source ~~ /^ [regex|rule|token] \s+ <.ident>? \s* '{' (.+) '}' \s* $/ {
                $source = $1;
            }
            else {
                die "Failed to get source for rule " ~ &rule.name;
            }
            %!generate_cache{&rule.name} = pge_compile($source);
        }

        # Now walk the regex to generate a result.
        return self.walk_regex(%!generate_cache{&rule.name});
    }

    multi method walk_regex(PGE::Exp::Concat $node) {
        return [~] $node.map({ self.walk_regex($^child) });
    }

    multi method walk_regex(PGE::Exp::Literal $node) {
        return $node.item;
    }

    multi method walk_regex(PGE::Exp::Quant $node) {
        my $to_repeat = self.walk_regex($node[0]);
        my $result = $to_repeat x $node<min>;
        my $times = $node<min>;
        while $times < $node<max> && rand() < $repeatiness {
            $result ~= $to_repeat;
        }
        return $result;
    }

    my method pge_compile($source) {
        # We do a little PIR for now, but hopefully when we have STD.pm in place
        # and it's Regex grammar or something else accessible from Perl 6 we will
        # not have to.
        my $rule;
        my $result;
        q:PIR {
            $P0 = find_lex '$rule'
            $P1 = compreg 'PGE::Perl6Regex'
            $P0 = $P1.'regex'($P0)
            store_lex '$result', $P0
        };
        return $result;
    }
}