Beefy Boxes and Bandwidth Generously Provided by pair Networks
The stupid question is the question not asked
 
PerlMonks  

Comment on

( #3333=superdoc: print w/ replies, xml ) Need Help??
Some time ago, I tried my hand at an Esoteric Programming Language, Iris.

To commemorate the birth of my first yungin' on the 22nd of March 2013, I've built Amelia. It's amazing what a little positive motivation can bring about. (She's already a little monkey!)

What follows is the implementation followed by a fibonacci program written in Amelia.

Implementation:
#!/usr/bin/perl #use warnings; use strict; use Data::Dumper; my $file = "sequence.ama"; my $string = get_file($file); my $still_alive = 1000; my @C = get_chromosome($string); my @R = qw//; wrapper(0,$still_alive); sub get_file{ my $infile = shift; my $string; open (my $fh, "<", $infile) or die "nopen $infile, $!"; while (<$fh>){ chomp; s/:.*//; #comments s/(\d)\s/$1,/g; #space to comma s/(\d);/$1,;/g; # forgottn comma before ; s/\s//g; #get rid of space s/,,+/,/g; #get rid of duplicate commas $string .= $_ } return $string; } sub output{ for (@R){ print "$_ "; } } sub finish{ my $message = shift; print "$message \nthe end. let's print output:\n"; output (\@R); die } sub deathcount{ $still_alive--; finish ("counted down\n") unless ($still_alive); } sub get_chromosome{ my $Genome = shift;#string my @C = map { [ map{ [ /(\d+),/g # the parens excise the commas ] } /\d+,\d+,\d+,/g ] } split /;/, $Genome; for (@C){ if ($#$_ > 1) { unless ($#$_ % 2){ splice @$_, -1, 1 } } } @C # @C[gene[codon[base,base,base]]] } sub wrapper{ my $ptr = shift; #genome pointer my $dead_count = shift; #max iterations before death my $i = $dead_count + 1; #iterator for top level call() while (1) { $ptr = call ($ptr, $i); #ptr is changed to call()'s return value if we #ever get to this point } } sub call{ my $ptr = shift; my $i = shift; my $alt_ptr = -1; for (1 .. $i){ deathcount(); #count down to process death my @g = map { [@$_] }@{$C[$ptr]}; #gene my $call = shift $g[0]; #1st base of 1st codon my $modcall = $call % 2; ($call % 2)?($alt_ptr = MOV(\@g,$ptr)):(MOD(\@g)); (return $alt_ptr) if ($alt_ptr >= 0); $ptr == $#C ? $ptr = 0 : $ptr++;#circular chromosome } return $alt_ptr; #if alt_ptr >= 0 #alt_ptr is used to reset ptr permanently. #the recursive calls to call() are unwound in favor of alt_ptr } sub MOD{ my $g = shift; #gene my ($loc,$reftype) = @{(shift @$g)}; my @ops = qw/+ - * \/ ** %/; $loc = abs($loc); $loc = $R[$loc] if ($reftype%2); $loc = 0 unless $loc; $R[$loc] = expression_processor($g,\@ops); } sub MOV{ my $g = shift; my $ptr = shift; #needed to check for infi-loop my @ops = qw/== > < >= <= != and or not xor/; my ($loc,$i) = @{(shift @$g)}; $loc = abs $loc; $loc = 0 if $loc > $#C; $i = abs $i; if (expression_processor($g, \@ops)){ (finish ("pointer collision")) if ($loc == $ptr); return $loc unless $i; return call($loc,$i); } return -1 } sub filter_v_or_o{ my ($v,$o,$total_bits,$orig) = @_; (return 0) if ($v-1 <= $o); (return 1) if ($v >= ($total_bits / 2)); return ($orig % 2) } sub expression_processor{ #build a polish notation expression from tri +plets. my $g = shift; #gene my $ops = shift; #operators my ($v,$o) = 0; #init counting vars my $total_bits = $#$g; my @expression; while (@$g){ my ($v_or_o, $data, $ref_type) = @{(shift @$g)}; $v_or_o = filter_v_or_o($v,$o,$total_bits,$v_or_o); $ref_type = ($ref_type % 3); ($data = $R[abs($data)]) if ($ref_type == 1); ($data = $R[$R[abs($data)]]) if ($ref_type == 2); $data = 0 unless $data; ($data = $ops->[$data % ($#$ops +1)]) if ($v_or_o); ($v_or_o)?($o++):($v++); unshift @expression, $data; } return solve(\@expression) } sub solve{ my $exp = shift; #print "this is the expression:"; #print Dumper $exp; #sleep 1; my $a = shift @$exp; ($a=~/\d/)? (return $a) : ($a = eval(solve($exp) . " $a " . solve($exp))); (finish("termination with n/0\n")) if ($@=~ /Illegal/); return $a; }
Fibbonacci code in Amelia:
0,0,0, :assigns a value to register 0, 0,5,0,; :the value is 5 0,3,0, : register 3 0,0,0,; : gets a 0 0,4,0, : register 4 0,1,0,; : gets a 1 0,1,0, : register 1 gets 0,1,0, : 1 0,0,1, : register[0] 0,1,0,; : - : - register[0] 1 (prefix notation) 0,2,0, : register 2 gets 0,1,0, : 1 0,1,1, : register[1] 0,1,0,; : - : - register[1] 1 (prefix notation) 0,0,1, : location referenced by register [0] 0,1,2, : value in register[2] is a reference to 0,2,2, : another register (this changes during run) 0,0,0,; : + : this produces each value in the : Fibonacci sequence 0,0,0, : add 1 to register[0] 0,0,1, 0,1,0, 0,0,0,; 1,7,0, : go to gene 7 0,25,1,; : if register[25] has a value : (other than 0) : this is gene 7 (infinite loop) : this is one way to end the program 1,3,0, :go to gene 3 1,1,0,; :if (1) :this is how we iterate ################## : this following is alternate way to terminate a program 0,0,0, : (gene 9) assign a divide by zero 0,0,0, 0,0,0, 0,3,0,; : / 0 0 (illegal devide by 0 - :ends program and outputs)
Output from Fibonacci:

26 24 23 0 1 1 2 3 5 8 13 21 34 55 89 144 233 377 610 987 1597 2584 4181 6765 10946 17711

The first three numbers are used for flow control.

$winks = 40; $food = crow; $state{$tired}?sleep($winks):eat($food);

In reply to A Sweet Little Esolang Implementation by corenth

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • Outside of code tags, you may need to use entities for some characters:
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others romping around the Monastery: (11)
    As of 2014-08-27 22:32 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      The best computer themed movie is:











      Results (253 votes), past polls