aboutsummaryrefslogtreecommitdiff
path: root/interpreter
diff options
context:
space:
mode:
authorDrahflow <drahflow@gmx.de>2012-12-08 14:29:18 +0100
committerDrahflow <drahflow@gmx.de>2012-12-08 14:29:18 +0100
commit74f3f1354afe9b6fe866527a1de2a8d16d1210b8 (patch)
treeb98303d84e99ab1829410ae38317c27c911217b5 /interpreter
Initial commit
Diffstat (limited to 'interpreter')
-rw-r--r--interpreter/.Elymas.pm.swpbin0 -> 12288 bytes
-rw-r--r--interpreter/.ElymasSys.pm.swpbin0 -> 12288 bytes
-rw-r--r--interpreter/.elymas.swpbin0 -> 77824 bytes
-rw-r--r--interpreter/Elymas.pm37
-rw-r--r--interpreter/ElymasLinux.pm58
-rw-r--r--interpreter/ElymasSys.pm58
-rwxr-xr-xinterpreter/elymas1128
7 files changed, 1281 insertions, 0 deletions
diff --git a/interpreter/.Elymas.pm.swp b/interpreter/.Elymas.pm.swp
new file mode 100644
index 0000000..5a52433
--- /dev/null
+++ b/interpreter/.Elymas.pm.swp
Binary files differ
diff --git a/interpreter/.ElymasSys.pm.swp b/interpreter/.ElymasSys.pm.swp
new file mode 100644
index 0000000..1b57678
--- /dev/null
+++ b/interpreter/.ElymasSys.pm.swp
Binary files differ
diff --git a/interpreter/.elymas.swp b/interpreter/.elymas.swp
new file mode 100644
index 0000000..b4fa9fa
--- /dev/null
+++ b/interpreter/.elymas.swp
Binary files differ
diff --git a/interpreter/Elymas.pm b/interpreter/Elymas.pm
new file mode 100644
index 0000000..d82900d
--- /dev/null
+++ b/interpreter/Elymas.pm
@@ -0,0 +1,37 @@
+package Elymas;
+
+use strict;
+use warnings;
+
+require Exporter;
+our @ISA = qw(Exporter);
+our @EXPORT = qw(popInt popString);
+
+use Data::Dumper;
+
+sub popInt {
+ my ($data) = @_;
+
+ my $i = pop @$data or die "Stack underflow";
+ die "Not integer " . Dumper($i) unless $i->[1] eq 'int';
+ return $i->[0];
+}
+
+sub popString {
+ my ($data) = @_;
+
+ my $s = pop @$data or die "Stack underflow";
+ die "Not string " . Dumper($s) unless $s->[1] eq 'string';
+ return $s->[0];
+}
+
+sub popArray {
+ my ($data) = @_;
+
+ my $a = pop @$data or die "Stack underflow";
+ die "Not array: " . Dumper($a) unless ref($a->[1]) eq 'ARRAY' and $a->[1]->[0] eq 'array';
+
+ return $a->[0];
+}
+
+1;
diff --git a/interpreter/ElymasLinux.pm b/interpreter/ElymasLinux.pm
new file mode 100644
index 0000000..1718060
--- /dev/null
+++ b/interpreter/ElymasLinux.pm
@@ -0,0 +1,58 @@
+package ElymasLinux;
+
+use strict;
+use warnings;
+
+use Elymas;
+
+use POSIX ();
+
+our $linux = {
+ 'open' => [sub {
+ my ($data, $scope) = @_;
+
+ my $mode = popInt($data);
+ my $flags = popInt($data);
+ my $pathname = popString($data);
+
+ my $fd = POSIX::open($pathname, $flags, $mode);
+ $fd = -1 unless defined $fd;
+
+ push @$data, [$fd, 'int'];
+ }, ['func', 'linux .open'], 'active'],
+ 'close' => [sub {
+ my ($data, $scope) = @_;
+
+ my $fd = popInt($data);
+
+ my $ret = POSIX::close($fd);
+ $ret = -1 unless defined $ret;
+
+ push @$data, [$ret, 'int'];
+ }, ['func', 'linux .close'], 'active'],
+# 'read' => [sub {
+# my ($data, $scope) = @_;
+#
+# my $count = popInt($data);
+# my $buf = popArray($data);
+# my $fd = popInt($data);
+#
+# my $ret = POSIX::close($fd);
+# $ret = -1 unless defined $ret;
+#
+# push @$data, [$ret, 'int'];
+# }, ['func', 'linux .read'], 'active'],
+};
+
+map { installIntConstant($_) } qw(O_RDONLY O_RDWR O_WRONLY);
+
+sub installIntConstant {
+ my ($name) = @_;
+
+ my $elymasName = $name;
+ $elymasName =~ s/_//g;
+
+ $linux->{$elymasName} = [${$POSIX::{$name}}, 'int', 'passive'];
+}
+
+1;
diff --git a/interpreter/ElymasSys.pm b/interpreter/ElymasSys.pm
new file mode 100644
index 0000000..1718060
--- /dev/null
+++ b/interpreter/ElymasSys.pm
@@ -0,0 +1,58 @@
+package ElymasLinux;
+
+use strict;
+use warnings;
+
+use Elymas;
+
+use POSIX ();
+
+our $linux = {
+ 'open' => [sub {
+ my ($data, $scope) = @_;
+
+ my $mode = popInt($data);
+ my $flags = popInt($data);
+ my $pathname = popString($data);
+
+ my $fd = POSIX::open($pathname, $flags, $mode);
+ $fd = -1 unless defined $fd;
+
+ push @$data, [$fd, 'int'];
+ }, ['func', 'linux .open'], 'active'],
+ 'close' => [sub {
+ my ($data, $scope) = @_;
+
+ my $fd = popInt($data);
+
+ my $ret = POSIX::close($fd);
+ $ret = -1 unless defined $ret;
+
+ push @$data, [$ret, 'int'];
+ }, ['func', 'linux .close'], 'active'],
+# 'read' => [sub {
+# my ($data, $scope) = @_;
+#
+# my $count = popInt($data);
+# my $buf = popArray($data);
+# my $fd = popInt($data);
+#
+# my $ret = POSIX::close($fd);
+# $ret = -1 unless defined $ret;
+#
+# push @$data, [$ret, 'int'];
+# }, ['func', 'linux .read'], 'active'],
+};
+
+map { installIntConstant($_) } qw(O_RDONLY O_RDWR O_WRONLY);
+
+sub installIntConstant {
+ my ($name) = @_;
+
+ my $elymasName = $name;
+ $elymasName =~ s/_//g;
+
+ $linux->{$elymasName} = [${$POSIX::{$name}}, 'int', 'passive'];
+}
+
+1;
diff --git a/interpreter/elymas b/interpreter/elymas
new file mode 100755
index 0000000..7d91cbf
--- /dev/null
+++ b/interpreter/elymas
@@ -0,0 +1,1128 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+BEGIN {
+ my $libPath = $0;
+ $libPath =~ s!/?elymas$!!;
+ push @INC, $libPath;
+}
+
+use Data::Dumper;
+# $Data::Dumper::Deparse = 1;
+
+use Elymas;
+# use ElymasLinux;
+use ElymasSys;
+
+my @globalCallStack;
+my @globalData;
+
+my $quoted = 0;
+my $globalScope = \{
+ '/' => [sub { }, ['func', '/'], 'active'],
+ '|' => [sub {
+ my ($data, $scope) = @_;
+
+ my $n = pop @$data or die "Stack underflow";
+ my $meaning = resolve($$scope, $data, $n->[0]);
+ if(not defined $meaning) {
+ die "could not resolve '$n->[0]'";
+ }
+ push @$data, [$meaning->[0], $meaning->[1]];
+ }, ['func', '|'], 'active'],
+ '\\' => [sub {
+ my ($data, $scope) = @_;
+
+ my $n = pop @$data or die "Stack underflow";
+ my $meaning = resolve($$scope, $data, $n->[0]);
+ if(not defined $meaning) {
+ die "could not resolve '$n'";
+ }
+ push @$data, [$meaning->[0], $meaning->[1]];
+ execute($data, $scope);
+ }, ['func', '\\'], 'active'],
+ '{' => [sub {
+ my ($data, $scope) = @_;
+ ++$quoted;
+ push @$data, ['{', 'tok', '{'];
+ }, ['func', '{'], 'quote'],
+ '}' => [sub {
+ my ($data, $scope) = @_;
+
+ --$quoted;
+
+ my @code;
+ while(1) {
+ my $t = pop @$data or die "Stack underflow";
+ last if($t->[1] eq 'tok' and $t->[0] eq '{');
+
+ unshift @code, $t;
+ };
+
+ if($quoted) {
+ push @$data, [sub {
+ my ($data, $scope) = @_;
+ my $createdSub;
+ push @$data, [$createdSub = sub {
+ my ($data) = @_;
+ my $lscope = \{ ' parent' => $$scope };
+ interpretCode(\@code, $data, $lscope);
+ }, ['func', Dumper(\@code)]];
+ }, ['func', 'func-quoted'], \@code];
+ } else {
+ my $createdSub;
+ push @$data, [$createdSub = sub {
+ my ($data) = @_;
+ my $lscope = \{ ' parent' => $$scope };
+ interpretCode(\@code, $data, $lscope);
+ }, ['func', Dumper(\@code)]];
+ }
+ }, ['func', '}'], 'quote'],
+ ';' => [sub {
+ my ($data, $scope) = @_;
+
+ my $g = pop @$data or die "Stack underflow";
+ my $f = pop @$data or die "Stack underflow";
+
+ push @$data, [sub {
+ my ($data, $scope) = @_;
+
+ push @$data, $f;
+ execute($data, $scope);
+ push @$data, $g;
+ execute($data, $scope);
+ }, ['func', 'f g ;']];
+ }, ['func', ';'], 'active'],
+ '[' => [sub {
+ my ($data, $scope) = @_;
+ push @$data, ['[', 'tok'];
+ }, ['func', '['], 'active'],
+ ']' => [sub {
+ my ($data, $scope) = @_;
+
+ my @content;
+ my $type = undef;
+ while(1) {
+ my $t = pop @$data or die "Stack underflow";
+ last if($t->[1] eq 'tok' and $t->[0] eq '[');
+
+ if($type) {
+ die "mismatched types in array" if($type ne $t->[1]);
+ } else {
+ $type = $t->[1];
+ }
+
+ unshift @content, $t;
+ };
+
+ push @$data, [\@content, ['array', '[]', [['range', 0, $#content]], [$type]]];
+ }, ['func', '}'], 'active'],
+ '<' => [sub {
+ my ($data, $scope) = @_;
+ $$scope = { ' parent' => $$scope };
+ }, ['func', '<'], 'active'],
+ '>' => [sub {
+ my ($data, $scope) = @_;
+ my %struct = %$$scope;
+
+ delete $struct{' parent'};
+
+ push @$data, [enstruct(\%struct)];
+ $$scope = $$scope->{' parent'};
+ }, ['func', '>'], 'active'],
+ '.' => [sub {
+ my ($data, $scope) = @_;
+
+ my $member = pop @$data;
+ my $struct = pop @$data;
+ $member = $member->[0];
+
+ die "not a struct during member dereference in $struct" unless $struct->[1]->[0] eq 'struct';
+ die "requested member $member is not in fact existent in " . Dumper($struct) unless exists $struct->[1]->[1]->{$member};
+
+ push @$data, $struct->[0]->{$member};
+ execute($data, $scope) if($data->[-1]->[2] eq 'active');
+ }, ['func', '.'], 'active'],
+ '.|' => [sub {
+ my ($data, $scope) = @_;
+
+ my $member = pop @$data;
+ my $struct = pop @$data;
+ $member = $member->[0];
+
+ die "not a struct during member dereference in $struct" unless $struct->[1]->[0] eq 'struct';
+ die "requested member $member is not in fact existent in " . Dumper($struct) unless exists $struct->[1]->[1]->{$member};
+
+ push @$data, $struct->[0]->{$member};
+ }, ['func', '.|'], 'active'],
+ 'deff' => [sub {
+ my ($data, $scope) = @_;
+
+ my $name = pop @$data or die "Stack underflow";
+ my $func = pop @$data or die "Stack underflow";
+
+ $$scope->{$name->[0]} = [@$func, 'active'];
+ }, ['func', 'deff'], 'active'],
+ 'defv' => [sub {
+ my ($data, $scope) = @_;
+
+ my $name = pop @$data or die "Stack underflow";
+ my $func = pop @$data or die "Stack underflow";
+
+ $$scope->{$name->[0]} = [@$func, 'passive'];
+ }, ['func', 'defv'], 'active'],
+ 'defq' => [sub {
+ my ($data, $scope) = @_;
+
+ my $name = pop @$data or die "Stack underflow";
+ my $func = pop @$data or die "Stack underflow";
+
+ $$scope->{$name->[0]} = [@$func, 'quote'];
+ }, ['func', 'defq'], 'active'],
+ '=' => [sub {
+ my ($data, $scope) = @_;
+
+ my $name = pop @$data or die "Stack underflow";
+ my $func = pop @$data or die "Stack underflow";
+
+ my $meaning = resolve($$scope, $data, $name->[0]);
+ if(not $meaning) {
+ $$scope->{$name->[0]} = [@$func, 'passive'];
+ } else {
+ $meaning->[0] = $func->[0];
+ $meaning->[1] = $func->[1];
+ }
+ }, ['func', 'defv'], 'active'],
+ 'code' => [sub {
+ my ($data, $scope) = @_;
+
+ my $f = pop @$data or die "Stack underflow";
+ my $code = $f->[2];
+
+ my $res = 0;
+ if(defined $code and not ref($code)) {
+ $res = 1;
+ } elsif(defined $code and ref($code) eq 'ARRAY') {
+ $res = 2;
+ }
+
+ push @$data, [$res, 'int'];
+ }, ['func', 'code'], 'active'],
+ 'sym' => [sub {
+ my ($data, $scope) = @_;
+
+ my $f = pop @$data or die "Stack underflow";
+ my $str = $f->[2];
+ die "not in fact code" unless defined $str;
+ die "code not a symbol" if ref($str) eq 'ARRAY';
+
+ push @$data, [$str, 'string'];
+ }, ['func', 'sym'], 'active'],
+ 'blk' => [sub {
+ my ($data, $scope) = @_;
+
+ my $f = pop @$data or die "Stack underflow";
+ my $block = $f->[2];
+ die "not in fact code" unless defined $block;
+ die "code not a block" unless ref($block) eq 'ARRAY';
+
+ push @$data, [$block, ['array', '... blk', [['range', 0, $#{$block}]], [undef]]];
+ }, ['func', 'blk'], 'active'],
+ 'rep' => [sub {
+ my ($data, $scope) = @_;
+
+ my $c = pop @$data or die "Stack underflow";
+ my $f = pop @$data or die "Stack underflow";
+
+ die "Not numeric: " . Dumper($c) unless $c->[1] eq 'int';
+
+ foreach my $i (1 .. $c->[0]) {
+ push @$data, $f;
+ execute($data, $scope);
+ }
+ }, ['func', 'rep'], 'active'],
+ '?' => [sub {
+ my ($data, $scope) = @_;
+
+ my $b = pop @$data or die "Stack underflow";
+ my $a = pop @$data or die "Stack underflow";
+ my $p = pop @$data or die "Stack underflow";
+
+ push @$data, ($p->[1] eq 'int' and $p->[0] == 0? $b: $a);
+ }, ['func', '?'], 'active'],
+
+# not really part of the spec, this is just for debugging
+ 'dump' => [sub {
+ my ($data, $scope) = @_;
+
+ my $d = pop @$data or die "Stack underflow";
+ print Dumper($d);
+ }, ['func', 'dump'], 'active'],
+ 'die' => [sub {
+ my ($data, $scope) = @_;
+
+ my $d = pop @$data or die "Stack underflow";
+ die Dumper($d); # , $scope);
+ }, ['func', 'die'], 'active'],
+
+# stuff from J
+ 'sig' => [sub {
+ my ($data, $scope) = @_;
+
+ my $v = pop @$data or die "Stack underflow";
+ die "Not numeric: " . Dumper($v) unless $v->[1] eq 'int';
+
+ push @$data, -1 if $v->[0] < 0;
+ push @$data, 0 if $v->[0] == 0;
+ push @$data, 1 if $v->[0] > 0;
+ }, ['func', 'sig'], 'active'],
+ 'len' => [sub {
+ my ($data, $scope) = @_;
+
+ my $a = pop @$data or die "Stack underflow";
+ die "Not array: " . Dumper($a) unless ref($a->[1]) eq 'ARRAY' and $a->[1]->[0] eq 'array';
+
+ push @$data, [scalar @{$a->[0]}, 'int'];
+ }, ['func', 'len'], 'active'],
+ '=[]' => [sub {
+ my ($data, $scope) = @_;
+
+ my $a = pop @$data or die "Stack underflow";
+ my $i = pop @$data or die "Stack underflow";
+ my $v = pop @$data or die "Stack underflow";
+ die "Not array: " . Dumper($a) unless ref($a->[1]) eq 'ARRAY' and $a->[1]->[0] eq 'array';
+ die "Not numeric: " . Dumper($i) unless $i->[1] eq 'int';
+ die "Type mismatch between value and array in assignment: " . Dumper($v, $a)
+ unless canCastTo($v->[1], $a->[1]->[3]->[0]);
+ my $idx = $i->[0];
+
+ $idx += @{$a->[0]} while($idx < 0);
+ $idx = $idx % @{$a->[0]};
+
+ $a->[0]->[$idx] = $v;
+ }, ['func', '=[]'], 'active'],
+ 'dearray' => [sub {
+ my ($data, $scope) = @_;
+
+ my $c = pop @$data or die "Stack underflow";
+ my $a = pop @$data or die "Stack underflow";
+ die "Not numeric: " . Dumper($c) unless $c->[1] eq 'int';
+ die "Not array: " . Dumper($a) unless ref($a->[1]) eq 'ARRAY' and $a->[1]->[0] eq 'array';
+
+ foreach my $i (0 .. $c->[0] - 1) {
+ push @$data, $a->[0]->[$i % @{$a->[0]}];
+ }
+ }, ['func', 'dearray'], 'active'],
+ 'each' => [sub {
+ my ($data, $scope) = @_;
+
+ my $f = pop @$data or die "Stack underflow";
+ my $a = pop @$data or die "Stack underflow";
+ die "Not array: " . Dumper($a) unless ref($a->[1]) eq 'ARRAY' and $a->[1]->[0] eq 'array';
+
+ foreach my $i (@{$a->[0]}) {
+ push @$data, $i;
+ push @$data, $f;
+ execute($data, $scope);
+ }
+ }, ['func', 'each'], 'active'],
+ 'range' => [sub {
+ my ($data, $scope) = @_;
+
+ my $e = pop @$data or die "Stack underflow";
+ my $s = pop @$data or die "Stack underflow";
+ die "Not numeric: " . Dumper($e) unless $e->[1] eq 'int';
+ die "Not numeric: " . Dumper($s) unless $s->[1] eq 'int';
+
+ $s = $s->[0];
+ $e = $e->[0];
+
+ push @$data, [[map { [$_, 'int'] } $s .. $e], ['array', '[]', [['range', 0, $e - $s]], ['int']]];
+ }, ['func', 'seq'], 'active'],
+ 'loop' => [sub {
+ my ($data, $scope) = @_;
+
+ my $b = pop @$data or die "Stack underflow";
+ my $t = pop @$data or die "Stack underflow";
+
+ while(1) {
+ push @$data, $t;
+ execute($data, $scope);
+
+ my $c = pop @$data or die "Stack underflow";
+ die "Not numeric: " . Dumper($c) unless $c->[1] eq 'int';
+ last unless $c->[0];
+
+ push @$data, $b;
+ execute($data, $scope);
+ }
+ }, ['func', 'loop'], 'active'],
+ 'dom' => [sub {
+ my ($data, $scope) = @_;
+
+ my $a = pop @$data or die "Stack underflow";
+
+ if(ref($a->[1]) eq 'ARRAY' and $a->[1]->[0] eq 'array') {
+ my $l = @{$a->[0]};
+
+ push @$data, [[map { [$_, 'int'] } 0 .. $l - 1], ['array', '[]', [['range', 0, $l - 1]], ['int']]];
+ } elsif(ref($a->[1]) eq 'ARRAY' and $a->[1]->[0] eq 'struct') {
+ die "no supporting dom member in struct" . Dumper($a) unless exists $a->[1]->[1]->{'dom'};
+
+ push @$data, $a->[0]->{'dom'};
+ execute($data, $scope) if($data->[-1]->[2] eq 'active');
+ } else {
+ die "dom not supportde on this value: " . Dumper($a);
+ }
+ }, ['func', 'dom'], 'active'],
+ 'exe' => [sub {
+ my ($data, $scope) = @_;
+
+ push @$data, $globalCallStack[-2];
+ }, ['func', 'rec'], 'active'],
+ 'linux' => [enstruct($ElymasLinux::linux), 'passive'],
+};
+
+sub installGlobal1IntFunction {
+ my ($name, $code) = @_;
+
+ $$globalScope->{$name} = [sub {
+ my ($data, $scope) = @_;
+
+ my $a = popInt($data);
+ push @$data, [&$code($a), 'int'];
+ }, ['func', $name, ['int'], ['int']], 'active'];
+}
+
+sub installGlobal2IntFunction {
+ my ($name, $code) = @_;
+
+ $$globalScope->{$name} = [sub {
+ my ($data, $scope) = @_;
+
+ my $b = popInt($data);
+ my $a = popInt($data);
+ push @$data, [&$code($a, $b), 'int'];
+ }, ['func', $name, ['int', 'int'], ['int']], 'active'];
+}
+
+# math and logic stuff
+installGlobal2IntFunction('add', sub { return $_[0] + $_[1] });
+installGlobal2IntFunction('sub', sub { return $_[0] - $_[1] });
+installGlobal2IntFunction('mul', sub { return $_[0] * $_[1] });
+installGlobal2IntFunction('div', sub { return int($_[0] / $_[1]) });
+installGlobal2IntFunction('mod', sub { return $_[0] % $_[1] });
+
+installGlobal2IntFunction('and', sub { return ($_[0] and $_[1])? 1: 0 });
+installGlobal2IntFunction('nand', sub { return (not ($_[0] and $_[1]))? 1: 0 });
+installGlobal2IntFunction('or', sub { return ($_[0] or $_[1])? 1: 0 });
+installGlobal2IntFunction('xor', sub { return ($_[0] xor $_[1])? 1: 0 });
+installGlobal2IntFunction('nxor', sub { return (not ($_[0] xor $_[1]))? 1: 0 });
+installGlobal2IntFunction('nor', sub { return (not ($_[0] or $_[1]))? 1: 0 });
+
+installGlobal2IntFunction('band', sub { return ($_[0] & $_[1])? 1: 0 });
+installGlobal2IntFunction('bnand', sub { return (~ ($_[0] & $_[1]))? 1: 0 });
+installGlobal2IntFunction('bor', sub { return ($_[0] | $_[1])? 1: 0 });
+installGlobal2IntFunction('bxor', sub { return ($_[0] ^ $_[1])? 1: 0 });
+installGlobal2IntFunction('bnxor', sub { return (~ ($_[0] ^ $_[1]))? 1: 0 });
+installGlobal2IntFunction('bnor', sub { return (~ ($_[0] | $_[1]))? 1: 0 });
+
+installGlobal2IntFunction('eq', sub { return ($_[0] == $_[1])? 1: 0 });
+installGlobal2IntFunction('neq', sub { return ($_[0] != $_[1])? 1: 0 });
+installGlobal2IntFunction('lt', sub { return ($_[0] < $_[1])? 1: 0 });
+installGlobal2IntFunction('le', sub { return ($_[0] <= $_[1])? 1: 0 });
+installGlobal2IntFunction('gt', sub { return ($_[0] > $_[1])? 1: 0 });
+installGlobal2IntFunction('ge', sub { return ($_[0] >= $_[1])? 1: 0 });
+
+installGlobal2IntFunction('gcd', sub { my ($a, $b) = @_; ($a, $b) = ($b, $a % $b) while($b); return $a; });
+
+installGlobal1IntFunction('neg', sub { return -$_[0] });
+installGlobal1IntFunction('not', sub { return not $_[0] });
+installGlobal1IntFunction('bnot', sub { return ~ $_[0] });
+installGlobal1IntFunction('abs', sub { return abs $_[0] });
+
+sub enstruct {
+ my ($struct) = @_;
+
+ return ($struct, ['struct', { map { my @e = ($_, [@{$struct->{$_}}]); shift @{$e[1]}; @e } keys %$struct }]);
+}
+
+# J comparison (http://www.jsoftware.com/docs/help701/dictionary/vocabul.htm)
+# = Self-Classify • Equal -> <TODO redundant> / eq
+# =. Is (Local) -> <nope>
+# =: Is (Global) -> <nope>
+
+# < Box • Less Than -> <nope> / lt
+# <. Floor • Lesser Of (Min) -> <TODO: float> / { _10 lt ? }
+# <: Decrement • Less Or Equal -> { 1 - } / le
+# > Open • Larger Than -> <nope> / gt
+# >. Ceiling • Larger of (Max) -> <TODO: float> / { _10 gt ? }
+# >: Increment • Larger Or Equal -> { 1 + } / ge
+
+# _ Negative Sign / Infinity -> neg / <TODO: float>
+# _. Indeterminate -> <TODO: floats>
+# _: Infinity -> <TODO: floats>
+#
+# + Conjugate • Plus -> <TODO: complex> / add
+# +. Real / Imaginary • GCD (Or) -> <TODO: complex> / gcd
+# +: Double • Not-Or -> { 2 * } / nor
+# * Signum • Times -> sig / mul
+# *. Length/Angle • LCM (And) -> <TODO: complex> / { |mul *10 gcd div }
+# *: Square • Not-And -> { _ mul } / nand
+# - Negate • Minus -> neg / sub
+# -. Not • Less -> not / <TODO: all elements of a which are not also in b>
+# -: Halve • Match -> { 2 div } / <TODO: recursive equal>
+# % Reciprocal • Divide -> { 1 -01 div } / div
+# %. Matrix Inverse • Matrix Divide -> <TODO matrix solve>
+# %: Square Root • Root -> <TODO: floats>
+
+# ^ Exponential • Power -> <TODO: exp> / <TODO: pow>
+# ^. Natural Log • Logarithm -> <TODO: ln> / <TODO: log>
+# ^: Power (u^:n u^:v) -> rep / <TODO: understand J>
+
+# $ Shape Of • Shape -> <TODO: think about abstract shapes and reshaping>
+# $. Sparse -> <nope>
+# $: Self-Reference -> { <depth> rec }
+# ~ Reflex • Passive / Evoke -> { _ } / { -01 } / { | }
+# ~. Nub • -> <TODO: implement "uniq">
+# ~: Nub Sieve • Not-Equal -> <TODO: implement "uniq-idx"> / ne
+# | Magnitude • Residue -> abs / mod
+# |. Reverse • Rotate (Shift) -> <TODO: think about abstract reverse> / <TODO: think about abstract rotate>
+# |: Transpose -> <TODO: think about abstract transpose implementation>
+#
+# . Determinant • Dot Product -> <TODO: implement the algorithm>
+# .. Even -> { -20*1*21* add 2 div }
+# .: Odd -> { -20*1*21* sub 2 div }
+# : Explicit / Monad-Dyad -> <nope> / <nope>
+# :. Obverse -> <TODO: think of inverse functions>
+# :: Adverse -> <TODO: think about error handling>
+# , Ravel • Append -> <TODO: create array of submost elements> / <TODO: think about abstract append>
+# ,. Ravel Items • Stitch -> <TODO: explicit 1-level mapping of ,>
+# ,: Itemize • Laminate -> <TODO: implementable without new primitives>
+# ; Raze • Link -> <nope (this be unboxing stuff)>
+# ;. Cut -> <TODO: implement said algorithms, but use separate functions>
+# ;: Words • Sequential Machine -> <TODO: think about providing lexing / sequential machine support>
+#
+# # Tally • Copy -> { len } / <TODO: implementable without new primitives>
+# #. Base 2 • Base -> <TODO: implement rebase: multiply then add, left atom is made into list, left list is multiplied up, try to do it without primitives>
+# #: Antibase 2 • Antibase -> <TODO: implement antibase, try to do it without primitives>
+# ! Factorial • Out Of -> <TODO: factorial and binomial coefficients, possibly without primitives>
+# !. Fit (Customize) -> <nope>
+# !: Foreign -> <TODO: wrap stuff from man 2>
+# / Insert • Table -> { =f _ len =l l dearray f l 1 sub rep } / <FIXME: create (only)-non-identical types and casts>
+# /. Oblique • Key -> <TODO: implement this without new primitives> / <TODO: implement with out new primitives>
+# /: Grade Up • Sort -> <TODO: implement grade and sort with basic primitives, create generic version> / <TODO: implement order with basic primitives>
+# \ Prefix • Infix -> <TODO: implement without new primitives> / <TODO: implement without new primitives>
+# \. Suffix • Outfix -> <TODO: implement without new primitives> / <TODO: implement without new primitives>
+# \: Grade Down • Sort -> <via generic sort> / <via generic sort>
+#
+# [ Same • Left -> { -0 } / { -1 }
+# [: Cap -> <nope>
+# ] Same • Right -> { -0 } / { -0 }
+# { Catalogue • From -> <TODO: should be implementable in terms of table> / { * }
+# {. Head • Take -> <TODO: implement without new primitives> / <TODO: implement take interval without new primitives>
+# {: Tail • -> <TODO: implement without new primitives>
+# {:: Map • Fetch -> <nope>
+# } Item Amend • Amend (m} u}) -> <TODO: implement without new primitives> / =[]
+# }. Behead • Drop -> <TODO: implement without new primitives> / <TODO: implement without new primitives>
+# }: Curtail • -> <TODO: implement without new primitives>
+#
+# " Rank (m"n u"n m"v u"v) -> <FIXME: think about (function) type casts>
+# ". Do • Numbers -> <nope> / <FIXME: create (sscanf-style) parser>
+# ": Default Format • Format -> <FIXME: create (printf-style) printer>
+# ` Tie (Gerund) -> <implement as arrays of functions>
+# `: Evoke Gerund -> { _ len dearray -<logic> }
+# @ Atop -> { -0*1* }
+# @. Agenda -> { =i =fs { fs * * } i each }
+# @: At -> <nope>
+# & Bond / Compose -> <via various - constructs>
+# &. &.: Under (Dual) -> <TODO: think about inverse functions>
+# &: Appose -> <via various - constructs>
+# ? Roll • Deal -> <TODO: implement rand>
+# ?. Roll • Deal (fixed seed) -> <TODO: implement srand>
+#
+# a. Alphabet -> <TODO: maybe create a lib for this>
+# a: Ace (Boxed Empty) -> <nope>
+# A. Anagram Index • Anagram -> <TODO: maybe create a lib for this>
+# b. Boolean / Basic -> <TODO: implement generic boolean function> / <TODO: think about runtime token availability>
+# C. Cycle-Direct • Permute -> <TODO: maybe create a lib for this>
+# d. Derivative -> <nope>
+# D. Derivative -> <TODO: maybe create a lib for this (also consider run/compile-time token availablitiy)>
+# D: Secant Slope -> <TODO: maybe create a lib for this (also consider run/compile-time token availablitiy)>
+# e. Raze In • Member (In) -> <nope> / <see grep.ey>
+# E. • Member of Interval -> <TODO: implement without new primitives>
+# f. Fix -> <TODO: implement cloning of closures>
+# H. Hypergeometric -> <TODO: maybe create a lib for this>
+#
+# i. Integers • Index Of -> range / <see grep.ey>
+# i: Steps • Index Of Last -> range <step> mul / <see grep.ey>
+# I. Indices • Interval Index -> <see grep.ey> / <nope>
+# j. Imaginary • Complex -> <TODO: complex>
+# L. Level Of • -> <nope>
+# L: Level At -> <nope>
+# M. Memo -> <TODO: implement function result caching>
+# NB. Comment -> #
+# o. Pi Times • Circle Function -> <TODO: create a lib for this>
+# p. Roots • Polynomial -> <TODO: create a lib for this>
+# p.. Poly. Deriv. • Poly. Integral -> <TODO: goes into the polynomial lib>
+# p: Primes -> <TODO: create a lib for this>
+#
+# q: Prime Factors • Prime Exponents -> <TODO: goes into the primes lib>
+# r. Angle • Polar -> <TODO: complex>
+# s: Symbol -> <nope>
+# S: Spread -> <nope>
+# t. Taylor Coeff. (m t. u t.) -> <TODO: goes into the polynomial lib>
+# t: Weighted Taylor -> <TODO: goes into the polynomial lib>
+# T. Taylor Approximation -> <TODO: goes into the polynomial lib>
+# u: Unicode -> <TODO: think about encoding>
+# x: Extended Precision -> <TODO: arbitrary precision lib>
+# _9: to 9: Constant Functions -> { 9 neg } ... { 9 }
+
+executeFile($ARGV[0]);
+
+sub executeFile {
+ my ($file) = @_;
+
+ open my $code, '<', $file or die "cannot open $file: $!";
+ while(my $line = <$code>) {
+ chomp $line;
+
+ my @tokens = tokenize($line);
+ interpretTokens(\@tokens, \@globalData, $globalScope);
+ }
+ close $code;
+}
+
+sub tokenize {
+ my ($line) = @_;
+ $line .= ' ';
+
+ my @t;
+
+ while($line) {
+ if($line =~ /^ +(.*)/s) {
+ $line = $1;
+ } elsif($line =~ /^#/s) {
+ $line = '';
+ } elsif($line =~ /^(\d+) +(.*)/s) {
+ $line = $2;
+ push @t, [$1, 'int'];
+ } elsif($line =~ /^"([^"]+)" +(.*)/s) {
+ $line = $2;
+ push @t, [$1, 'string'];
+ } elsif($line =~ /^([^a-zA-Z ]+)([a-zA-Z]+) +(.*)/s) {
+ $line = "$1 $3";
+ push @t, [$2, 'string'];
+ } elsif($line =~ /^([a-zA-Z]+|[^a-zA-Z ]+) +(.*)/s) {
+ $line = $2;
+ push @t, [$1, 'tok'];
+ } else {
+ die "cannot tokenize: '$line'";
+ }
+ }
+
+ return @t;
+}
+
+sub applyResolvedName {
+ my ($t, $meaning, $data, $scope) = @_;
+
+ if(not defined $meaning) {
+ if($quoted) {
+ push @$data, [sub {
+ my ($data, $scope) = @_;
+
+ my $meaning = resolve($$scope, $data, $t->[0]);
+ applyResolvedName($t, $meaning, $data, $scope);
+ }, ['func', 'quoted late-resolve of ' . $t->[0]], $t->[0]];
+ } else {
+ die "could not resolve '$t->[0]'";
+ }
+ } elsif($meaning->[2] eq 'passive') {
+ if($quoted) {
+ push @$data, [sub { push @{$_[0]}, [$meaning->[0], $meaning->[1]] }, ['func', 'quoted-constant of ' . $t->[0]], $t->[0]];
+ } else {
+ push @$data, [$meaning->[0], $meaning->[1]];
+ }
+ } elsif($meaning->[2] eq 'active') {
+ if($quoted) {
+ push @$data, [$meaning->[0], $meaning->[1], $t->[0]];
+ } else {
+ push @$data, [$meaning->[0], $meaning->[1]];
+ execute($data, $scope);
+ }
+ } elsif($meaning->[2] eq 'quote') {
+ push @$data, [$meaning->[0], $meaning->[1]];
+ execute($data, $scope);
+ } else {
+ die "unknown scope entry meaning for '$t->[0]'";
+ }
+}
+
+sub interpretTokens {
+ my ($tokens, $data, $scope) = @_;
+
+ foreach my $t (@$tokens) {
+ eval {
+ if($t->[1] eq 'tok') {
+ my $meaning = resolve($$scope, $data, $t->[0]);
+ applyResolvedName($t, $meaning, $data, $scope);
+ } elsif(ref($t->[1]) eq 'ARRAY' and $t->[1]->[0] eq 'func') {
+ die "function pointer in interpretTokens";
+ } else {
+ push @$data, $t;
+ }
+ };
+ if($@) {
+ #print "Code: " . Dumper($tokens);
+ #print "Scope: " . Dumper($scope);
+ print "Stack: " . Dumper($data);
+ print "Token: " . Dumper($t);
+ die;
+ }
+ }
+}
+
+sub interpretCode {
+ my ($code, $data, $scope) = @_;
+
+ foreach my $t (@$code) {
+ eval {
+ if($t->[1] eq 'tok') {
+ die "unexpanded token in interpretCode";
+ } elsif(ref($t->[1]) eq 'ARRAY' and $t->[1]->[0] eq 'func') {
+ push @$data, $t;
+ execute($data, $scope);
+ } else {
+ push @$data, $t;
+ }
+ };
+ if($@) {
+ #print "Code: " . Dumper($tokens);
+ #print "Scope: " . Dumper($scope);
+ print "Stack: " . Dumper($data);
+ print "Token: " . Dumper($t);
+ die;
+ }
+ }
+}
+
+sub resolve {
+ my ($scope, $data, $name) = @_;
+
+ die "resolution for undefined name attempted" unless defined $name;
+
+ return $scope->{$name} if(exists $scope->{$name});
+ return resolve($scope->{' parent'}, $data, $name) if(exists $scope->{' parent'});
+
+ if($name =~ /^(_+)(\d*)$/s) {
+ my @spec = split //, $2;
+ @spec = (0) unless @spec;
+
+ return [sub {
+ my ($data, $scope) = @_;
+
+ my @new;
+ foreach my $i (@spec) {
+ die "Stack underflow" if @$data < $i + 1;
+ push @new, $data->[-$i - 1];
+ }
+ push @$data, @new;
+ }, ['func', 'auto-created of ' . $name], 'active'];
+ } elsif($name =~ /^(-+)([0-9*]*)$/s) {
+ my $max = length($1) - 1;
+ my @spec = split //, $2;
+ $max = $_ > $max? $_: $max foreach grep { $_ ne '*' } @spec;
+
+ return [sub {
+ my ($data, $scope) = @_;
+
+ my @buffer;
+ foreach (0 .. $max) {
+ die "Stack underflow" unless @$data;
+ push @buffer, pop @$data;
+ }
+
+ foreach my $i (@spec) {
+ if($i eq '*') {
+ execute($data, $scope);
+ } else {
+ push @$data, $buffer[$i];
+ }
+ }
+ }, ['func', 'auto-created of ' . $name], 'active'];
+ } elsif($name =~ /^\*(\d*)$/s) {
+ my @spec = split //, $1;
+
+ return [sub {
+ my ($data, $scope) = @_;
+
+ my @buffer;
+ foreach my $i (@spec) {
+ die "Stack underflow" if @$data < $i + 2;
+ push @buffer, $data->[-$i - 2];
+ }
+ execute($data, $scope);
+ push @$data, @buffer;
+ }, ['func', 'auto-created of ' . $name], 'active'];
+ }
+
+ return undef;
+}
+
+sub arrayAccess {
+ my ($array, $data, $scope) = @_;
+
+ my $i = pop @$data or die "Stack underflow";
+ die "array index must be int" unless $i->[1] eq 'int';
+
+ push @$data, $array->[0]->[$i->[0]];
+}
+
+sub typeStack {
+ my ($type) = @_;
+
+ if(ref($type) eq 'ARRAY') {
+ if($type->[0] eq 'func' or $type->[0] eq 'array') {
+ if(not exists $type->[2]) {
+ die "type analysis incomplete on " . Dumper($type);
+ }
+ if(@{$type->[2]} == 1 and @{$type->[3]} == 1) {
+ my $ret = typeStack($type->[3]->[0]);
+ unshift @$ret, $type->[2]->[0];
+ return $ret;
+ }
+ }
+ }
+
+ return [$type];
+}
+
+sub typeEqual {
+ my ($a, $b) = @_;
+
+ return 0 if(ref($a) xor ref($b));
+ if(ref($a) and ref($b)) {
+ return 0 if($a->[0] ne $b->[0]);
+
+ if($a->[0] eq 'range') {
+ return $a->[1] == $b->[1] && $a->[2] == $b->[2];
+ } elsif($a->[0] eq 'array' or $a->[0] eq 'func') {
+ return 0 if(@{$a->[2]} != @{$b->[2]});
+ return 0 if(@{$a->[3]} != @{$b->[3]});
+
+ return 0 unless @{$a->[2]} == grep { typeEqual($a->[2]->[$_], $b->[2]->[$_]) } 0 .. $#{$a->[2]};
+ return 0 unless @{$a->[3]} == grep { typeEqual($a->[3]->[$_], $b->[3]->[$_]) } 0 .. $#{$a->[3]};
+ return 1;
+ } else {
+ die "not yet implemented";
+ }
+ }
+
+ return $a eq $b;
+}
+
+sub canCastTo {
+ my ($subtype, $supertype) = @_;
+
+ return 1 if(typeEqual($subtype, $supertype));
+ return 1 if($supertype eq '*');
+ return 1 if($supertype eq 'int' and ref($subtype) eq 'ARRAY' and $subtype->[0] eq 'range');
+
+ return 0;
+}
+
+sub commonSubType {
+ my ($a, $b) = @_;
+
+ return $a if(canCastTo($a, $b));
+ return $b if(canCastTo($b, $a));
+
+ return undef;
+}
+
+sub typeMismatchCount {
+ my ($formal, $concrete) = @_;
+
+ my @rFormal = reverse @$formal;
+ my @rConcrete = reverse @$concrete;
+
+ my $mismatches = 0;
+
+ while(@rFormal) {
+ my $f = shift @rFormal;
+
+ if(canCastTo($rConcrete[0], $f)) {
+ shift @rConcrete;
+ } else {
+ ++$mismatches;
+ }
+ }
+
+ return $mismatches;
+}
+
+sub isVariableType {
+ my ($type) = @_;
+
+ return 0;
+}
+
+sub isIterableType {
+ my ($type) = @_;
+
+ return 1 if(ref($type) eq 'ARRAY' and $type->[0] eq 'range');
+
+ return 0;
+}
+
+sub getLoopStart {
+ my ($iterable) = @_;
+
+ if(ref($iterable->[1]) eq 'ARRAY' and $iterable->[1]->[0] eq 'array') {
+ return [0, 'int'];
+ }
+
+ die "Cannot iterate: " . Dumper($iterable);
+}
+
+sub isLoopEnd {
+ my ($iterable, $i) = @_;
+
+ if(ref($iterable->[1]) eq 'ARRAY' and $iterable->[1]->[0] eq 'array') {
+ return $i->[0] == @{$iterable->[0]};
+ }
+
+ die "Cannot iterate: " . Dumper($iterable);
+}
+
+sub doLoopStep {
+ my ($iterable, $i) = @_;
+
+ if(ref($iterable->[1]) eq 'ARRAY' and $iterable->[1]->[0] eq 'array') {
+ return [$i->[0] + 1, 'int'];
+ }
+
+ die "Cannot iterate: " . Dumper($iterable);
+}
+
+# Executing a function f: A->B->C (i.e. B A f) on concrete arguments b a.
+# Phase 1
+# Foreach argument:
+# Find the function input type from top of concrete argument type stack,
+# increase viewport from top of concrete type stack
+# match type from bottom to top, if type cannot be found, create constant function
+# final match is that which creates minimal number of constant function layers
+# Phase 2
+# Foreach argument type:
+# Identify the type stack above the match from phase 1.
+# Run from right (stacktop) argument to left (stacklow) argument:
+# Take topmost type, check whether it can be found in other stacks (from top)
+# Eliminate all matching types via function or loop creation
+
+sub execute {
+ my ($data, $scope) = @_;
+ my $f = pop @$data or die "Stack underflow";
+
+ if(ref($f->[1]) ne 'ARRAY') {
+ push @$data, $f;
+ return;
+ }
+
+ if($f->[1]->[0] eq 'array') {
+ my $ff = $f;
+ $f = [sub {
+ my ($data, $scope) = @_;
+ arrayAccess($ff, $data, $scope);
+ }, ['func', 'array-to-func-cast', ['int'], [$ff->[1]->[1]]]];
+ }
+
+ die "complex type unsuitable for execution" if($f->[1]->[0] ne 'func');
+
+ if(not $f->[1]->[2]) {
+ # untyped function, just call
+ push @globalCallStack, $f;
+ &{$f->[0]}($data, $scope);
+ pop @globalCallStack;
+ return;
+ }
+
+ my @concreteArgs;
+ my @viewPortOffset;
+
+ # Phase 1
+ for(my $argI = $#{$f->[1]->[2]}; $argI >= 0; --$argI) {
+ # print "Analyzing Arg $argI\n";
+
+ my $formalArg = $f->[1]->[2]->[$argI];
+ my $formalTypeStack = typeStack($formalArg);
+ my $c = pop @$data;
+ my $typeStack = typeStack($c->[1]);
+ # die "Type-Stack: " . Dumper($typeStack);
+
+ my $bestViewPortSize = 0;
+ my $bestViewPortMatch = @$typeStack + 1;
+
+ # print "Formal Type Stack: @$formalTypeStack\n";
+ # print " Type Stack: @$typeStack\n";
+
+ if(isVariableType($typeStack->[-1])) {
+ for(my $viewPortSize = 1; $viewPortSize < @$typeStack + 1; ++$viewPortSize) {
+ my @typeViewPort;
+ unshift @typeViewPort, $typeStack->[$_ - 1] for(1 .. $viewPortSize);
+
+ # print "@$formalTypeStack vs. @$typeStack\n";
+
+ my $viewPortMatch = typeMismatchCount($formalTypeStack, $typeStack);
+ if($viewPortMatch < $bestViewPortMatch) {
+ $bestViewPortSize = $viewPortSize;
+ $bestViewPortMatch = $viewPortMatch;
+ }
+ }
+ } else {
+ $bestViewPortSize = @$typeStack;
+ $bestViewPortMatch = 0;
+ }
+
+ # convert concrete argument to exactly matching function
+ # ... which calls the concrete argument using its relevant args
+ if($bestViewPortMatch == 0) {
+ # zero mismatches, can directly use concrete argument
+ unshift @viewPortOffset, @$typeStack - @$formalTypeStack;
+ } else {
+ # if argument is concrete, but we need are construction a function overall, then concrete
+ # argument needs to be converted to a constant function in whatever domain is necessary
+ die "concrete argument constant functionification needs to be implemented, mismatch: $bestViewPortMatch";
+ $c = sub { "magic goes here FIXME" };
+ }
+
+ unshift @concreteArgs, $c;
+ }
+
+ # print "Viewport Offsets: @viewPortOffset\n";
+
+ # Phase 2,
+ my @toBeAbstractedTypes;
+ foreach my $i (0 .. $#viewPortOffset) {
+ my @remaining = @{typeStack($concreteArgs[$i]->[1])};
+ @{$toBeAbstractedTypes[$i]} = @remaining[0 .. $viewPortOffset[$i] - 1];
+ }
+
+ # print "To be abstracted: " . Dumper(@toBeAbstractedTypes);
+
+ if(not grep { @$_ } @toBeAbstractedTypes) {
+ # no types need to be abstracted, function can be called
+ push @globalCallStack, $f;
+ &{$f->[0]}(\@concreteArgs, $scope);
+ pop @globalCallStack;
+ push @$data, @concreteArgs;
+ } else {
+ my @argTypes; # the type stack of the new function
+ my @stageCalls; # which functions to call in each stage
+ my @loops; # undef for lambda abstraction, loop bound source for loops
+
+ foreach my $i (reverse 0 .. $#toBeAbstractedTypes) {
+ while(@{$toBeAbstractedTypes[$i]}) {
+ my $type = shift @{$toBeAbstractedTypes[$i]};
+
+ my $stageCalls = [$i];
+ my $iterationSource = undef; # which concrete argument we'll take the iteration bounds from
+ if(isIterableType($type)) {
+ $iterationSource = $i;
+ }
+
+ foreach my $j (reverse 0 .. $i - 1) {
+ next unless @{$toBeAbstractedTypes[$j]};
+ my $common = commonSubType($type, $toBeAbstractedTypes[$j]->[0]);
+ next unless $common;
+ $type = $common;
+
+ if(isIterableType($type) and not defined $iterationSource) {
+ $iterationSource = $j;
+ }
+
+ shift @{$toBeAbstractedTypes[$j]};
+ unshift @$stageCalls, $j;
+ }
+
+ if(defined $iterationSource) {
+ unshift @argTypes, undef;
+ unshift @loops, $iterationSource;
+ } else {
+ unshift @argTypes, $type;
+ unshift @loops, undef;
+ }
+
+ push @stageCalls, $stageCalls;
+ }
+ }
+
+ # die Dumper(\@argTypes, \@stageCalls, \@loops);
+
+ my $unravel; $unravel = sub {
+ my ($data, $concreteArgs, $stageCalls, $argTypes, $loops) = @_;
+
+ my @stageCallCopy = @$stageCalls;
+ my @argTypeCopy = @$argTypes;
+ my @loopCopy = @$loops;
+
+ my $stage = pop @stageCallCopy;
+ my $argType = pop @argTypeCopy;
+ my $loop = pop @loopCopy;
+
+ if($argType) {
+ my $abstraction = sub {
+ my ($data, $scope) = @_;
+ my $v = pop @$data;
+
+ my @argCopy = @$concreteArgs;
+
+ foreach my $i (@$stage) {
+ my @s = ($v, $argCopy[$i]);
+ execute(\@s, $scope);
+ $argCopy[$i] = $s[0];
+ }
+
+ &$unravel($data, \@argCopy, \@stageCallCopy, \@argTypeCopy, \@loopCopy);
+ };
+
+ push @$data, [$abstraction, ['func', 'autoabstraction of ' . $f->[1]->[1], [grep { $_ } @argTypeCopy], undef]];
+ # FIXME the undef can be determined
+ } elsif(defined $loop) {
+ my @argCopy = @$concreteArgs;
+
+ my @results;
+ for (my $i = getLoopStart($argCopy[$loop]); !isLoopEnd($argCopy[$loop], $i); $i = doLoopStep($argCopy[$loop], $i)) {
+ my @argCopy2 = @$concreteArgs;
+
+ foreach my $j (@$stage) {
+ my @s = ($i, $argCopy2[$j]);
+ execute(\@s, $scope);
+ $argCopy2[$j] = $s[0];
+ }
+
+ my $count = @$data;
+ &$unravel($data, \@argCopy2, \@stageCallCopy, \@argTypeCopy, \@loopCopy);
+ push @results, pop @$data;
+ die "abstracted function produced multiple results (can be handled corretly, needs to be implemented)"
+ unless $count == @$data;
+ # by producing two arrays side by side
+ }
+
+ push @$data, [\@results, ['array', '[]', [['range', 0, $#results]], [undef]]];
+ # FIXME the undef can be determined
+ } else {
+ my @argCopy = @$concreteArgs;
+
+ push @globalCallStack, $f;
+ &{$f->[0]}(\@argCopy, $scope);
+ pop @globalCallStack;
+ push @$data, @argCopy;
+ }
+ };
+
+ &$unravel($data, \@concreteArgs, \@stageCalls, \@argTypes, \@loops);
+ }
+}