Perl6: classes and working with binary data

ROOM FOR IMPROVEMENT: It would probably be better if the class defined below implemented the Buf "role".  That way, code that used it could (for example) call .list and .elems directly on the class... which I think would be a very nice way to open up the class.  Or is that TOO open?  Meh, I think people who hack on Commodore 1541 diskette images should be implicitly trusted.

class Image {
    has Str $.sourcefile is rw;  # accessors auto-generated
    has Buf $!buffer;            # private, no accessors

    has $!hdr = (17 * 21) * 256; # byte offset
   
    method load() {
       return "no sourcefile specified" unless $.sourcefile;
       
       # read in a binary file
       my $fh = open( $.sourcefile, :r, :bin );
       $!buffer = $fh.slurp-rest(:bin);
       return "$.sourcefile loaded";
     
       # (oops - forgot to close the file)
    }
   
    method size()  { $!buffer.elems }
 

    # Each of these methods return "Buf": a class used
    # for dealing with binary data buffers.

    method label() { $!buffer.subbuf($!hdr + 143, 16) }
    method hdr()   { $!buffer.subbuf($!hdr, 256) }   
    method dir( Int $index ) {
        my $offset = $!hdr + 256 + $index * 32;
        return $!buffer.subbuf($offset+2, 30);
    }
}

my Image $test = Image.new( sourcefile => "mule.d64" );
say $test.load();
say $test.size(), " bytes read";

my $hdr   = $test.hdr();  
my $label = $test.label();

print "Label: ";
for $label.list -> $val {
   if 31 < $val < 92 { print chr($val) }
   else { print '.' }  
}
print "\n";

my $blob  = $test.dir(1); # (actually the 2nd entry)

for $blob.list -> $val {
   if 31 < $val < 92 { print chr($val) }
   else { print '.' }  
}

% perl6 Image.p6
mule.d64 loaded
174848 bytes read
Label: .M.U.L.E........
...MULE.2.....................

Perl6: January installer for Windows

http://rakudo.org/downloads/star/

Finally, a new .msi for Perl6.

Perl6: insane (in a good way)

Just an example.  I can't believe how amusing yet efficient this syntax is.

my  %ingredients = :4eggs, :2sticks-of-butter, :4cups-of-sugar;
say %ingredients;
# OUTPUT>>:
# cups-of-sugar => 4, eggs => 4, sticks-of-butter => 2

Is Perl6 really Perl?

There has been some discussion about whether Perl6 was mis-named.

I thought that that was a silly discussion not worth getting involved in.  It's quite obviously Perl in some form.

The argument, if I understand it, is that Perl6 "sounds like" a version increment from Perl 5.  This violates the principle of least surprise.

OK, I can understand that.  In that sense it would be mis-named.  But then what do you CALL it?  I haven't seen any suggestions.

So I'll suggest one based on the compiler used for it.  Call it Rakudo.  At least until a better name is thunk up.

Perl6: error by design in split()?

So while splitting a string, I found some odd results.  But it's actually NOT a bug... and therefore I consider that to be a DESIGN ERROR.

Suppose we have a $string "Hello, world!", and we split it into characters.  In Perl, we do it these ways:

my @foo = split '', $string; # perl 5
my @foo = $string.split(''); # perl 6

And in both cases, we end up with an array:

[ H e l l o ,   w o r l d ! ]

HOWEVER, in Perl6 I see something odd: two extra characters in my stream:

[]  <= what's that?  \0? \b?
[H]
[e]
[l]
[l]
[o]
[,]
[ ]
[w]
[o]
[r]
[l]
[d]
[!]
[] <= what's that?  \0?  \b?

So let's check to see if those two end elements are defined.

for @bar -> $letter
{
   printf "[$letter] %x\n", $letter.ord if $letter;
   say "undef" unless $letter;
}

undef
[H] 48
[e] 65
[l] 6c
[l] 6c
[o] 6f
[,] 2c
[ ] 20
[w] 77
[o] 6f
[r] 72
[l] 6c
[d] 64
[!] 21
undef


Looks like a bug to me.  And yet the docs say:

If DELIMITER is a string, it is searched for literally and not treated as a regex. If DELIMITER is the empty string, it effectively returns all characters of the string separately (plus an empty string at the begin and at the end).

A number of optional named parameters can be specified, which alter the result being returned. The :v, :k, :kv and :p named parameters all perform a special action with regards to the delimiter found.

