More performance still.

5 files changed, 288 insertions, 148 deletions

diff --git a/compiler/elymasAsm.ey b/compiler/elymasAsm.ey
index 3a7ca60..a793a16 100644
--- a/compiler/elymasAsm.ey
+++ b/compiler/elymasAsm.ey
@@ -11,40 +11,43 @@
   } "%" defq
 
   # registers
-  { [ /rax /rcx /rdx /rbx /rsp /rbp /rsi /rdi /r8 /r9 /r10 /r11 /r12 /r13 /r14 /r15 ] streq any } /bit64 deff
-  { [ /eax /ecx /edx /ebx /esp /ebp /esi /edi /r8d /r9d /r10d /r11d /r12d /r13d /r14d /r15d ] streq any } /bit32 deff
+  < [ /rax /rcx /rdx /rbx /rsp /rbp /rsi /rdi /r8 /r9 /r10 /r11 /r12 /r13 /r14 /r15 ] { 1 -01 defv }' each > ==bit64table
+  { bit64table -01 . -- } /bit64assert deff
+
+  < [ /eax /ecx /edx /ebx /esp /ebp /esi /edi /r8d /r9d /r10d /r11d /r12d /r13d /r14d /r15d ] { 1 -01 defv }' each > ==bit32table
+  { bit32table -01 . -- } /bit32assert deff
+
   { [ /ax /cx /dx /bx /sp /bp /si /di /r8w /r9w /r10w /r11w /r12w /r13w /r14w /r15w ] streq any } /bit16 deff
   { [ /al /cl /dl /bl /spl /ah /bpl /ch /sil /dh /dil /bh /r8b /r9b /r10b /r11b /r12b /r13b /r14b /r15b ] streq any } /bit8 deff
   
-  { { streq any }_ ==reg
-    [
-      [ /zero /al /ax /eax /rax /none ]
-      [ /one /cl /cx /ecx /rcx ]
-      [ /two /dl /dx /edx /rdx ]
-      [ /three /bl /bx /ebx /rbx ]
-      [ /four /sib /spl /ah /sp /esp /rsp ]
-      [ /five /bpl /ch /bp /ebp /rbp ]
-      [ /six /sil /si /esi /rsi ]
-      [ /seven /dil /di /edi /rdi ]
-      [ /r8b /r8w /r8d /r8 ]
-      [ /r9b /r9w /r9d /r9 ]
-      [ /r10b /r10w /r10d /r10 ]
-      [ /r11b /r11w /r11d /r11 ]
-      [ /r12b /r12w /r12d /r12 ]
-      [ /r13b /r13w /r13d /r13 ]
-      [ /r14b /r14w /r14d /r14 ]
-      [ /r15b /r15w /r15d /r15 ]
-    ] reg index
-    _ 1 neg gt assert
-  } /regno deff
+  <
+    [ /zero /al /ax /eax /rax /none ] { 0 -01 defv }' each
+    [ /one /cl /cx /ecx /rcx ] { 1 -01 defv }' each
+    [ /two /dl /dx /edx /rdx ] { 2 -01 defv }' each
+    [ /three /bl /bx /ebx /rbx ] { 3 -01 defv }' each
+    [ /four /sib /spl /ah /sp /esp /rsp ] { 4 -01 defv }' each
+    [ /five /bpl /ch /bp /ebp /rbp ] { 5 -01 defv }' each
+    [ /six /sil /si /esi /rsi ] { 6 -01 defv }' each
+    [ /seven /dil /di /edi /rdi ] { 7 -01 defv }' each
+    [ /r8b /r8w /r8d /r8 ] { 8 -01 defv }' each
+    [ /r9b /r9w /r9d /r9 ] { 9 -01 defv }' each
+    [ /r10b /r10w /r10d /r10 ] { 10 -01 defv }' each
+    [ /r11b /r11w /r11d /r11 ] { 11 -01 defv }' each
+    [ /r12b /r12w /r12d /r12 ] { 12 -01 defv }' each
+    [ /r13b /r13w /r13d /r13 ] { 13 -01 defv }' each
+    [ /r14b /r14w /r14d /r14 ] { 14 -01 defv }' each
+    [ /r15b /r15w /r15d /r15 ] { 15 -01 defv }' each
+  > ==regnoTable
+
+  { regnoTable -01 . } /regno deff
 
   # encoding a REX prefix
