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
|
package oplist;
use strict;
use warnings;
use File::Spec::Functions qw(splitpath updir catpath catdir);
use constant OPLIST => do {
my ($path, $directory, $filename) = splitpath(__FILE__);
catpath($path, catdir($directory, (updir()) x 2, qw(src core)), 'oplist');
};
# Parse MoarVM oplist file and stash it in @OPLIST and %OPLIST
sub parse_oplist {
my ($fh) = @_;
my @oplist;
while (<$fh>) {
# remove comments and skip empty strings
chomp and s/#.*$//;
next unless length;
my ($name, @meta) = split /\s+/;
my ($attribute, @operands, @adverbs);
for (@meta) {
if (m/^[-+.:*]\w$/) {
$attribute = $_;
} elsif (m/^:\w+$/) {
push @adverbs, $_;
} elsif (m/^([rw])l?\((.+)\)$/) {
push @operands, $1 => $2;
} else {
push @operands, '' => $_;
}
}
push @oplist, [ $name, $attribute, \@operands, \@adverbs ];
}
return @oplist;
}
sub import {
my ($class, $file) = (@_, OPLIST);
open my $fh, '<', $file or die $!;
my @oplist = parse_oplist($fh);
my %oplist = map {
$_->[0] => { attr => $_->[1], operands => $_->[2], adverbs => $_->[3] }
} @oplist;
my ($caller) = caller();
{
no strict 'refs';
*{$caller . '::OPLIST'} = \@oplist;
*{$caller . '::OPLIST'} = \%oplist;
}
close $fh;
}
1;
|
