[13389] in Perl-Users-Digest
Perl-Users Digest, Issue: 799 Volume: 9
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Tue Sep 14 21:18:02 1999
Date: Tue, 14 Sep 1999 18:10:20 -0700 (PDT)
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)
Perl-Users Digest Tue, 14 Sep 1999 Volume: 9 Number: 799
Today's topics:
Lambda calculus stuff in Perl (Kragen Sitaker)
NDBM_File problem. <zigouras@mail.med.upenn.edu>
Re: Newbe question on Substitution <wih@ncgr.org>
Re: Newbe question on Substitution (Abigail)
Re: Perl / C Memory (Martien Verbruggen)
trimming spaces from a string <wellhaven@worldnet.att.net>
Unix and Perl script (Trevor Osatchuk)
Digest Administrivia (Last modified: 1 Jul 99) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Tue, 14 Sep 1999 23:26:24 GMT
From: kragen@dnaco.net (Kragen Sitaker)
Subject: Lambda calculus stuff in Perl
Message-Id: <AQAD3.11146$N77.842625@typ11.nn.bcandid.com>
Just sent this out to the kragen-hacks list.
To be clear, this post is NOT A QUESTION. I repeat: NOT A QUESTION. I
posted it because I thought some people here might enjoy it, and
perhaps discuss it a bit. But it works already. :)
(Well, actually, there are a couple of things I'm curious about.
What's the probability random_expr will recurse until I run out of
memory? What's the big O of the tokenization? But I can figure those
out myself, given time, although I wouldn't mind if someone commented.)
Here's something I hacked up while waiting for tapes to copy. Much of
it is inspired by exercises from _Essentials of Programming
Languages_.
It reads in expressions in the lambda calculus (in ASCII; you spell
'lambda' as ,\ and use strings of alphanumeric characters for variable
names and write application of function x to argument y as (x)y) from
standard input. As a special case, an input line saying 'random' will
be replaced with a randomly generated lambda expression.
Then it evaluates the expressions, using normal-order evaluation, and
prints out the evaluation sequence in TeX. (It stops after ten
reductions, as it is currently written.) It ends the output with \bye,
so the output can be run through TeX to be printed. However, it's easy
to make lambda expressions so wide that they will run off the right
side of the page.
I have included (but commented out the calls to) code to print out the
lambda expressions in the same ASCII format they're input in or as
Scheme or Perl expressions.
Some people might get pissed off at me for using lowercase class names
in Perl. Other people might get pissed off at me for interleaving the
code for the classes in a semi-random manner. Still other people might
get pissed off at me for including 'get' functions to get particular
attributes of the objects, when I didn't really have to. All of these
people might have good points.
BUGS:
- the TeX output is not ideal; I'd like the left and right parentheses
to get bigger as they go outward, and I probably should find some way
of stacking things.
- the alpha-renaming code doesn't check to see if the new variable name
it's picked happens to collide with existing free variables in the
affected region. It just hopes you don't use variable names like
g0039.
- some of the people I said above might be pissed off might be right.
- it doesn't notice if you add trailing junk on the input line after the
lambda expression.
- I don't know whether the parsing is linear-time in the size of the
input (as it should be), because I'm not sure about whether the s///
operations I'm using take time proportional to the size of the string.
If they do, the parsing is quadratic.
- the indentation is too deep.
- dying to indicate failure to reduce is too extreme. I should probably
return undef instead.
- some of the code is too far from the comments that explain it.
- I don't understand the conditions under which the random_expr code has
a finite probability of infinite recursion.
- the user interface totally stinks.
#!/usr/bin/perl -w
# stuff for manipulating lambda-expressions.
# a few basic things:
# - variable references;
# - lambdas;
# - applications.
package varref;
use strict;
# $str is the textual name of the variable.
sub new {
my ($class, $str) = @_;
return bless [$str], $class;
}
sub tex { return $_[0][0]; }
sub ascii { return $_[0][0]; }
sub scheme { return $_[0][0]; }
sub name { return $_[0][0]; }
sub perl { return '$' . $_[0][0]; }
package lambda;
use strict;
# $formal is the textual name of the variable.
# $body is a reference to the varref, app, or lambda that is the body
# of the lambda.
sub new {
my ($class, $formal, $body) = @_;
return bless [$formal, $body], $class;
}
sub tex {
my $self = shift;
return join '',
"\\lambda ",
$self->[0],
'.',
$self->[1]->tex();
}
sub ascii {
my $self = shift;
return join '',
",\\",
$self->[0],
'.',
$self->[1]->ascii();
}
sub scheme {
my $self = shift;
return join '', "(lambda (", $self->[0], ") ", $self->[1]->scheme(),
")";
}
sub perl {
my $self = shift;
return join '', 'sub { my $', $self->[0], ' = shift; return ',
$self->[1]->perl(), '; }';
}
sub formalname { $_[0][0] }
sub body { $_[0][1] }
package app;
use strict;
sub new {
my ($class, $rator, $rand) = @_;
return bless [$rator, $rand], $class;
}
sub tex {
my $self = shift;
return join '',
'\\left(',
$self->[0]->tex(),
'\\right)',
$self->[1]->tex();
}
sub ascii {
my $self = shift;
return join '',
'(',
$self->[0]->ascii(),
')',
$self->[1]->ascii();
}
sub scheme {
my $self = shift;
return join '', "(", $self->[0]->scheme(), " ", $self->[1]->scheme(),
")";
}
sub perl {
my $self = shift;
return join '', '(', $self->[0]->perl(), ')->(', $self->[1]->perl(),
')';
}
sub rator { $_[0][0] }
sub rand { $_[0][1] }
package main;
use strict;
# parse expressions written in the following grammar.
# expr ::= varref | lambda | app
# varref ::= (letters)
# lambda ::= ",\" varref "." expr
# app ::= "(" expr ")" expr
#
# This is the same grammar output by the 'ascii' methods.
#
# Each parse routine strips shit off the beginning of $expr.
# This means $expr must be passed around by reference.
sub parse_expr {
my ($expr) = @_;
if ($$expr =~ /^,\\/) {
return parse_lambda ($expr);
} elsif ($$expr =~ /^\(/) {
return parse_app ($expr);
} else {
return parse_varref ($expr);
}
}
sub parse_lambda {
my ($expr) = @_;
if ($$expr =~ s/^,\\(\w+)\.//) {
my $var = $1;
return new lambda ($var, parse_expr($expr));
} else {
die "Got bad lambda at beginning of $$expr\n";
}
}
sub parse_app {
my ($expr) = @_;
$$expr =~ s/^\(// or die "Missing ( at beginning of $$expr\n";
my $rator = parse_expr($expr);
$$expr =~ s/^\)// or die "Missing ) after operator: $$expr\n";
my $rand = parse_expr($expr);
return new app ($rator, $rand);
}
sub parse_varref {
my ($expr) = @_;
$$expr =~ s/^(\w+)// or die "missing varref in varref $$expr\n";
return new varref($1);
}
# A beta-reducible expression, or beta-redex, is of the form
# (,\x.y)z
# That is, it's an application whose operator is a lambda.
# Beta-reduction consists of replacing the whole thing with y, with
# free occurrences of x in y replaced with z, written y[z/x].
# But we must be careful to avoid variable capture.
# So a case-by-case definition:
# if y is a variable reference, then
# if y is not x, then y[z/x] is y.
# but if y is x, then y[z/x] is z.
# but if y is an application (a)b, then y[z/x] is (a[z/x])b[z/x].
# but if y is a lambda ,\a.b, then
# if a does not occur free in z, then y[z/x] is ,\a.b[z/x].
# but if a does occur free in z, then a must be renamed to some
# other variable c which doesn't occur free in z or in
# b. (This is called "alpha-renaming".) So we get
# ,\c.b[c/a] -- and then we apply [z/x], getting
# ,\c.b[c/a][z/x]. We can get c from a gensym sort of
# function.
{ my $num = '0000'; sub gensym { "g" . ++$num } }
#
# "x occurs free in y" if
# - y is a variable reference and x is y;
# - y is an application (a)b and x occurs free in a or b;
# - y is a lambda ,\a.b and x is not a and occurs free in b.
# In the following routines, $var is the textual name of the variable.
package varref;
sub occurs_free {
my ($self, $var) = @_;
return ($var eq $self->[0]);
}
sub substitute {
my ($self, $replacement, $var) = @_;
if ($self->[0] eq $var) {
return $replacement;
} else {
return $self;
}
}
package app;
sub occurs_free {
my ($self, $var) = @_;
return ($self->[0]->occurs_free($var)) ||
($self->[1]->occurs_free($var));
}
sub substitute {
my ($self, $replacement, $var) = @_;
return new app ($self->[0]->substitute($replacement, $var),
$self->[1]->substitute($replacement, $var));
}
package lambda;
sub occurs_free {
my ($self, $var) = @_;
if ($self->[0] eq $var) {
return 0;
} else {
return $self->[1]->occurs_free($var);
}
}
sub substitute {
my ($self, $replacement, $var) = @_;
if ($replacement->occurs_free($self->[0])) {
my $newvar = main::gensym();
return (new lambda(
$newvar,
$self->[1]->substitute(
new varref($newvar),
$self->[0]
)->substitute($replacement, $var)
))
} else {
return new lambda(
$self->[0],
$self->[1]->substitute($replacement, $var)
);
}
}
package main;
sub beta_redex {
my ($expr) = @_;
return ($expr->isa('app') and $expr->rator()->isa('lambda'));
}
sub beta_reduce {
my ($expr) = @_;
die "not a beta redex: " . $expr->ascii() if not beta_redex($expr);
return $expr->rator()->body()->substitute(
$expr->rand(), $expr->rator()->formalname());
}
# Be careful with this one. It obviously is not guaranteed to
# terminate; what's not obvious is the conditions under which it will
# probabilistically terminate. In particular, if the probability of
# the 'app' production is too high, the probability of termination
# can become finite.
#
sub random_expr;
sub random_expr {
my $r = rand;
my @vars = ('a'..'z');
return new varref ($vars[int rand @vars]) if ($r < 0.3);
return new app (random_expr, random_expr) if ($r < 0.5);
return new lambda ($vars[int rand @vars], random_expr);
}
# The probability of the lambda production terminating is the same as
# the probability of random_expr terminating.
# The probability of the varref production terminating is 1; it doesn't
# recurse.
# The probability of the app production terminating is the square of the
# probability of random_expr terminating.
# The probability of random_expr terminating is P(varref) * P(varref
# terminating) + P(app) * P(app terminating) + P(lambda) * P(lambda
# terminating).
# So P(random_expr terminating) = P(varref) + P(lambda) * P(random_expr
# terminating) + P(app) * P(random_expr terminating) * P(random_expr
# terminating).
# Say X for P(random_expr terminating), V for P(varref), L for
# P(lambda), and A for P(app). Then
# X = V + LX + AX^2
# So it's just a plain old quadratic equation; result is (-b +- sqrt(b^2
# - 4ac)) / 2a, or (-L +- sqrt(L^2 - 4 * A * V))/2A. In this case,
# that's (-0.5 +- sqrt(0.25 - 4 * 0.2 * 0.3)/(2 * 0.2)
# Unfortunately, this comes out to -1.5 and -1, which are obviously
# wrong. So I made a mistake somewhere in here.
# How to do normal-order reduction?
# Well, you can't do normal-order reduction on a variable reference.
# To do it on an application, first you try to beta-reduce the
# application; if that fails, you try to do it on the operator; if that
# fails, you try to do it on the operand; if that fails, you can't do
# it.
# To do it on a lambda, you try to do normal-order reduction on the
# body.
# Maybe I ought to use 'undef' or null here instead of dying.
package varref;
sub normal_order_reduce { die "can't reduce a variable\n" }
package app;
sub normal_order_reduce {
my ($self) = @_;
if (main::beta_redex($self)) {
return main::beta_reduce($self);
} else {
my $reduced_rator = eval { $self->[0]->normal_order_reduce() };
return new app ($reduced_rator, $self->[1]) unless $@;
my $reduced_rand = eval { $self->[1]->normal_order_reduce() };
return new app ($self->[0], $reduced_rand) unless $@;
die "Can't reduce this application\n";
}
}
package lambda;
sub normal_order_reduce {
my ($self) = @_;
return new lambda ($self->[0], $self->[1]->normal_order_reduce());
}
package main;
while (<>) {
chomp;
my $expr;
if ($_ eq 'random') {
$expr = random_expr;
} else {
$expr = eval { parse_expr \$_ };
if ($@) {
warn $@;
next;
}
}
# print "ASCII: ", $expr->ascii(), "\n";
# print "TeX: ", $expr->tex(), "\n";
# print "Scheme: ", $expr->scheme(), "\n";
# print "Perl: ", $expr->perl(), "\n";
# if (beta_redex($expr)) {
# print "beta-redex; reduces to ", beta_reduce($expr)->ascii(), "\n";
# }
for my $i (1..10) {
print '$$', $expr->tex(), '$$', "\n";
my $nexpr;
$nexpr = eval {$expr->normal_order_reduce()};
if ($@) {
print "\n\nThe expression cannot be reduced further.\n\n";
last;
} else {
$expr = $nexpr;
}
}
}
print "\\bye\n";
--
<kragen@pobox.com> Kragen Sitaker <http://www.pobox.com/~kragen/>
Tue Sep 14 1999
55 days until the Internet stock bubble bursts on Monday, 1999-11-08.
<URL:http://www.pobox.com/~kragen/bubble.html>
------------------------------
Date: Tue, 14 Sep 1999 20:55:50 -0400
From: Nico Zigouras <zigouras@mail.med.upenn.edu>
Subject: NDBM_File problem.
Message-Id: <Pine.OSF.4.05.9909142053350.13794-100000@mail.med.upenn.edu>
Hi:
I have some databases that need NDBM_File module to access them but the
version of Perl that came with RH Linux 6.0 doesn't seem to have it or let
my CGI access it.
I am trying to install a new Perl but getting errors when trying to load
NDBM_File.
Has anyone had problems with this module and have any suggestions?
Thanks in advance, please also respond to my email.
------------------------------
Date: Tue, 14 Sep 1999 17:10:06 -0600
From: wih <wih@ncgr.org>
Subject: Re: Newbe question on Substitution
Message-Id: <37DED5CE.AED570DC@ncgr.org>
Mike wrote:
> and this doesn't:
>
> $test = "Test string with path= c:\\path\\sub1\\sub2\\file.exe";
> $lookfor = "c:\\path\\sub1\\sub2";
> $subwith = "c:\\testpath";
>
> $test=~s/$lookfor/$subwith/;
>
> print $test;
>
> which outputs: Test string with path= c:\path\sub1\sub2\file.exe
It's substituting just fine.
In your case, when you print out the string contained in $test. The
interpreter actually sees the string $test as: Test string with path=
c:\\path\\sub1\\sub2\\file.exe
with the correct number of backslashes. BUT since you've fed the $test to a
print statement, it will interpret the \\ to mean print a single \ ...
wih
------------------------------
Date: 14 Sep 1999 19:27:40 -0500
From: abigail@delanet.com (Abigail)
Subject: Re: Newbe question on Substitution
Message-Id: <slrn7ttq4i.gcd.abigail@alexandra.delanet.com>
Mike (prNOSPAMesutti@atitech.ca) wrote on MMCCV September MCMXCIII in
<URL:news:R3AD3.14$Em1.109076@bunson.tor.sfl.net>:
""
"" $test = "Test string with path= c:\\path\\sub1\\sub2\\file.exe";
"" $lookfor = "c:\\path\\sub1\\sub2";
"" $subwith = "c:\\testpath";
""
"" $test=~s/$lookfor/$subwith/;
""
"" print $test;
""
"" which outputs: Test string with path= c:\path\sub1\sub2\file.exe
""
""
"" I'm using ActiveStates 516e distribution on a Win9x machine. Is there
"" something about double backslashes that the substitution expression doesn't
"" like?
No. It's because the substitution expression never *sees* the double
backslashes, just the single ones.
Try printing out $lookfor and $subwith before you do the substitution.
Then read up on the quotemeta function.
Abigail
--
perl -we 'print split /(?=(.*))/s => "Just another Perl Hacker\n";'
-----------== Posted via Newsfeeds.Com, Uncensored Usenet News ==----------
http://www.newsfeeds.com The Largest Usenet Servers in the World!
------== Over 73,000 Newsgroups - Including Dedicated Binaries Servers ==-----
------------------------------
Date: Tue, 14 Sep 1999 23:56:49 GMT
From: mgjv@comdyn.com.au (Martien Verbruggen)
Subject: Re: Perl / C Memory
Message-Id: <5hBD3.107$LN1.4551@nsw.nnrp.telstra.net>
In article <nmuD3.13465$wW2.11607@news.rdc1.ct.home.com>,
Dan Sugalski <dan@tuatha.sidhe.org> writes:
> And anonymous mmap looks to be a linux-only feature.
> since the feature you're looking at
> (anonymous mmap) is tagged as linux only.
\begin[unix]{offtopic}
That's not entirely true. Flavours of Unix that do anonymous mmaps that
I know of:
386BSD 0.0 +
4.3BSd (various flavours)
4.4BSD
NetBSD 1.2 +
FreeBSD (all versions I think)
OpenBSD (all versions I think)
I can't recall whether Ultrix had this or not, but I seem to vaguely
remember something about it, it's too long ago.
None of the SVR4 systems I know has anonymous mmaps.
The big presence of all sorts of BSDs is not a surprise, since most of
the ones above are based on each other (most are based on 4.4BSD), and
4.3BSD is the first one to have anonymous mmaps. I suspect that linux
actually borrowed this BSD-ism in recent times.
\end{offtopic}
Martien
PS. I'm not sure about the parentage of 386BSD, which may actually
have its roots in 4.3BSD.
--
Martien Verbruggen |
Interactive Media Division | Never hire a poor lawyer. Never buy
Commercial Dynamics Pty. Ltd. | from a rich salesperson.
NSW, Australia |
------------------------------
Date: Tue, 14 Sep 1999 21:02:09 -0400
From: "Dolly & Will Cardwell" <wellhaven@worldnet.att.net>
Subject: trimming spaces from a string
Message-Id: <7rmr41$4lv$1@bgtnsc01.worldnet.att.net>
#Given:
$s=' aa bcdef ';
$t='aa bcdef';
# I'd like them to match.
# That is, I want to match as though leading and and trailing spaces were
removed.
# For example:
if ( $s eq $t) { # This of course needs help
print "They match.\n";
}else{
print "They don't match.\n";
}
# -------------------------------------------------------
# While I have your attention, May I sneek in another?
# Feel free to leave one undone.
#Given:
$s='abc*def * ghi';
$sep='*'; # $sep may vary, and asterisk is a candidate.
@flds=split /$sep/, $s; # This won't split on * but works for non-spcl
chars
print "@flds\n";
# @flds = split /\*/, $s; # works OK - i.e. when the asterisk is a
literal
# but not .../\$sep/....
# Hope I have all more trivial bugs removed. Don't have my compiler
# readily available.
# Thank you so much for your help!
# Will Cardwell
#
------------------------------
Date: Tue, 14 Sep 1999 23:59:52 GMT
From: fybar@junctionnet.com (Trevor Osatchuk)
Subject: Unix and Perl script
Message-Id: <37dee0b6.441742882@news.telusplanet.net>
I am trying to write a backup script for a Unix machine using Perl as
I can only pass a finite number of filenames to a tar at a time. The
Unix command that I want to use is:
find ./usr -name "bin" -print > files.list
The best I can come up with is this:
open (FILES_LIST,"|find ./usr -name "bin" -print >files.list");
I have used the same type of command with an ls, but I cannot get the
syntax right for the find.
trev
------------------------------
Date: 1 Jul 99 21:33:47 GMT (Last modified)
From: Perl-Users-Request@ruby.oce.orst.edu (Perl-Users-Digest Admin)
Subject: Digest Administrivia (Last modified: 1 Jul 99)
Message-Id: <null>
Administrivia:
The Perl-Users Digest is a retransmission of the USENET newsgroup
comp.lang.perl.misc. For subscription or unsubscription requests, send
the single line:
subscribe perl-users
or:
unsubscribe perl-users
to almanac@ruby.oce.orst.edu.
To submit articles to comp.lang.perl.misc (and this Digest), send your
article to perl-users@ruby.oce.orst.edu.
To submit articles to comp.lang.perl.announce, send your article to
clpa@perl.com.
To request back copies (available for a week or so), send your request
to almanac@ruby.oce.orst.edu with the command "send perl-users x.y",
where x is the volume number and y is the issue number.
The Meta-FAQ, an article containing information about the FAQ, is
available by requesting "send perl-users meta-faq" from
almanac@ruby.oce.orst.edu. The real FAQ, as it appeared last in the
newsgroup, can be retrieved with the request "send perl-users FAQ" from
almanac@ruby.oce.orst.edu. Due to their sizes, neither the Meta-FAQ nor
the FAQ are included in the digest.
The "mini-FAQ", which is an updated version of the Meta-FAQ, is
available by requesting "send perl-users mini-faq" from
almanac@ruby.oce.orst.edu.
For other requests pertaining to the digest, send mail to
perl-users-request@ruby.oce.orst.edu. Do not waste your time or mine
sending perl questions to the -request address, I don't have time to
answer them even if I did know the answer.
------------------------------
End of Perl-Users Digest V9 Issue 799
*************************************
