madmaurice/Minilisp.pm
1
1
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

Add debug mode for lexer

Browse source
This commit is contained in:
madmaurice 2021-04-08 23:32:53 +02:00
parent cf9f90c19b
commit 4aaff13d91
1 changed files with 19 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

19
lib/Minilisp.pm
View file

@ -34,26 +34,42 @@ sub tokenize {
$str =~ s/^\s+//; $str =~ s/^\s+//;
$str =~ s/\s+$//; $str =~ s/\s+$//;
my $debug = sub {};
$debug = sub {
my $msg = shift;
my $strcpy = $str;
$strcpy =~ s/^/ /mg;
print "-- $msg\n$strcpy\n";
} if !!$ENV{LEXER_DEBUG};
$debug->("Begin parsing");
while ($str) while ($str)
{ {
if ($str =~ s/^;.*\n//) if ($str =~ s/^;.*\n//)
{ {
$debug->("Comment");
# Comment. do nothing # Comment. do nothing
} }
elsif ($str =~ s/^\(//) elsif ($str =~ s/^\(//)
{ {
$debug->("Left parenthesis");
push @tokens, { type => LPAREN }; push @tokens, { type => LPAREN };
} }
elsif($str =~ s/^\)//) elsif($str =~ s/^\)//)
{ {
$debug->("Right parenthesis");
push @tokens, { type => RPAREN }; push @tokens, { type => RPAREN };
} }
elsif($str =~ s/^'\(//) # short notation for lists elsif($str =~ s/^'\(//) # short notation for lists
{ {
$debug->("Short list");
push @tokens, { type => LIST }, { type => LPAREN }; push @tokens, { type => LIST }, { type => LPAREN };
} }
elsif($str =~ s/^'([^\s()"]+)//) elsif($str =~ s/^'([^\s()"]+)//)
{ {
$debug->("Keyword $1");
push @tokens, { push @tokens, {
type => KEYWORD, type => KEYWORD,
value => $1, value => $1,
@ -61,6 +77,7 @@ sub tokenize {
} }
elsif($str =~ s/^"(([^"\\]|\\.)+)"//) elsif($str =~ s/^"(([^"\\]|\\.)+)"//)
{ {
$debug->("String '$1'");
my $value = $1; my $value = $1;
my %special_chars = ( my %special_chars = (
@ -86,6 +103,7 @@ sub tokenize {
} }
elsif($ident =~ /^-?([0-9]+|[0-9]*\.[0-9]*)$/) elsif($ident =~ /^-?([0-9]+|[0-9]*\.[0-9]*)$/)
{ {
$debug->("Number '$1'");
if($ident =~ s/^-//) if($ident =~ s/^-//)
{ {
$ident = 0 - $ident; $ident = 0 - $ident;
@ -98,6 +116,7 @@ sub tokenize {
} }
else else
{ {
$debug->("Identifier '$1'");
push @tokens, { push @tokens, {
type => IDENT, type => IDENT,
value => $ident, value => $ident,