Wednesday, January 14, 2009

Higher Order Perl (Python Style) : Chapter 2


#
# Dispatch Tables
#

# sub read_config {
# my ($filename) = @_;
# open my($CF), $filename or return; # Failure
# while (<$CF>) {
# chomp;
# my ($directive, $rest) = split /\s+/, $_, 2;
# if ($directive eq 'CHDIR') {
# chdir($rest) or die "Couldn't chdir to '$rest': $!; aborting";
# } elsif ($directive eq 'LOGFILE') {
# open STDERR, ">>", $rest
# or die "Couldn't open log file '$rest': $!; aborting";
# } elsif ($directive eq 'VERBOSITY') {
# $VERBOSITY = $rest;
# } elsif ($directive eq ...) {
# ...
# } ...
# } else {
# die "Unrecognized directive $directive on line $. of $filename; aborting";
# }
# }
# return 1; # Success
# }
def read_config(filename):
global VERBOSITY
for i, line in enumerate(file(filename)):
line = line.strip()
directive, rest = line.split(None, 1)
try:
if directive == "CHDIR":
os.chdir(rest)
elif directive == "LOGFILE":
sys.stderr = file(rest, "w")
elif directive == "VERBOSITY":
VERBOSITY = rest
elif directive == ...:
...
else:
sys.exit("Unrecognized directive %s in line %s of %s; aborting" % (directive, i, filename))
except StandardError, why:
sys.exit(why)
return 1 # success


# sub read_config {
# my ($filename, $actions) = @_;
# open my($CF), $filename or return; # Failure
# while (<$CF>) {
# chomp;
# my ($directive, $rest) = split /\s+/, $_, 2;
# if (exists $actions->{$directive}) {
# $actions->{$directive}->($rest);
# } else {
# die "Unrecognized directive $directive on line $. of $filename; aborting";
# }
# }
# return 1; # Success
# }
def read_config(filename, actions):
for i, line in enumerate(file(filename)):
line = line.strip()
directive, rest = line.split(None, 1)
if directive in actions:
actions[directive](rest)
else:
sys.exit("Unrecognized directive %s in line %s of %s; aborting" % (directive, i, filename))
return 1 # success

# $dispatch_table =
# { CHDIR => \&change_dir,
# LOGFILE => \&open_log_file,
# VERBOSITY => \&set_verbosity,
# ... => ...,
# };
dispatch_table = {
"CHDIR" : change_dir,
"LOGFILE" : open_log_file,
"VERBOSITY" : set_verbosity,
... : ...,
}

# sub change_dir {
# my ($dir) = @_;
# chdir($dir)
# or die "Couldn't chdir to '$dir': $!; aborting";
# }
# sub open_log_file {
# open STDERR, ">>", $_[0]
# or die "Couldn't open log file '$_[0]': $!; aborting";
# }
# sub set_verbosity {
# $VERBOSITY = shift
# }
def change_dir(dir):
try:
os.chdir(dir)
except OSError, why:
sys.exit(why)
def open_log_file(log_file):
try:
sys.stderr = file(log_file, "w")
except OSError, why:
sys.exit(why)
def set_verbosity(verbosity):
global VERBOSITY
VERBOSITY = verbosity

# $dispatch_table =
# { CHDIR => sub { my ($dir) = @_;
# chdir($dir) or
# die "Couldn't chdir to '$dir' $!; aborting";
# :
# },
# LOGFILE => sub { open STDERR, ">>", $_[0] or
# die "Couldn't open log file '$_[0]': $!; aborting";
# },
# VERBOSITY => sub { $VERBOSITY = shift },
# ... => ...,
# };

# This doesn't map well since lambda doesn't allow
# statements.


# 'DEFINE' => \&define_config_directive,
"DEFINE" : define_config_directive,

# sub define_config_directive {
# my $rest = shift;
# $rest =~ s/∧ \s+//;
# my ($new_directive, $def_txt) = split /\s+/, $rest, 2;
# if (exists $CONFIG_DIRECTIVE_TABLE{$new_directive}) {
# warn "$new_directive already defined; skipping.\n";
# return;
# }
# my $def = eval "sub { $def_txt }";
# if (not defined $def) {
# warn "Could not compile definition for '$new_directive': $@; skipping.\n";
# return;
# }
# $CONFIG_DIRECTIVE_TABLE{$new_directive} = $def;
# }

def define_config_directive(rest):
rest = rest.strip()
new_directive, def_txt = rest.split(None, 1)

if new_directive in CONFIG_DIRECTIVE_TABLE:
print "%s already defined; skipping." % new_directive
return

try:
_def = eval("""lambda x: %s""" % def_txt)
except StandardError, why:
print "Could not compile definition for '%s': %s" % (new_directive, why)
return

CONFIG_DIRECTIVE_TABLE[new_directive] = _def


