File Coverage

blib/lib/Language/MinCaml/Lexer.pm
Criterion Covered Total %
statement 33 76 43.4
branch 18 50 36.0
condition n/a
subroutine 9 9 100.0
pod 0 2 0.0
total 60 137 43.8


line stmt bran cond sub pod time code
1             package Language::MinCaml::Lexer;
2 4     4   730 use strict;
  4         10  
  4         153  
3 4     4   25 use Carp;
  4         11  
  4         298  
4 4     4   23 use IO::File;
  4         8  
  4         753  
5 4     4   4028 use Readonly;
  4         15905  
  4         220  
6 4     4   2387 use Language::MinCaml::Token;
  4         13  
  4         51  
7 4     4   2720 use Language::MinCaml::Type;
  4         12  
  4         32  
8 4     4   2980 use Language::MinCaml::Util;
  4         12  
  4         7937  
9              
10             Readonly my %keywords
11             => (true => \&Token_BOOL, false => \&Token_BOOL, not => \&Token_NOT,
12             if => \&Token_IF, then => \&Token_THEN, else => \&Token_ELSE,
13             let => \&Token_LET, in => \&Token_IN, rec => \&Token_REC);
14              
15             sub new {
16 3     3 0 14 my($class, $code) = @_;
17 3         113 bless { code => $code }, $class;
18             }
19              
20             sub next_token {
21 2     2 0 6 my $self = shift;
22 2         14 my $buffer = $self->{code}->buffer;
23 2         4 my $token;
24             my $value;
25              
26 2         25 while ($buffer =~ /^\s+/) {
27 0         0 $self->{code}->forward(length($&));
28 0         0 $buffer = $self->{code}->buffer;
29             }
30              
31 2 100       37 if ($buffer =~ /^\d+(\.\d*)?([eE][+\-]?\d+)?/) {
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    0          
    0          
32 1         3 $value = $&;
33 1 50       21 $token = $value =~ /[.eE]/ ? Token_FLOAT($value) : Token_INT($value);
34             }
35             elsif ($buffer =~ /^\(/) {
36 0         0 $value = '(';
37 0         0 $token = Token_LPAREN();
38             }
39             elsif ($buffer =~ /^\)/) {
40 0         0 $value = ')';
41 0         0 $token = Token_RPAREN();
42             }
43             elsif ($buffer =~ /^\+\.?/) {
44 0         0 $value = $&;
45 0 0       0 $token = $value eq '+.' ? Token_PLUS_DOT() : Token_PLUS();
46             }
47             elsif ($buffer =~ /^-\.?/) {
48 0         0 $value = $&;
49 0 0       0 $token = $value eq '-.' ? Token_MINUS_DOT() : Token_MINUS();
50             }
51             elsif ($buffer =~ /^\*\./) {
52 0         0 $value = '*.';
53 0         0 $token = Token_AST_DOT();
54             }
55             elsif ($buffer =~ /^\/\./) {
56 0         0 $value = '/.';
57 0         0 $token = Token_SLASH_DOT();
58             }
59             elsif ($buffer =~ /^=/) {
60 0         0 $value = '=';
61 0         0 $token = Token_EQUAL();
62             }
63             elsif ($buffer =~ /^<[>=\-]?/) {
64 0         0 $value = $&;
65 0 0       0 if ($value eq '<>') {
    0          
    0          
66 0         0 $token = Token_LESS_GREATER();
67             }
68             elsif ($value eq '<=') {
69 0         0 $token = Token_LESS_EQUAL();
70             }
71             elsif ($value eq '<-') {
72 0         0 $token = Token_LESS_MINUS();
73             }
74             else {
75 0         0 $token = Token_LESS();
76             }
77             }
78             elsif ($buffer =~ /^>=?/) {
79 0         0 $value = $&;
80 0 0       0 $token = $value eq '>=' ? Token_GREATER_EQUAL() : Token_GREATER();
81             }
82             elsif ($buffer =~ /^,/) {
83 0         0 $value = ',';
84 0         0 $token = Token_COMMA();
85             }
86             elsif ($buffer =~ /^_/) {
87 0         0 $value = '_';
88 0         0 $token = Token_IDENT(create_temp_ident_name(Type_Unit()));
89             }
90             elsif ($buffer =~ /^\./) {
91 0         0 $value = '.';
92 0         0 $token = Token_DOT();
93             }
94             elsif ($buffer =~ /^;/) {
95 0         0 $value = ';';
96 0         0 $token = Token_SEMICOLON();
97             }
98             elsif ($buffer =~ /^[a-z][0-9a-zA-Z_]*/) {
99 1         4 $value = $&;
100 1 50       9 if (exists $keywords{$value}) {
101 0         0 $token = &{$keywords{$value}}($value);
  0         0  
102             }
103             else {
104 1         32 $token = Token_IDENT($value);
105             }
106             }
107             elsif ($buffer =~ /^Array\.create/) {
108 0           $value = 'Array.create';
109 0           $token = Token_ARRAY_CREATE();
110             }
111             elsif ($buffer eq q{}) {
112 0           $value = q{};
113 0           $token = Token_EOF();
114             }
115             else {
116 0           croak "Unknown token at line $self->{code}->{line}, column $self->{code}->{column} in input.";
117             }
118              
119 0           $token->line($self->{code}->line);
120 0           $token->column($self->{code}->column);
121 0           $self->{code}->forward(length($value));
122 0           $token;
123             }
124              
125             1;