--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/interps/clc-intercal/CLC-INTERCAL-Base-1.-94.-2/INTERCAL/Numbers.pm	Sun Dec 09 19:30:08 2012 +0000
@@ -0,0 +1,214 @@
+package Language::INTERCAL::Numbers;
+
+# Numbers which never drop bits, no matter how hard you shake them
+
+# This file is part of CLC-INTERCAL
+
+# Copyright (c) 2006-2008 Claudio Calvelli, all rights reserved.
+
+# CLC-INTERCAL is copyrighted software. However, permission to use, modify,
+# and distribute it is granted provided that the conditions set out in the
+# licence agreement are met. See files README and COPYING in the distribution.
+
+use strict;
+use vars qw($VERSION $PERVERSION);
+($VERSION) = ($PERVERSION = "CLC-INTERCAL/Base INTERCAL/Numbers.pm 1.-94.-2") =~ /\s(\S+)$/;
+
+use Carp;
+use Language::INTERCAL::Exporter '1.-94.-2';
+use Language::INTERCAL::Splats '1.-94.-2', qw(:SP);
+use Language::INTERCAL::DataItem '1.-94.-2';
+use vars qw(@ISA);
+@ISA = qw(Language::INTERCAL::DataItem);
+
+my @twospotbits = qw(32 20 16 12 12 10);
+my @spotbits = qw(16 10 8 6 6 5);
+
+sub new {
+    @_ or croak "Usage: new Language::INTERCAL::Numbers" .
+		"[::Spot|::Twospot|BITS, ] VALUE";
+    my $class = shift;
+    my $bits;
+    if ($class->isa('Language::INTERCAL::Numbers::Spot')) {
+	@_ == 1 or croak "Usage: new $class VALUE";
+	$bits = 16;
+    } elsif ($class->isa('Language::INTERCAL::Numbers::Twospot')) {
+	@_ == 1 or croak "Usage: new $class VALUE";
+	$bits = 32;
+    } else {
+	@_ == 2 or croak "Usage: new $class BITS, BITS";
+	$bits = shift;
+	$bits > 32 and croak "Invalid number of BITS";
+	$class .= $bits > 16 ? '::Twospot' : '::Spot';
+	$bits = $bits > 16 ? 32 : 16;
+    }
+    my ($value) = @_;
+    if (ref $value) {
+	UNIVERSAL::isa($value, 'Language::INTERCAL::Numbers')
+	    or faint(SP_NUMBER, 'Is a reference');
+	$value = $value->{value};
+    }
+    $bits <= 16 && $value > 0xffff and faint(SP_SPOTS, $value, 'one spot');
+    $value > 0xffffffff and faint(SP_SPOTS, $value, 'two spots');
+    my $type = $bits <= 16 ? 'Spot' : 'Twospot';
+    bless {
+	bits => $bits <= 16 ? 16 : 32,
+	value => $value,
+	overload => undef,
+    }, $class;
+}
+
+sub num_digits {
+    @_ == 2 or croak "Usage: NUMBER/CLASS->num_digits(BASE)";
+    my ($num, $base) = @_;
+    $base >= 2 && $base <= 7 or croak "Invalid BASE";
+    $base -= 2;
+    $num->isa('Language::INTERCAL::Numbers::Spot')
+	and return $spotbits[$base];
+    $num->isa('Language::INTERCAL::Numbers::Twospot')
+	and return $twospotbits[$base];
+    croak "Invalid NUMBER/CLASS";
+}
+
+sub from_digits {
+    @_ > 3
+	or croak "Usage: Language::INTERCAL::Numbers->from_digits(BASE, DIGITS)";
+    my ($class, $base, @values) = @_;
+    my $type;
+    if (@values == $spotbits[$base - 2]) {
+	$type = 'Language::INTERCAL::Numbers::Spot';
+    } elsif (@values == $twospotbits[$base - 2]) {
+	$type = 'Language::INTERCAL::Numbers::Twospot';
+    } else {
+	faint(SP_DIGITS, $base, scalar(@values))
+    }
+    my $value = 0;
+    for my $n (@values) {
+	$value = $value * $base + $n % $base;
+    }
+    $type->new($value);
+}
+
+sub _assign {
+    @_ == 2 or croak "Usage: NUMBER->assign(VALUE)";
+    my ($num, $value) = @_;
+    if (ref $value) {
+	UNIVERSAL::isa($value, 'Language::INTERCAL::Numbers')
+	    or faint(SP_NUMBER, 'Is a reference');
+	$value = $value->{value};
+    }
+    $num->{bits} <= 16 && $value > 0xffff
+	and faint(SP_SPOTS, $value, 'one spot');
+    $value > 0xffffffff and faint(SP_SPOTS, $value, 'two spots');
+    $num->{value} = $value;
+    $num;
+}
+
+sub as_list {
+    @_ == 1 or croak "Usage: NUMBER->as_list";
+    my ($num) = @_;
+    ($num);
+}
+
+sub copy {
+    @_ == 1 or croak "Usage: NUMBER->copy";
+    my ($num) = @_;
+    bless {
+	value => $num->{value},
+	bits => $num->{bits},
+	overload => $num->{overload},
+    }, ref $num;
+}
+
+sub digits {
+    @_ == 2 or croak "Usage: NUMBER->digits(BASE)";
+    my ($num, $base) = @_;
+    faint(SP_BASE, $base) if $base < 2 || $base > 7;
+    my $bits = $num->{bits} < 17
+	     ? $spotbits[$base - 2]
+	     : $twospotbits[$base - 2];
+    my $orig = $num->{value};
+    my $value = $orig;
+    my @result = ();
+    for (my $n = 0; $n < $bits; $n++) {
+	unshift @result, $value % $base;
+	$value = int($value / $base);
+    }
+    $value and faint(SP_DIGITS, $base, $orig);
+    @result;
+}
+
+sub elements { 1 }
+
+sub number {
+    @_ == 1 or croak "Usage: NUMBER->number";
+    my ($num) = @_;
+    $num->{value};
+}
+
+sub print {
+    @_ == 1 or croak "Usage: NUMBER->print";
+    my ($num) = @_;
+    '#' . $num->{value};
+}
+
+# some methods in case these values are used as array/class
+
+sub as_string { faint(SP_NOARRAY); }
+sub filehandle { faint(SP_NOTCLASS); }
+sub _get { faint(SP_NOARRAY); }
+sub hybrid { faint(SP_NOARRAY); }
+sub range { faint(SP_NOARRAY); }
+sub _store { faint(SP_NOARRAY); }
+sub tail { faint(SP_NOARRAY); }
+
+package Language::INTERCAL::Numbers::Spot;
+
+use Carp;
+use Language::INTERCAL::Splats '1.-94.-2', qw(:SP);
+
+use vars qw(@ISA);
+@ISA = qw(Language::INTERCAL::Numbers);
+
+sub spot {
+    @_ == 1 or croak "Usage: NUMBER->spot";
+    goto &Language::INTERCAL::Numbers::copy;
+}
+
+sub twospot {
+    @_ == 1 or croak "Usage: NUMBER->twospot";
+    my ($num) = @_;
+    my $value = $num->{value};
+    bless {
+	value => $value,
+	bits => 32,
+	overload => $num->{overload},
+    }, 'Language::INTERCAL::Numbers::Twospot';
+}
+
+package Language::INTERCAL::Numbers::Twospot;
+
+use Carp;
+use Language::INTERCAL::Splats '1.-94.-2', qw(:SP);
+
+use vars qw(@ISA);
+@ISA = qw(Language::INTERCAL::Numbers);
+
+sub spot {
+    @_ == 1 or croak "Usage: NUMBER->spot";
+    my ($num) = @_;
+    my $value = $num->{value};
+    $value > 0xffff and faint(SP_SPOTS, $value, 'one spot');
+    bless {
+	value => $value,
+	bits => 16,
+	overload => $num->{overload},
+    }, 'Language::INTERCAL::Numbers::Spot';
+}
+
+sub twospot {
+    @_ == 1 or croak "Usage: NUMBER->twospot";
+    goto &Language::INTERCAL::Numbers::copy;
+}
+
+1;