#!/usr/bin/env perl

use v5.30.0; # implies strict
use warnings;
use feature 'state';

use FindBin qw/$Bin/;
use lib qq{$Bin/../lib};

use Sub::Genius ();

#
# Implements classic JAPH, perl hacker hackerman benchmark
# sequentially consistent, yet oblivious, way - that's right!
# This is a Sequential Consistency Oblivious Algorithm (in the
# same vein as 'cache oblivious' algorithms
#
# paradigm below is effective 'fork'/'join'
#
my $pre = q{
begin
(
  J &
    A &
      P &
        H
)
end
};

# Load PRE describing concurrent semantics
my $sq = Sub::Genius->new(preplan => $pre );

my $GLOBAL = {};

# 'compile' PRE
$sq->init_plan;

# run loop-ish
$sq->run_once(
    verbose => $ARGV[0],

    # 'scope' is passed as reference to all calls, effectively
    # acts as shared memory, federated only among subroutine
    # participating in the serialized excecution plan
    scope => {
        japh    => [ qw/just Another perl/, q{Hacker,} ],
        curr    => 0,
        contrib => [],
    }
);

# Dump $GLOBAL that's now been changed
if ( $ARGV[0] ) {
    print qq{\n... actual contributions of each sub ...\n};
    foreach my $k ( keys %$GLOBAL ) {
        printf( qq{  %s() => %s\n}, $k, $GLOBAL->{$k} );
    }
}

#                      #
## S T A T E  S U B S ##
#                      #

# noop
sub begin {
    my $scope = shift;
    state $persist = {};    # gives subroutine memory, also 'private'
    my $private = {};       # reset after each call
    return;
}

sub J {
    my $scope = shift;
    state $persist = { akctual => $scope->{japh}->[ $scope->{curr} ], };    # gives subroutine memory, also 'private'
                                                                            # sub's killroy
    $GLOBAL->{J} = $persist->{akctual};

    ++$scope->{curr};
    my $private = {};                                                       # reset after each call
    push @{ $scope->{contrib} }, $persist->{akctual};
    return;
}

sub A {
    my $scope = shift;
    state $persist = { akctual => $scope->{japh}->[ $scope->{curr} ], };    # gives subroutine memory, also 'private'
                                                                            # sub's killroy
    $GLOBAL->{A} = $persist->{akctual};

    ++$scope->{curr};
    my $private = {};                                                       # reset after each call
    push @{ $scope->{contrib} }, $persist->{akctual};
    return;
}

sub H {
    my $scope = shift;
    state $persist = { akctual => $scope->{japh}->[ $scope->{curr} ], };    # gives subroutine memory, also 'private'
                                                                            # sub's killroy
    $GLOBAL->{H} = $persist->{akctual};

    ++$scope->{curr};
    my $private = {};                                                       # reset after each call
    push @{ $scope->{contrib} }, $persist->{akctual};
    return;
}

sub P {
    my $scope = shift;
    state $persist = { akctual => $scope->{japh}->[ $scope->{curr} ], };    # gives subroutine memory, also 'private'
                                                                            # sub's killroy
    $GLOBAL->{P} = $persist->{akctual};

    ++$scope->{curr};
    my $private = {};                                                       # reset after each call
    push @{ $scope->{contrib} }, $persist->{akctual};
    return;
}

sub end {
    my $scope = shift;
    state $persist = {};                                                    # gives subroutine memory, also 'private'
    my $private = {};                                                       # reset after each call
    printf( "%s\n", join( q{ }, @{ $scope->{contrib} } ) );
    return;
}

exit;
##</code><code>##

b 70
b 82
b 94
b 106
b 118
b 126
c
c
v
p $persist->{akctual}
v
c
p $persist->{akctual}
v
c
p $persist->{akctual}
v
c
p $persist->{akctual}
v
c
p @{$scope->{contrib}}
#save 4.seq.txt
##</code><code>##

$ perl -d 1.japh.pl jehosophat

Loading DB routines from perl5db.pl version 1.55
Editor support available.

Enter h or 'h h' for help, or 'man perldebug' for more help.

