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