• :skip-empty
  

If specified, do not return empty strings before or after a delimiter.

Baloney.  That's not how I expect split to work BY DEFAULT.  I expect that string to be split, and nothing added, thank you very much.

EVEN BETTER, :skip-empty doesn't appear to work in the admittedly pre-1.0 version of Perl6 I'm running (2015.09).

A Short Perl6 ASCII Rotator

This script rotates a simple chunk of ASCII art based on user input (90, 180, or 270 degrees). It's not very elegant, and there's a minor and annoying bug in it, but I'm done for the day, so.  Here's a test run:

+OO
OOO
OOO

% 90


OOO
OOO
+OO


% 180


OO+
OOO
OOO


% 270


OOO
OOO
OO+


% 180


+OO
OOO
OOO


%

And here's the code.


my Str @test = ("+OO"
               ,"OOO"
               ,"OOO");


my $r = 0;

loop
{
    run( 'cls' );
    say @test.join( "\n" );
    my $in = prompt "\n% ";

    @test = rotate( 90,  @test )  if $in ~~ /90/;
    @test = rotate( 180, @test ) if $in ~~ /180/;
    @test = rotate( 270, @test ) if $in ~~ /270/;
}          

sub rotate( $degrees, Str @pixobject )
{
   return @pixobject if $degrees % 360 == 0;
  
   my Str @a = @pixobject;
  
   @a = rotate90( @a );
   @a = rotate90( @a ) if $degrees > 90;
   @a = rotate90( @a ) if $degrees > 180;

   return @a;
}  

sub rotate90( Str @pixobject )
{
   my Str @new = ();
   for @pixobject -> $line
   {
      my Str @row = $line.split('');
      my $len = @row.elems;
      for (0..$len) -> $i
      {
         @new[$len-$i] = '' unless @new[$len-$i];
         @new[$len-$i] ~= @row[$i] if @row[$i];
      }
   }
   return @new;
}

Perl6 and subroutines

The old way almost works.  You can't use shift, but if you mind the Perl6 sigil you're good:

   sub hello 
   {
      my $who = @_[0];
      print "hello, $who\n";
   }

> hello('Dave')
hello, Dave

But the new way is  S O   M U C H   B E T T E R:

   sub hello($who)
   {
      say "hello, $who";
   }

> hello('Dave')
hello, Dave

Oh it's about time!  And if you're working with lots of programmers and are paranoid about type checking:

   sub hello(Str $who)
   {
      say "I'm sorry $who, I'm afraid I can't do that";
   }

> hello('Dave')
I'm sorry Dave, I'm afraid I can't do that.

> hello(3)
CHECK FAILED:
Calling 'hello' will never work with argument types (int) (line 1)
    Expected: :(Str $name)

Perl6: Basic File I/O

NOTE: The I/O Role is explained in detail here: http://doc.perl6.org/type/IO

   my $content = slurp 'text.txt';
   say $content.chars, " chars";

35 chars

   my $output = "And now for some multiline data:
   The first line.
   The second line.
   Anudda line.
   Okay I'm done.";

   spurt "output.txt", $output; 



OK, it wrapped the file handle for me.  That's cool.

File test flags are attached to an IO Role:

   say "text.txt".IO.d;  # am I a dir?
   say "text.txt".IO.e;  # do I exist?
   say "text.txt".IO.f;  # am I a file?

False
True
True

...and if you try it the old way, you'll get the amusing:

   say -e "text.txt";

Confused

Perl6 and Hashes

Mostly like Perl 5 hashes, but there are a couple of new tidbits to amuse.

For example, this 100% traditional Perl line works the same as before:

   my %foo = ( a => 1, b => 2 );
   print keys %foo, "\n";

a b

...but you can also do it in this kinesthetically exotic-looking way:

   my %foo = :a(1), :b(2);
   say %foo.keys

a b

