# Units.pl: convert units of measurement
# Author: M-J. Dominus (mjd-perl-units-id-iut+buobvys+@plover.com)
-# License: GPL, Copyright (C) 1996,1999
-# NOTE: Integrated into blootbot by xk.
+# License: GPL, Copyright (C) 1996,1999
+# NOTE: Integrated into infobot by xk.
package Units;
+# use strict; # TODO
+
#$DEBUG_p = 1;
#$DEBUG_o = 1;
#$DEBUG_l = 1;
yotta => 21,
zetta => 24,
);
- $PREF = join '|', sort {$PREF{$a} <=> $PREF{$b}} (keys %PREF);
+ $PREF = join '|', sort { $PREF{$a} <=> $PREF{$b} } (keys %PREF);
}
################################################################
{ my $defs_read = 0;
- $defs_read += read_defs("$main::bot_misc_dir/unittab");
+ $defs_read += read_defs("$::bot_data_dir/unittab");
unless ($defs_read) {
- &main::ERROR("Could not read any of the initialization files UNITTAB");
+ &::ERROR('Could not read any of the initialization files UNITTAB');
return;
}
}
trim($from);
if ($from =~ s/^\s*\#\s*//) {
if (definition_line($from)) {
- &main::DEBUG("Defined.");
+ &::DEBUG("Defined.");
} else {
- &main::DEBUG("Error: $PARSE_ERROR.");
+ &::DEBUG("Error: $PARSE_ERROR.");
}
- &main::DEBUG("FAILURE 1.");
+ &::DEBUG("FAILURE 1.");
return;
}
unless ($from =~ /\S/) {
- &main::DEBUG("FAILURE 2");
+ &::DEBUG('FAILURE 2');
return;
}
my $hu = parse_unit($from);
if (is_Zero($hu)) {
- &main::DEBUG($PARSE_ERROR);
- &main::msg($main::who, $PARSE_ERROR);
+ &::DEBUG($PARSE_ERROR);
+ &::msg($::who, $PARSE_ERROR);
return;
}
redo unless $to =~ /\S/;
$wu = parse_unit($to);
if (is_Zero($wu)) {
- &main::DEBUG($PARSE_ERROR);
+ &::DEBUG($PARSE_ERROR);
}
my $quot = unit_divide($hu, $wu);
if (is_dimensionless($quot)) {
my $q = $quot->{_};
if ($q == 0) {
- &main::performStrictReply("$to is an invalid unit?");
+ &::performStrictReply("$to is an invalid unit?");
return;
}
# yet another powers hack.
- $from =~ s/(\D+)(\d)/$1\^$2/g;
- $to =~ s/(\D+)(\d)/$1\^$2/g;
+ $from =~ s/([[:alpha:]]+)(\d)/$1\^$2/g;
+ $to =~ s/([[:alpha:]]+)(\d)/$1\^$2/g;
- &main::performStrictReply(sprintf("$from is approximately \002%.6g\002 $to", $q));
+ &::performStrictReply(sprintf("$from is approximately \002%.6g\002 $to", $q));
} else {
- &main::performStrictReply("$from cannot be correctly converted to $to.");
+ &::performStrictReply("$from cannot be correctly converted to $to.");
-# print
+# print
# "conformability (Not the same dimension)\n",
-# "\t", $from, " is ", text_unit($hu), "\n",
-# "\t", $to, " is ", text_unit($wu), "\n",
+# "\t", $from, ' is ', text_unit($hu), "\n",
+# "\t", $to, ' is ', text_unit($wu), "\n",
# ;
}
}
print ">>> $_\n" if $DEBUG_d;
my $r = definition_line($_);
unless (defined $r) {
- warn "Error in line $. of $file: $PARSE_ERROR. Skipping.\n";
+ warn "Error in line $. of $file: $PARSE_ERROR. Skipping.\n";
}
}
print STDERR "Loaded file `$file'.\n" if $show_file_loading;
sub unit_divide {
my ($a, $b) = @_;
if ($b->{_} == 0) {
- &main::DEBUG("Division by zero error");
+ &::DEBUG('Division by zero error');
return;
}
my $r = {%$a};
$text .= " $d";
$text .= "^$e" if $e > 1;
}
-
+
$text;
}
################################################################
BEGIN {
sub sh { ['shift', $_[0]] };
sub go { ['goto', $_[0]] };
- @actions =
+ @actions =
(
# Initial state
{PREFIX => sh(1),
DIVIDE => sh(12),
_ => ['reduce', 1, 'topunit'],
},
- # State 8: unit -> constant . unit
+ # State 8: unit -> constant . unit
# unit -> constant .
{PREFIX => sh(1),
NUMBER => sh(2), # Shift-reduce conflict resolved in favor of shift
},
# State 11: unit -> unit TIMES . unit
{PREFIX => sh(1),
- NUMBER => sh(2),
+ NUMBER => sh(2),
NAME => sh(3),
FUNDAMENTAL => sh(4),
FRACTION => sh(5),
},
# State 12: unit -> unit DIVIDE . unit
{PREFIX => sh(1),
- NUMBER => sh(2),
+ NUMBER => sh(2),
NAME => sh(3),
FUNDAMENTAL => sh(4),
FRACTION => sh(5),
},
# State 13: unit -> unit . TIMES unit
# unit -> unit . DIVIDE unit
- # unit -> constant unit .
+ # unit -> constant unit .
# unit -> unit . NUMBER
{NUMBER => sh(10), # Shift-reduce conflict resolved in favor of shift
TIMES => sh(11), # Shift-reduce conflict resolved in favor of shift
# State 14: unit => '(' unit ')' .
{ _ => ['reduce', 3, 'unit', sub {$_[1]}] },
# State 15: unit -> unit . TIMES unit
- # unit -> unit TIMES unit .
+ # unit -> unit TIMES unit .
# unit -> unit . DIVIDE unit
- # unit -> unit . NUMBER
+ # unit -> unit . NUMBER
{NUMBER => sh(10), # Shift-reduce conflict resolved in favor of shift
_ => ['reduce', 3, 'unit', sub {unit_multiply($_[0], $_[2])}],
},
# State 16: unit -> unit . TIMES unit
- # unit -> unit DIVIDE unit .
- # unit -> unit . DIVIDE unit
- # unit -> unit . NUMBER
+ # unit -> unit DIVIDE unit .
+ # unit -> unit . DIVIDE unit
+ # unit -> unit . NUMBER
{NUMBER => sh(10), # Shift-reduce conflict resolved in favor of shift
_ => ['reduce', 3, 'unit', sub{unit_divide($_[2], $_[0])}],
},
$PARSE_ERROR = 'Syntax error';
return Zero;
}
-
+
my ($primary, @actargs) = @$action;
print STDERR " $primary (@actargs)\n" if $DEBUG_p;
if ($primary eq 'accept') {
push @state_st, $STATE;
# $STATE = $state_st[-1];
print STDERR "Post-reduction state is $STATE.\n" if $DEBUG_p;
-
+
# Now look for `goto' actions
my $goto = $actions[$STATE]{$result_type};
unless ($goto && $goto->[0] eq 'goto') {
- &main::ERROR("No post-reduction goto in state $STATE for $result_type.");
+ &::ERROR("No post-reduction goto in state $STATE for $result_type.");
return;
}
print STDERR "goto $goto->[1]\n" if $DEBUG_p;
$STATE = $goto->[1];
} else {
- &main::ERROR("Bad primary $primary");
+ &::ERROR("Bad primary $primary");
return;
}
}
sub lex {
my ($s) = @_;
my @t = split /(
- \*{3} # Special `new unit' symbol
- | [()*-] # Symbol
- | \s*(?:\/|\bper\b)\s* # Division
- | \d*\.\d+(?:[eE]-?\d+)? # Decimal number
- | \d+\|\d+ # Fraction
- | \d+ # Integer
-# | (?:$PREF)-? # Prefix (handle differently)
+ \*{3} # Special `new unit' symbol
+ | [()*-] # Symbol
+ | \s*(?:\/|\bper\b)\s* # Division
+ | \d*\.\d+(?:[eE]-?\d+)? # Decimal number
+ | \d+\|\d+ # Fraction
+ | \d+ # Integer
+# | (?:$PREF)-? # Prefix (handle differently)
| [A-Za-z_][A-Za-z_.]* # identifier
- | \s+ # White space
- )/ox, $s;
+ | \s+ # White space
+ )/ox, $s;
@t = grep {$_ ne ''} @t; # Discard empty and all-white tokens
\@t;
}
projects / infobot.git / blobdiff