chrislo-sourceclassifier 0.2.0 → 0.2.1

data/sources/perl/ackermann.perl-2.perl

@@ -1,25 +0,0 @@
-#!/usr/bin/perl
-# $Id: ackermann.perl-2.perl,v 1.1 2005-04-04 14:56:35 bfulgham Exp $
-# http://www.bagley.org/~doug/shootout/
-
-# With help from Ernesto Hernandez-Novich
-use integer;
-
-# Note:  If memoization were allowed in this program, we could
-# do so by adding:
-use Memoize;
-memoize("Ack");
-
-# in our quest for speed, we must get ugly:
-# it helps reduce stack frame size a little bit
-# from Leif Stensson
-sub Ack {
-    return $_[0] ? ($_[1] ? Ack($_[0]-1, Ack($_[0], $_[1]-1))
-		    : Ack($_[0]-1, 1))
-	: $_[1]+1;
-}
-
-my $NUM = $ARGV[0];
-$NUM = 1 if ($NUM < 1);
-my $ack = Ack(3, $NUM);
-print "Ack(3,$NUM): $ack\n";

data/sources/perl/ackermann.perl-3.perl

@@ -1,20 +0,0 @@
-#!/usr/bin/perl
-# $Id: ackermann.perl-3.perl,v 1.1 2005-04-27 16:51:28 greg-guest Exp $
-# http://www.bagley.org/~doug/shootout/
-
-# We avoid using memoize by inlining the cache
-# from Thomas Drugeon
-
-# in our quest for speed, we must get ugly:
-# it helps reduce stack frame size a little bit
-# from Leif Stensson
-sub Ack {
-    $_[0] ? ($Ack[$_[0]][$_[1]] ||= $_[1] ? Ack($_[0]-1, Ack($_[0], $_[1]-1))
-		    : Ack($_[0]-1, 1))
-	: $_[1]+1;
-}
-
-my $NUM = $ARGV[0];
-$NUM = 1 if ($NUM < 1);
-my $ack = Ack(3, $NUM);
-print "Ack(3,$NUM): $ack\n";

data/sources/perl/ackermann.perl-4.perl

@@ -1,18 +0,0 @@
-#!/usr/bin/perl
-# The Great Win32 Computer Language Shootout
-# http://shootout.alioth.debian.org/
-# modified by Isaac Gouy
-
-use integer;
-
-sub Ack {
-    my($M, $N) = @_;
-    return( $N + 1 )         if ($M == 0);
-    return( Ack($M - 1, 1) ) if ($N == 0);
-    Ack($M - 1, Ack($M, $N - 1));
-}
-
-my $NUM = $ARGV[0];
-$NUM = 1 if ($NUM < 1);
-my $ack = Ack(3, $NUM);
-print "Ack(3,$NUM): $ack\n";

data/sources/perl/ary.perl

@@ -1,25 +0,0 @@
-#!/usr/bin/perl
-# $Id: ary.perl,v 1.2 2004-05-22 07:25:00 bfulgham Exp $
-# http://www.bagley.org/~doug/shootout/
-
-# this program is modified from:
-#   http://cm.bell-labs.com/cm/cs/who/bwk/interps/pap.html
-# Timing Trials, or, the Trials of Timing: Experiments with Scripting
-# and User-Interface Languages</a> by Brian W. Kernighan and
-# Christopher J. Van Wyk.
-
-my $n = @ARGV[0] || 1;
-my @X;
-my @Y;
-
-my $last = $n - 1;
-for my $i (0..$last) {
-    $X[$i] = $i + 1;
-}
-for my $k (0..999) {
-    for my $i (reverse 0..$last) {
-	$Y[$i] += $X[$i];
-    }
-}
-
-print "$Y[0] $Y[$last]\n";

data/sources/perl/ary.perl-2.perl

@@ -1,23 +0,0 @@
-#!/usr/bin/perl
-# The Great Computer Language Shootout
-# http://shootout.alioth.debian.org/
-# Modified: 2005-06-18 Cosimo Streppone
-
-use integer;
-
-my $n = @ARGV[0] || 1;
-my(@X, @Y, $i, $k);
-my $last = $n - 1;
-
-# Initialize @X list in a single step
-@X = (1 .. $n);
-
-# Execute 1000 times
-for(0 .. 999) {
-    # Use of `$_' aliasing is faster than using a lexical var
-    # Also, there is no need to reverse (0 .. $last) list
-    $Y[$_] += $X[$_] for 0 .. $last;
-}
-
-print $Y[0], ' ', $Y[$last], "\n";
-

data/sources/perl/binarytrees.perl