# This doesn't map well to the python way of doing things since
# lambdas are sort of limited. Instead we would
# probably just define the functions with a name directly.
# On the other hand if you really must doing everything "lambda style"
# you can probably get farther than you'd first guess with clever uses
# of and/or connectors in your lambda expression


# sub read_config {
# my ($filename, $actions) = @_;
# open my($CF), $filename or return; # Failure
# while (<$CF>) {
# chomp;
# my ($directive, $rest) = split /\s+/, $_, 2;
# if (exists $actions->{$directive}) {
# $actions->{$directive}->($rest, $actions);
# } else {
# die "Unrecognized directive $directive on line $. of $filename; aborting";
# }
# }
# return 1; # Success
# }
def read_config(filename, actions):
for i, line in enumerate(file(filename)):
line = line.strip()
directive, rest = line.split(None, 1)
if directive in actions:
actions[directive](rest, actions)
else:
sys.exit("Unrecognized directive %s in line %s of %s; aborting" % (directive, i, filename))
return 1 # success


# sub define_config_directive {
# my ($rest, $dispatch_table) = @_;
# $rest =~ s/∧ \s+//;
# my ($new_directive, $def_txt) = split /\s+/, $rest, 2;
# if (exists $dispatch_table->{$new_directive}) {
# warn "$new_directive already defined; skipping.\n";
# return;
# }
# my $def = eval "sub { $def_txt }";
# if (not defined $def) {
# warn "Could not compile definition for '$new_directive': $@; skipping.\n";
# return;
# }
# $dispatch_table->{$new_directive} = $def;
# }
def define_config_directive(rest, dispatch_table):
rest = rest.strip()
new_directive, def_txt = rest.split(None, 1)

if new_directive in dispatch_table:
print "%s already defined; skipping." % new_directive
return

try:
_def = eval("""lambda x: %s""" % def_txt)
except StandardError, why:
print "Could not compile definition for '%s': %s" % (new_directive, why)
return

dispatch_table[new_directive] = _def



# sub read_config {
# my ($filename, $actions, $user_param) = @_;
# open my($CF), $filename or return; # Failure
# while (<$CF>) {
# my ($directive, $rest) = split /\s+/, $_, 2;
# if (exists $actions->{$directive}) {
# $actions->{$directive}->($rest, $user_param, $actions);
# } else {
# die "Unrecognized directive $directive on line $. of $filename; aborting";
# }
# }
# return 1; # Success
# }
def read_config(filename, actions, user_param):
for i, line in enumerate(file(filename)):
line = line.strip()
directive, rest = line.split(None, 1)
if directive in actions:
actions[directive](rest, user_param, actions)
else:
sys.exit("Unrecognized directive %s in line %s of %s; aborting" % (directive, i, filename))
return 1 # success

#read_config($filename, $dispatch_table, \@dirs);
read_config(filename, dispatch_table, dirs)

#read_config($filename, $dispatch_table, []);
read_config(filename, dispatch_table, [])


# sub read_config {
# my ($filename, $actions, $user_param) = @_;
# open my($CF), $filename or return; # Failure
# while (<$CF>) {
# my ($directive, $rest) = split /\s+/, $_, 2;
# if (exists $actions->{$directive}) {
# $actions->{$directive}->($directive, $rest, $actions, $user_param);
# } else {
# die "Unrecognized directive $directive on line $. of $filename; aborting";
# }
# }
# return 1; # Success
# }
def read_config(filename, actions, user_param):
for i, line in enumerate(file(filename)):
line = line.strip()
directive, rest = line.split(None, 1)
if directive in actions:
actions[directive](directive, rest, user_param, actions)
else:
sys.exit("Unrecognized directive %s in line %s of %s; aborting" % (directive, i, filename))
return 1 # success


# sub set_var {
# my ($var, $val) = @_;
# $$var = $val;
# }
# OK, this is pretty unnatural at this point
# we would almost certianly work instead with a
# global or passed in dictionary
# (not tested)
def set_var(var, val):
exec "global %s" % var
exec "%s = %r" % (var, val)


# sub set_var {
# my ($var, $val, undef, $config_hash) = @_;
# $config_hash->{$var} = $val;
# }
def set_var(var, val, _, config_hash):
config_hash[var] = val



# sub open_input_file {
# my ($handle, $filename) = @_;
# unless (open $handle, $filename) {
# warn "Couldn't open $handle file '$filename': $!; ignoring.\n";
# }
# }
# yet more unnatural hackery (not tested)
# again, we'd probably work with a global or passed in dictionary
def open_input_file(handle, filename):
exec "global %s" % handle
exec """
try:
%s = file('%s')
except StandardError, why:
print "Counldn't open %s file '%s': %%s; ignoring." %% why
return """ % (handle, filename, handle, filename)