And as before, you can use curly braces to get at values (although don't trip over the sigil):

   say %foo{ 'a' };

1

But the bracket-quote mechanism works too.

   say %foo<a>;

1

Perl6: Array Interpolation

   my @foo = 1, 1, 2, 3, 5, 8;
   say "Not interpolated: @foo";
   say "Interpolated: @foo[]";

Not interpolated: @foo
Interpolated: 1 1 2 3 5 8

Perl6: comb, map and more arrays

   my @foo = <A B C D>;
   say @foo[2]; # hey, sigils don't "conjugate" anymore.
   say +@foo;      # count items in this array
   say +<A B C D>; # same thing

C 
4 
4

Next, map to apply a transform to each element of an array:

   say @foo.map( { $_ } )
   say <A B C D>.map( { $_ } )  # works with bare arrays too

A B C D
A B C D

   my $foo = 0;
   say <A B C D>.map( { 2 } )   
   say <A B C D>.map( { $foo++ } )

2 2 2 2
0 1 2 3


Now for some fun grep-like stuff: comb.

[http://doc.perl6.org/routine/comb] Searches for a regex in $input and returns a list of all matches (as Str by default, or as Match if $match is True), limited to at most $limit matches.

   my $in = 'ABCDABCDCBAABBDCC';
   say $in.comb( /A/ );      # find all A's
   say $in.comb( /A/, 2 );   # find at most 2 A's

A A A A
A A

   say +$in.comb( /A/ );     # count A's
   say +$in.comb( /B/ );     # count B's
   say +$in.comb( /C/ );     # count C's
   say +$in.comb( /D/ );     # count D's

4 
5
5
3


 It sure would be nice to roll those last four statements together.  Here's one way:
  
   for <A B C D> -> $letter 
   { 
      say +$in.comb( /$letter/ ) 
   }

4 
5
5
3


Slightly terser:

   for <A B C D> { say +$in.comb( /$_/ ) }

4 
5
5
3

Or, using map:

   say <A B C D>.map( { +$in.comb( /$_/ ) } );  

4 5 5 3

Pop Quiz: why did that last statement return its result on one line instead of four lines?

Perl6: run and shell

   run 'echo', "hello Tuesday!"; # external command, no shell
   shell 'ls -ltr';              # runs via system shell.

(When using "shell", metacharacters are interpreted by the shell, including pipes, redirects, environment variable substitutions, etc.)

$ perl6 shell.pl6
hello Tuesday!
total 48
-rw-r--r--  1 rje  501   54 Nov 29 18:10 hello.pl6
-rw-r--r--  1 rje  501  268 Nov 30 07:37 arrays.pl6
-rw-r--r--  1 rje  501  281 Nov 30 07:43 control.pl6
-rw-r--r--  1 rje  501  505 Nov 30 07:49 for.pl6
-rw-r--r--  1 rje  501  264 Nov 30 08:04 input.pl6
-rw-r--r--  1 rje  501   71 Dec  1 08:06 shell.pl6

Perl6: get and prompt

   #
   # get and prompt
   #

   my $name;

   say "Hi, what's your name?";
   $name=get;

   my $weekday = prompt( "Well $name, what day is today? " );

   given $weekday {
      when 'Monday' { say 'My condolences.' }
      default { say "$weekday, eh?" }
   }

$ perl6 input.pl6
Hi, what's your name?
Rob
Well Rob, what day is today? Monday
My condolences.

Perl6: for, given, and proceed

   #
   #  for, given, and proceed
   #

   my @array = 1, 2, 3;

   for @array -> $item {
      say $item * 100
   }
   print "\n";

   my $var = 42;

   given $var {
      when 0..50 { say 'Less than 50' }
      when Int   { say 'Is an Int' }
      when 42    { say 42 }
      default    { say 'huh?' }
   }
   print "\n";

   given $var {
      when 0..50 { say 'Less than 50'; proceed }
      when Int   { say 'Is an Int'; proceed }
      when 42    { say 42 }
      default    { say 'huh?' }
   }

$ perl6 for.pl6
100
200
300

Less than 50

Less than 50
Is an Int
42

Perl6: if, unless, with, and without

   #
   #  if, unless, with, and without
   #

   my $age = 19;
   my $age2;

   if not $age < 19 {
      say 'Adult';
   }

   unless $age < 19 {
      say 'Adult';
   }

   with $age {
      say '$age has a value';
   }

   with $age2 {
      say '$age2 has a value';
   }

   without $age2 {
      say '$age2 does not have a value';
   }

$ perl6 control.pl6
Adult
Adult
$age has a value
$age2 does not have a value

Perl6: Arrays

   my @animals = [ 'camel', 'llama', 'vicuña'];
   @animals.push( "owl" );

   say "The zoo contains " ~ @animals.elems ~ " animals";
   say "The animals are: " ~ @animals;

$ perl6 arrays.pl6
The zoo contains 4 animals
The animals are: camel llama vicuña owl


   say "Sort:    " ~ @animals.sort;
   say "Natural: " ~ @animals;

   @animals.=sort;
   say "New    : " ~ @animals;

Sort:    camel llama owl vicuña
Natural: camel llama vicuña owl
New    : camel llama owl vicuña

Perl6: Hello, World!

say 'hello world!';

$ perl6 hello.pl6
hello world!

Oh, this is going to be fun...

if True { say 'hello' };

$ perl6 hello.pl6
hello
 
 

CargoCult in a Nutshell

Here's my working syntax for CargoCult.

assumptions

numerical expressions are per C standards.


variable declarations:

my [<type>] <id> [= <initialization expression>];

Array variables start with the sigil '@'.  They're indexed with square brackets, as in C.


function declarations:

fn <returntype> <name> parm1, parm2, ...

<body>
endfn


function calls:

[<return value> =] <function name([<parameters>])>;


function parameters are comma-separated, and typed or untyped.  If typed, the type precedes the identifier, e.g. callMyFunction( String foo, int bar );


for loops (currently only increment, by 1):

for |<indexname>| <start>..<end>

<body>
endfor


if statements:

if ( <expression> )
<body>
endif


return statements:

return <expression>;

CargoCult as an Intermediate Language

I face the onerous task of converting my commodore image reading code from AS3 into Perl and Objective-C.

Rather than port code twice to two platforms, I'd rather use CargoCult as the specification, and use real languages as targets.

I don't have to get 100% code conversion: I just need to get 80% of the way there to make this worthwhile.

That means CargoCult is a high-level Intermediate Language of sorts.  It's C-like, but uses syntactic sugar in a way that makes it relatively easy to write generators to transform it to other languages.  My goal is to be able to make line-by-line translators without having to do any real analysis of the code.

Here's a sample of CargoCult 1.0.

fn int buildZones totalSectors, startTrack, @zones

   for |index| 0..@zones.length
  
      my track = 1 + GLOBAL.totalTracks + startTrack;
      my sectorCount = @zones[index][1];
      my endTrack = 1 + GLOBAL.totalTracks + @zones[index][0];
     
      GLOBAL.totalTracks += @zones[index][0];
     
      for |jdex| track..endTrack
     
         GLOBAL.@trackOffset[ jdex ] = totalSectors * 0x100;
         GLOBAL.@sectorOffset[ jdex ] = totalSectors;
         GLOBAL.@sectorsInTrack[ jdex ] = sectorCount;
        
         totalSectors += sectorCount;
     
      endfor
     
   endfor
  
   return totalSectors;
  
endfn


I've successfully translated this into fully functional Perl, ActionScript3, and Objective-C.  It took 80 lines of code for each, but after that the translator was able to translate another CargoCult function, as well.

What I want to do next is build up a set of translations for each target language, for each transformation needed (line preprocessing, library call handing, subroutine handling, loop handling, and line postprocessing).

Java to ActionScript (via Perl)

#!/usr/bin/perl

while(<>)
{
   s/\bfinal//;
   s/\b(int|long) (\w+)/ var $2:int/;
   s/\bboolean (\w+)/ var $1:Boolean/;
   s/\bString (\w+)/ var $1:String/;
   s/System.out.println/trace/;

   s/ (void|int|String) (\w+\(.*?\))/ function $2:$1/;


   print;
}

The Commodore 1541 disk drive is a computer, with a 6502 microprocessor and its own RAM.  It talks to the Commodore 64 via a hastily-built proprietary serial variant of the IEEE488 bus.

And it's a pain to emulate.

Luckily, it's a solved problem, more or less, if your chosen programming language is C++ or Java.  If you want to do it in, say, ActionScript, then you are out of luck.

...unless you know Perl.

ActionScript, as you may know, has a fuzzy relationship with Java.  Its compiler is written in Java.  Its VM may very well be based on the JVM.  So it is no surprise that ActionScript source is in many ways a cipher of Java.

I wrote a very small Perl script to convert Java source to ActionScript source.  It doesn't do a 100% job, but in all things the best is the enemy of the good, and the Burrito Principle holds (80% of the meat is in 20% of the burrito).  So this gets me most of the way there, leaving small scraps to deal with (instead of facing a complete and more tedious rewrite).