line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
#!/usr/bin/perl |
2
|
|
|
|
|
|
|
package PerlPowerTools::units; |
3
|
|
|
|
|
|
|
|
4
|
1
|
|
|
1
|
|
600
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
28
|
|
5
|
1
|
|
|
1
|
|
5
|
use warnings; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
28
|
|
6
|
1
|
|
|
1
|
|
482
|
use open qw(:std :utf8); |
|
1
|
|
|
|
|
1227
|
|
|
1
|
|
|
|
|
5
|
|
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
=begin metadata |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
Name: units |
11
|
|
|
|
|
|
|
Description: conversion program |
12
|
|
|
|
|
|
|
Author: Mark-Jason Dominus, mjd-perl-units@plover.com |
13
|
|
|
|
|
|
|
License: gpl |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
=end metadata |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
=cut |
18
|
|
|
|
|
|
|
|
19
|
1
|
|
|
1
|
|
139
|
use Config; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
179
|
|
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
# Usage: |
22
|
|
|
|
|
|
|
# units [-f unittab] |
23
|
|
|
|
|
|
|
our $VERSION = '1.01'; |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
BEGIN { |
26
|
1
|
|
|
1
|
|
611
|
require Data::Dumper; |
27
|
32845
|
|
|
32845
|
|
90491
|
sub dumper { Data::Dumper->new([@_])->Indent(1)->Sortkeys(1)->Terse(1)->Useqq(1)->Deparse(1)->Dump } |
28
|
|
|
|
|
|
|
|
29
|
1
|
|
|
|
|
6826
|
foreach my $letter ( qw( d p o l t ) ) { |
30
|
1
|
|
|
1
|
|
7
|
no strict 'refs'; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
195
|
|
31
|
5
|
|
|
|
|
11
|
my $env_var = uc( "UNITS_DEBUG_$letter" ); |
32
|
5
|
100
|
|
|
|
18
|
my( $debugging ) = grep { defined and length } ( $ENV{$env_var}, $ENV{UNITS_DEBUG}, 0 ); |
|
15
|
|
|
|
|
38
|
|
33
|
5
|
|
|
485818
|
|
157
|
*{"debug_$letter"} = ! $debugging ? sub {} : sub { |
34
|
0
|
|
|
|
|
0
|
my $indent; |
35
|
0
|
|
|
|
|
0
|
my $m = join '', @_; |
36
|
0
|
0
|
|
|
|
0
|
$indent = $1 if $m =~ s/\A(\s*)//; |
37
|
0
|
|
|
|
|
0
|
print "$indent$letter>>> $m\n"; |
38
|
|
|
|
|
|
|
} |
39
|
5
|
50
|
|
|
|
16
|
} |
40
|
|
|
|
|
|
|
} |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
our %unittab; # Definitions loaded here |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
# Metric prefixes. These must be powers of ten or change the |
45
|
|
|
|
|
|
|
# token_value subroutine |
46
|
|
|
|
|
|
|
our %PREF; |
47
|
|
|
|
|
|
|
our $PREF; |
48
|
|
|
|
|
|
|
our $PARSE_ERROR; |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
BEGIN { |
51
|
1
|
|
|
1
|
|
14
|
%PREF = ( |
52
|
|
|
|
|
|
|
yotta => -24, |
53
|
|
|
|
|
|
|
zetta => -21, |
54
|
|
|
|
|
|
|
atto => -18, |
55
|
|
|
|
|
|
|
femto => -15, |
56
|
|
|
|
|
|
|
pico => -12, |
57
|
|
|
|
|
|
|
nano => - 9, |
58
|
|
|
|
|
|
|
micro => - 6, |
59
|
|
|
|
|
|
|
milli => - 3, |
60
|
|
|
|
|
|
|
centi => - 2, |
61
|
|
|
|
|
|
|
deci => - 1, |
62
|
|
|
|
|
|
|
deca => 1, |
63
|
|
|
|
|
|
|
deka => 1, |
64
|
|
|
|
|
|
|
hecto => 2, |
65
|
|
|
|
|
|
|
hect => 2, |
66
|
|
|
|
|
|
|
kilo => 3, |
67
|
|
|
|
|
|
|
myria => 4, |
68
|
|
|
|
|
|
|
mega => 6, |
69
|
|
|
|
|
|
|
giga => 9, |
70
|
|
|
|
|
|
|
tera => 12, |
71
|
|
|
|
|
|
|
zepto => 15, |
72
|
|
|
|
|
|
|
yocto => 18, |
73
|
|
|
|
|
|
|
); |
74
|
1
|
|
|
|
|
9
|
$PREF = join '|', sort {$PREF{$a} <=> $PREF{$b}} (keys %PREF); |
|
67
|
|
|
|
|
594
|
|
75
|
|
|
|
|
|
|
} |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
__PACKAGE__->run(@ARGV) unless caller; |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
sub run { |
80
|
0
|
|
|
0
|
|
0
|
my( $class, @args ) = @_; local @ARGV; |
|
0
|
|
|
|
|
0
|
|
81
|
|
|
|
|
|
|
|
82
|
0
|
|
|
|
|
0
|
my $args = $class->process_args( @args ); |
83
|
|
|
|
|
|
|
|
84
|
0
|
|
|
|
|
0
|
$class->read_unittab( $args->{unittabs}[0] ); |
85
|
|
|
|
|
|
|
|
86
|
0
|
0
|
|
|
|
0
|
if (@{ $args->{args} }) { |
|
0
|
|
|
|
|
0
|
|
87
|
0
|
|
|
|
|
0
|
my ($have, $want) = @{ $args->{args} }; |
|
0
|
|
|
|
|
0
|
|
88
|
0
|
|
|
|
|
0
|
my $have_hr = $class->unit_have($have); |
89
|
0
|
|
|
|
|
0
|
my $want_hr = $class->unit_want($want); |
90
|
0
|
|
|
|
|
0
|
my %r = $class->unit_convert($have_hr, $want_hr); |
91
|
0
|
|
|
|
|
0
|
print_result(%r); |
92
|
|
|
|
|
|
|
} else { |
93
|
0
|
|
|
|
|
0
|
while (1) { |
94
|
0
|
|
|
|
|
0
|
print "You have: "; |
95
|
0
|
|
|
|
|
0
|
my $have = <>; |
96
|
0
|
0
|
|
|
|
0
|
exit 0 unless $have =~ /\S/; |
97
|
0
|
|
|
|
|
0
|
my $have_hr = $class->unit_have($have); |
98
|
0
|
0
|
|
|
|
0
|
next if is_Zero($have_hr->{hu}); |
99
|
|
|
|
|
|
|
|
100
|
0
|
|
|
|
|
0
|
print "You want: "; |
101
|
0
|
|
|
|
|
0
|
my $want = <>; |
102
|
0
|
0
|
|
|
|
0
|
exit 0 unless $want =~ /\S/; |
103
|
0
|
|
|
|
|
0
|
my $want_hr = $class->unit_want($want); |
104
|
0
|
0
|
|
|
|
0
|
next if is_Zero($want_hr->{wu}); |
105
|
|
|
|
|
|
|
|
106
|
0
|
|
|
|
|
0
|
my %r = $class->unit_convert($have_hr, $want_hr); |
107
|
0
|
|
|
|
|
0
|
print_result(%r); |
108
|
|
|
|
|
|
|
} |
109
|
|
|
|
|
|
|
} |
110
|
|
|
|
|
|
|
|
111
|
0
|
|
|
|
|
0
|
exit 0; |
112
|
|
|
|
|
|
|
} |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
sub test { |
115
|
20
|
|
|
20
|
|
34383
|
my ($class, $have, $want) = @_; |
116
|
|
|
|
|
|
|
|
117
|
20
|
|
|
|
|
73
|
$class->read_unittab(); |
118
|
20
|
|
|
|
|
147
|
my $have_hr = $class->unit_have($have); |
119
|
20
|
|
|
|
|
81
|
my $want_hr = $class->unit_want($want); |
120
|
20
|
|
|
|
|
77
|
my %r = $class->unit_convert($have_hr, $want_hr); |
121
|
20
|
|
|
|
|
186
|
return %r; |
122
|
|
|
|
|
|
|
} |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
sub default_unittabs { |
125
|
0
|
|
|
0
|
|
0
|
grep { -e } qw(/usr/lib/unittab); |
|
0
|
|
|
|
|
0
|
|
126
|
|
|
|
|
|
|
} |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
sub env_unittabs { |
129
|
1
|
|
|
1
|
|
8
|
no warnings 'uninitialized'; |
|
1
|
|
|
|
|
10
|
|
|
1
|
|
|
|
|
4243
|
|
130
|
0
|
|
|
0
|
|
0
|
split /$Config{path_sep}/, $ENV{UNITTAB}; |
131
|
|
|
|
|
|
|
} |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
sub process_args { |
134
|
0
|
|
|
0
|
|
0
|
my( $class, @args ) = @_; |
135
|
|
|
|
|
|
|
|
136
|
0
|
|
|
|
|
0
|
my @unittabs; |
137
|
|
|
|
|
|
|
my $USAGE; |
138
|
|
|
|
|
|
|
|
139
|
0
|
|
0
|
|
|
0
|
while (@args and $args[0] =~ /^-/) { |
140
|
0
|
|
|
|
|
0
|
my $flag = shift @args; |
141
|
0
|
0
|
|
|
|
0
|
if ($flag =~ /^-(f|-file)?$/) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
142
|
0
|
|
|
|
|
0
|
push @unittabs, shift @args; |
143
|
|
|
|
|
|
|
} elsif ($flag =~ /^-(W|-warranty)$/) { |
144
|
0
|
|
|
|
|
0
|
$class->WARRANTY(); |
145
|
0
|
|
|
|
|
0
|
exit 0; |
146
|
|
|
|
|
|
|
} elsif ($flag =~ /^-(C|-copying)$/) { |
147
|
0
|
|
|
|
|
0
|
$class->COPYING(); |
148
|
0
|
|
|
|
|
0
|
exit 0; |
149
|
|
|
|
|
|
|
} elsif ($flag =~ /^--version$/) { |
150
|
0
|
|
|
|
|
0
|
print "perl units version $VERSION.\n"; |
151
|
0
|
|
|
|
|
0
|
exit 0; |
152
|
|
|
|
|
|
|
} else { |
153
|
0
|
|
|
|
|
0
|
warn "Unknown flag: $flag.\n"; |
154
|
0
|
|
|
|
|
0
|
$USAGE++; |
155
|
|
|
|
|
|
|
} |
156
|
|
|
|
|
|
|
} |
157
|
|
|
|
|
|
|
|
158
|
0
|
0
|
0
|
|
|
0
|
$class->usage() if $USAGE || @args == 1 || @args > 2; |
|
|
|
0
|
|
|
|
|
159
|
|
|
|
|
|
|
|
160
|
0
|
0
|
|
|
|
0
|
@unittabs = $class->env_unittabs unless @unittabs; |
161
|
0
|
0
|
|
|
|
0
|
@unittabs = $class->default_unittabs unless @unittabs; |
162
|
|
|
|
|
|
|
|
163
|
0
|
|
|
|
|
0
|
{ unittabs => \@unittabs, args => \@args } |
164
|
|
|
|
|
|
|
} |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
sub read_unittab { |
167
|
20
|
|
|
20
|
|
45
|
my( $class, $file ) = @_; |
168
|
20
|
|
|
|
|
24
|
my $read_unittab = 0; |
169
|
|
|
|
|
|
|
|
170
|
20
|
|
|
|
|
37
|
my( $name, $fh ) = do { |
171
|
20
|
50
|
33
|
|
|
75
|
if( defined $file and -e $file ) { |
172
|
0
|
0
|
|
|
|
0
|
open my($fh), '<:encoding(UTF-8)', $file or do { |
173
|
0
|
|
|
|
|
0
|
die "Could not open <$file>: Aborting."; |
174
|
|
|
|
|
|
|
}; |
175
|
0
|
|
|
|
|
0
|
( $file, $fh ) |
176
|
|
|
|
|
|
|
} |
177
|
|
|
|
|
|
|
else { |
178
|
20
|
|
|
|
|
47
|
debug_d( "Reading from DATA" ); |
179
|
1
|
50
|
|
1
|
|
8
|
open my $fh, '<:encoding(UTF-8)', __FILE__ or die; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
7
|
|
|
20
|
|
|
|
|
1486
|
|
180
|
20
|
100
|
|
|
|
14561
|
while( <$fh> ) { last if /\A__(?:DATA|END)__/ } |
|
25180
|
|
|
|
|
52518
|
|
181
|
20
|
|
|
|
|
79
|
( 'DATA', $fh ); |
182
|
|
|
|
|
|
|
} |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
}; |
185
|
|
|
|
|
|
|
|
186
|
20
|
|
|
|
|
156
|
$class->read_defs( $name, $fh ); |
187
|
|
|
|
|
|
|
} |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
sub unit_have { |
190
|
20
|
|
|
20
|
|
81
|
my ($class, $have) = @_; |
191
|
|
|
|
|
|
|
|
192
|
20
|
|
|
|
|
52
|
trim($have); |
193
|
|
|
|
|
|
|
|
194
|
20
|
|
|
|
|
33
|
my $is_negative = 0; |
195
|
20
|
100
|
|
|
|
88
|
if ($have =~ /^[-]/) { |
196
|
2
|
|
|
|
|
5
|
$is_negative = 1; |
197
|
2
|
|
|
|
|
10
|
$have =~ s/^[-]//; # remove minus sign |
198
|
|
|
|
|
|
|
} |
199
|
|
|
|
|
|
|
|
200
|
20
|
|
|
|
|
68
|
my $is_quantified = $have =~ /^[\d.]+/; |
201
|
|
|
|
|
|
|
|
202
|
20
|
50
|
|
|
|
73
|
if ($have =~ s/^\s*\#\s*//) { |
203
|
0
|
0
|
|
|
|
0
|
if ($class->definition_line($have)) { |
204
|
0
|
|
|
|
|
0
|
print "Defined.\n"; |
205
|
|
|
|
|
|
|
} else { |
206
|
0
|
|
|
|
|
0
|
print "Error: $PARSE_ERROR.\n"; |
207
|
|
|
|
|
|
|
} |
208
|
0
|
|
|
|
|
0
|
return; |
209
|
|
|
|
|
|
|
} |
210
|
20
|
50
|
|
|
|
93
|
return unless $have =~ /\S/; |
211
|
|
|
|
|
|
|
|
212
|
20
|
|
|
|
|
67
|
my $hu = $class->parse_unit($have); |
213
|
|
|
|
|
|
|
|
214
|
20
|
50
|
|
|
|
80
|
if (is_Zero($hu)) { |
215
|
0
|
|
|
|
|
0
|
print $PARSE_ERROR, "\n"; |
216
|
0
|
|
|
|
|
0
|
return; |
217
|
|
|
|
|
|
|
} |
218
|
|
|
|
|
|
|
|
219
|
20
|
|
|
|
|
145
|
return { have => $have, hu => $hu, neg => $is_negative, quan => $is_quantified }; |
220
|
|
|
|
|
|
|
} |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
sub unit_want { |
223
|
20
|
|
|
20
|
|
57
|
my ($class, $want) = @_; |
224
|
|
|
|
|
|
|
|
225
|
20
|
|
|
|
|
54
|
trim($want); |
226
|
20
|
50
|
|
|
|
109
|
return unless $want =~ /\S/; |
227
|
|
|
|
|
|
|
|
228
|
20
|
|
|
|
|
69
|
my $wu = $class->parse_unit($want); |
229
|
|
|
|
|
|
|
|
230
|
20
|
50
|
|
|
|
63
|
if (is_Zero($wu)) { |
231
|
0
|
|
|
|
|
0
|
print $PARSE_ERROR, "\n"; |
232
|
|
|
|
|
|
|
} |
233
|
20
|
|
|
|
|
121
|
return { want => $want, wu => $wu }; |
234
|
|
|
|
|
|
|
} |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
sub unit_convert { |
237
|
20
|
|
|
20
|
|
53
|
my ($class, $have_hr, $want_hr ) = @_; |
238
|
|
|
|
|
|
|
|
239
|
20
|
|
|
|
|
43
|
my $have = $have_hr->{have}; |
240
|
20
|
|
|
|
|
39
|
my $hu = $have_hr->{hu}; |
241
|
20
|
|
|
|
|
36
|
my $is_negative = $have_hr->{neg}; |
242
|
20
|
|
|
|
|
32
|
my $is_quantified = $have_hr->{quan}; |
243
|
|
|
|
|
|
|
|
244
|
20
|
|
|
|
|
28
|
my $want = $want_hr->{want}; |
245
|
20
|
|
|
|
|
39
|
my $wu = $want_hr->{wu}; |
246
|
|
|
|
|
|
|
|
247
|
20
|
|
|
|
|
41
|
debug_t('have unit', dumper($hu)); |
248
|
20
|
|
|
|
|
169
|
debug_t('want unit', dumper($wu)); |
249
|
|
|
|
|
|
|
|
250
|
20
|
|
|
|
|
157
|
my $is_temperature = 0; |
251
|
20
|
100
|
|
|
|
89
|
$is_temperature++ if $hu->{Temperature}; |
252
|
20
|
100
|
|
|
|
63
|
$is_temperature++ if $wu->{Temperature}; |
253
|
|
|
|
|
|
|
|
254
|
20
|
100
|
|
|
|
62
|
my $quot |
255
|
|
|
|
|
|
|
= $is_temperature == 2 |
256
|
|
|
|
|
|
|
? undef |
257
|
|
|
|
|
|
|
: unit_divide($hu, $wu); |
258
|
|
|
|
|
|
|
|
259
|
20
|
|
|
|
|
30
|
my %retval; |
260
|
|
|
|
|
|
|
|
261
|
20
|
100
|
|
|
|
65
|
if ($is_temperature == 2) { |
|
|
50
|
|
|
|
|
|
262
|
|
|
|
|
|
|
# we have temperature units |
263
|
13
|
|
|
|
|
73
|
$have =~ s/^[-]?[\d.]*\s*//; |
264
|
13
|
|
|
|
|
36
|
my $v = $hu->{'_'}; |
265
|
13
|
100
|
|
|
|
40
|
$v *= -1 if $is_negative; |
266
|
13
|
100
|
|
|
|
49
|
$v = 0 if not $is_quantified; |
267
|
|
|
|
|
|
|
my $k |
268
|
|
|
|
|
|
|
= exists $hu->{hof} |
269
|
13
|
100
|
|
|
|
309
|
? $hu->{hof}->{to}->($v) |
270
|
|
|
|
|
|
|
: $v; |
271
|
|
|
|
|
|
|
my $t |
272
|
|
|
|
|
|
|
= exists $wu->{hof} |
273
|
13
|
100
|
|
|
|
186
|
? $wu->{hof}->{from}->($k) |
274
|
|
|
|
|
|
|
: $k; |
275
|
13
|
|
|
|
|
117
|
%retval = ( type => 'temperature', v => $v, have => $have, t => $t, want => $want ); |
276
|
|
|
|
|
|
|
} |
277
|
|
|
|
|
|
|
elsif (is_dimensionless($quot)) { |
278
|
7
|
|
|
|
|
16
|
my $q = $quot->{_}; |
279
|
7
|
|
|
|
|
15
|
my $p = 1/$q; |
280
|
7
|
|
|
|
|
42
|
%retval = ( type => 'dimless', q => $q, p => $p); |
281
|
|
|
|
|
|
|
} |
282
|
|
|
|
|
|
|
else { |
283
|
0
|
|
|
|
|
0
|
%retval = ( type=> 'error', msg => |
284
|
|
|
|
|
|
|
"conformability (Not the same dimension)\n" . |
285
|
|
|
|
|
|
|
"\t" . $have . " is " . text_unit($hu) . "\n" . |
286
|
|
|
|
|
|
|
"\t" . $want . " is " . text_unit($wu) . "\n" |
287
|
|
|
|
|
|
|
); |
288
|
|
|
|
|
|
|
} |
289
|
|
|
|
|
|
|
|
290
|
20
|
|
|
|
|
129
|
return %retval; |
291
|
|
|
|
|
|
|
} |
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
sub print_result { |
294
|
0
|
|
|
0
|
|
0
|
my (%r) = @_; |
295
|
|
|
|
|
|
|
printf "\t%.6g %s is %.6g %s\n", $r{v}, $r{have}, $r{t}, $r{want} |
296
|
0
|
0
|
|
|
|
0
|
if $r{type} eq 'temperature'; |
297
|
|
|
|
|
|
|
printf "\t* %.6g\n\t/ %.6g\n", $r{q}, $r{p} |
298
|
0
|
0
|
|
|
|
0
|
if $r{type} eq 'dimless'; |
299
|
0
|
0
|
|
|
|
0
|
print $r{msg} if $r{type} eq 'error'; |
300
|
|
|
|
|
|
|
} |
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
################################################################ |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
sub usage { |
305
|
0
|
|
|
0
|
|
0
|
my( $class ) = @_; |
306
|
0
|
|
|
|
|
0
|
my @default_unittabs = $class->default_unittabs(); |
307
|
|
|
|
|
|
|
|
308
|
0
|
|
|
|
|
0
|
print STDERR <
|
309
|
|
|
|
|
|
|
Usage: $0 [-f definition-file] [option]... |
310
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
valid options are: |
312
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
-? --help display this help text |
314
|
|
|
|
|
|
|
-f --file use specified definition file instead of |
315
|
|
|
|
|
|
|
@default_unittabs |
316
|
|
|
|
|
|
|
-W --warranty display information about (lack of) warranty |
317
|
|
|
|
|
|
|
-C --copying display information about license |
318
|
|
|
|
|
|
|
--version display version information |
319
|
|
|
|
|
|
|
|
320
|
|
|
|
|
|
|
Report bugs to https://github.com/briandfoy/PerlPowerTools/issues |
321
|
|
|
|
|
|
|
EOM |
322
|
0
|
|
|
|
|
0
|
exit 1; |
323
|
|
|
|
|
|
|
} |
324
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
sub read_defs { |
326
|
20
|
|
|
20
|
|
67
|
my ($class, $filename, $fh) = @_; |
327
|
20
|
|
|
|
|
66
|
while (<$fh>) { |
328
|
8420
|
100
|
|
|
|
20239
|
next if m|\A/|; # comment line |
329
|
8400
|
|
|
|
|
14742
|
trim($_); |
330
|
8400
|
100
|
|
|
|
24363
|
next unless /\S/; |
331
|
|
|
|
|
|
|
|
332
|
7060
|
|
|
|
|
17436
|
debug_d( "$_" ); |
333
|
7060
|
|
|
|
|
14064
|
my $hash = $class->definition_line($_); |
334
|
7060
|
|
|
|
|
18219
|
foreach my $key ( keys %$hash ) { |
335
|
7060
|
|
|
|
|
63283
|
$unittab{$key} = $hash->{$key}; |
336
|
|
|
|
|
|
|
} |
337
|
|
|
|
|
|
|
} |
338
|
|
|
|
|
|
|
} |
339
|
|
|
|
|
|
|
|
340
|
|
|
|
|
|
|
sub definition_line { |
341
|
7060
|
|
|
7060
|
|
11302
|
my ($class, $line) = @_; |
342
|
7060
|
|
|
|
|
24492
|
my ($name, $data) = split /\s+/, $line, 2; |
343
|
7060
|
|
|
|
|
13922
|
my $value = $class->parse_unit($data); |
344
|
7060
|
100
|
|
|
|
16178
|
debug_t("$name => $data") if $data =~ /^\{\s/; |
345
|
7060
|
|
|
|
|
6600
|
my $rc = do { |
346
|
7060
|
100
|
|
|
|
15050
|
if ($data =~ /^\{\s/) { |
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
347
|
60
|
|
|
|
|
7994
|
my $hof = eval $data; # hash of functions |
348
|
60
|
|
|
|
|
399
|
+{ $name => { _ => 1, hof => $hof, Temperature => 1 } } |
349
|
|
|
|
|
|
|
} |
350
|
0
|
|
|
|
|
0
|
elsif (is_Zero($value)) { undef } |
351
|
180
|
|
|
|
|
685
|
elsif (is_fundamental($value)) { +{ $name => {_ => 1, $name => 1} } } |
352
|
6820
|
|
|
|
|
20498
|
else { +{ $name => $value } } |
353
|
|
|
|
|
|
|
}; |
354
|
|
|
|
|
|
|
|
355
|
7060
|
50
|
|
|
|
11154
|
unless( defined $rc ) { |
356
|
0
|
|
|
|
|
0
|
$line =~ s/\s+/ => /; |
357
|
0
|
|
|
|
|
0
|
warn "Parse error: $PARSE_ERROR in $line. Skipping.\n"; |
358
|
0
|
|
|
|
|
0
|
$rc = {}; |
359
|
|
|
|
|
|
|
} |
360
|
|
|
|
|
|
|
|
361
|
7060
|
|
|
|
|
11669
|
return $rc; |
362
|
|
|
|
|
|
|
} |
363
|
|
|
|
|
|
|
|
364
|
|
|
|
|
|
|
sub trim { # note that trim() is a L-value sub |
365
|
8440
|
|
|
8440
|
|
17048
|
$_[0] =~ s/\#.*$//;; |
366
|
8440
|
|
|
|
|
47959
|
$_[0] =~ s/\s+$//; |
367
|
8440
|
|
|
|
|
17819
|
$_[0] =~ s/^\s+//; |
368
|
|
|
|
|
|
|
} |
369
|
|
|
|
|
|
|
|
370
|
120
|
|
|
120
|
|
570
|
sub Zero () { +{ _ => 0 } } |
371
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
# here we guard the zero test by first checking to see |
373
|
|
|
|
|
|
|
# if we're dealing with a temperature |
374
|
7040
|
|
66
|
7040
|
|
27827
|
sub is_Zero { !$_[0]{Temperature} && !$_[0]{_} } |
375
|
|
|
|
|
|
|
|
376
|
|
|
|
|
|
|
sub unit_lookup { |
377
|
9602
|
|
|
9602
|
|
13330
|
my ($name) = @_; |
378
|
9602
|
|
|
|
|
23600
|
debug_l( "Looking up unit '$name'" ); |
379
|
9602
|
100
|
|
|
|
29476
|
return $unittab{$name} if exists $unittab{$name}; |
380
|
504
|
100
|
|
|
|
1379
|
if ($name =~ /s$/) { |
381
|
4
|
|
|
|
|
6
|
my $shortname = $name; |
382
|
4
|
|
|
|
|
16
|
$shortname =~ s/s$//; |
383
|
4
|
50
|
|
|
|
20
|
return $unittab{$shortname} if exists $unittab{$shortname}; |
384
|
|
|
|
|
|
|
} |
385
|
500
|
|
|
|
|
2462
|
my ($prefix, $rest) = ($name =~ /^($PREF-?)(.*)/o); |
386
|
500
|
100
|
|
|
|
945
|
unless ($prefix) { |
387
|
60
|
|
|
|
|
142
|
$PARSE_ERROR = "Unknown unit '$name'"; |
388
|
60
|
|
|
|
|
164
|
return Zero; |
389
|
|
|
|
|
|
|
} |
390
|
440
|
|
|
|
|
745
|
my $base_unit = unit_lookup($rest); # Recursive |
391
|
440
|
|
|
|
|
2062
|
con_multiply($base_unit, 10**$PREF{$prefix}); |
392
|
|
|
|
|
|
|
} |
393
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
sub unit_multiply { |
395
|
5064
|
|
|
5064
|
|
6714
|
my ($a, $b) = @_; |
396
|
5064
|
|
|
|
|
5522
|
debug_o( "Multiplying @{[%$a]} by @{[%$b]}: " ); |
|
5064
|
|
|
|
|
30635
|
|
|
5064
|
|
|
|
|
23263
|
|
397
|
5064
|
|
|
|
|
19259
|
my $r = {%$a}; |
398
|
5064
|
|
|
|
|
13308
|
$r->{_} *= $b->{_}; |
399
|
5064
|
|
|
|
|
9773
|
for my $u (keys %$b) { |
400
|
6644
|
100
|
|
|
|
12274
|
next if $u eq '_'; |
401
|
1580
|
|
|
|
|
3104
|
$r->{$u} += $b->{$u}; |
402
|
|
|
|
|
|
|
} |
403
|
5064
|
|
|
|
|
6032
|
debug_o( "\tResult: @{[%$r]}" ); |
|
5064
|
|
|
|
|
32327
|
|
404
|
5064
|
|
|
|
|
10545
|
$r; |
405
|
|
|
|
|
|
|
} |
406
|
|
|
|
|
|
|
|
407
|
|
|
|
|
|
|
sub unit_divide { |
408
|
1389
|
|
|
1389
|
|
2764
|
my ($a, $b) = @_; |
409
|
1389
|
|
|
|
|
5133
|
my $r = {%$a}; |
410
|
1389
|
50
|
|
|
|
3501
|
die "Division by zero error" if $b->{_} == 0; |
411
|
1389
|
|
|
|
|
2283
|
$r->{_} /= $b->{_}; |
412
|
1389
|
|
|
|
|
2895
|
for my $u (keys %$b) { |
413
|
2899
|
100
|
|
|
|
4988
|
next if $u eq '_'; |
414
|
1510
|
|
|
|
|
3140
|
$r->{$u} -= $b->{$u}; |
415
|
|
|
|
|
|
|
} |
416
|
1389
|
|
|
|
|
2373
|
$r; |
417
|
|
|
|
|
|
|
} |
418
|
|
|
|
|
|
|
|
419
|
|
|
|
|
|
|
sub unit_power { |
420
|
1481
|
|
|
1481
|
|
2389
|
my ($p, $u) = @_; |
421
|
1481
|
|
|
|
|
1692
|
debug_o( "Raising unit @{[%$u]} to power $p." ); |
|
1481
|
|
|
|
|
10761
|
|
422
|
1481
|
|
|
|
|
5246
|
my $r = {%$u}; |
423
|
1481
|
|
|
|
|
3996
|
$r->{_} **= $p; |
424
|
1481
|
|
|
|
|
3611
|
for my $d (keys %$r) { |
425
|
2982
|
100
|
|
|
|
4733
|
next if $d eq '_'; |
426
|
1501
|
|
|
|
|
2414
|
$r->{$d} *= $p; |
427
|
|
|
|
|
|
|
} |
428
|
1481
|
|
|
|
|
2058
|
debug_o( "\tResult: @{[%$r]}" ); |
|
1481
|
|
|
|
|
9575
|
|
429
|
1481
|
|
|
|
|
3040
|
$r; |
430
|
|
|
|
|
|
|
} |
431
|
|
|
|
|
|
|
|
432
|
|
|
|
|
|
|
sub unit_dimensionless { |
433
|
4204
|
|
|
4204
|
|
13854
|
debug_o( "Turning $_[0] into a dimensionless unit." ); |
434
|
4204
|
|
|
|
|
10071
|
return +{_ => $_[0]}; |
435
|
|
|
|
|
|
|
} |
436
|
|
|
|
|
|
|
|
437
|
|
|
|
|
|
|
sub con_multiply { |
438
|
484
|
|
|
484
|
|
855
|
my ($u, $c) = @_; |
439
|
484
|
|
|
|
|
709
|
debug_o( "Multiplying unit @{[%$u]} by constant $c." ); |
|
484
|
|
|
|
|
4460
|
|
440
|
484
|
|
|
|
|
1816
|
my $r = {%$u}; |
441
|
484
|
|
|
|
|
1078
|
$r->{_} *= $c; |
442
|
484
|
|
|
|
|
618
|
debug_o( "\tResult: @{[%$r]}" ); |
|
484
|
|
|
|
|
3363
|
|
443
|
484
|
|
|
|
|
1144
|
$r; |
444
|
|
|
|
|
|
|
} |
445
|
|
|
|
|
|
|
|
446
|
|
|
|
|
|
|
sub is_dimensionless { |
447
|
7
|
|
|
7
|
|
20
|
my ($r) = @_; |
448
|
7
|
|
|
|
|
18
|
for my $u (keys %$r) { |
449
|
15
|
100
|
|
|
|
30
|
next if $u eq '_'; |
450
|
8
|
50
|
|
|
|
24
|
return if $r->{$u} != 0; |
451
|
|
|
|
|
|
|
} |
452
|
7
|
|
|
|
|
24
|
return 1; |
453
|
|
|
|
|
|
|
} |
454
|
|
|
|
|
|
|
|
455
|
|
|
|
|
|
|
# Generate bogus unit value that signals that a new fundamental unit |
456
|
|
|
|
|
|
|
# is being defined |
457
|
|
|
|
|
|
|
sub new_fundamental_unit { |
458
|
180
|
|
|
180
|
|
507
|
return +{__ => 'new', _ => 1}; |
459
|
|
|
|
|
|
|
} |
460
|
|
|
|
|
|
|
|
461
|
|
|
|
|
|
|
# Recognize this bogus value when it appears again. |
462
|
|
|
|
|
|
|
sub is_fundamental { |
463
|
7000
|
|
|
7000
|
|
12587
|
exists $_[0]{__}; |
464
|
|
|
|
|
|
|
} |
465
|
|
|
|
|
|
|
|
466
|
|
|
|
|
|
|
sub text_unit { |
467
|
0
|
|
|
0
|
|
0
|
my ($u) = @_; |
468
|
0
|
|
|
|
|
0
|
my (@pos, @neg); |
469
|
0
|
|
|
|
|
0
|
my $c = $u->{_}; |
470
|
0
|
|
|
|
|
0
|
for my $k (sort keys %$u) { |
471
|
0
|
0
|
0
|
|
|
0
|
next if $k eq '_' or $k eq 'hof'; |
472
|
0
|
0
|
|
|
|
0
|
push @pos, $k if $u->{$k} > 0; |
473
|
0
|
0
|
|
|
|
0
|
push @neg, $k if $u->{$k} < 0; |
474
|
|
|
|
|
|
|
} |
475
|
0
|
0
|
|
|
|
0
|
my $text = ($c == 1 ? '' : $c); |
476
|
0
|
|
|
|
|
0
|
for my $d (@pos) { |
477
|
0
|
|
|
|
|
0
|
my $e = $u->{$d}; |
478
|
0
|
|
|
|
|
0
|
$text .= " $d"; |
479
|
0
|
0
|
|
|
|
0
|
$text .= "^$e" if $e > 1; |
480
|
|
|
|
|
|
|
} |
481
|
|
|
|
|
|
|
|
482
|
0
|
0
|
|
|
|
0
|
$text .= ' per' if @neg; |
483
|
0
|
|
|
|
|
0
|
for my $d (@neg) { |
484
|
0
|
|
|
|
|
0
|
my $e = - $u->{$d}; |
485
|
0
|
|
|
|
|
0
|
$text .= " $d"; |
486
|
0
|
0
|
|
|
|
0
|
$text .= "^$e" if $e > 1; |
487
|
|
|
|
|
|
|
} |
488
|
|
|
|
|
|
|
|
489
|
0
|
|
|
|
|
0
|
$text; |
490
|
|
|
|
|
|
|
} |
491
|
|
|
|
|
|
|
################################################################ |
492
|
|
|
|
|
|
|
# |
493
|
|
|
|
|
|
|
# I'm the parser |
494
|
|
|
|
|
|
|
# |
495
|
|
|
|
|
|
|
|
496
|
|
|
|
|
|
|
our @actions; |
497
|
|
|
|
|
|
|
BEGIN { |
498
|
48
|
|
|
48
|
|
169
|
sub sh { ['shift', $_[0]] }; |
499
|
13
|
|
|
13
|
|
55
|
sub go { ['goto', $_[0]] }; |
500
|
|
|
|
|
|
|
|
501
|
1
|
|
|
1
|
|
5
|
my $eof_state = 98; |
502
|
|
|
|
|
|
|
|
503
|
|
|
|
|
|
|
@actions = |
504
|
|
|
|
|
|
|
( |
505
|
|
|
|
|
|
|
# Initial state |
506
|
|
|
|
|
|
|
{ |
507
|
|
|
|
|
|
|
PREFIX => sh(1), |
508
|
|
|
|
|
|
|
NUMBER => sh(2), |
509
|
|
|
|
|
|
|
NAME => sh(3), |
510
|
|
|
|
|
|
|
FUNDAMENTAL => sh(4), |
511
|
|
|
|
|
|
|
FRACTION => sh(5), |
512
|
|
|
|
|
|
|
POWER => sh(17), |
513
|
|
|
|
|
|
|
'(' => sh(6), |
514
|
|
|
|
|
|
|
'unit' => go(7), |
515
|
|
|
|
|
|
|
'topunit' => go($eof_state), |
516
|
|
|
|
|
|
|
'constant' => go(8), |
517
|
|
|
|
|
|
|
}, |
518
|
|
|
|
|
|
|
|
519
|
|
|
|
|
|
|
# State 1: constant -> PREFIX . |
520
|
|
|
|
|
|
|
{ _ => ['reduce', 1, 'constant']}, |
521
|
|
|
|
|
|
|
|
522
|
|
|
|
|
|
|
# State 2: constant -> NUMBER . |
523
|
|
|
|
|
|
|
{ _ => ['reduce', 1, 'constant']}, |
524
|
|
|
|
|
|
|
|
525
|
|
|
|
|
|
|
# State 3: unit -> NAME . |
526
|
|
|
|
|
|
|
{ _ => ['reduce', 1, 'unit', \&unit_lookup ]}, |
527
|
|
|
|
|
|
|
|
528
|
|
|
|
|
|
|
# State 4: unit -> FUNDAMENTAL . |
529
|
|
|
|
|
|
|
{ _ => ['reduce', 1, 'unit', \&new_fundamental_unit ]}, |
530
|
|
|
|
|
|
|
|
531
|
|
|
|
|
|
|
# State 5: constant -> FRACTION . |
532
|
|
|
|
|
|
|
{ _ => ['reduce', 1, 'constant']}, |
533
|
|
|
|
|
|
|
|
534
|
|
|
|
|
|
|
# State 6: unit -> '(' . unit ')' |
535
|
|
|
|
|
|
|
{PREFIX => sh(1), |
536
|
|
|
|
|
|
|
NUMBER => sh(2), |
537
|
|
|
|
|
|
|
NAME => sh(3), |
538
|
|
|
|
|
|
|
FUNDAMENTAL => sh(4), |
539
|
|
|
|
|
|
|
FRACTION => sh(5), |
540
|
|
|
|
|
|
|
'(' => sh(6), |
541
|
|
|
|
|
|
|
'unit' => go(9), |
542
|
|
|
|
|
|
|
'constant' => go(8), |
543
|
|
|
|
|
|
|
}, |
544
|
|
|
|
|
|
|
|
545
|
|
|
|
|
|
|
# State 7: topunit -> unit . |
546
|
|
|
|
|
|
|
# unit -> unit . TIMES unit |
547
|
|
|
|
|
|
|
# unit -> unit . DIVIDE unit |
548
|
|
|
|
|
|
|
# unit -> unit . NUMBER |
549
|
|
|
|
|
|
|
{NUMBER => sh(10), |
550
|
|
|
|
|
|
|
TIMES => sh(11), |
551
|
|
|
|
|
|
|
DIVIDE => sh(12), |
552
|
|
|
|
|
|
|
POWER => sh(17), |
553
|
|
|
|
|
|
|
_ => ['reduce', 1, 'topunit'], |
554
|
|
|
|
|
|
|
}, |
555
|
|
|
|
|
|
|
|
556
|
|
|
|
|
|
|
# State 8: unit -> constant . unit |
557
|
|
|
|
|
|
|
# unit -> constant . |
558
|
|
|
|
|
|
|
{PREFIX => sh(1), |
559
|
|
|
|
|
|
|
NUMBER => sh(2), # Shift-reduce conflict resolved in favor of shift |
560
|
|
|
|
|
|
|
NAME => sh(3), |
561
|
|
|
|
|
|
|
FUNDAMENTAL => sh(4), |
562
|
|
|
|
|
|
|
FRACTION => sh(5), |
563
|
|
|
|
|
|
|
'(' => sh(6), |
564
|
|
|
|
|
|
|
_ => ['reduce', 1, 'unit', \&unit_dimensionless], |
565
|
|
|
|
|
|
|
'unit' => go(13), |
566
|
|
|
|
|
|
|
'constant' => go(8), |
567
|
|
|
|
|
|
|
}, |
568
|
|
|
|
|
|
|
|
569
|
|
|
|
|
|
|
# State 9: unit -> unit . TIMES unit |
570
|
|
|
|
|
|
|
# unit -> unit . DIVIDE unit |
571
|
|
|
|
|
|
|
# unit -> '(' unit . ')' |
572
|
|
|
|
|
|
|
# unit -> unit . NUMBER |
573
|
|
|
|
|
|
|
{NUMBER => sh(10), |
574
|
|
|
|
|
|
|
TIMES => sh(11), |
575
|
|
|
|
|
|
|
DIVIDE => sh(12), |
576
|
|
|
|
|
|
|
POWER => sh(17), |
577
|
|
|
|
|
|
|
')' => sh(14), |
578
|
|
|
|
|
|
|
}, |
579
|
|
|
|
|
|
|
|
580
|
|
|
|
|
|
|
# State 10: unit -> unit NUMBER . |
581
|
|
|
|
|
|
|
{ _ => ['reduce', 2, 'unit', |
582
|
|
|
|
|
|
|
sub { |
583
|
1481
|
50
|
|
|
|
3759
|
unless (int($_[1]) == $_[1]) { |
584
|
0
|
|
|
|
|
0
|
ABORT("Nonintegral power $_[1]"); |
585
|
0
|
|
|
|
|
0
|
return Zero; |
586
|
|
|
|
|
|
|
} |
587
|
1481
|
|
|
|
|
2653
|
unit_power(@_); |
588
|
|
|
|
|
|
|
} |
589
|
|
|
|
|
|
|
], |
590
|
|
|
|
|
|
|
}, |
591
|
|
|
|
|
|
|
|
592
|
|
|
|
|
|
|
# State 11: unit -> unit TIMES . unit |
593
|
|
|
|
|
|
|
{PREFIX => sh(1), |
594
|
|
|
|
|
|
|
NUMBER => sh(2), |
595
|
|
|
|
|
|
|
NAME => sh(3), |
596
|
|
|
|
|
|
|
FUNDAMENTAL => sh(4), |
597
|
|
|
|
|
|
|
FRACTION => sh(5), |
598
|
|
|
|
|
|
|
'(' => sh(6), |
599
|
|
|
|
|
|
|
'unit' => go(15), |
600
|
|
|
|
|
|
|
'constant' => go(8), |
601
|
|
|
|
|
|
|
}, |
602
|
|
|
|
|
|
|
|
603
|
|
|
|
|
|
|
# State 12: unit -> unit DIVIDE . unit |
604
|
|
|
|
|
|
|
{PREFIX => sh(1), |
605
|
|
|
|
|
|
|
NUMBER => sh(2), |
606
|
|
|
|
|
|
|
NAME => sh(3), |
607
|
|
|
|
|
|
|
FUNDAMENTAL => sh(4), |
608
|
|
|
|
|
|
|
FRACTION => sh(5), |
609
|
|
|
|
|
|
|
'(' => sh(6), |
610
|
|
|
|
|
|
|
'unit' => go(16), |
611
|
|
|
|
|
|
|
'constant' => go(8), |
612
|
|
|
|
|
|
|
}, |
613
|
|
|
|
|
|
|
|
614
|
|
|
|
|
|
|
# State 13: unit -> unit . TIMES unit |
615
|
|
|
|
|
|
|
# unit -> unit . DIVIDE unit |
616
|
|
|
|
|
|
|
# unit -> constant unit . |
617
|
|
|
|
|
|
|
# unit -> unit . NUMBER |
618
|
|
|
|
|
|
|
{NUMBER => sh(10), # Shift-reduce conflict resolved in favor of shift |
619
|
|
|
|
|
|
|
TIMES => sh(11), # Shift-reduce conflict resolved in favor of shift |
620
|
|
|
|
|
|
|
DIVIDE => sh(12), # Shift-reduce conflict resolved in favor of shift |
621
|
|
|
|
|
|
|
POWER => sh(17), |
622
|
|
|
|
|
|
|
_ => ['reduce', 2, 'unit', \&con_multiply], |
623
|
|
|
|
|
|
|
}, |
624
|
|
|
|
|
|
|
|
625
|
|
|
|
|
|
|
# State 14: unit => '(' unit ')' . |
626
|
0
|
|
|
|
|
0
|
{ _ => ['reduce', 3, 'unit', sub {$_[1]}] }, |
627
|
|
|
|
|
|
|
|
628
|
|
|
|
|
|
|
# State 15: unit -> unit . TIMES unit |
629
|
|
|
|
|
|
|
# unit -> unit TIMES unit . |
630
|
|
|
|
|
|
|
# unit -> unit . DIVIDE unit |
631
|
|
|
|
|
|
|
# unit -> unit . NUMBER |
632
|
|
|
|
|
|
|
{NUMBER => sh(10), # Shift-reduce conflict resolved in favor of shift |
633
|
5064
|
|
|
|
|
8791
|
_ => ['reduce', 3, 'unit', sub {unit_multiply($_[0], $_[2])}], |
634
|
|
|
|
|
|
|
}, |
635
|
|
|
|
|
|
|
|
636
|
|
|
|
|
|
|
# State 16: unit -> unit . TIMES unit |
637
|
|
|
|
|
|
|
# unit -> unit DIVIDE unit . |
638
|
|
|
|
|
|
|
# unit -> unit . DIVIDE unit |
639
|
|
|
|
|
|
|
# unit -> unit . NUMBER |
640
|
|
|
|
|
|
|
{NUMBER => sh(10), # Shift-reduce conflict resolved in favor of shift |
641
|
1382
|
|
|
|
|
2636
|
_ => ['reduce', 3, 'unit', sub{unit_divide($_[2], $_[0])}], |
642
|
|
|
|
|
|
|
}, |
643
|
|
|
|
|
|
|
|
644
|
|
|
|
|
|
|
# State 17: unit -> unit POWER . unit |
645
|
|
|
|
|
|
|
{ |
646
|
|
|
|
|
|
|
NUMBER => sh(2), |
647
|
|
|
|
|
|
|
'constant' => go(18), |
648
|
|
|
|
|
|
|
}, |
649
|
|
|
|
|
|
|
|
650
|
|
|
|
|
|
|
# State 18: unit -> unit POWER |
651
|
|
|
|
|
|
|
{ |
652
|
|
|
|
|
|
|
NUMBER => sh(2), |
653
|
1
|
|
|
|
|
3
|
_ => ['reduce', 3, 'unit', sub{ unit_power($_[0], $_[2])}], |
|
0
|
|
|
|
|
0
|
|
654
|
|
|
|
|
|
|
}, |
655
|
|
|
|
|
|
|
|
656
|
|
|
|
|
|
|
); |
657
|
|
|
|
|
|
|
|
658
|
1
|
|
|
|
|
8
|
$actions[98] = {EOF => go($eof_state + 1),}; |
659
|
1
|
|
|
|
|
1608
|
$actions[99] = {_ => ['accept']}; |
660
|
|
|
|
|
|
|
} |
661
|
|
|
|
|
|
|
|
662
|
|
|
|
|
|
|
sub ABORT { |
663
|
0
|
|
|
0
|
|
0
|
$PARSE_ERROR = shift; |
664
|
|
|
|
|
|
|
} |
665
|
|
|
|
|
|
|
|
666
|
|
|
|
|
|
|
sub parse_unit { |
667
|
7100
|
|
|
7100
|
|
11251
|
my ($class, $s) = @_; |
668
|
7100
|
|
|
|
|
9161
|
my $tokens = lex($s); |
669
|
7100
|
|
|
|
|
8505
|
my $STATE = 0; |
670
|
7100
|
|
|
|
|
7786
|
my (@state_st, @val_st); |
671
|
|
|
|
|
|
|
|
672
|
7100
|
|
|
|
|
7496
|
$PARSE_ERROR = undef; |
673
|
|
|
|
|
|
|
|
674
|
7100
|
|
|
|
|
11870
|
debug_p( '-' x 50 . "\n" ); |
675
|
|
|
|
|
|
|
# Now let's run the parser |
676
|
7100
|
|
|
|
|
7746
|
for (;;) { |
677
|
68462
|
100
|
|
|
|
101922
|
return Zero if $PARSE_ERROR; |
678
|
|
|
|
|
|
|
|
679
|
68402
|
|
|
|
|
122569
|
debug_p( "Tokens: " . join( ' ', map { "<$_>" } @$tokens ) ); |
|
98465
|
|
|
|
|
218250
|
|
680
|
68402
|
100
|
|
|
|
124825
|
my $la = @$tokens ? token_type($tokens->[0]) : 'EOF'; |
681
|
68402
|
|
|
|
|
150418
|
debug_p( "Now in state $STATE. Lookahead type is $la." ); |
682
|
68402
|
|
|
|
|
144340
|
debug_p( "State stack is (@state_st)." ); |
683
|
68402
|
|
|
|
|
76107
|
my $actiontab = $actions[$STATE]; |
684
|
68402
|
|
66
|
|
|
149945
|
my $action = $actiontab->{$la} || $actiontab->{_}; |
685
|
68402
|
50
|
|
|
|
92593
|
unless ($action) { |
686
|
0
|
|
|
|
|
0
|
$PARSE_ERROR = 'Syntax error'; |
687
|
0
|
|
|
|
|
0
|
return Zero; |
688
|
|
|
|
|
|
|
} |
689
|
|
|
|
|
|
|
|
690
|
68402
|
|
|
|
|
106387
|
my ($primary, @actargs) = @$action; |
691
|
68402
|
|
|
|
|
174939
|
debug_p( "Next thing: $primary (@actargs)" ); |
692
|
68402
|
100
|
|
|
|
139202
|
if ($primary eq 'accept') { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
693
|
7040
|
|
|
|
|
19908
|
return $val_st[0]; # Success! |
694
|
|
|
|
|
|
|
} elsif ($primary eq 'shift') { |
695
|
21517
|
|
|
|
|
26813
|
my $token = shift @$tokens; |
696
|
21517
|
|
|
|
|
27818
|
my $val = token_value($token); |
697
|
21517
|
|
|
|
|
58851
|
debug_p( "shift: token: <$token> val: <$val>" ); |
698
|
21517
|
|
|
|
|
32215
|
push @val_st, $val; |
699
|
21517
|
|
|
|
|
23639
|
push @state_st, $STATE; |
700
|
21517
|
|
|
|
|
24776
|
$STATE = $actargs[0]; |
701
|
21517
|
|
|
|
|
31466
|
debug_p( "shift: state: <$STATE>" ); |
702
|
|
|
|
|
|
|
} elsif ($primary eq 'goto') { |
703
|
7040
|
|
|
|
|
10702
|
$STATE = $actargs[0]; |
704
|
|
|
|
|
|
|
} elsif ($primary eq 'reduce') { |
705
|
32805
|
|
|
|
|
49957
|
my ($n_args, $result_type, $semantic) = @actargs; |
706
|
32805
|
|
|
|
|
31484
|
my @arglist; |
707
|
32805
|
|
|
|
|
55026
|
while ($n_args--) { |
708
|
47222
|
|
|
|
|
54239
|
push @arglist, pop @val_st; |
709
|
47222
|
|
|
|
|
80313
|
$STATE = pop @state_st; |
710
|
|
|
|
|
|
|
} |
711
|
32805
|
100
|
|
|
|
53705
|
my $result = $semantic ? &$semantic(@arglist) : $arglist[0]; |
712
|
32805
|
|
|
|
|
43548
|
push @val_st, $result; |
713
|
32805
|
|
|
|
|
41297
|
push @state_st, $STATE; |
714
|
32805
|
|
|
|
|
48728
|
debug_p( "reduce: Value stack is " . dumper( \@val_st ) ); |
715
|
|
|
|
|
|
|
|
716
|
32805
|
|
|
|
|
190889
|
debug_p( "Post-reduction state is $STATE." ); |
717
|
|
|
|
|
|
|
|
718
|
|
|
|
|
|
|
# Now look for 'goto' actions |
719
|
32805
|
|
|
|
|
50598
|
my $goto = $actions[$STATE]{$result_type}; |
720
|
32805
|
50
|
33
|
|
|
106613
|
unless ($goto && $goto->[0] eq 'goto') { |
721
|
0
|
|
|
|
|
0
|
die "No post-reduction goto in state $STATE for $result_type.\n"; |
722
|
|
|
|
|
|
|
} |
723
|
32805
|
|
|
|
|
65299
|
debug_p( "goto $goto->[1]" ); |
724
|
32805
|
|
|
|
|
77314
|
$STATE = $goto->[1]; |
725
|
|
|
|
|
|
|
} else { |
726
|
0
|
|
|
|
|
0
|
die "Bad primary $primary"; |
727
|
|
|
|
|
|
|
} |
728
|
|
|
|
|
|
|
} |
729
|
|
|
|
|
|
|
} |
730
|
|
|
|
|
|
|
|
731
|
|
|
|
|
|
|
|
732
|
|
|
|
|
|
|
sub lex { |
733
|
7100
|
|
|
7100
|
|
8476
|
my ($s) = @_; |
734
|
7100
|
|
|
|
|
7540
|
my $N = '(?:\d+\.\d+|\d+|\.\d+)(?:[eE][-+]?\d+)?'; |
735
|
|
|
|
|
|
|
|
736
|
7100
|
|
|
|
|
82990
|
my @t = split /( |
737
|
|
|
|
|
|
|
(?: \*.\* | !.! ) # Special 'new unit' symbol |
738
|
|
|
|
|
|
|
| [()*-] # Symbol |
739
|
|
|
|
|
|
|
| \s*(?:\/|\bper\b)\s* # Division |
740
|
|
|
|
|
|
|
| (?:$N\|$N) # Fraction |
741
|
|
|
|
|
|
|
| $N # Decimal number |
742
|
|
|
|
|
|
|
| \d+ # Integer |
743
|
|
|
|
|
|
|
| [A-Za-z_][A-Za-z_.]* # identifier |
744
|
|
|
|
|
|
|
| \s+ # White space |
745
|
|
|
|
|
|
|
)/ox, $s; |
746
|
7100
|
50
|
|
|
|
14127
|
@t = grep {defined and $_ ne ''} @t; # Discard empty and all-white tokens |
|
47154
|
|
|
|
|
122105
|
|
747
|
7100
|
|
|
|
|
26939
|
debug_p( "Input: $s Tokens: @t" ); |
748
|
7100
|
|
|
|
|
13203
|
\@t; |
749
|
|
|
|
|
|
|
} |
750
|
|
|
|
|
|
|
|
751
|
|
|
|
|
|
|
sub token_type { |
752
|
35112
|
|
|
35112
|
|
47438
|
my ($token) = @_; |
753
|
35112
|
50
|
|
|
|
52726
|
return $token->[0] if ref $token; |
754
|
35112
|
50
|
|
|
|
73570
|
return $token if $token =~ /[()]/; |
755
|
35112
|
100
|
|
|
|
83277
|
return 'TIMES' if $token =~ /^\s+$/; |
756
|
22520
|
100
|
|
|
|
33241
|
return 'FUNDAMENTAL' if $token =~ m/\A(!.!|\*.\*)\z/; |
757
|
22340
|
100
|
|
|
|
58849
|
return 'DIVIDE' if $token =~ /^\s*(\/|\bper\b)\s*$/; |
758
|
18716
|
100
|
66
|
|
|
55432
|
return 'TIMES' if $token eq '*' || $token eq '-'; |
759
|
16416
|
100
|
|
|
|
28165
|
return 'FRACTION' if $token =~ /^\d+\|\d+$/; |
760
|
15615
|
100
|
|
|
|
33149
|
return 'NUMBER' if $token =~ /^[.\d]/; |
761
|
9206
|
50
|
|
|
|
12914
|
return 'POWER' if $token eq '^'; |
762
|
9206
|
|
|
|
|
12683
|
return 'NAME'; |
763
|
|
|
|
|
|
|
} |
764
|
|
|
|
|
|
|
|
765
|
|
|
|
|
|
|
sub token_value { |
766
|
21517
|
|
|
21517
|
|
28548
|
my ($token) = @_; |
767
|
21517
|
|
|
|
|
44690
|
debug_p( "TOKEN VALUE: <$token>" ); |
768
|
|
|
|
|
|
|
|
769
|
21517
|
|
|
|
|
22476
|
my $rc = do { |
770
|
21517
|
100
|
|
|
|
65843
|
if( $token =~ /^([()*\/-]|\s*\bper\b\s*)$/ ) { $token } |
|
2162
|
100
|
|
|
|
3216
|
|
771
|
|
|
|
|
|
|
elsif( $token =~ /(\d+)\|(\d+)/ ) { |
772
|
841
|
50
|
|
|
|
3286
|
if( $2 == 0 ) { |
773
|
0
|
|
|
|
|
0
|
ABORT("Zero denominator in fraction '$token'"); |
774
|
0
|
|
|
|
|
0
|
return 0; |
775
|
|
|
|
|
|
|
} |
776
|
841
|
|
|
|
|
2178
|
$1/$2; |
777
|
|
|
|
|
|
|
} |
778
|
18514
|
|
|
|
|
27721
|
else { $token } |
779
|
|
|
|
|
|
|
}; |
780
|
|
|
|
|
|
|
|
781
|
21517
|
|
|
|
|
34576
|
return $rc; # Perl takes care of the others. |
782
|
|
|
|
|
|
|
} |
783
|
|
|
|
|
|
|
|
784
|
|
|
|
|
|
|
sub WARRANTY { |
785
|
0
|
|
|
0
|
|
|
print <
|
786
|
|
|
|
|
|
|
11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY |
787
|
|
|
|
|
|
|
FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN |
788
|
|
|
|
|
|
|
OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES |
789
|
|
|
|
|
|
|
PROVIDE THE PROGRAM \"AS IS\" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED |
790
|
|
|
|
|
|
|
OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF |
791
|
|
|
|
|
|
|
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS |
792
|
|
|
|
|
|
|
TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE |
793
|
|
|
|
|
|
|
PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, |
794
|
|
|
|
|
|
|
REPAIR OR CORRECTION. |
795
|
|
|
|
|
|
|
|
796
|
|
|
|
|
|
|
12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING |
797
|
|
|
|
|
|
|
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR |
798
|
|
|
|
|
|
|
REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, |
799
|
|
|
|
|
|
|
INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING |
800
|
|
|
|
|
|
|
OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED |
801
|
|
|
|
|
|
|
TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY |
802
|
|
|
|
|
|
|
YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER |
803
|
|
|
|
|
|
|
PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE |
804
|
|
|
|
|
|
|
POSSIBILITY OF SUCH DAMAGES. |
805
|
|
|
|
|
|
|
EOM |
806
|
|
|
|
|
|
|
} |
807
|
|
|
|
|
|
|
|
808
|
|
|
|
|
|
|
sub COPYING { |
809
|
0
|
|
|
0
|
|
|
print <
|
810
|
|
|
|
|
|
|
GNU GENERAL PUBLIC LICENSE |
811
|
|
|
|
|
|
|
Version 2, June 1991 |
812
|
|
|
|
|
|
|
|
813
|
|
|
|
|
|
|
Copyright (C) 1989, 1991 Free Software Foundation, Inc. |
814
|
|
|
|
|
|
|
675 Mass Ave, Cambridge, MA 02139, USA |
815
|
|
|
|
|
|
|
Everyone is permitted to copy and distribute verbatim copies |
816
|
|
|
|
|
|
|
of this license document, but changing it is not allowed. |
817
|
|
|
|
|
|
|
|
818
|
|
|
|
|
|
|
Preamble |
819
|
|
|
|
|
|
|
|
820
|
|
|
|
|
|
|
The licenses for most software are designed to take away your |
821
|
|
|
|
|
|
|
freedom to share and change it. By contrast, the GNU General Public |
822
|
|
|
|
|
|
|
License is intended to guarantee your freedom to share and change free |
823
|
|
|
|
|
|
|
software--to make sure the software is free for all its users. This |
824
|
|
|
|
|
|
|
General Public License applies to most of the Free Software |
825
|
|
|
|
|
|
|
Foundation's software and to any other program whose authors commit to |
826
|
|
|
|
|
|
|
using it. (Some other Free Software Foundation software is covered by |
827
|
|
|
|
|
|
|
the GNU Library General Public License instead.) You can apply it to |
828
|
|
|
|
|
|
|
your programs, too. |
829
|
|
|
|
|
|
|
|
830
|
|
|
|
|
|
|
When we speak of free software, we are referring to freedom, not |
831
|
|
|
|
|
|
|
price. Our General Public Licenses are designed to make sure that you |
832
|
|
|
|
|
|
|
have the freedom to distribute copies of free software (and charge for |
833
|
|
|
|
|
|
|
this service if you wish), that you receive source code or can get it |
834
|
|
|
|
|
|
|
if you want it, that you can change the software or use pieces of it |
835
|
|
|
|
|
|
|
in new free programs; and that you know you can do these things. |
836
|
|
|
|
|
|
|
|
837
|
|
|
|
|
|
|
To protect your rights, we need to make restrictions that forbid |
838
|
|
|
|
|
|
|
anyone to deny you these rights or to ask you to surrender the rights. |
839
|
|
|
|
|
|
|
These restrictions translate to certain responsibilities for you if you |
840
|
|
|
|
|
|
|
distribute copies of the software, or if you modify it. |
841
|
|
|
|
|
|
|
|
842
|
|
|
|
|
|
|
For example, if you distribute copies of such a program, whether |
843
|
|
|
|
|
|
|
gratis or for a fee, you must give the recipients all the rights that |
844
|
|
|
|
|
|
|
you have. You must make sure that they, too, receive or can get the |
845
|
|
|
|
|
|
|
source code. And you must show them these terms so they know their |
846
|
|
|
|
|
|
|
rights. |
847
|
|
|
|
|
|
|
|
848
|
|
|
|
|
|
|
We protect your rights with two steps: (1) copyright the software, and |
849
|
|
|
|
|
|
|
(2) offer you this license which gives you legal permission to copy, |
850
|
|
|
|
|
|
|
distribute and/or modify the software. |
851
|
|
|
|
|
|
|
|
852
|
|
|
|
|
|
|
Also, for each author's protection and ours, we want to make certain |
853
|
|
|
|
|
|
|
that everyone understands that there is no warranty for this free |
854
|
|
|
|
|
|
|
software. If the software is modified by someone else and passed on, we |
855
|
|
|
|
|
|
|
want its recipients to know that what they have is not the original, so |
856
|
|
|
|
|
|
|
that any problems introduced by others will not reflect on the original |
857
|
|
|
|
|
|
|
authors' reputations. |
858
|
|
|
|
|
|
|
|
859
|
|
|
|
|
|
|
Finally, any free program is threatened constantly by software |
860
|
|
|
|
|
|
|
patents. We wish to avoid the danger that redistributors of a free |
861
|
|
|
|
|
|
|
program will individually obtain patent licenses, in effect making the |
862
|
|
|
|
|
|
|
program proprietary. To prevent this, we have made it clear that any |
863
|
|
|
|
|
|
|
patent must be licensed for everyone's free use or not licensed at all. |
864
|
|
|
|
|
|
|
|
865
|
|
|
|
|
|
|
The precise terms and conditions for copying, distribution and |
866
|
|
|
|
|
|
|
modification follow. |
867
|
|
|
|
|
|
|
|
868
|
|
|
|
|
|
|
GNU GENERAL PUBLIC LICENSE |
869
|
|
|
|
|
|
|
TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION |
870
|
|
|
|
|
|
|
|
871
|
|
|
|
|
|
|
0. This License applies to any program or other work which contains |
872
|
|
|
|
|
|
|
a notice placed by the copyright holder saying it may be distributed |
873
|
|
|
|
|
|
|
under the terms of this General Public License. The "Program", below, |
874
|
|
|
|
|
|
|
refers to any such program or work, and a "work based on the Program" |
875
|
|
|
|
|
|
|
means either the Program or any derivative work under copyright law: |
876
|
|
|
|
|
|
|
that is to say, a work containing the Program or a portion of it, |
877
|
|
|
|
|
|
|
either verbatim or with modifications and/or translated into another |
878
|
|
|
|
|
|
|
language. (Hereinafter, translation is included without limitation in |
879
|
|
|
|
|
|
|
the term "modification".) Each licensee is addressed as "you". |
880
|
|
|
|
|
|
|
|
881
|
|
|
|
|
|
|
Activities other than copying, distribution and modification are not |
882
|
|
|
|
|
|
|
covered by this License; they are outside its scope. The act of |
883
|
|
|
|
|
|
|
running the Program is not restricted, and the output from the Program |
884
|
|
|
|
|
|
|
is covered only if its contents constitute a work based on the |
885
|
|
|
|
|
|
|
Program (independent of having been made by running the Program). |
886
|
|
|
|
|
|
|
Whether that is true depends on what the Program does. |
887
|
|
|
|
|
|
|
|
888
|
|
|
|
|
|
|
1. You may copy and distribute verbatim copies of the Program's |
889
|
|
|
|
|
|
|
source code as you receive it, in any medium, provided that you |
890
|
|
|
|
|
|
|
conspicuously and appropriately publish on each copy an appropriate |
891
|
|
|
|
|
|
|
copyright notice and disclaimer of warranty; keep intact all the |
892
|
|
|
|
|
|
|
notices that refer to this License and to the absence of any warranty; |
893
|
|
|
|
|
|
|
and give any other recipients of the Program a copy of this License |
894
|
|
|
|
|
|
|
along with the Program. |
895
|
|
|
|
|
|
|
|
896
|
|
|
|
|
|
|
You may charge a fee for the physical act of transferring a copy, and |
897
|
|
|
|
|
|
|
you may at your option offer warranty protection in exchange for a fee. |
898
|
|
|
|
|
|
|
|
899
|
|
|
|
|
|
|
2. You may modify your copy or copies of the Program or any portion |
900
|
|
|
|
|
|
|
of it, thus forming a work based on the Program, and copy and |
901
|
|
|
|
|
|
|
distribute such modifications or work under the terms of Section 1 |
902
|
|
|
|
|
|
|
above, provided that you also meet all of these conditions: |
903
|
|
|
|
|
|
|
|
904
|
|
|
|
|
|
|
a) You must cause the modified files to carry prominent notices |
905
|
|
|
|
|
|
|
stating that you changed the files and the date of any change. |
906
|
|
|
|
|
|
|
|
907
|
|
|
|
|
|
|
b) You must cause any work that you distribute or publish, that in |
908
|
|
|
|
|
|
|
whole or in part contains or is derived from the Program or any |
909
|
|
|
|
|
|
|
part thereof, to be licensed as a whole at no charge to all third |
910
|
|
|
|
|
|
|
parties under the terms of this License. |
911
|
|
|
|
|
|
|
|
912
|
|
|
|
|
|
|
c) If the modified program normally reads commands interactively |
913
|
|
|
|
|
|
|
when run, you must cause it, when started running for such |
914
|
|
|
|
|
|
|
interactive use in the most ordinary way, to print or display an |
915
|
|
|
|
|
|
|
announcement including an appropriate copyright notice and a |
916
|
|
|
|
|
|
|
notice that there is no warranty (or else, saying that you provide |
917
|
|
|
|
|
|
|
a warranty) and that users may redistribute the program under |
918
|
|
|
|
|
|
|
these conditions, and telling the user how to view a copy of this |
919
|
|
|
|
|
|
|
License. (Exception: if the Program itself is interactive but |
920
|
|
|
|
|
|
|
does not normally print such an announcement, your work based on |
921
|
|
|
|
|
|
|
the Program is not required to print an announcement.) |
922
|
|
|
|
|
|
|
|
923
|
|
|
|
|
|
|
These requirements apply to the modified work as a whole. If |
924
|
|
|
|
|
|
|
identifiable sections of that work are not derived from the Program, |
925
|
|
|
|
|
|
|
and can be reasonably considered independent and separate works in |
926
|
|
|
|
|
|
|
themselves, then this License, and its terms, do not apply to those |
927
|
|
|
|
|
|
|
sections when you distribute them as separate works. But when you |
928
|
|
|
|
|
|
|
distribute the same sections as part of a whole which is a work based |
929
|
|
|
|
|
|
|
on the Program, the distribution of the whole must be on the terms of |
930
|
|
|
|
|
|
|
this License, whose permissions for other licensees extend to the |
931
|
|
|
|
|
|
|
entire whole, and thus to each and every part regardless of who wrote it. |
932
|
|
|
|
|
|
|
|
933
|
|
|
|
|
|
|
Thus, it is not the intent of this section to claim rights or contest |
934
|
|
|
|
|
|
|
your rights to work written entirely by you; rather, the intent is to |
935
|
|
|
|
|
|
|
exercise the right to control the distribution of derivative or |
936
|
|
|
|
|
|
|
collective works based on the Program. |
937
|
|
|
|
|
|
|
|
938
|
|
|
|
|
|
|
In addition, mere aggregation of another work not based on the Program |
939
|
|
|
|
|
|
|
with the Program (or with a work based on the Program) on a volume of |
940
|
|
|
|
|
|
|
a storage or distribution medium does not bring the other work under |
941
|
|
|
|
|
|
|
the scope of this License. |
942
|
|
|
|
|
|
|
|
943
|
|
|
|
|
|
|
3. You may copy and distribute the Program (or a work based on it, |
944
|
|
|
|
|
|
|
under Section 2) in object code or executable form under the terms of |
945
|
|
|
|
|
|
|
Sections 1 and 2 above provided that you also do one of the following: |
946
|
|
|
|
|
|
|
|
947
|
|
|
|
|
|
|
a) Accompany it with the complete corresponding machine-readable |
948
|
|
|
|
|
|
|
source code, which must be distributed under the terms of Sections |
949
|
|
|
|
|
|
|
1 and 2 above on a medium customarily used for software interchange; or, |
950
|
|
|
|
|
|
|
|
951
|
|
|
|
|
|
|
b) Accompany it with a written offer, valid for at least three |
952
|
|
|
|
|
|
|
years, to give any third party, for a charge no more than your |
953
|
|
|
|
|
|
|
cost of physically performing source distribution, a complete |
954
|
|
|
|
|
|
|
machine-readable copy of the corresponding source code, to be |
955
|
|
|
|
|
|
|
distributed under the terms of Sections 1 and 2 above on a medium |
956
|
|
|
|
|
|
|
customarily used for software interchange; or, |
957
|
|
|
|
|
|
|
|
958
|
|
|
|
|
|
|
c) Accompany it with the information you received as to the offer |
959
|
|
|
|
|
|
|
to distribute corresponding source code. (This alternative is |
960
|
|
|
|
|
|
|
allowed only for noncommercial distribution and only if you |
961
|
|
|
|
|
|
|
received the program in object code or executable form with such |
962
|
|
|
|
|
|
|
an offer, in accord with Subsection b above.) |
963
|
|
|
|
|
|
|
|
964
|
|
|
|
|
|
|
The source code for a work means the preferred form of the work for |
965
|
|
|
|
|
|
|
making modifications to it. For an executable work, complete source |
966
|
|
|
|
|
|
|
code means all the source code for all modules it contains, plus any |
967
|
|
|
|
|
|
|
associated interface definition files, plus the scripts used to |
968
|
|
|
|
|
|
|
control compilation and installation of the executable. However, as a |
969
|
|
|
|
|
|
|
special exception, the source code distributed need not include |
970
|
|
|
|
|
|
|
anything that is normally distributed (in either source or binary |
971
|
|
|
|
|
|
|
form) with the major components (compiler, kernel, and so on) of the |
972
|
|
|
|
|
|
|
operating system on which the executable runs, unless that component |
973
|
|
|
|
|
|
|
itself accompanies the executable. |
974
|
|
|
|
|
|
|
|
975
|
|
|
|
|
|
|
If distribution of executable or object code is made by offering |
976
|
|
|
|
|
|
|
access to copy from a designated place, then offering equivalent |
977
|
|
|
|
|
|
|
access to copy the source code from the same place counts as |
978
|
|
|
|
|
|
|
distribution of the source code, even though third parties are not |
979
|
|
|
|
|
|
|
compelled to copy the source along with the object code. |
980
|
|
|
|
|
|
|
|
981
|
|
|
|
|
|
|
4. You may not copy, modify, sublicense, or distribute the Program |
982
|
|
|
|
|
|
|
except as expressly provided under this License. Any attempt |
983
|
|
|
|
|
|
|
otherwise to copy, modify, sublicense or distribute the Program is |
984
|
|
|
|
|
|
|
void, and will automatically terminate your rights under this License. |
985
|
|
|
|
|
|
|
However, parties who have received copies, or rights, from you under |
986
|
|
|
|
|
|
|
this License will not have their licenses terminated so long as such |
987
|
|
|
|
|
|
|
parties remain in full compliance. |
988
|
|
|
|
|
|
|
|
989
|
|
|
|
|
|
|
5. You are not required to accept this License, since you have not |
990
|
|
|
|
|
|
|
signed it. However, nothing else grants you permission to modify or |
991
|
|
|
|
|
|
|
distribute the Program or its derivative works. These actions are |
992
|
|
|
|
|
|
|
prohibited by law if you do not accept this License. Therefore, by |
993
|
|
|
|
|
|
|
modifying or distributing the Program (or any work based on the |
994
|
|
|
|
|
|
|
Program), you indicate your acceptance of this License to do so, and |
995
|
|
|
|
|
|
|
all its terms and conditions for copying, distributing or modifying |
996
|
|
|
|
|
|
|
the Program or works based on it. |
997
|
|
|
|
|
|
|
|
998
|
|
|
|
|
|
|
6. Each time you redistribute the Program (or any work based on the |
999
|
|
|
|
|
|
|
Program), the recipient automatically receives a license from the |
1000
|
|
|
|
|
|
|
original licensor to copy, distribute or modify the Program subject to |
1001
|
|
|
|
|
|
|
these terms and conditions. You may not impose any further |
1002
|
|
|
|
|
|
|
restrictions on the recipients' exercise of the rights granted herein. |
1003
|
|
|
|
|
|
|
You are not responsible for enforcing compliance by third parties to |
1004
|
|
|
|
|
|
|
this License. |
1005
|
|
|
|
|
|
|
|
1006
|
|
|
|
|
|
|
7. If, as a consequence of a court judgment or allegation of patent |
1007
|
|
|
|
|
|
|
infringement or for any other reason (not limited to patent issues), |
1008
|
|
|
|
|
|
|
conditions are imposed on you (whether by court order, agreement or |
1009
|
|
|
|
|
|
|
otherwise) that contradict the conditions of this License, they do not |
1010
|
|
|
|
|
|
|
excuse you from the conditions of this License. If you cannot |
1011
|
|
|
|
|
|
|
distribute so as to satisfy simultaneously your obligations under this |
1012
|
|
|
|
|
|
|
License and any other pertinent obligations, then as a consequence you |
1013
|
|
|
|
|
|
|
may not distribute the Program at all. For example, if a patent |
1014
|
|
|
|
|
|
|
license would not permit royalty-free redistribution of the Program by |
1015
|
|
|
|
|
|
|
all those who receive copies directly or indirectly through you, then |
1016
|
|
|
|
|
|
|
the only way you could satisfy both it and this License would be to |
1017
|
|
|
|
|
|
|
refrain entirely from distribution of the Program. |
1018
|
|
|
|
|
|
|
|
1019
|
|
|
|
|
|
|
If any portion of this section is held invalid or unenforceable under |
1020
|
|
|
|
|
|
|
any particular circumstance, the balance of the section is intended to |
1021
|
|
|
|
|
|
|
apply and the section as a whole is intended to apply in other |
1022
|
|
|
|
|
|
|
circumstances. |
1023
|
|
|
|
|
|
|
|
1024
|
|
|
|
|
|
|
It is not the purpose of this section to induce you to infringe any |
1025
|
|
|
|
|
|
|
patents or other property right claims or to contest validity of any |
1026
|
|
|
|
|
|
|
such claims; this section has the sole purpose of protecting the |
1027
|
|
|
|
|
|
|
integrity of the free software distribution system, which is |
1028
|
|
|
|
|
|
|
implemented by public license practices. Many people have made |
1029
|
|
|
|
|
|
|
generous contributions to the wide range of software distributed |
1030
|
|
|
|
|
|
|
through that system in reliance on consistent application of that |
1031
|
|
|
|
|
|
|
system; it is up to the author/donor to decide if he or she is willing |
1032
|
|
|
|
|
|
|
to distribute software through any other system and a licensee cannot |
1033
|
|
|
|
|
|
|
impose that choice. |
1034
|
|
|
|
|
|
|
|
1035
|
|
|
|
|
|
|
This section is intended to make thoroughly clear what is believed to |
1036
|
|
|
|
|
|
|
be a consequence of the rest of this License. |
1037
|
|
|
|
|
|
|
|
1038
|
|
|
|
|
|
|
8. If the distribution and/or use of the Program is restricted in |
1039
|
|
|
|
|
|
|
certain countries either by patents or by copyrighted interfaces, the |
1040
|
|
|
|
|
|
|
original copyright holder who places the Program under this License |
1041
|
|
|
|
|
|
|
may add an explicit geographical distribution limitation excluding |
1042
|
|
|
|
|
|
|
those countries, so that distribution is permitted only in or among |
1043
|
|
|
|
|
|
|
countries not thus excluded. In such case, this License incorporates |
1044
|
|
|
|
|
|
|
the limitation as if written in the body of this License. |
1045
|
|
|
|
|
|
|
|
1046
|
|
|
|
|
|
|
9. The Free Software Foundation may publish revised and/or new versions |
1047
|
|
|
|
|
|
|
of the General Public License from time to time. Such new versions will |
1048
|
|
|
|
|
|
|
be similar in spirit to the present version, but may differ in detail to |
1049
|
|
|
|
|
|
|
address new problems or concerns. |
1050
|
|
|
|
|
|
|
|
1051
|
|
|
|
|
|
|
Each version is given a distinguishing version number. If the Program |
1052
|
|
|
|
|
|
|
specifies a version number of this License which applies to it and "any |
1053
|
|
|
|
|
|
|
later version", you have the option of following the terms and conditions |
1054
|
|
|
|
|
|
|
either of that version or of any later version published by the Free |
1055
|
|
|
|
|
|
|
Software Foundation. If the Program does not specify a version number of |
1056
|
|
|
|
|
|
|
this License, you may choose any version ever published by the Free Software |
1057
|
|
|
|
|
|
|
Foundation. |
1058
|
|
|
|
|
|
|
|
1059
|
|
|
|
|
|
|
10. If you wish to incorporate parts of the Program into other free |
1060
|
|
|
|
|
|
|
programs whose distribution conditions are different, write to the author |
1061
|
|
|
|
|
|
|
to ask for permission. For software which is copyrighted by the Free |
1062
|
|
|
|
|
|
|
Software Foundation, write to the Free Software Foundation; we sometimes |
1063
|
|
|
|
|
|
|
make exceptions for this. Our decision will be guided by the two goals |
1064
|
|
|
|
|
|
|
of preserving the free status of all derivatives of our free software and |
1065
|
|
|
|
|
|
|
of promoting the sharing and reuse of software generally. |
1066
|
|
|
|
|
|
|
|
1067
|
|
|
|
|
|
|
EOM |
1068
|
|
|
|
|
|
|
|
1069
|
0
|
|
|
|
|
|
WARRANTY(); |
1070
|
0
|
|
|
|
|
|
1; |
1071
|
|
|
|
|
|
|
} |
1072
|
|
|
|
|
|
|
|
1073
|
|
|
|
|
|
|
=encoding utf8 |
1074
|
|
|
|
|
|
|
|
1075
|
|
|
|
|
|
|
=head1 NAME |
1076
|
|
|
|
|
|
|
|
1077
|
|
|
|
|
|
|
units - conversion program |
1078
|
|
|
|
|
|
|
|
1079
|
|
|
|
|
|
|
=head1 SYNOPSIS |
1080
|
|
|
|
|
|
|
|
1081
|
|
|
|
|
|
|
% units |
1082
|
|
|
|
|
|
|
You have: in |
1083
|
|
|
|
|
|
|
You want: cm |
1084
|
|
|
|
|
|
|
* 2.54 |
1085
|
|
|
|
|
|
|
/ 0.393701 |
1086
|
|
|
|
|
|
|
|
1087
|
|
|
|
|
|
|
% units [-f /path/to/unittab] [want_unit have_unit] |
1088
|
|
|
|
|
|
|
|
1089
|
|
|
|
|
|
|
=head1 OPTIONS |
1090
|
|
|
|
|
|
|
|
1091
|
|
|
|
|
|
|
-? --help Display help text |
1092
|
|
|
|
|
|
|
-f --file Use specified definition file |
1093
|
|
|
|
|
|
|
-W --warranty Display information about (lack of) warranty |
1094
|
|
|
|
|
|
|
-C --copying Display license information |
1095
|
|
|
|
|
|
|
--version Display version information |
1096
|
|
|
|
|
|
|
|
1097
|
|
|
|
|
|
|
=head1 DESCRIPTION |
1098
|
|
|
|
|
|
|
|
1099
|
|
|
|
|
|
|
NOTE: This does not handle the Gnu units format (https://www.gnu.org/software/units/). |
1100
|
|
|
|
|
|
|
|
1101
|
|
|
|
|
|
|
The units program converts quantities expressed in various scales to their |
1102
|
|
|
|
|
|
|
equivalents in other scales. The units program can only handle multiplicative |
1103
|
|
|
|
|
|
|
or affine scale changes (except for temperature). It works in one of |
1104
|
|
|
|
|
|
|
two ways. If given two units as command line arguments, it reports |
1105
|
|
|
|
|
|
|
the conversion. Otherwise, it operates interactively by prompting the user |
1106
|
|
|
|
|
|
|
for inputs: |
1107
|
|
|
|
|
|
|
|
1108
|
|
|
|
|
|
|
% units |
1109
|
|
|
|
|
|
|
You have: meters |
1110
|
|
|
|
|
|
|
You want: feet |
1111
|
|
|
|
|
|
|
* 3.2808399 |
1112
|
|
|
|
|
|
|
/ 0.3048 |
1113
|
|
|
|
|
|
|
|
1114
|
|
|
|
|
|
|
You have: cm3 |
1115
|
|
|
|
|
|
|
You want: gallons |
1116
|
|
|
|
|
|
|
* 0.00026417205 |
1117
|
|
|
|
|
|
|
/ 3785.4118 |
1118
|
|
|
|
|
|
|
|
1119
|
|
|
|
|
|
|
You have: meters/s |
1120
|
|
|
|
|
|
|
You want: furlongs/fortnight |
1121
|
|
|
|
|
|
|
* 6012.8848 |
1122
|
|
|
|
|
|
|
/ 0.00016630952 |
1123
|
|
|
|
|
|
|
|
1124
|
|
|
|
|
|
|
You have: 1|2 inch |
1125
|
|
|
|
|
|
|
You want: cm |
1126
|
|
|
|
|
|
|
* 1.27 |
1127
|
|
|
|
|
|
|
/ 0.78740157 |
1128
|
|
|
|
|
|
|
|
1129
|
|
|
|
|
|
|
You have: 98.6 F |
1130
|
|
|
|
|
|
|
You want: C |
1131
|
|
|
|
|
|
|
98.6 F is 37 C |
1132
|
|
|
|
|
|
|
|
1133
|
|
|
|
|
|
|
You have: -40 C |
1134
|
|
|
|
|
|
|
You want: F |
1135
|
|
|
|
|
|
|
-40 C is -40 F |
1136
|
|
|
|
|
|
|
|
1137
|
|
|
|
|
|
|
Powers of units can be specified using the '^' character as shown in the |
1138
|
|
|
|
|
|
|
example, or by simple concatenation: 'cm3' is equivalent to 'cm^3'. |
1139
|
|
|
|
|
|
|
|
1140
|
|
|
|
|
|
|
Multiplication of units can be specified by using spaces, a dash or an asterisk. |
1141
|
|
|
|
|
|
|
|
1142
|
|
|
|
|
|
|
Division of units is indicated by the slash ('/'). Note that multiplication has |
1143
|
|
|
|
|
|
|
a higher precedence than division, so 'm/s/s' is the same as 'm/s^2' or 'm/s s'. |
1144
|
|
|
|
|
|
|
Division of numbers must be indicated using the vertical bar ('|'). To convert |
1145
|
|
|
|
|
|
|
half a meter, you would write '1|2 meter'. If you write '1/2 meter' then the |
1146
|
|
|
|
|
|
|
units program would interpret that as equivalent to '0.5/meter'. |
1147
|
|
|
|
|
|
|
|
1148
|
|
|
|
|
|
|
If you enter incompatible unit types, the units program will print a message |
1149
|
|
|
|
|
|
|
indicating that the units are not conformable and it will display the reduced |
1150
|
|
|
|
|
|
|
form for each unit: |
1151
|
|
|
|
|
|
|
|
1152
|
|
|
|
|
|
|
You have: ergs/hour |
1153
|
|
|
|
|
|
|
You want: fathoms kg^2 / day |
1154
|
|
|
|
|
|
|
conformability error |
1155
|
|
|
|
|
|
|
2.7777778e-11 kg m^2 / sec^3 |
1156
|
|
|
|
|
|
|
2.1166667e-05 kg^2 m / sec |
1157
|
|
|
|
|
|
|
|
1158
|
|
|
|
|
|
|
The conversion information is read from a units data file. The default file |
1159
|
|
|
|
|
|
|
includes definitions for most familiar units, abbreviations and metric |
1160
|
|
|
|
|
|
|
prefixes. Some constants of nature included are: |
1161
|
|
|
|
|
|
|
|
1162
|
|
|
|
|
|
|
pi ratio of circumference to diameter |
1163
|
|
|
|
|
|
|
c speed of light |
1164
|
|
|
|
|
|
|
e charge on an electron |
1165
|
|
|
|
|
|
|
g acceleration of gravity |
1166
|
|
|
|
|
|
|
force same as g |
1167
|
|
|
|
|
|
|
mole Avogadro's number |
1168
|
|
|
|
|
|
|
water pressure per unit height of water |
1169
|
|
|
|
|
|
|
mercury pressure per unit height of mercury |
1170
|
|
|
|
|
|
|
au astronomical unit |
1171
|
|
|
|
|
|
|
|
1172
|
|
|
|
|
|
|
The unit 'pound' is a unit of mass. Compound names are run together so 'pound |
1173
|
|
|
|
|
|
|
force' is a unit of force. The unit 'ounce' is also a unit of mass. The fluid |
1174
|
|
|
|
|
|
|
ounce is 'floz'. British units that differ from their US counterparts are |
1175
|
|
|
|
|
|
|
prefixed with 'br', and currency is prefixed with its country name: |
1176
|
|
|
|
|
|
|
'belgiumfranc', 'britainpound'. When searching for a unit, if the specified |
1177
|
|
|
|
|
|
|
string does not appear exactly as a unit name, then units will try to remove a |
1178
|
|
|
|
|
|
|
trailing 's' or a trailing 'es' and check again for a match. |
1179
|
|
|
|
|
|
|
|
1180
|
|
|
|
|
|
|
To find out what units are available read the standard units file. If you want |
1181
|
|
|
|
|
|
|
to add your own units you can supply your own file. If no standard file |
1182
|
|
|
|
|
|
|
exists and you do not supply your own file, this program uses internal |
1183
|
|
|
|
|
|
|
data. |
1184
|
|
|
|
|
|
|
|
1185
|
|
|
|
|
|
|
A unit is specified on a single line by giving its name and an equivalence. Be |
1186
|
|
|
|
|
|
|
careful to define new units in terms of old ones so that reductions leads to |
1187
|
|
|
|
|
|
|
primitive units. Primitive (a.k.a. fundamental) units are defined |
1188
|
|
|
|
|
|
|
with a string of three characters which begin and end with '*' or '!'. |
1189
|
|
|
|
|
|
|
Note that the units program will not detect infinite loops that could be |
1190
|
|
|
|
|
|
|
caused by careless unit definitions. |
1191
|
|
|
|
|
|
|
|
1192
|
|
|
|
|
|
|
Comments in the unit definition file begin with a '/' or '#' character at |
1193
|
|
|
|
|
|
|
the beginning of a line. Once the parser has successfully parsed a |
1194
|
|
|
|
|
|
|
unit name and it's definition, the remainder of the line is ignored. |
1195
|
|
|
|
|
|
|
This makes it safe to incude in-line comments. |
1196
|
|
|
|
|
|
|
|
1197
|
|
|
|
|
|
|
Prefixes are defined in the same way as standard units, but with a |
1198
|
|
|
|
|
|
|
trailing dash at the end of the prefix name. If a unit is not found even |
1199
|
|
|
|
|
|
|
after removing trailing 's' or 'es', then it will be checked against the |
1200
|
|
|
|
|
|
|
list of prefixes. Prefixes will be removed until a legal base unit is |
1201
|
|
|
|
|
|
|
identified. |
1202
|
|
|
|
|
|
|
|
1203
|
|
|
|
|
|
|
Here is an example of a short units file that defines some basic units. |
1204
|
|
|
|
|
|
|
|
1205
|
|
|
|
|
|
|
m !a! |
1206
|
|
|
|
|
|
|
sec *** |
1207
|
|
|
|
|
|
|
Temperature *** |
1208
|
|
|
|
|
|
|
micro- 1e-6 |
1209
|
|
|
|
|
|
|
minute 60 sec |
1210
|
|
|
|
|
|
|
hour 60 min |
1211
|
|
|
|
|
|
|
inch 0.0254 m |
1212
|
|
|
|
|
|
|
ft 12 inches |
1213
|
|
|
|
|
|
|
mile 5280 ft |
1214
|
|
|
|
|
|
|
|
1215
|
|
|
|
|
|
|
If a "Temperature" dimension is defined in the units table, then |
1216
|
|
|
|
|
|
|
you can define various temperature scales as units by specifying |
1217
|
|
|
|
|
|
|
the code needed to convert the unit to or from Kelvin. |
1218
|
|
|
|
|
|
|
The built-in units table has definitions for Kelvin (K), Celsius (C), |
1219
|
|
|
|
|
|
|
Fahrenheit (F) and Rankine (R). |
1220
|
|
|
|
|
|
|
|
1221
|
|
|
|
|
|
|
The code consists of a perl hash containing the keys 'to' and 'from'. |
1222
|
|
|
|
|
|
|
The values are the subroutine definitions necessary to convert a |
1223
|
|
|
|
|
|
|
value from Kelvin to the specified unit, or to Kelvin from the the |
1224
|
|
|
|
|
|
|
specified unit. See the built-in unit table for examples. |
1225
|
|
|
|
|
|
|
|
1226
|
|
|
|
|
|
|
A temperature unit entered at "You have" without any constant |
1227
|
|
|
|
|
|
|
preceding it will default to zero units. This is in contrast to |
1228
|
|
|
|
|
|
|
non-temperature units, where a bare unit name is assumed to mean 1 |
1229
|
|
|
|
|
|
|
unit. Also, for temperatures only, negative constants are allowed. |
1230
|
|
|
|
|
|
|
This enables, for example, a conversation between -40C and F. |
1231
|
|
|
|
|
|
|
|
1232
|
|
|
|
|
|
|
=head1 AUTHOR |
1233
|
|
|
|
|
|
|
|
1234
|
|
|
|
|
|
|
Mark-Jason Dominus, C<< >> |
1235
|
|
|
|
|
|
|
|
1236
|
|
|
|
|
|
|
Temperature support by Gary Puckering, C<< >> |
1237
|
|
|
|
|
|
|
|
1238
|
|
|
|
|
|
|
Currently maintained in https://github.com/briandfoy/PerlPowerTools |
1239
|
|
|
|
|
|
|
|
1240
|
|
|
|
|
|
|
=head1 BUGS |
1241
|
|
|
|
|
|
|
|
1242
|
|
|
|
|
|
|
=head1 COPYRIGHT and LICENSE |
1243
|
|
|
|
|
|
|
|
1244
|
|
|
|
|
|
|
This program is copyright (c) M-J. Dominus (1996, 1999). |
1245
|
|
|
|
|
|
|
|
1246
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it under |
1247
|
|
|
|
|
|
|
the terms of the GNU General Public License as published by the Free Software |
1248
|
|
|
|
|
|
|
Foundation; either version 2 of the License, or (at your option) any later |
1249
|
|
|
|
|
|
|
version, or under Perl's 'Artistic License'. |
1250
|
|
|
|
|
|
|
|
1251
|
|
|
|
|
|
|
This program is distributed in the hope that it will be useful, but WITHOUT ANY |
1252
|
|
|
|
|
|
|
WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A |
1253
|
|
|
|
|
|
|
PARTICULAR PURPOSE. See the GNU General Public License for more details. |
1254
|
|
|
|
|
|
|
|
1255
|
|
|
|
|
|
|
=cut |
1256
|
|
|
|
|
|
|
|
1257
|
|
|
|
|
|
|
__PACKAGE__ |
1258
|
|
|
|
|
|
|
|
1259
|
|
|
|
|
|
|
__END__ |