# sub read_config {
# my ($filename, $actions, $userparam) = @_;
# open my($CF), $filename or return; # Failure
# while (<$CF>) {
# chomp;
# my ($directive, $rest) = split /\s+/, $_, 2;
# my $action = $actions->{$directive} || $actions->{_DEFAULT_};
# if ($action) {
# $action->($directive, $rest, $actions, $userparam);
# } else {
# die "Unrecognized directive $directive on line $. of $filename; aborting";
# }
# }
# return 1; # Success
# }
def read_config(filename, actions, user_param):
for i, line in enumerate(file(filename)):
line = line.strip()
directive, rest = line.split(None, 1)
action = actions[directive] or actions["__DEFAULT__"]
if action:
action[directive](directive, rest, user_param, actions)
else:
sys.exit("Unrecognized directive %s in line %s of %s; aborting" % (directive, i, filename))
return 1 # success

# sub no_such_directive {
# my ($directive) = @_;
# warn "Unrecognized directive $directive at line $.; ignoring.\n";
# }
# python doesn't have a trivial way to get the line number
# so we leave that out, but may get close with inspect
def no_such_directive(directive):
print "Unrecognized directive %s; ignoring." % directive

# sub no_such_directive {
# my ($bad, $rest, $table) = @_;
# my ($best_match, $best_score);
# for my $good (keys %$table) {
# my $score = score_match($bad, $good);
# if ($score > $best_score) {
# $best_score = $score;
# $best_match = $good;
# }
# }
# warn "Unrecognized directive $bad at line $.;\n";
# warn "\t(perhaps you meant $best_match?)\n";
# }
def no_such_directive(bad, rest, table):
best_match = None
best_score = 0

for good in table:
score = score_match(bad, good)
if score > best_score:
best_score = score
best_match = good

print "Unrecognized directive %s." % bad
print "\t(perhaps you meant %s?)" % best_match


# $address_actions =
# { _DEFAULT_ => sub { my ($id, $addr, $act, $aref) = @_;
# push @$aref, [$id, $addr];
# },
# };
# read_config($ADDRESS_FILE, $address_actions, \@address_array);
address_actions = {
"__DEFAULT__" : lambda id, addr, act, aref: aref.append([id, addr])
}
read_config(ADDRESS_FILE, address_actions, address_array)


# my $result = evaluate($ARGV[0]);
# print "Result: $result\n";
# sub evaluate {
# my @stack;
# my ($expr) = @_;
# my @tokens = split /\s+/, $expr;
# for my $token (@tokens) {
# if ($token =~ /∧ \d+$/) { # It's a number
# push @stack, $token;
# } elsif ($token eq '+') {
# push @stack, pop(@stack) + pop(@stack);
# } elsif ($token eq '-') {
# my $s = pop(@stack);
# push @stack, pop(@stack) - $s
# } elsif ($token eq '*') {
# push @stack, pop(@stack) * pop(@stack);
# } elsif ($token eq '/') {
# my $s = pop(@stack);
# push @stack, pop(@stack) / $s
# } else {
# die "Unrecognized token '$token'; aborting";
# }
# }
# return pop(@stack);
# }
result = evaluate(sys.argv[1])
print "Result: %s" % result
def evaluate(expr):
stack = []
tokens = expr.split()
for token in tokens:
if token.isdigit():
stack.insert(0, int(token))
elif token == "+":
stack.insert(0, (stack.pop(0) + stack.pop(0)))
elif token == "-":
s = stack.pop(1)
stack.insert(0, (stack.pop(0) - s))
elif token == "*":
stack.insert(0, (stack.pop(0) * stack.pop(0)))
elif token == "/":
s = stack.pop(1)
stack.insert(0, (stack.pop(0) / s))
else:
sys.exit("Unrecognized toke '%s'; aborting" % token)
return stack.pop(0)



# my @stack;
# my $actions = {
# '+' => sub { push @stack, pop(@stack) + pop(@stack) },
# '*' => sub { push @stack, pop(@stack) * pop(@stack) },
# '-' => sub { my $s = pop(@stack); push @stack, pop(@stack) - $s },
# '/' => sub { my $s = pop(@stack); push @stack, pop(@stack) / $s },
# 'NUMBER' => sub { push @stack, $_[0] },
# '_DEFAULT_' => sub { die "Unrecognized token '$_[0]'; aborting" }
# };
# my $result = evaluate($ARGV[0], $actions);
# print "Result: $result\n";
# sub evaluate {
# my ($expr, $actions) = @_;
# my @tokens = split /\s+/, $expr;
#
# for my $token (@tokens) {
# my $type;
# if ($token =~ /∧ \d+$/) { # It's a number
# $type = 'NUMBER';
# }
# my $action = $actions->{$type}
# || $actions->{$token}
# || $actions->{_DEFAULT_};
# $action->($token, $type, $actions);
# }
# return pop(@stack);
# }
stack = []
actions = {
"+" : (lambda *x: stack.insert(0, stack.pop(0) + stack.pop(0))),
"-" : (lambda *x: stack.insert(0, -stack.pop(0) + stack.pop(0))),
"*" : (lambda *x: stack.insert(0, stack.pop(0) * stack.pop(0))),
"/" : (lambda *x: stack.insert(0, (1/stack.pop(0)) * stack.pop(0))),
"NUMBER" : (lambda *x: stack.insert(0, int(x[0]))),
"__DEFAULT__" : (lambda *x: sys.exit("Unrecognized token '%s'; aborting" % x[0]))
}

