lib/Inline/Befunge.pm

   1 #
   2 # This file is part of Inline::Befunge.
   3 # Copyright (c) 2001-2007 Jerome Quelin, all rights reserved.
   4 #
   5 # This program is free software; you can redistribute it and/or modify
   6 # it under the same terms as Perl itself.
   7 #
   8 #
   9
  10 package Inline::Befunge;
  11
  12 use strict;
  13 use warnings;
  14
  15 use Carp;
  16 use Language::Befunge;
  17 require Inline; # use Inline forbidden.
  18 our @ISA = qw! Inline !; # not "use base" (use will take precedence over require)
  19 our $VERSION   = '1.0.0';
  20
  21
  22 sub register {
  23     return
  24       { language => 'Befunge',
  25         aliases  => [ 'befunge', 'BEFUNGE', 'bef', 'BEF' ],
  26         type     => 'interpreted',
  27         suffix   => 'bef',
  28       };
  29 }
  30
  31 sub validate {
  32     my $self = shift;
  33
  34     # Initializes funcs.
  35     $self->{ILSM}{DEBUG} = 0;
  36
  37     while(@_ >= 2) {
  38         my ($key, $value) = (shift, shift);
  39         $key eq "DEBUG" and $self->{ILSM}{DEBUG} = $value, next;
  40         croak "Unsupported option found: '$key'.";
  41     }
  42 }
  43
  44
  45 sub build {
  46     my $self = shift;
  47     # The magic incantations to register.
  48     my $path = $self->{API}{install_lib}."/auto/".$self->{API}{modpname};
  49     $self->mkpath($path) unless -d $path;
  50     my $file = $self->{API}{location};
  51     open FOO_OBJ, "> $file" or croak "Can't open $file for output\n$!";
  52     print FOO_OBJ $self->{API}{code};
  53     close FOO_OBJ;
  54 }
  55
  56
  57 sub load {
  58     # Fetch object and package.
  59     my $self = shift;
  60     my $pkg  = $self->{API}{pkg} || 'main';
  61
  62     # Fetch code and create the interpreter.
  63     my $code = $self->{API}{code};
  64     my $bef  = $self->{ILSM}{bef} = Language::Befunge->new;
  65     $bef->store_code( $code );
  66     $bef->set_DEBUG( $self->{ILSM}{DEBUG} );
  67
  68     # Parse the code.
  69     # Each subroutine should be:
  70     # ;:subname1; < @ ,,,,"foo"a
  71     # ;:subname2;
  72     # etc.
  73     my $funcs = $bef->get_torus->labels_lookup;
  74     $self->{ILSM}{funcs} = join " ", sort keys %$funcs;
  75
  76     foreach my $subname ( keys %$funcs ) {
  77         no strict 'refs';
  78         *{"${pkg}::$subname"} =
  79           sub {
  80               # Cosmetics.
  81               $bef->debug( "\n-= SUBROUTINE $subname =-\n" );
  82               $bef->set_file( "Inline-$subname" );
  83
  84               # Create the first Instruction Pointer.
  85               my $ip = Language::Befunge::IP->new ;
  86
  87               # Move the IP at the beginning of the function.
  88               my $pos = Language::Befunge::Vector->new( 2,
  89                   $funcs->{$subname}[0],
  90                   $funcs->{$subname}[1],
  91               );
  92               $ip->set_position($pos);
  93               my $delta = Language::Befunge::Vector->new( 2,
  94                   $funcs->{$subname}[2],
  95                   $funcs->{$subname}[3],
  96               );
  97               $ip->set_delta($delta);
  98
  99               # Fill the stack with arguments.
 100               $ip->spush_args( @_ );
 101
 102               # Initialize the interpreter.
 103               $bef->set_ips( [ $ip ] );
 104               #$bef->set_kcounter(-1);
 105               $bef->set_retval(0);
 106
 107               # Loop as long as there are IPs.
 108               $bef->next_tick while scalar @{ $bef->get_ips };
 109
 110               # Return the exit code and the TOSS.
 111 #               return $bef->lastip->end eq '@' ?
 112 #                   @{ $bef->lastip->toss }  # return the TOSS.
 113 #                 : $bef->retval;            # return exit code.
 114               return $bef->get_retval;  # quick'n'dirty bugfix
 115           };
 116
 117     }
 118 }
 119
 120
 121 sub info {
 122     my $self = shift;
 123     my $text = <<'END';
 124 The following functions have been defined via Inline::Befunge:
 125 $self->{ILSM}{funcs}
 126 END
 127     return $text;
 128 }
 129
 130
 131 1;
 132 __END__
 133
 134
 135 =head1 NAME
 136
 137 Inline::Befunge - write Perl subs in Befunge
 138
 139
 140 =head1 SYNOPSIS
 141
 142     use Inline "Befunge";
 143
 144     print "9 + 16 = ", add(9, 16), "\n";
 145     print "9 - 16 = ", subtract(9, 16),"\n";
 146
 147     __END__
 148     __Befunge__
 149     ;:add; +q
 150
 151     ;:subtract; -q
 152
 153
 154 =head1 DESCRIPTION
 155
 156 The C<Inline::Befunge> module allows you to put Befunge source code
 157 directly "inline" in a Perl script or module.
 158
 159 This allows you to write cool stuff with all the power of Befunge!
 160
 161
 162 =head1 USING Inline::Befunge
 163
 164 Using C<Inline::Befunge> will seem very similar to using a another
 165 Inline language, thanks to Inline's consistent look and feel.
 166
 167 This section will explain how to use C<Inline::Befunge>.
 168
 169 For more details on C<Inline>, see C<perldoc Inline>.
 170
 171
 172 =head2 Feeding Inline with your code
 173
 174 The recommended way of using Inline is the following:
 175
 176     use Inline Befunge;
 177
 178     ...
 179
 180     __END__
 181     __Befunge__
 182
 183       Befunge source code goes here.
 184
 185 But there are much more ways to use Inline. You'll find them in
 186 C<perldoc Inline>.
 187
 188
 189 =head2 Defining functions
 190
 191 As a befunge fan, you know that Befunge does not support named
 192 subroutines. So, I introduced a little hack (thank goes to Sean
 193 O'Rourke) in order for Inline to work: each subroutine definition
 194 should be prepended with a comment C<;:subname;> (notice the colon
 195 prepended).
 196
 197 You'll notice how smart it is, since it's enclosed in comments, and
 198 therefore the overall meaning of the code isn't changed.
 199
 200 You can define your subroutines in any of the four cardinal directions,
 201 and the subroutine velocity will be the velocity defined by the
 202 comment. That is, if you define a subroutine in a vertical comment
 203 from bottom to top, when called, the subroutine will start with a
 204 velocity of (0,-1).
 205
 206 You can add comments after the subname. Thus, C<;:foo - a foo
 207 subroutine;> defines a new subroutine C<foo>.
 208
 209 So, here's a valid example:
 210
 211     use Inline "Befunge";
 212
 213     hello();
 214
 215     __END__
 216     __Befunge__
 217     ;:hello - print a msg;<q_,#! #:<"Hello world!"a
 218
 219         ;
 220         :
 221         a             q - ;tcartsbus:;
 222         d
 223         d
 224         ;
 225         +  ;not a valid func def;
 226         q
 227
 228
 229 In this example, I defined three functions: C<hello()>, C<add()> and
 230 C<substract>, and you can call them from within perl as if they were
 231 valid perl functions. The fourth comment C<;not a valid func def;>
 232 isn't a valid function definition since it lacks a colon C<:> just
 233 after the C<;>.
 234
 235
 236 =head2 Passing arguments
 237
 238 In order to write useful functions, one should be able to pass
 239 arguments.  This is possible, and one will find the arguments on the
 240 TOSS of the interpreter: this means the stack may not be empty at the
 241 beginning of the run. If you're a purist, then you may ignore this and
 242 call your functions without arguments, and the stack will be empty.
 243
 244 Strings are pushed as 0gnirts.
 245
 246 B</!\> Remember, Befunge works with a stack: the first argument will
 247 be the first pushed, ie, the deeper in the stack.
 248
 249 For example, when calling an inlined Befunge function like this:
 250 C<foo( 'bar', 7, 'baz' );>, then the stack will be (bottom->top): C<(0
 251 114 97 98 7 0 122 97 98)>.
 252
 253
 254 =head2 Return values
 255
 256 Furthermore, one can return some values from the befunge
 257 subroutines... how exciting!
 258
 259 To do so, the Befunge semantics have been a little adapted:
 260
 261 =over 4
 262
 263 =item o
 264
 265 when an Instruction Pointer reaches a C<q> instruction, one cell will
 266 be popped from its stack and will be returned. This works like a
 267 scalar return.
 268
 269 =item o
 270
 271 when an Instruction Pointer reaches a C<@> instruction, it will be
 272 killed (just as in traditional Befunge). But when the B<last> IP
 273 reaches a C<@>, then the sub is exited and will return the whole stack
 274 of the IP that just died. This works like a list return.
 275
 276 B</!\> Be careful, that you will return a list of integer values. You
 277 are to decide what to do with those values (especially, you are to
 278 convert back to characters with the C<chr> perl builtin function and
 279 join the chars if you're waiting for a string!).
 280
 281 =back
 282
 283
 284 =head2 Supported options
 285
 286 C<Inline::Befunge> supports a DEBUG option, to follow the IP(s) as
 287 they are running on the funge-space.
 288
 289 Use the following to activate it:
 290
 291     use Inline( Befunge => 'DATA',
 292                 DEBUG   => 1 );
 293
 294     ...
 295     __END__
 296     __Befunge__
 297
 298       Enter you befunge code here.
 299
 300
 301 =head1 PUBLIC METHODS
 302
 303 =head2 register(  )
 304
 305 Register as an Inline Language Support Module.
 306
 307
 308 =head2 validate(  )
 309
 310 Check the params for the Befunge interpreter. Currently no options are
 311 supported.
 312
 313
 314 =head2 build(  )
 315
 316 Register the Befunge as a valid Inline extension.
 317
 318
 319 =head2 load(  )
 320
 321 This function actually fetches the Befunge code. It first splits it to
 322 find the functions.
 323
 324
 325 =head2 info(  )
 326
 327 Return a small report about the Befunge code.
 328
 329
 330 =head1 SEE ALSO
 331
 332 =over 4
 333
 334 =item L<perl>
 335
 336 =item L<Inline>
 337
 338 =item L<Language::Befunge>
 339
 340 =back
 341
 342
 343 =head1 ACKNOWLEDGEMENTS
 344
 345 I would like to thank:
 346
 347 =over 4
 348
 349 =item o
 350
 351 Brian Ingerson, for writing the incredibly cool C<Inline> module, and
 352 giving the world's programmers enough rope to hang themselves many
 353 times over.
 354
 355 =item o
 356
 357 Chris Pressey, creator of Befunge, who gave a whole new dimension to
 358 both coding and obfuscating.
 359
 360 =item o
 361
 362 Sean O'Rourke E<lt>seano@alumni.rice.eduE<gt> for his incredible cool
 363 idea on defining labels in Befunge code.
 364
 365 =back
 366
 367
 368 =head1 AUTHOR
 369
 370 Jerome Quelin, C<< <jquelin at cpan.org> >>
 371
 372
 373 =head1 COPYRIGHT AND LICENCE
 374
 375 Copyright (c) 2001-2007 Jerome Quelin, all rights reserved.
 376
 377 This program is free software; you can redistribute it and/or modify
 378 it under the same terms as Perl itself.
 379
 380
 381 =cut
 382