@@ -1,66 +0,0 @@
-#!/usr/bin/perl
-# The Computer Language Shootout
-# http://shootout.alioth.debian.org/
-#
-# Contributed by Doug King
-# Corrected by Heiner Marxen
-
-use integer;
-
-sub item_check {
-    my ($tree) = @_;
-
-    return $$tree[2] unless (defined $$tree[0]);
-    return $$tree[2] + item_check($$tree[0]) - item_check($$tree[1]);
-}
-
-
-sub bottom_up_tree {
-    my($item, $depth) = @_;
-
-    return [ undef, undef, $item ] if $depth <= 0;
-    return [ bottom_up_tree(2 * $item - 1, $depth - 1),
-	     bottom_up_tree(2 * $item,     $depth - 1),
-	     $item ];
-}
-
-
-$n = shift @ARGV;
-
-$min_depth = 4;
-
-if ( ($min_depth + 2) > $n) {
-    $max_depth = $min_depth + 2;
-} else {
-    $max_depth = $n;
-}
-
-$stretch_depth = $max_depth + 1;
-
-$stretch_tree = bottom_up_tree(0, $stretch_depth);
-print "stretch tree of depth $stretch_depth\t check: ", item_check($stretch_tree), "\n";
-$stretch_tree = undef;
-
-$long_lived_tree = bottom_up_tree(0, $max_depth);
-
-$depth = $min_depth;
-while( $depth <= $max_depth ) {
-
-    $iterations = 2 ** ($max_depth - $depth + $min_depth);
-    $check = 0;
-
-    for $i (1..$iterations) {
-	$temp_tree = bottom_up_tree($i, $depth);
-	$check += item_check($temp_tree);
-	$temp_tree = undef;
-
-	$temp_tree = bottom_up_tree(-$i, $depth);
-	$check += item_check($temp_tree);
-	$temp_tree = undef;
-    }
-
-    print $iterations * 2, "\t trees of depth $depth\t check: ", $check, "\n";
-    $depth += 2;
-}
-
-print "long lived tree of depth $max_depth\t check: ", item_check($long_lived_tree), "\n";

data/sources/perl/binarytrees.perl-2.perl

@@ -1,71 +0,0 @@
-# The Computer Language Benchmarks Game
-# http://shootout.alioth.debian.org/
-#
-# Contributed by Doug King
-# Corrected by Heiner Marxen
-# Tree-building made non-recursive by Steffen Mueller
-
-use integer;
-
-sub item_check {
-    my ($tree) = @_;
-
-    return $tree->[2] unless (defined $tree->[0]);
-    return $tree->[2] + item_check($tree->[0]) - item_check($tree->[1]);
-}
-
-
-sub bottom_up_tree {
-    my($depth) = @_;
-
-    my @pool;
-    push @pool, [undef, undef, -$_] foreach 0..2**$depth-1;
-
-    foreach my $exponent (reverse(0..($depth-1))) {
-        push @pool, [reverse(splice(@pool, 0, 2)), $_] 
-                       foreach reverse(-(2**$exponent-1) .. 0);
-    }
-    return $pool[0];
-}
-
-
-my $n = shift @ARGV;
-
-my $min_depth = 4;
-my $max_depth;
-
-if ( ($min_depth + 2) > $n) {
-    $max_depth = $min_depth + 2;
-} else {
-    $max_depth = $n;
-}
-
-{
-    my $stretch_depth = $max_depth + 1;
-    my $stretch_tree = bottom_up_tree($stretch_depth);
-    print "stretch tree of depth $stretch_depth\t check: ",
-           item_check($stretch_tree), "\n";
-}
-
-my $long_lived_tree = bottom_up_tree($max_depth);
-
-my $depth = $min_depth;
-while( $depth <= $max_depth ) {
-    my $iterations = 2 ** ($max_depth - $depth + $min_depth);
-    my $check = 0;
-
-    foreach my $i (1..$iterations) {
-	my $temp_tree = bottom_up_tree($depth);
-	$check += item_check($temp_tree);
-
-	$temp_tree = bottom_up_tree($depth);
-	$check += item_check($temp_tree);
-    }
-
-    print $iterations * 2, "\t trees of depth $depth\t check: ", $check, "\n";
-    $depth += 2;
-}
-
-print "long lived tree of depth $max_depth\t check: ", 
-       item_check($long_lived_tree), "\n";
-

data/sources/perl/chameneos.perl

@@ -1,67 +0,0 @@
-#########################################
-#     The Computer Language Shootout    #
-#   http://shootout.alioth.debian.org/  #
-#                                       #
-#      Contributed by Jesse Millikan    #
-#########################################
-
-use threads;
-use threads::shared;
-
-# Complement method is numerical based on Haskell version
-my ($red, $yellow, $blue, $none) = (0,1,2,3);
-
-# Count, signal and mutex are all $meetings
-my $meetings : shared = $ARGV[0];
-
-# Locked and updated by each thread when it ends
-my $total_meetings : shared = 0;
-
-# Colour communication variables
-my $first : shared = $none;
-my $second : shared = $none;
-
-# $_ is thread on the outer map and color on the inner loop
-map { $_->join } (map {
- # async starts a new thread running the block given
- async {
-  my ($color, $other_color) = ($_,$none);
-  my $met = 0; 
-
-  # with 'redo', loop until 'last' is called
-  LIVE: { 
-
-   # Meeting place 
-   { 
-    lock $meetings;
-    
-    last LIVE if($meetings <= 0); # 'fade' by jumping out of the block
-
-    if($first != $none){
-     $other_color = $first;
-     $second = $color;
-     cond_signal $meetings; 
-     $meetings -= 1;
-     $first = $none;
-    }
-    else
-    {
-     $first = $color; 
-     cond_wait $meetings;
-     $other_color = $second;
-    }
-   } # Unlock the meeting place 
-
-   $color = 3 - $color - $other_color if($color != $other_color);
-   $met++;
-
-   redo;
-  }
-
-  # Lock the total and add own to it before dying
-  lock $total_meetings;
-  $total_meetings += $met;
- }
-} ($blue, $red, $yellow, $blue));
-
-print "$total_meetings\n";

