###############################################################################
# Use clauses
#
# Strict variable scopes
use strict;
# Calculate using integers rather than floating point numbers
use integer;
# Use structs
use Class::Struct;
###############################################################################
# Data type definitions
#
# Token structure
#
# Every token has an type. Additionally, the token may
# include additional information such as the name of a symbol or the value
# of an integer. To save such information the tokenizer will use the value
# field of the struct.
struct( token => {
type => '$',
value => '$',
});
###############################################################################
# Global variables
# Symbol table. Maps characters to integer values.
my %symtable;
# Output of the tokenizer is saved in this list that shall contain token
# structs (defined above) only
my @tokens;
# Global iterator (integer) to the @tokens array
my $itoken = 0;
# Token types as enumerables
use constant COMMA => 1;
use constant DOT => 2;
use constant ID => 3;
use constant EQUALS => 4;
use constant PLUS => 5;
use constant MINUS => 6;
use constant MULTIPLY => 7;
use constant DIVIDE => 8;
use constant INTEGER => 9;
use constant RPAREN => 10;
use constant LPAREN => 11;
# Mapping between token identifiers and symbols that represent them in the
# language
my %tokenmap = (
',' => COMMA,
'.' => DOT,
'=' => EQUALS,
'+' => PLUS,
'-' => MINUS,
'*' => MULTIPLY,
'/' => DIVIDE,
')' => RPAREN,
'(' => LPAREN,
);
###############################################################################
# Main routine
print "*" x 80;
print "/prog/ language interpreter by Anonymous\n";
print "Type a program and press enter. To quit, press Ctrl-C (EOF)\n";
print "*" x 80;
print "\n\n";
print "> ";
while (<STDIN>) {
cleanup();
tokenize($_);
eval_program();
print "> ";
}
###############################################################################
# Subroutines
#
# tokenize
#
# Input: an expression as a scalar
# Return value: none
# Description: fills the array @array with token structs according to the input
sub tokenize {
chomp;
my $input = $_;
while ($input) {
# Match integers, identifiers and symbols and create an appropriate
# token with a identifier and value. Value of value is zero
# if the token is an operator.
my $token = new token;
if ($input =~ /^([0-9]+)/) {
# This token is an integer
$token->type(INTEGER);
$token->value($1);
} elsif ($input =~ /^([a-z])/) {
# This token is an identifier
$token->type(ID);
$token->value($1);
} elsif ($input =~ /^(.)/) {
# This is an operator...
if (exists($tokenmap{$1})) {
$token->type($tokenmap{$1});
$token->value($1);
} else {
# ...or garbage
die "Unrecognized token: \"$1\".\n";
}
}
# Insert token in the list
$tokens[@tokens] = $token;
# Skip over the part that was just tokenized
$input = $';
}
}
################################################################################
# read_token_id
#
# Input: none
# Return value: returns the identifier of the current token
# Description: -
sub read_token_id {
return $tokens[$itoken]->type;
}
###############################################################################
#
# read_token_val
#
# Input: none
# Return value: returns the value of the current token
# Description: -
sub read_token_val {
return $tokens[$itoken]->value;
}
###############################################################################
#
# next_token
#
# Input: none
# Return value: none
# Description: increments the variable that points to a token
sub next_token {
$itoken++;
if ($itoken >= @tokens) {
die "Unexpected end of input.\n";
}
}
###############################################################################
#
# previous_token
#
# Input: none
# Return value: none
# Description: decrements the variable that points to a token
sub previous_token {
$itoken--;
# Caller of this function takes responsibility that $itoken >= holds
# before any token is read.
}
###############################################################################
#
# eval_program
#
# Input: none
# Output: none
# Description: evaluates a program
sub eval_program {
my $result_as_string;
# Evaluate the first expression (mandatory) and print its result
my $result = eval_expr();
$result_as_string = $result;
my $more_blocks = 1;
while ($more_blocks) {
# Another expression in the program separated by a comma may exist.
# If there is no expression, the program must end to a dot.
if (read_token_id() == DOT) {
$more_blocks = 0;
} elsif (read_token_id() == COMMA) {
next_token();
$result = eval_expr();
$result_as_string = $result_as_string . ", " . "$result";
}
}
print "$result_as_string\n";
}
###############################################################################
#
# eval_expr
#
# Input: none
# Output: integer value of the expression
# Description: parses and evaluates the value of an expression
sub eval_expr {
# Var. value will used in the calculation of this block's value and will
# in the end of this subprocedure hold that particular result
my $value;
# Var. assignee holds the name of the symbol that might be assigned
# a value in this block
my $assignee;
if (read_token_id() == ID) {
# Assignment might take place in this block. Save the name of the
# identifier that might be assigned.
$assignee = read_token_val();
next_token();
if (read_token_id() == EQUALS) {
# Assignment will take place in this block
next_token();
} else {
# Assignment won't take place! Backtrack by one token.
$assignee = 0;
previous_token();
}
}
# Evaluate first term (mandatory)
$value = eval_term();
# The value of the first term may be subjected to addition or subtraction
while (read_token_id() == PLUS || read_token_id() == MINUS) {
if (read_token_id() == PLUS) {
# Addition
next_token();
$value = $value + eval_term();
} elsif (read_token_id() == MINUS) {
# Subtraction
next_token();
$value = $value - eval_term();
}
}
# Assign the value of the block to an identifier if one was specified.
# The result will be stored in the symtable.
if ($assignee) {
$symtable{$assignee} = $value;
}
return $value;
}
###############################################################################
#
# eval_term
#
# Input: none
# Output: integer value of the term
# Description: passes and evaluates the value of a term
sub eval_term() {
# Term will consist of at least one factor
my $value = eval_factor();
# The factor might be subjected to multiplication or divsion operations
# with other factors.
while (read_token_id() == MULTIPLY || read_token_id() == DIVIDE) {
if (read_token_id() == MULTIPLY) {
# Multiplication required
next_token();
$value = $value * eval_factor();
} elsif (read_token_id() == DIVIDE) {
# Division required
next_token();
my $divisor = eval_factor();
die "Division by zero.\n" if !$divisor;
$value = $value / $divisor;
}
}
return $value;
}
###############################################################################
#
# eval_factor
#
# Input: none
# Output: integer value of the factor
# Description: passes and evaluates the value of a factor
sub eval_factor() {
my $value;
# Factor can be an integer, an identifier or an expression surrounded
# by parentheses.
if (read_token_id() == INTEGER) {
$value = read_token_val();
next_token();
} elsif (read_token_id() == ID) {
my $identifier = read_token_val();
next_token();
if (exists($symtable{$identifier})) {
$value = $symtable{$identifier};
} else {
die "Undefined identifier \"$identifier\".\n";
}
} elsif (read_token_id() == LPAREN) {
next_token();
$value = eval_expr();
# A matching left parentheses must be found
die "Unmatched parentheses.\n" if read_token_id() != RPAREN;
next_token();
} else {
my $unexpected = read_token_val();
die "Syntax error: '$unexpected' unexpected\n";
}
return $value;
}
###############################################################################
#
# cleanup
#
# Input: none
# Output: none
# Description: initializes global variables to zeroes or empties them
sub cleanup {
# Initialize global variables
$itoken = 0;
@tokens = ();
%symtable = ();
}
###############################################################################
# End of file
Name:
Anonymous2009-09-02 16:16
actual useful comments in my anon's code? it's moar leikly than you think