1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
|
#!/usr/bin/perl
# This is a Perl rewrite of a C program I wrote a while back that
# generates random strings from a language specified in BNF. Try
# 'gen.pl < thought' to see how it works.
# $Id: gen.pl,v 1.1 2002/04/10 04:58:09 srz Exp $
# Structs for the grammar.
# These two aren't really used as classes per se but it's convenient
# to bless things into them so you can see what's going on in the
# debugger.
package Rule;
package Branch;
package Literal;
sub new {
my ($class, $value) = @_;
bless { value => $value }, $class;
}
package Name;
sub new {
my ($class, $name) = @_;
bless { name => $name }, $class;
}
# Here is the actual generation code.
package main;
use GenParser;
use Fstream;
srand(time|$$);
$s = Fstream->new(\*STDIN, 'STDIN');
$p = GenParser->new(\&GenParser::yylex, \&GenParser::yyerror, 0);
$p->yyparse($s);
&fixup_names;
&gen($rules{$start});
# connect rule invocations to the actual rule.
sub fixup_names {
my ($rule, $branch, $item);
foreach $rule (values %rules) {
foreach $branch (@$rule) {
foreach $item (@$branch) {
if ($item->isa("Name")) {
my $r = $rules{$item->{name}} or
die "Undefined rule " . $item->{name};
$item->{blist} = $r;
}
}
}
}
}
# generate language. We keep a manual stack instead of doing a
# recursive call (just for the hell of it).
sub gen {
my ($blist) = @_;
my @stack;
LOOP:
my $ilist = [ @{$$blist[int(rand(@$blist))]} ];
push(@stack, $ilist);
while (@stack) {
my $ilist = $stack[-1];
while (@$ilist) {
my $item = shift @$ilist;
if ($item->isa("Literal")) {
print $item->{value};
}
elsif ($item->isa("Name")) {
$blist = $item->{blist};
goto LOOP;
}
}
pop @stack;
}
}
|