main::(1.japh.pl:20):	my $pre = q{
main::(1.japh.pl:21):	begin
main::(1.japh.pl:22):	(
main::(1.japh.pl:23):	  J &
main::(1.japh.pl:24):	    A &
main::(1.japh.pl:25):	      P &
main::(1.japh.pl:26):	        H
main::(1.japh.pl:27):	)
main::(1.japh.pl:28):	end
  DB<1> source 4.seq.txt                                                        
>> b 70
>> b 82
>> b 94
>> b 106
>> b 118
>> b 126
>> c
plan: "begin A H J P end" <<<

Execute:

main::begin(1.japh.pl:70):	    return;
>> c
main::A(1.japh.pl:94):	    return;
>> v
91:	    ++$scope->{curr};
92:	    my $private = {};                                                       # reset after each call
93:	    push @{ $scope->{contrib} }, $persist->{akctual};
94==>b	    return;
95 	}
96 	
97 	sub H {
98:	    my $scope = shift;
99:	    state $persist = { akctual => $scope->{japh}->[ $scope->{curr} ], };    # gives subroutine memory, also 'private'
100 	                                                                            # sub's killroy
>> p $persist->{akctual}
just
>> v
98:	    my $scope = shift;
99:	    state $persist = { akctual => $scope->{japh}->[ $scope->{curr} ], };    # gives subroutine memory, also 'private'
100 	                                                                            # sub's killroy
101:	    $GLOBAL->{H} = $persist->{akctual};
102 	
103:	    ++$scope->{curr};
104:	    my $private = {};                                                       # reset after each call
105:	    push @{ $scope->{contrib} }, $persist->{akctual};
106:b	    return;
107 	}
>> c
main::H(1.japh.pl:106):	    return;
>> p $persist->{akctual}
Another
>> v
103:	    ++$scope->{curr};
104:	    my $private = {};                                                       # reset after each call
105:	    push @{ $scope->{contrib} }, $persist->{akctual};
106==>b	    return;
107 	}
108 	
109 	sub P {
110:	    my $scope = shift;
111:	    state $persist = { akctual => $scope->{japh}->[ $scope->{curr} ], };    # gives subroutine memory, also 'private'
112 	                                                                            # sub's killroy
>> c
main::J(1.japh.pl:82):	    return;
>> p $persist->{akctual}
perl
>> v
79:	    ++$scope->{curr};
80:	    my $private = {};                                                       # reset after each call
81:	    push @{ $scope->{contrib} }, $persist->{akctual};
82==>b	    return;
83 	}
84 	
85 	sub A {
86:	    my $scope = shift;
87:	    state $persist = { akctual => $scope->{japh}->[ $scope->{curr} ], };    # gives subroutine memory, also 'private'
88 	                                                                            # sub's killroy
>> c
main::P(1.japh.pl:118):	    return;
>> p $persist->{akctual}
Hacker,
>> v
115:	    ++$scope->{curr};
116:	    my $private = {};                                                       # reset after each call
117:	    push @{ $scope->{contrib} }, $persist->{akctual};
118==>b	    return;
119 	}
120 	
121 	sub end {
122:	    my $scope = shift;
123:	    state $persist = {};                                                    # gives subroutine memory, also 'private'
124:	    my $private = {};                                                       # reset after each call
>> c
just Another perl Hacker,
main::end(1.japh.pl:126):	    return;
>> p @{$scope->{contrib}}
justAnotherperlHacker,
>> #save 4.seq.txt

  DB<14> q                                                                      
$ 

##</code><code>##

M
b 82
c
y
c
#save 3.2.txt
##</code><code>##

$ perl -d 1.japh.pl jesophat
...
  DB<1> source 3.2.txt                                                          
1.japh.pl*      2.seq.txt       3.2.txt         4.seq.txt       _Sub::Genius/
1.seq.txt       3.1.txt         3.seq.txt       5.seq.txt
  DB<1> source 3.2.txt 
>> M

'FLAT.pm' => '1.0.4 from /usr/local/share/perl/5.30.0/FLAT.pm'
'FLAT/DFA.pm' => '/usr/local/share/perl/5.30.0/FLAT/DFA.pm'
'FLAT/DFA/Minimal.pm' => '/usr/local/share/perl/5.30.0/FLAT/DFA/Minimal.pm'
'FLAT/FA.pm' => '/usr/local/share/perl/5.30.0/FLAT/FA.pm'
'FLAT/NFA.pm' => '/usr/local/share/perl/5.30.0/FLAT/NFA.pm'
'FLAT/PFA.pm' => '/usr/local/share/perl/5.30.0/FLAT/PFA.pm'
'FLAT/Regex.pm' => '/usr/local/share/perl/5.30.0/FLAT/Regex.pm'
'FLAT/Regex/Op.pm' => '/usr/local/share/perl/5.30.0/FLAT/Regex/Op.pm'
'FLAT/Regex/Parser.pm' => '/usr/local/share/perl/5.30.0/FLAT/Regex/Parser.pm'
'FLAT/Regex/WithExtraOps.pm' => '/usr/local/share/perl/5.30.0/FLAT/Regex/WithExtraOps.pm'
'FLAT/Symbol.pm' => '/usr/local/share/perl/5.30.0/FLAT/Symbol.pm'
'FLAT/Symbol/Regex.pm' => '/usr/local/share/perl/5.30.0/FLAT/Symbol/Regex.pm'
'FLAT/Transition.pm' => '/usr/local/share/perl/5.30.0/FLAT/Transition.pm'
'FLAT/Transition/Simple.pm' => '/usr/local/share/perl/5.30.0/FLAT/Transition/Simple.pm'

>> b 82
>> c
plan: "begin A P J H end" <<<

Execute:

main::J(1.japh.pl:82):	    return;
>> y
$GLOBAL = HASH(0x557b5132e420)
   'A' => 'just'
   'J' => 'perl'
   'P' => 'Another'
$persist = HASH(0x557b5251d3b8)
   'akctual' => 'perl'

$private = HASH(0x557b5251d298)
     empty hash
$scope = HASH(0x557b524e0fd8)
   'contrib' => ARRAY(0x557b5132e3d8)
      0  'just'
      1  'Another'
      2  'perl'
   'curr' => 3
   'japh' => ARRAY(0x557b510bec80)
      0  'just'
      1  'Another'
      2  'perl'
      3  'Hacker,'
$sq = Sub::Genius=HASH(0x557b5214ad38)
   'DFA' => FLAT::DFA=HASH(0x557b524d2410)
      'ALPHA' => HASH(0x557b524e1a28)
         'A' => 8
         'H' => 8
         'J' => 8
         'P' => 8
         'begin' => 1
         'end' => 1

   'preplan' => '[begin]([J]&[A]&[P]&[H])[end]'
   'preprocess' => 1
>> c
just Another perl Hacker,

... actual contributions of each sub ...
  H() => Hacker,
  P() => Another
  A() => just
  J() => perl
Debugged program terminated.  Use q to quit or R to restart,

##</code><code>##

$ perldoc /usr/local/share/perl/5.30.0/Sub/Genius.pm
$ perldoc /usr/local/share/perl/5.30.0/FLAT.pm
$ perldoc /usr/local/share/perl/5.30.0/FLAT/DFA.pm