result = evaluate(sys.argv[1], actions)
print "Result: %s" % result
def evaluate(expr, actions):
tokens = expr.split()

for token in tokens:
type = None
if token.isdigit():
type = "NUMBER"
action = actions.get(type or token) or actions["__DEFAULT__"]
action(token, type, actions)
return stack.pop(0)


#sqrt' => sub { push @stack, sqrt(pop(@stack)) },
"sqrt" : (lambda *x: stack.insert(0, math.sqrt(stack.pop(0))))

# my $actions = {
# 'NUMBER' => sub { push @stack, $_[0] },
# '_DEFAULT_' => sub { my $s = pop(@stack);
# push @stack,
# [ $_[0], pop(@stack), $s ]
# },
# };
actions = {
"NUMBER" : (lambda *x: stack.insert(0, int(x[0]))),
"__DEFAULT__" : (lambda *x: stack.insert(0, [x[0], stack.pop(1), stack.pop(0)]))
}


# sub AST_to_string {
# my ($tree) = @_;
# if (ref $tree) {
# my ($op, $a1, $a2) = @$tree;
# my ($s1, $s2) = (AST_to_string($a1),
# AST_to_string($a2));
# "($s1 $op $s2)";
# } else {
# $tree;
# }
# }
def AST_to_string(tree):
if tree:
op, a1, a2 = tree
s1, s2 = AST_to_string(a1), AST_to_string(a2)
return "%s %s %s" % (s1, op, s2)
else:
return tree

# sub elementfunc {
# my $table = { h1 => sub { shift; my $text = join '', @_;
# print $text; return $text ;
# }
# _DEFAULT_ => sub { shift; my $text = join '', @_;
# return $text ;
# };
# my ($element) = @_;
# my $tag = $element->{_tag};
# my $action = $table->{$tag} || $table{_DEFAULT_};
# return $action->(@_);
# }
def elementfunc(element):
table = {"h1" : (lambda html, results: "".join(results)),
"__DEFAULT__" : (lambda html, results: "".join(results))}

tag = element["_tag"]
action = table.get(tag) or table["__DEFAULT__"]
return action(element)



# sub walk_html {
# my ($html, $textfunc, $elementfunc_table) = @_;
# return $textfunc->($html) unless ref $html; # It's a plain string
# my ($item, @results);
# for $item (@{$html->{_content}}) {
# push @results, walk_html($item, $textfunc, $elementfunc_table);
# }
# my $tag = $html->{_tag};
# my $elementfunc = $elementfunc_table->{$tag}
# || $elementfunc_table->{_DEFAULT_}
# || die "No function defined for tag '$tag'";
# return $elementfunc->($html, @results);
# }
def walk_html(html, textfunc, elementfunc_table):
if type(html) == str:
return textfunc(html)

results = []
for item in html["_content"]:
results.append(walk_html(item, textfunc, elementfunc_table))

tag = html["_tag"]
elementfunc = elementfunc_table.get(tag) or elementfunc_table.get("__DEFAULT__")
if not elementfunc:
sys.exit("No function defined for tag '%s'" % tag)
return elementfunc(html, results)


# sub walk_html {
# my ($html, $textfunc, $elementfunc, $userparam) = @_;
# return $textfunc->($html, $userparam) unless ref $html;
# my ($item, @results);
# for $item (@{$html->{_content}}) {
# push @results, walk_html($item, $textfunc, $elementfunc, $userparam);
# }
# return $elementfunc->($html, $userparam, @results);
# }
def walk_html(html, textfunc, elementfunc, userparam):
if type(html) == str:
return textfunc(html)

results = []
for item in html["_content"]:
results.append(walk_html(item, textfunc, elementfunc, userparam))

return elementfunc(html, results, userparam)

# walk_html($html_text,
# # $textfunc
# sub { my ($text, $aref) = @_;
# push @$aref, $text },
# # $elementfunc does nothing
# sub { },
# # user parameter
# \@text_array
# );
def walk_html(html_text,
lambda text, aref: aref.append(text),
lambda x,y: [],
text_array)

No comments: