Commit | Line | Data |
---|---|---|
b5dedee0 JM |
1 | package reader; |
2 | use feature qw(switch); | |
3 | use strict; | |
60f2b363 | 4 | use warnings FATAL => qw(all); |
01c97316 | 5 | no if $] >= 5.018, warnings => "experimental::smartmatch"; |
b5dedee0 JM |
6 | use Exporter 'import'; |
7 | our @EXPORT_OK = qw( read_str ); | |
8 | ||
16354bb4 | 9 | use types qw($nil $true $false _hash_map); |
b5dedee0 JM |
10 | |
11 | use Data::Dumper; | |
12 | ||
13 | { | |
14 | package Reader; | |
15 | sub new { | |
16 | my $class = shift; | |
17 | bless { position => 0, tokens => shift } => $class | |
18 | } | |
19 | sub next { my $self = shift; return $self->{tokens}[$self->{position}++] } | |
20 | sub peek { my $self = shift; return $self->{tokens}[$self->{position}] } | |
21 | } | |
22 | ||
23 | sub tokenize { | |
24 | my($str) = @_; | |
25 | my @tokens = $str =~ /[\s,]*(~@|[\[\]{}()'`~^@]|"(?:\\.|[^\\"])*"|;.*|[^\s\[\]{}('"`,;)]*)/g; | |
a3b0621d | 26 | return grep {! /^;|^$/} @tokens; |
b5dedee0 JM |
27 | } |
28 | ||
29 | sub read_atom { | |
30 | my($rdr) = @_; | |
31 | my $token = $rdr->next(); | |
32 | given ($token) { | |
33 | when(/^-?[0-9]+$/) { return Integer->new($token) } | |
a5a66058 JM |
34 | when(/^"/) { |
35 | my $str = substr $token, 1, -1; | |
36 | $str =~ s/\\"/"/g; | |
37 | $str =~ s/\\n/\n/g; | |
38 | return String->new($str) | |
39 | } | |
b5dedee0 JM |
40 | when(/^nil$/) { return $nil } |
41 | when(/^true$/) { return $true } | |
42 | when(/^false$/) { return $false } | |
43 | default { return Symbol->new($token) } | |
44 | } | |
45 | } | |
46 | ||
47 | sub read_list { | |
48 | my($rdr,$class,$start,$end) = @_; | |
49 | $start = $start || '('; | |
50 | $end = $end || ')'; | |
51 | ||
52 | my $token = $rdr->next(); | |
53 | my @lst = (); | |
54 | if ($token ne $start) { | |
55 | die "expected '$start'"; | |
56 | } | |
57 | while (($token = $rdr->peek()) ne $end) { | |
58 | if (! defined $token) { | |
59 | die "expected '$end', got EOF"; | |
60 | } | |
61 | push(@lst, read_form($rdr)); | |
62 | } | |
63 | $rdr->next(); | |
64 | if ($class eq 'List') { | |
65 | return List->new(\@lst); | |
66 | } elsif ($class eq 'Vector') { | |
67 | return Vector->new(\@lst); | |
68 | } else { | |
16354bb4 | 69 | return _hash_map(@lst); |
b5dedee0 JM |
70 | } |
71 | } | |
72 | ||
73 | sub read_form { | |
74 | my($rdr) = @_; | |
75 | my $token = $rdr->peek(); | |
76 | given ($token) { | |
fd637e03 JM |
77 | when("'") { $rdr->next(); List->new([Symbol->new('quote'), |
78 | read_form($rdr)]) } | |
79 | when('`') { $rdr->next(); List->new([Symbol->new('quasiquote'), | |
80 | read_form($rdr)]) } | |
81 | when('~') { $rdr->next(); List->new([Symbol->new('unquote'), | |
82 | read_form($rdr)]) } | |
83 | when('~@') { $rdr->next(); List->new([Symbol->new('splice-unquote'), | |
84 | read_form($rdr)]) } | |
89bd4de1 JM |
85 | when('^') { $rdr->next(); my $meta = read_form($rdr); |
86 | List->new([Symbol->new('with-meta'), | |
87 | read_form($rdr), $meta]) } | |
88 | when('@') { $rdr->next(); List->new([Symbol->new('deref'), | |
89 | read_form($rdr)]) } | |
90 | ||
fd637e03 JM |
91 | when(')') { die "unexpected ')'" } |
92 | when('(') { return read_list($rdr, 'List') } | |
93 | when(']') { die "unexpected ']'" } | |
94 | when('[') { return read_list($rdr, 'Vector', '[', ']') } | |
95 | when('}') { die "unexpected '}'" } | |
96 | when('{') { return read_list($rdr, 'HashMap', '{', '}') } | |
97 | default { return read_atom($rdr) } | |
b5dedee0 JM |
98 | } |
99 | } | |
100 | ||
101 | sub read_str { | |
102 | my($str) = @_; | |
103 | my @tokens = tokenize($str); | |
89bd4de1 JM |
104 | #print "tokens: " . Dumper(\@tokens); |
105 | if (scalar(@tokens) == 0) { die BlankException->new(); } | |
b5dedee0 JM |
106 | return read_form(Reader->new(\@tokens)); |
107 | } | |
108 | ||
109 | #print Dumper(read_str("123")); | |
110 | #print Dumper(read_str("+")); | |
111 | #print Dumper(read_str("\"abc\"")); | |
112 | #print Dumper(read_str("nil")); | |
113 | #print Dumper(read_str("true")); | |
114 | #print Dumper(read_str("false")); | |
115 | #print Dumper(read_str("(+ 2 3)")); | |
116 | #print Dumper(read_str("(foo 2 (3 4))")); | |
117 | ||
118 | 1; |