line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Language::Basic::Function; |
2
|
|
|
|
|
|
|
# Part of Language::Basic by Amir Karger (See Basic.pm for details) |
3
|
|
|
|
|
|
|
|
4
|
|
|
|
|
|
|
=pod |
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
=head1 NAME |
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
Language::Basic::Function - Package to handle user-defined and intrinsic |
9
|
|
|
|
|
|
|
Functions in BASIC. |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
=head1 SYNOPSIS |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
See L for the overview of how the Language::Basic module |
14
|
|
|
|
|
|
|
works. This pod page is more technical. |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
A Function can be either an intrinsic BASIC function, like INT or CHR$, |
17
|
|
|
|
|
|
|
or a user-defined function, like FNX (defined with the DEF command). |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
=head1 DESCRIPTION |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
The check_args method checks that the right number and type of function |
22
|
|
|
|
|
|
|
arguments were input. |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
The evaluate method actually calculates the value of the function, given |
25
|
|
|
|
|
|
|
certain arguments. |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
The lookup method looks up the function in the function lookup table. |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
The output_perl method returns a string that's the Perl equivalent to |
30
|
|
|
|
|
|
|
the BASIC function. |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
=cut |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
# Fields: |
35
|
|
|
|
|
|
|
# arg_types - a string. If a function takes a String and two Numeric |
36
|
|
|
|
|
|
|
# arguments, the string will be "SNN". Like in Perl, a semicolon |
37
|
|
|
|
|
|
|
# separates required from optional arguments |
38
|
|
|
|
|
|
|
|
39
|
16
|
|
|
16
|
|
98
|
use strict; |
|
16
|
|
|
|
|
44
|
|
|
16
|
|
|
|
|
715
|
|
40
|
16
|
|
|
16
|
|
91
|
use Language::Basic::Common; |
|
16
|
|
|
|
|
25
|
|
|
16
|
|
|
|
|
13258
|
|
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
# sub-packages |
43
|
|
|
|
|
|
|
{ |
44
|
|
|
|
|
|
|
package Language::Basic::Function::Intrinsic; |
45
|
|
|
|
|
|
|
package Language::Basic::Function::Defined; |
46
|
|
|
|
|
|
|
} |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
# Lookup table for functions |
49
|
|
|
|
|
|
|
my %Table; |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
# This sub puts the function in the lookup table |
52
|
|
|
|
|
|
|
sub new { |
53
|
171
|
|
|
171
|
0
|
237
|
my ($class, $name) = @_; |
54
|
|
|
|
|
|
|
|
55
|
171
|
|
|
|
|
552
|
my $self = { |
56
|
|
|
|
|
|
|
"name" => $name, |
57
|
|
|
|
|
|
|
} ; |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
# Put this sub in lookup table |
60
|
171
|
|
|
|
|
435
|
$Table{$name} = $self; |
61
|
|
|
|
|
|
|
|
62
|
171
|
100
|
|
|
|
851
|
my $type = ($name =~ /\$$/) ? "String" : "Numeric"; |
63
|
|
|
|
|
|
|
# Create a new subclass object, & return it |
64
|
171
|
|
|
|
|
461
|
my $subclass = $class . "::$type"; |
65
|
171
|
|
|
|
|
659
|
bless $self, $subclass; |
66
|
|
|
|
|
|
|
} # end sub Language::Basic::Function::new |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
# Lookup a function by name in the function table. |
69
|
|
|
|
|
|
|
# This will (in theory) never be called before new has been called |
70
|
|
|
|
|
|
|
# for function $name |
71
|
|
|
|
|
|
|
sub lookup { |
72
|
54
|
|
|
54
|
0
|
88
|
my $name = shift; |
73
|
54
|
|
|
|
|
506
|
return $Table{$name}; |
74
|
|
|
|
|
|
|
} # end sub Language::Basic::Variable::lookup |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
# Check argument number and type. Exit_Error if there's a problem. |
77
|
|
|
|
|
|
|
sub check_args { |
78
|
12
|
|
|
12
|
0
|
23
|
my ($self, $arglist) = @_; |
79
|
12
|
|
|
|
|
19
|
my @args = @{$arglist->{"arguments"}}; |
|
12
|
|
|
|
|
37
|
|
80
|
|
|
|
|
|
|
# Test for several errors at once |
81
|
12
|
|
|
|
|
23
|
my $error = ""; |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
# Handle optional args |
84
|
12
|
|
|
|
|
21
|
my ($min_types, $max_types); |
85
|
12
|
|
|
|
|
34
|
my $types = $self->{"arg_types"}; |
86
|
12
|
100
|
|
|
|
60
|
if ($types =~ s/(.*);/$1/) { |
87
|
3
|
|
|
|
|
8
|
$min_types = length($1); |
88
|
|
|
|
|
|
|
} else { |
89
|
9
|
|
|
|
|
26
|
$min_types = length($types); |
90
|
|
|
|
|
|
|
} |
91
|
12
|
|
|
|
|
24
|
$max_types = length($types); |
92
|
|
|
|
|
|
|
|
93
|
12
|
50
|
33
|
|
|
273
|
$error .= ("Wrong number of arguments to function\n") |
94
|
|
|
|
|
|
|
unless @args <= $max_types && @args >= $min_types; |
95
|
|
|
|
|
|
|
# Now check each argument type |
96
|
12
|
|
|
|
|
196
|
foreach my $type (split (//, $types)) { |
97
|
19
|
50
|
|
|
|
84
|
my $arg = shift @args or last; # may be optional args |
98
|
|
|
|
|
|
|
# This should never happen, hence die, not Exit_Error |
99
|
19
|
50
|
|
|
|
160
|
ref($arg) =~ /(String|Numeric)$/ or |
100
|
|
|
|
|
|
|
die "Error in LBF::Defined::check_args"; |
101
|
19
|
|
|
|
|
53
|
my $atype = substr($1,0,1); |
102
|
19
|
50
|
|
|
|
82
|
if ($atype ne $type) { |
103
|
0
|
0
|
|
|
|
0
|
$error .= $type eq "N" ? |
104
|
|
|
|
|
|
|
"String argument given, Numeric required.\n" : |
105
|
|
|
|
|
|
|
"Numeric argument given, String required.\n"; |
106
|
|
|
|
|
|
|
} |
107
|
|
|
|
|
|
|
} |
108
|
12
|
|
|
|
|
42
|
chomp($error); # Exit_Error will add last \n back in. |
109
|
12
|
50
|
|
|
|
133
|
Exit_Error($error) if $error; |
110
|
|
|
|
|
|
|
} # end sub Language::Basic::Variable::check_args |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
=head2 |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
Class Language::Basic::Function::Intrinsic |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
This class handles intrinsic BASIC functions. |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
=cut |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
# |
121
|
|
|
|
|
|
|
# Fields: |
122
|
|
|
|
|
|
|
# subroutine - a ref to a sub that implements the BASIC routine in Perl |
123
|
|
|
|
|
|
|
# (assuming the args are in @_) |
124
|
|
|
|
|
|
|
{ |
125
|
|
|
|
|
|
|
package Language::Basic::Function::Intrinsic; |
126
|
|
|
|
|
|
|
@Language::Basic::Function::Intrinsic::ISA = qw(Language::Basic::Function); |
127
|
16
|
|
|
16
|
|
1367
|
use Language::Basic::Common; |
|
16
|
|
|
|
|
728
|
|
|
16
|
|
|
|
|
25296
|
|
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
=pod |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
The initialize method sets up BASIC's supported functions at the beginning |
132
|
|
|
|
|
|
|
of the program. The all-important @Init holds a ref for each function |
133
|
|
|
|
|
|
|
to an array holding: |
134
|
|
|
|
|
|
|
- the function name, |
135
|
|
|
|
|
|
|
- the number and type of arguments (in a Perl function prototype-like style), |
136
|
|
|
|
|
|
|
- a subref that performs the equivalent of the BASIC function, and |
137
|
|
|
|
|
|
|
- a string for the output_perl method. That string is either the name of an |
138
|
|
|
|
|
|
|
equivalent Perl function, like "ord" for BASIC's "ASC", or (if there is no |
139
|
|
|
|
|
|
|
exact equivalent) a BLOCK that performs the same action. |
140
|
|
|
|
|
|
|
Adding intrinsic BASIC functions therefore involves adding to this array. |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
=cut |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
sub initialize { |
145
|
|
|
|
|
|
|
# The type is an N or S for each Numeric or String argument the |
146
|
|
|
|
|
|
|
# function takes. |
147
|
|
|
|
|
|
|
# funcstring is a string that gives the perl equivalent to the |
148
|
|
|
|
|
|
|
# BASIC function. (Used for output_perl) If it's just a word, then perl |
149
|
|
|
|
|
|
|
# and BASIC have exactly equivalent functions, which makes the function |
150
|
|
|
|
|
|
|
# call much easier. Otherwise, it's something in {} that will become |
151
|
|
|
|
|
|
|
# a sub. |
152
|
|
|
|
|
|
|
# TODO it would be pretty sexy to have the subref and the funcstring |
153
|
|
|
|
|
|
|
# do the same thing (i.e., create the sub with an eval of funcstring). |
154
|
|
|
|
|
|
|
# Only reason so far I can think of not to is Exit_Error call in CHR$. |
155
|
|
|
|
|
|
|
# But I could create an Exit_Error routine in output perl script! |
156
|
0
|
|
|
0
|
|
0
|
my @Init = ( |
157
|
|
|
|
|
|
|
# Numeric functions... |
158
|
1
|
|
|
1
|
|
5
|
["ASC", "S", sub {ord(shift)}, "ord" ], |
159
|
0
|
|
|
0
|
|
0
|
["INT", "N", sub {int(shift)}, "int" ], |
160
|
0
|
|
|
0
|
|
0
|
["LEN", "S", sub {length(shift)}, "length" ], |
161
|
|
|
|
|
|
|
# Don't use the arg. BASIC passes in |
162
|
0
|
|
|
0
|
|
0
|
["RND", "N", sub {rand()}, "{rand()}" ], |
163
|
|
|
|
|
|
|
["VAL", "S", sub {0+shift;}, "{0+shift;}"], |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
# and String functions... |
166
|
|
|
|
|
|
|
['CHR$', "N", |
167
|
|
|
|
|
|
|
sub { |
168
|
1
|
|
|
1
|
|
2
|
my $a=shift; |
169
|
1
|
50
|
33
|
|
|
9
|
if ($a>127 || $a<0) {Exit_Error("Arg. to CHR\$ must be < 127")} |
|
0
|
|
|
|
|
0
|
|
170
|
1
|
|
|
|
|
5
|
chr($a); |
171
|
|
|
|
|
|
|
}, "chr" |
172
|
|
|
|
|
|
|
], |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
['MID$', "SN;N", |
175
|
|
|
|
|
|
|
sub { |
176
|
25
|
|
|
25
|
|
34
|
my ($str, $index, $length) = @_; |
177
|
25
|
|
|
|
|
32
|
$index--; # BASIC strings index from 1! |
178
|
25
|
50
|
|
|
|
139
|
return (defined $length ? |
179
|
|
|
|
|
|
|
substr($str, $index, $length) : |
180
|
|
|
|
|
|
|
substr($str, $index) ); |
181
|
|
|
|
|
|
|
}, |
182
|
0
|
|
|
0
|
|
0
|
join("\n\t", |
183
|
|
|
|
|
|
|
"{", |
184
|
|
|
|
|
|
|
'my ($str, $index, $length) = @_;', |
185
|
|
|
|
|
|
|
'$index--;', |
186
|
|
|
|
|
|
|
'return (defined $length ? ', |
187
|
|
|
|
|
|
|
' substr($str, $index, $length)', |
188
|
|
|
|
|
|
|
' : substr($str, $index) );') |
189
|
|
|
|
|
|
|
. "\n}" |
190
|
|
|
|
|
|
|
], |
191
|
21
|
|
|
21
|
|
833
|
['STR$', "N", sub {'' . shift;}, "{'' . shift;}"], |
192
|
|
|
|
|
|
|
); |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
# Initialize intrinsic functions |
195
|
21
|
|
|
|
|
95
|
foreach (@Init) { |
196
|
168
|
|
|
|
|
299
|
my ($name, $arg_types, $subref, $perl_sub) = @$_; |
197
|
168
|
|
|
|
|
541
|
my $func = new Language::Basic::Function::Intrinsic ($name); |
198
|
|
|
|
|
|
|
# Now set up the Function object with the function definition etc. |
199
|
168
|
|
|
|
|
618
|
$func->define($arg_types, $subref, $perl_sub); |
200
|
|
|
|
|
|
|
} |
201
|
|
|
|
|
|
|
} # end sub Language::Basic::Function::Intrinsic::initialize |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
# This sub defines a function, i.e. says what it does with its arguments |
204
|
|
|
|
|
|
|
sub define { |
205
|
|
|
|
|
|
|
# $subref is a sub ref which "translates" the BASIC function into Perl |
206
|
|
|
|
|
|
|
# arg_types is a string containing an N or S for each Numeric or String |
207
|
|
|
|
|
|
|
# argument the function takes |
208
|
|
|
|
|
|
|
# perlsub is a string which is the perl equivalent of the basic function |
209
|
168
|
|
|
168
|
|
251
|
my ($self, $arg_types, $subref, $perl_sub) = @_; |
210
|
168
|
|
|
|
|
866
|
$self->{"subroutine"} = $subref; |
211
|
168
|
|
|
|
|
264
|
$self->{"arg_types"} = $arg_types; |
212
|
168
|
|
|
|
|
645
|
$self->{"perl_sub"} = $perl_sub; |
213
|
|
|
|
|
|
|
} # end sub Language::Basic::Function::Intrinsic::define |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
sub evaluate { |
216
|
|
|
|
|
|
|
# Note that number & type of args has already been checked |
217
|
27
|
|
|
27
|
|
160
|
my ($self, @args) = @_; |
218
|
|
|
|
|
|
|
# Put this in an eval to find errors? |
219
|
27
|
|
|
|
|
33
|
return &{$self->{"subroutine"}} (@args); |
|
27
|
|
|
|
|
98
|
|
220
|
|
|
|
|
|
|
} # end sub Language::Basic::Function::Intrinsic::evaluate |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
# output the function name |
223
|
|
|
|
|
|
|
sub output_perl { |
224
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
225
|
0
|
|
|
|
|
0
|
my $prog = &Language::Basic::Program::current_program; |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
# If it's a basic function that translates to an intrinsic function, |
228
|
|
|
|
|
|
|
# just return the function |
229
|
0
|
|
|
|
|
0
|
my $perl_sub = $self->{"perl_sub"}; |
230
|
0
|
0
|
|
|
|
0
|
return $perl_sub unless $perl_sub =~ /^\{/; |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
# Otherwise, it's more complicated |
233
|
0
|
|
|
|
|
0
|
my $name = $self->{"name"}; |
234
|
|
|
|
|
|
|
# Use ucfirst(lc) for intrinsic functions so we don't get |
235
|
|
|
|
|
|
|
# messed up with real intrinsic functions |
236
|
0
|
|
|
|
|
0
|
$name = ucfirst(lc($name)); |
237
|
0
|
|
|
|
|
0
|
$name =~ s/\$$/_str/; |
238
|
|
|
|
|
|
|
# It's a BASIC intrinsic function w/ a perl equivalent |
239
|
0
|
|
|
|
|
0
|
$name .= "_bas"; |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
# Note that we're going to have to add sub description at the |
242
|
|
|
|
|
|
|
# end of the perl script |
243
|
0
|
|
|
|
|
0
|
$prog->need_sub($name, $perl_sub); |
244
|
|
|
|
|
|
|
|
245
|
0
|
|
|
|
|
0
|
return $name; |
246
|
|
|
|
|
|
|
} # end sub Language::Basic::Function::Intrinsic::output_perl |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
package Language::Basic::Function::Intrinsic::String; |
249
|
|
|
|
|
|
|
@Language::Basic::Function::Intrinsic::String::ISA = |
250
|
|
|
|
|
|
|
qw(Language::Basic::Function::Intrinsic Language::Basic::Function::String); |
251
|
|
|
|
|
|
|
package Language::Basic::Function::Intrinsic::Numeric; |
252
|
|
|
|
|
|
|
@Language::Basic::Function::Intrinsic::Numeric::ISA = |
253
|
|
|
|
|
|
|
qw(Language::Basic::Function::Intrinsic Language::Basic::Function::Numeric); |
254
|
|
|
|
|
|
|
} # end package Language::Basic::Function::Intrinsic |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
###################################################################### |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
=head2 |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
Class Language::Basic::Function::Defined |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
This class handles functions defined by the user in DEF statements. |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
=cut |
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
# |
267
|
|
|
|
|
|
|
# Fields: |
268
|
|
|
|
|
|
|
# variables - the function parameters. (LB::Variable::Scalar objects) |
269
|
|
|
|
|
|
|
# expression - an arithmetic expression. When the function parameters |
270
|
|
|
|
|
|
|
# are correctly set, evaluating this expression will yield the |
271
|
|
|
|
|
|
|
# value of the function |
272
|
|
|
|
|
|
|
{ |
273
|
|
|
|
|
|
|
package Language::Basic::Function::Defined; |
274
|
|
|
|
|
|
|
@Language::Basic::Function::Defined::ISA = qw(Language::Basic::Function); |
275
|
16
|
|
|
16
|
|
887
|
use Language::Basic::Common; |
|
16
|
|
|
|
|
30
|
|
|
16
|
|
|
|
|
22385
|
|
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
# This sub declares a function, i.e. says how many arguments it has |
278
|
|
|
|
|
|
|
sub declare { |
279
|
|
|
|
|
|
|
# $arglist is a ref to a list of LB::Variable::Lvalues, which are the |
280
|
|
|
|
|
|
|
# arguments to the Function. (E.g., X in DEF FN(X)) |
281
|
|
|
|
|
|
|
# $exp is an LB::Expression which, when evaluated on the arguments, |
282
|
|
|
|
|
|
|
# will implement the function |
283
|
3
|
|
|
3
|
|
7
|
my ($self, $arglistref) = @_; |
284
|
3
|
|
|
|
|
4
|
my $types; # Each arg is S (String) or N (Numeric) |
285
|
|
|
|
|
|
|
|
286
|
3
|
|
|
|
|
8
|
foreach my $arg (@$arglistref) { |
287
|
4
|
50
|
|
|
|
37
|
ref($arg) =~ /(String|Numeric)$/ or die "Error in LBF::Defined::define"; |
288
|
4
|
|
|
|
|
18
|
$types .= substr($1,0,1); |
289
|
|
|
|
|
|
|
} |
290
|
3
|
|
|
|
|
18
|
$self->{"arg_types"} = $types; |
291
|
|
|
|
|
|
|
|
292
|
3
|
|
|
|
|
13
|
$self->{"arguments"} = $arglistref; |
293
|
|
|
|
|
|
|
} # end sub Language::Basic::Function::Defined::define |
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
# This sub defines a function, i.e. says what it does with its arguments |
296
|
|
|
|
|
|
|
# Just involves setting the function's "expression" field. |
297
|
|
|
|
|
|
|
sub define { |
298
|
3
|
|
|
3
|
|
8
|
my ($self, $exp) = @_; |
299
|
3
|
|
|
|
|
13
|
$self->{"expression"} = $exp; |
300
|
|
|
|
|
|
|
} |
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
# Actually evaluate the function on its arguments |
303
|
|
|
|
|
|
|
# Set each parameter (in "variables" field) to the value given in the |
304
|
|
|
|
|
|
|
# arguments, then evaluate the expression. |
305
|
|
|
|
|
|
|
# Just in case user has a function FN(X) and uses X elsewhere in the |
306
|
|
|
|
|
|
|
# program, save the value of X just before we set X based on the argument. |
307
|
|
|
|
|
|
|
# This is a poor man's version of variable scoping. |
308
|
|
|
|
|
|
|
sub evaluate { |
309
|
|
|
|
|
|
|
# Note that number & type of args has already been checked |
310
|
7
|
|
|
7
|
|
12
|
my ($self, @args) = @_; |
311
|
7
|
50
|
|
|
|
20
|
Exit_Error("Function is not defined!") unless defined $self->{"expression"}; |
312
|
|
|
|
|
|
|
|
313
|
7
|
|
|
|
|
9
|
my @save_vars; |
314
|
7
|
|
|
|
|
10
|
foreach (@{$self->{"arguments"}}) { |
|
7
|
|
|
|
|
18
|
|
315
|
8
|
|
|
|
|
23
|
my $var = $_->variable; |
316
|
8
|
|
|
|
|
16
|
my $arg = shift @args; |
317
|
8
|
|
|
|
|
21
|
push @save_vars, $var->value; |
318
|
8
|
|
|
|
|
22
|
$var->set($arg); |
319
|
|
|
|
|
|
|
} |
320
|
|
|
|
|
|
|
|
321
|
7
|
|
|
|
|
38
|
my $value = $self->{"expression"}->evaluate; |
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
# Now restore the values of the function parameters that we may have |
324
|
|
|
|
|
|
|
# changed. |
325
|
7
|
|
|
|
|
11
|
foreach (@{$self->{"arguments"}}) { |
|
7
|
|
|
|
|
48
|
|
326
|
8
|
|
|
|
|
20
|
my $var = $_->variable; |
327
|
8
|
|
|
|
|
15
|
my $save = shift @save_vars; |
328
|
8
|
|
|
|
|
53
|
$var->set($save); |
329
|
|
|
|
|
|
|
} |
330
|
|
|
|
|
|
|
|
331
|
7
|
|
|
|
|
22
|
return $value; |
332
|
|
|
|
|
|
|
} # end sub Language::Basic::Function::Defined::evaluate |
333
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
# output the function name |
335
|
|
|
|
|
|
|
sub output_perl { |
336
|
0
|
|
|
0
|
|
|
my $self = shift; |
337
|
0
|
|
|
|
|
|
my $name = $self->{"name"}; |
338
|
0
|
|
|
|
|
|
$name = lc($name); |
339
|
|
|
|
|
|
|
# First "string", then "function" |
340
|
0
|
|
|
|
|
|
$name =~ s/\$$/_str/; |
341
|
0
|
|
|
|
|
|
$name =~ s/^fn(.*)/$1_fun/; |
342
|
0
|
|
|
|
|
|
return $name; |
343
|
|
|
|
|
|
|
} # end sub Language::Basic::Function::Defined::output_perl |
344
|
|
|
|
|
|
|
|
345
|
|
|
|
|
|
|
package Language::Basic::Function::Defined::String; |
346
|
|
|
|
|
|
|
@Language::Basic::Function::Defined::String::ISA = |
347
|
|
|
|
|
|
|
qw(Language::Basic::Function::Defined Language::Basic::Function::String); |
348
|
|
|
|
|
|
|
package Language::Basic::Function::Defined::Numeric; |
349
|
|
|
|
|
|
|
@Language::Basic::Function::Defined::Numeric::ISA = |
350
|
|
|
|
|
|
|
qw(Language::Basic::Function::Defined Language::Basic::Function::Numeric); |
351
|
|
|
|
|
|
|
} # end package Language::Basic::Function::Defined |
352
|
|
|
|
|
|
|
|
353
|
|
|
|
|
|
|
{ |
354
|
|
|
|
|
|
|
# set ISA for "return type" classes |
355
|
|
|
|
|
|
|
package Language::Basic::Function::Numeric; |
356
|
|
|
|
|
|
|
@Language::Basic::Function::Numeric::ISA = qw |
357
|
|
|
|
|
|
|
(Language::Basic::Function Language::Basic::Numeric); |
358
|
|
|
|
|
|
|
package Language::Basic::Function::String; |
359
|
|
|
|
|
|
|
@Language::Basic::Function::String::ISA = qw |
360
|
|
|
|
|
|
|
(Language::Basic::Function Language::Basic::String); |
361
|
|
|
|
|
|
|
} |
362
|
|
|
|
|
|
|
1; # end package Language::Basic::Function |