-  { ==b ==x ==r ==w
-                          %40
-    w                0 gt %08 mul add
-    r regno %08 band 0 gt %04 mul add
-    x regno %08 band 0 gt %02 mul add
-    b regno %08 band 0 gt %01 mul add
+  { # ==b ==x ==r ==w
+                            %40
+    -01 regno %08 band 0 gt %01 mul add
+    -01 regno %08 band 0 gt %02 mul add
+    -01 regno %08 band 0 gt %04 mul add
+    -01                0 gt %08 mul add
   } /rex deff
 
   { =mem =reg
@@ -123,8 +126,8 @@
 
   # instructions
   { ==reg ==mem
-    reg bit32 assert
-    mem bit64 assert
+    reg bit32assert
+    mem bit64assert
 
     reg regno %07 gt mem regno %07 gt or { 0 reg /none mem rex } rep
     %03
@@ -132,7 +135,7 @@
   } /addlMemReg deff
 
   { ==mem ==disp ==i
-    mem bit64 assert
+    mem bit64assert
     i 256 lt assert
 
     1 /none /none mem rex
@@ -143,7 +146,7 @@
   } /addqImm8MemDisp8 deff
 
   { ==reg ==i
-    reg bit64 assert
+    reg bit64assert
     i 256 lt assert
 
     1 /none /none reg rex
@@ -153,8 +156,8 @@
   } /addqImm8Reg deff
 
   { ==reg ==mem ==disp
-    reg bit64 assert
-    mem bit64 assert
+    reg bit64assert
+    mem bit64assert
     disp 128 lt assert
 
     1 reg /none mem rex
@@ -164,8 +167,8 @@
   } /addqMemDisp8Reg deff
 
   { ==dst ==src
-    dst bit64 assert
-    src bit64 assert
+    dst bit64assert
+    src bit64assert
 
     1 src /none dst rex
     %01
@@ -173,7 +176,7 @@
   } /addqRegReg deff
 
   { ==reg
-    reg bit64 assert
+    reg bit64assert
 
     reg regno %07 gt { 1 /none /none reg rex } rep
     %FF
@@ -190,8 +193,8 @@
   } /cmpsq deff
 
   { ==mem ==reg
-    reg bit32 assert
-    mem bit64 assert
+    reg bit32assert
+    mem bit64assert
 
     reg regno %07 gt mem regno %07 gt or { 0 reg /none mem rex } rep
     %39
@@ -199,8 +202,8 @@
   } /cmplRegMem deff
 
   { ==mem ==reg
-    reg bit64 assert
-    mem bit64 assert
+    reg bit64assert
+    mem bit64assert
 
     1 reg /none mem rex
     %39
@@ -208,8 +211,8 @@
   } /cmpqRegMem deff
 
   { ==dst ==src
-    dst bit64 assert
-    src bit64 assert
+    dst bit64assert
+    src bit64assert
 
     1 src /none dst rex
     %39
@@ -217,7 +220,7 @@
   } /cmpqRegReg deff
 
   { ==reg
-    reg bit64 assert
+    reg bit64assert
 
     1 /none /none reg rex
     %FF
@@ -253,8 +256,8 @@
   %74 /jz defJmp
 
   { ==reg ==mem
-    reg bit32 assert
-    mem bit64 assert
+    reg bit32assert
+    mem bit64assert
 
     reg regno %07 gt mem regno %07 gt or { 0 reg /none mem rex } rep
     %8B
@@ -262,7 +265,7 @@
   } /movlMemReg deff
 
   { ==reg ==i
-    reg bit64 assert
+    reg bit64assert
 
     1 /none /none reg rex
     %B8 reg regno %07 band add
@@ -270,7 +273,7 @@
   } /movqImmReg deff
 
   { ==mem ==disp ==i
-    mem bit64 assert
+    mem bit64assert
     i 2147483648 lt assert
     i 2147483648 neg ge assert
 
@@ -282,15 +285,15 @@
   } /movqImm32MemDisp8 deff
 
   { ==reg
-    reg bit64 assert
+    reg bit64assert
 
     1 /none /none reg rex
     %B8 reg regno %07 band add
   } /movqImmOOBReg deff
 
   { ==reg ==mem ==disp
-    reg bit64 assert
-    mem bit64 assert
+    reg bit64assert
+    mem bit64assert
     disp 128 lt assert
 
     1 reg /none mem rex
@@ -300,9 +303,9 @@
   } /movqMemDisp8Reg deff
 
   { ==reg ==mem ==idx
-    reg bit64 assert
-    mem bit64 assert
-    idx bit64 assert
+    reg bit64assert
+    mem bit64assert
+    idx bit64assert
 
     1 reg idx mem rex
     %8B
@@ -311,8 +314,8 @@
   } /movqMemIndexReg deff
 
   { ==reg ==mem
-    reg bit64 assert
-    mem bit64 assert
+    reg bit64assert
+    mem bit64assert
 
     1 reg /none mem rex
     %8B
@@ -320,8 +323,8 @@
   } /movqMemReg deff
 
   { ==mem ==reg
-    reg bit64 assert
-    mem bit64 assert
+    reg bit64assert
+    mem bit64assert
 
     1 reg /none mem rex
     %89
@@ -329,8 +332,8 @@
   } /movqRegMem deff
 
   { ==mem ==disp ==reg
-    reg bit64 assert
-    mem bit64 assert
+    reg bit64assert
+    mem bit64assert
     disp 128 lt assert
 
     1 reg /none mem rex
@@ -340,9 +343,9 @@
   } /movqRegMemDisp8 deff
   
   { ==mem ==idx ==reg
-    reg bit64 assert
-    mem bit64 assert
-    idx bit64 assert
+    reg bit64assert
+    mem bit64assert
+    idx bit64assert
 
     1 reg idx mem rex
     %89
@@ -351,8 +354,8 @@
   } /movqRegMemIndex deff
 
   { ==dst ==src
-    src bit64 assert
-    dst bit64 assert
+    src bit64assert
+    dst bit64assert
 
     1 src /none dst rex
     %89
@@ -360,7 +363,7 @@
   } /movqRegReg deff
 
   { ==mem ==i
-    mem bit64 assert
+    mem bit64assert
     i 256 lt assert
 
     %80
@@ -369,7 +372,7 @@
   } /orbImmMem deff
 
   { ==mem ==disp ==i
-    mem bit64 assert
+    mem bit64assert
     i 256 lt assert
     disp 128 lt assert
 
@@ -415,7 +418,7 @@
   } /retn deff
 
   { ==reg ==i
-    reg bit64 assert
+    reg bit64assert
     i 64 lt assert
 
     1 /none /none reg rex
@@ -425,7 +428,7 @@
   } /shlqImm8Reg deff
 
   { ==reg
-    reg bit64 assert
+    reg bit64assert
 
     1 /none /none reg rex
     %D1
@@ -433,7 +436,7 @@
   } /shrq1Reg deff
 
   { ==reg ==i
-    reg bit64 assert
+    reg bit64assert
     i 256 lt assert
 
     1 /none /none reg rex
@@ -443,8 +446,8 @@
   } /subqImm8Reg deff
 
   { ==reg ==mem ==disp
-    reg bit64 assert
-    mem bit64 assert
+    reg bit64assert
+    mem bit64assert
     disp 128 lt assert
 
     1 reg /none mem rex
@@ -454,8 +457,8 @@
   } /subqMemDisp8Reg deff
 
   { ==reg ==mem
-    reg bit32 assert
-    mem bit64 assert
+    reg bit32assert
+    mem bit64assert
 
     reg regno %07 gt mem regno %07 gt or { 0 reg /none mem rex } rep
     %2B
@@ -463,8 +466,8 @@
   } /sublMemReg deff
 
   { ==reg ==mem
-    reg bit64 assert
-    mem bit64 assert
+    reg bit64assert
+    mem bit64assert
 
     1 reg /none mem rex
     %2B
@@ -472,8 +475,8 @@
   } /subqMemReg deff
 
   { ==dst ==src
-    dst bit64 assert
-    src bit64 assert
+    dst bit64assert
+    src bit64assert
 
     1 src /none dst rex
     %29
@@ -485,8 +488,8 @@
   } /syscall deff
 
   { ==dst ==src
-    dst bit64 assert
-    src bit64 assert
+    dst bit64assert
+    src bit64assert
 
     1 src /none dst rex
     %85
@@ -499,8 +502,8 @@
   } /ud2 deff
 
   { ==mem ==reg
-    reg bit64 assert
-    mem bit64 assert
+    reg bit64assert
+    mem bit64assert
 
     1 reg /none mem rex
     %87
@@ -508,8 +511,8 @@
   } /xchgqRegMem deff
 
   { ==dst ==src
-    dst bit64 assert
-    src bit64 assert
+    dst bit64assert
+    src bit64assert
 
     1 src /none dst rex
     %87
@@ -517,8 +520,8 @@
   } /xchgqRegReg deff
 
   { ==reg ==mem
-    reg bit64 assert
-    mem bit64 assert
+    reg bit64assert
+    mem bit64assert
 
     1 reg /none mem rex
     %33
@@ -526,8 +529,8 @@
   } /xorqMemReg deff
 
   { ==mem ==reg
-    reg bit64 assert
-    mem bit64 assert
+    reg bit64assert
+    mem bit64assert
 
     1 reg /none mem rex
     %31
@@ -535,8 +538,8 @@
   } /xorqRegMem deff
 
   { ==dst ==src
-    dst bit64 assert
-    src bit64 assert
+    dst bit64assert
+    src bit64assert
 
     1 src /none dst rex
     %31
@@ -562,8 +565,8 @@
 
   { ==opcodes
     opcodes len 1 sub PAGESIZE div 1 add PAGESIZE mul sys .asm .alloc /codearea defv
-    codearea .base ==i
-    opcodes { i sys .asm .poke i 1 add =i } each
+    sys .asm .|poke =*poke
+    codearea .base opcodes { -101 poke 1 add } each --
     codearea
   } /arrayToCode deff
 
diff --git a/compiler/elymasAsmLib.ey b/compiler/elymasAsmLib.ey
index 76cb7e7..60ea53d 100644
--- a/compiler/elymasAsmLib.ey
+++ b/compiler/elymasAsmLib.ey
@@ -486,11 +486,11 @@
     ] /ASCII defv
 
     { # ==addr
-      [ -01 8 { _ sys .asm .peek -01 1 add } rep -- ] reverse { -01 256 mul add } fold
+      [ -01 7 add 8 { _ sys .asm .peek -01 1 sub } rep -- ] { -01 256 mul add } fold
     } /peekImm64 deff
 
     { # ==addr
-      [ -01 4 { _ sys .asm .peek -01 1 add } rep -- ] reverse { -01 256 mul add } fold
+      [ -01 3 add 4 { _ sys .asm .peek -01 1 sub } rep -- ] { -01 256 mul add } fold
     } /peekImm32 deff
 
     { # ==addr
diff --git a/compiler/standard.ey b/compiler/standard.ey
index 7df61f3..b294da8 100644
--- a/compiler/standard.ey
+++ b/compiler/standard.ey
@@ -7,16 +7,16 @@
   } quoted { } { * } ? *
 } "}_" defq
 
-{ =*f _ =*a len ==l
-  l {
+{ -1110 ; ==f =*a len _
+  {
     0 a
-    1 l 1 sub range { a f } each
-    } { "fold on empty array" die }
+    1 -102 1 sub range f each
+    }' { "fold on empty array" die }'
   ? *
 } /fold deff
 
-{ _ =*a len ==l
-  [ 1 l range { l -01 sub a } each ]
+{ _ =*a len
+  [ 1 -1202 range { -110 sub a -01 }' each -- ]
 } /reverse deff
 
 { |or fold } /any deff
diff --git a/interpreter/Elymas.pm b/interpreter/Elymas.pm
index 2661f5b..8d702f5 100644
--- a/interpreter/Elymas.pm
+++ b/interpreter/Elymas.pm
@@ -6,7 +6,7 @@ use warnings;
 require Exporter;
 our @ISA = qw(Exporter);
 our @EXPORT = qw(
-  popInt popString popArray arrayAccess $quoted @globalCallStack
+  popInt popString popArray $quoted @globalCallStack
   interpretCode compileCode execute executeString executeFile resolve canCastTo typeEqual
 );
 
@@ -40,15 +40,6 @@ sub popArray {
   return $a->[0];
 }
 
-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] % @{$array->[0]}];
-}
-
 sub interpretCode {
   my ($code, $data, $scope) = @_;
 
@@ -76,26 +67,106 @@ sub interpretCode {
 sub compileCode {
   my ($code) = @_;
 
-  my $ret = "my \$i = 0; eval {\n";
+  my $ret = "";
+  my $popPending = 0;
+  my $popCode = "pop \@globalCallStack;\n";
+  my $hasStackOps = 0;
+  my $skip = 0;
+
+  $ret .= "my \$i = 0; my \$name; my \$meaning; my \$rscope; eval {\n";
 
   foreach my $i (0 .. $#$code) {
+    if($skip) {
+      $skip = 0;
+      next;
+    }
+
     my $t = $code->[$i];
 
     if(ref($t->[1]) eq 'ARRAY' and $t->[1]->[0] eq 'func') {
       if(not $t->[1]->[2]) {
-        # untyped function, just call, no need to go through execute
-        $ret .= "\$i = $i;\n";
-        $ret .= "push \@globalCallStack, \$code[$i];\n";
-        $ret .= "&{\$code[$i]->[0]}(\$data, \$lscope);\n";
-        $ret .= "pop \@globalCallStack;\n";
+        if($t->[1]->[1] =~ /^quoted late-resolve of/) {
+          $ret .= $popCode and $popPending = 0 if $popPending;
+          my $name = $t->[2];
+          # $ret .= "\$name = '$name'; Elymas::applyResolvedName(\$name, resolve(\$\$lscope, \$data, \$name), \$data, \$lscope, 0);\n";
+          # $ret .= "\$meaning = resolve(\$\$lscope, \$data, '$name');\n";
+          $ret .= "\$meaning = undef;\n";
+          $ret .= "\$rscope = \$\$lscope;\n";
+          $ret .= "do {\n";
+          $ret .= "  \$meaning = \$rscope->{'$name'} and \$rscope = undef if exists \$rscope->{'$name'};\n";
+          $ret .= "  \$rscope = \$rscope->{' parent'};\n";
+          $ret .= "} while(defined \$rscope);\n";
+          $ret .= "die 'could not resolve \"$name\"' unless defined \$meaning;\n";
+          $ret .= <<'EOPERL';
+          if($meaning->[2] eq 'passive') {
+            push @$data, [$meaning->[0], $meaning->[1]];
+          } elsif($meaning->[2] eq 'active' or $meaning->[2] eq 'quote') {
+            execute([$meaning->[0], $meaning->[1]], $data, $scope);
+          } else {
+            die "unknown scope entry meaning: " . $meaning->[2];
+          }
+EOPERL
+        } elsif($t->[1]->[1] eq '/') {
+          # nop
+        } elsif($t->[1]->[1] eq '_') {
+          $ret .= "# _\n";
+          $ret .= "push \@\$data, \$data->[-1];\n";
+        } else {
+          # untyped function, just call, no need to go through execute
+          $ret .= "\$i = $i;\n";
+          if($popPending) {
+            $ret .= "\$globalCallStack[-1] = \$code[$i];\n";
+          } else {
+            $ret .= "push \@globalCallStack, \$code[$i];\n";
+          }
+          $ret .= "&{\$code[$i]->[0]}(\$data, \$lscope); # " . $code->[$i]->[1]->[1] . "\n";
+          $popPending = 1;
+        }
       } else {
-        $ret .= "\$i = $i; execute(\$code[$i], \$data, \$lscope);\n";
+        $ret .= $popCode and $popPending = 0 if $popPending;
+        $ret .= "\$i = $i; execute(\$code[$i], \$data, \$lscope); # " . $code->[$i]->[1]->[1] . "\n";
       }
     } else {
-      $ret .= "push \@\$data, \$code[$i];\n";
+      if($i < $#$code and ref($code->[$i + 1]->[1]) eq 'ARRAY' and $code->[$i + 1]->[1]->[1] eq '-') {
+        # inline stack operation
+
+        $ret .= "# -" . $code->[$i]->[0] . "\n";
+
+        my $spec = $code->[$i]->[0];
+        my $max = 0;
+
+        my @spec = split //, $spec;
+        $max = $_ > $max? $_: $max foreach grep { $_ ne '*' } @spec;
+
+        $ret .= "die 'Stack underflow in inlined stack-op' unless \@\$data >= $max;\n";
+        $hasStackOps = 1;
+        $ret .= "\@buffer = ();\n";
+
+        foreach (0 .. $max) {
+          $ret .= "push \@buffer, pop \@\$data;\n";
+        }
+
+        foreach my $j (@spec) {
+          if($j eq '*') {
+            $ret .= "\$f = pop \@\$data or die 'Stack underflow in -*';\n";
+            $ret .= "execute(\$f, \$data, \$scope);\n";
+          } else {
+            $ret .= "push \@\$data, \$buffer[$j];\n";
+          }
+        }
+        
+        $skip = 1;
+      } else {
+        $ret .= "push \@\$data, \$code[$i]; # " . $code->[$i]->[0] . "\n";
+      }
     }
   }
 
+  $ret .= $popCode and $popPending = 0 if $popPending;
+  if($hasStackOps) {
+    $ret = "my \$f; my \@buffer; \n" . $ret;
+  }
+
   $ret .= <<'EOPERL';
   };
   if($@) {
@@ -275,8 +346,12 @@ sub execute {
   if($f->[1]->[0] eq 'array') {
     my $ff = $f;
     $f = [sub {
-      my ($data, $scope) = @_;
-      arrayAccess($ff, $data, $scope);
+      my ($data) = @_;
+
+      my $i = pop @$data or die "Stack underflow";
+      die "array index must be int" unless $i->[1] eq 'int';
+
+      push @$data, $ff->[0]->[$i->[0] % @{$ff->[0]}];
     }, ['func', 'array-to-func-cast', ['int'], [$ff->[1]->[1]]]];
   } elsif($f->[1]->[0] ne 'func') {
     die "complex type unsuitable for execution";
@@ -291,16 +366,23 @@ sub execute {
   }
 
   # COMMON case optimization (can be removed without any effect on semantics)
-  my $allTrivial = 1;
-  for(my $argI = $#{$f->[1]->[2]}; $argI >= 0; --$argI) {
-    if($data->[-1-$argI]->[1] ne $f->[1]->[2]->[$argI]) {
-      $allTrivial = 0;
-      last;
-    }
-  }
-
-  # trivial scalar arguments all over the place
-  if($allTrivial) {
+#  my $allTrivial = 1;
+#  for(my $argI = $#{$f->[1]->[2]}; $argI >= 0; --$argI) {
+#    if($data->[-1-$argI]->[1] ne $f->[1]->[2]->[$argI]) {
+#      $allTrivial = 0;
+#      last;
+#    }
+#  }
+#
+#  # trivial scalar arguments all over the place
+#  if($allTrivial) {
+#    push @globalCallStack, $f;
+#    &{$f->[0]}($data, $scope);
+#    pop @globalCallStack;
+#    return;
+#  }
+
+  if(@{$f->[1]->[2]} == grep { $data->[-1-$_]->[1] eq $f->[1]->[2]->[$_] } 0 .. $#{$f->[1]->[2]}) {
     push @globalCallStack, $f;
     &{$f->[0]}($data, $scope);
     pop @globalCallStack;
@@ -493,8 +575,11 @@ sub resolve {
 
   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'});
+  do {
+    return $scope->{$name} if(exists $scope->{$name});
+    $scope = $scope->{' parent'};
+  } while(defined $scope);
+
   return undef;
 }
 
diff --git a/interpreter/ElymasGlobal.pm b/interpreter/ElymasGlobal.pm
index 709fbb3..42b8bee 100644
--- a/interpreter/ElymasGlobal.pm
+++ b/interpreter/ElymasGlobal.pm
@@ -115,23 +115,52 @@ EOPERL
 
       die "unexpanded token in quoted code" if grep { $_->[1] eq 'tok' } @code;
 
-      if($quoted) {
-        push @$data, [sub {
-          my ($data, $refScope) = @_;
-          my $scope = $$refScope;
+#      if($quoted) {
+#        push @$data, [sub {
+#          my ($data, $refScope) = @_;
+#          my $scope = $$refScope;
+#
+#          push @$data, [sub {
+#            my ($data) = @_;
+#            interpretCode(\@code, $data, \$scope);
+#          }, ['func', 'Dumper(\@code)']];
+#        }, ['func', 'func-quoted'], \@code];
+#      } else {
+#        push @$data, [sub {
+#          my ($data) = @_;
+#          interpretCode(\@code, $data, \$scope);
+#        }, ['func', 'Dumper(\@code)']];
+#      }
 
-          push @$data, [sub {
-            my ($data) = @_;
-            interpretCode(\@code, $data, \$scope);
-          }, ['func', 'Dumper(\@code)']];
-        }, ['func', 'func-quoted'], \@code];
+      if($quoted) {
+        my $sub = <<'EOPERL' .
+          sub {
+            my ($data, $refScope) = @_;
+            my $scope = $$refScope;
+            my $s = sub {
+                my ($data) = @_;
+                my $lscope = \$scope;
+EOPERL
+                compileCode(\@code) . <<'EOPERL';
+              };
+            push @$data, [$s, ['func', 'compiled sub (1)']];
+          }
+EOPERL
+        $sub = eval($sub);
+        push @$data, [$sub, ['func', 'func-quoted'], \@code];
       } else {
-        push @$data, [sub {
-          my ($data) = @_;
-          interpretCode(\@code, $data, \$scope);
-        }, ['func', 'Dumper(\@code)']];
+        my $sub = <<'EOPERL' .
+          sub {
+            my ($data) = @_;
+            my $lscope = \$scope;
+EOPERL
+            compileCode(\@code) . <<'EOPERL';
+          };
+EOPERL
+        $sub = eval($sub);
+        push @$data, [$sub, ['func', 'compiled sub (2)']];
       }
-    }, ['func', '}'], 'quote'],
+    }, ['func', "}'"], 'quote'],
   'quoted' => [sub {
       my ($data, $scope) = @_;
       push @$data, [$quoted? 1: 0, 'int'];
@@ -341,6 +370,17 @@ EOPERL
 
       die "Not numeric: " . Dumper($c) unless $c->[1] eq 'int';
 
+      # COMMON case optimization (can be removed without any effect on semantics)
+      if(ref($f->[1]) eq 'ARRAY' and $f->[1]->[0] eq 'func' and not $f->[1]->[2]) {
+        push @globalCallStack, $f;
+        foreach my $i (1 .. $c->[0]) {
+          &{$f->[0]}($data, $scope);
+        }
+        pop @globalCallStack;
+        return;
+      }
+      # END COMMON
+      
       foreach my $i (1 .. $c->[0]) {
         execute($f, $data, $scope);
       }
@@ -520,7 +560,19 @@ EOPERL
       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';
-
+  
+      # COMMON case optimization (can be removed without any effect on semantics)
+      if(ref($f->[1]) eq 'ARRAY' and $f->[1]->[0] eq 'func' and not $f->[1]->[2]) {
+        push @globalCallStack, $f;
+        foreach my $i (@{$a->[0]}) {
+          push @$data, $i;
+          &{$f->[0]}($data, $scope);
+        }
+        pop @globalCallStack;
+        return;
+      }
+      # END COMMON
+      
       foreach my $i (@{$a->[0]}) {
         push @$data, $i;
         execute($f, $data, $scope);