data/sources/perl/echo.perl

@@ -1,81 +0,0 @@
-#!/usr/bin/perl
-# $Id: echo.perl,v 1.1.1.1 2004-05-19 18:09:37 bfulgham Exp $
-# http://www.bagley.org/~doug/shootout/
-
-use Socket;
-
-my $DATA = "Hello there sailor\n";
-
-sub server_sock {
-    local *SS;
-    socket(SS, PF_INET, SOCK_STREAM, 0) or
-	die "server/socket ($!)";
-    setsockopt(SS, SOL_SOCKET, SO_REUSEADDR, pack("l", 1)) or
-	die "server/setsockopt ($!)";
-    bind(SS, sockaddr_in(0, INADDR_LOOPBACK)) or
-	die "server/bind ($!)";
-    listen(SS, 2);
-    return(*SS);
-}
-
-sub get_port {
-    local *SK = shift;
-    (sockaddr_in(getsockname(SK)))[0];
-}
-
-sub client_sock {
-    my $port = shift;
-    local *CS;
-    socket(CS, PF_INET, SOCK_STREAM, getprotobyname('tcp')) or
-	die "client/socket ($!)";
-    connect(CS, sockaddr_in($port, INADDR_LOOPBACK)) or
-	die "client/connect ($!)";
-    return(*CS);
-}
-
-sub echo_client {
-    my($N, $port) = @_;
-    local *SOCK = client_sock($port);
-    select(SOCK);
-    $| = 1;
-    for my $i (0..($N-1)) {
-	print $DATA;
-	my $ans = <SOCK>;
-	($ans eq $DATA) or die qq{client: "$DATA" ne "$ans"};
-    }
-    close SOCK;
-}
-
-sub echo_server {
-    my($N) = @_;
-    local *SSOCK = server_sock();
-    my $port = get_port(*SSOCK);
-    my $pid = fork;
-    defined $pid or die "server/fork ($!)";
-    if ($pid) {
-	# parent is server
-	local *CSOCK;
-	accept(CSOCK, SSOCK) or die "server/accept ($!)";
-	select(CSOCK);
-	$| = 1;
-	my $n = 0;
-	while (<CSOCK>) {
-	    print $_;
-	    $n += length($_);
-	}
-	select(STDOUT);
-	print "server processed $n bytes\n";
-    } else {
-	# child is client
-	echo_client($N, $port);
-    }
-    wait();
-}
-
-sub main {
-    my $N = $ARGV[0] || 1;
-    echo_server($N);
-    exit(0);
-}
-
-main();

data/sources/perl/except.perl

@@ -1,73 +0,0 @@
-#!/usr/bin/perl
-# $Id: except.perl,v 1.1.1.1 2004-05-19 18:09:43 bfulgham Exp $
-# http://www.bagley.org/~doug/shootout/
-
-use integer;
-
-my $HI = 0;
-my $LO = 0;
-my $NUM = $ARGV[0];
-$NUM = 1 if ($NUM < 1);
-
-package Lo_Exception;
-
-sub new {
-    bless({Val => shift}, __PACKAGE__);
-}
-
-package Hi_Exception;
-
-sub new {
-    bless({Val => shift}, __PACKAGE__);
-}
-
-package main;
-
-sub some_function {
-    my $num = shift;
-    eval {
-	&hi_function($num);
-    };
-    if ($@) {
-	die "We shouldn't get here ($@)";
-    }
-}
-
-sub hi_function {
-    my $num = shift;
-    eval {
-	&lo_function($num);
-    };
-    if (ref($@) eq "Hi_Exception") {
-	$HI++;		# handle
-    } elsif ($@) {
-	die $@;		# rethrow
-    }
-}
-
-sub lo_function {
-    my $num = shift;
-    eval {
-	&blowup($num);
-    };
-    if (ref($@) eq "Lo_Exception") {
-	$LO++;		# handle
-    } elsif ($@) {
-	die $@;		# rethrow
-    }
-}
-
-sub blowup {
-    my $num = shift;
-    if ($num % 2) {
-	die Lo_Exception->new(Num => $num);
-    } else {
-	die Hi_Exception->new(Num => $num);
-    }
-}
-
-$NUM = $ARGV[0];
-while ($NUM--) {
-    &some_function($NUM);
-}
-print "Exceptions: HI=$HI / LO=$LO\n";