t/compilers/imcc/syn/tail.t

   1 #!perl
   2 # Copyright (C) 2005-2007, The Perl Foundation.
   3 # $Id$
   4
   5 use strict;
   6 use warnings;
   7 use lib qw( . lib ../lib ../../lib );
   8 use Test::More;
   9 use Parrot::Config;
  10 use Parrot::Test tests => 6;
  11
  12 ##############################
  13 # Parrot Calling Conventions:  Tail call optimization.
  14
  15 $ENV{TEST_PROG_ARGS} = '-Oc';
  16
  17 pir_output_is( <<'CODE', <<'OUT', "tail call optimization, final position" );
  18 .sub _main :main
  19     $P1 = new 'Integer'
  20     $P1 = 20
  21     $P2 = new 'Integer'
  22     $P2 = 3
  23     .const .Sub f = "_floor"
  24     .const .Sub c = "_funcall"
  25     set_args "0,0,0", f, $P1, $P2
  26     get_results "0,0", $P3, $P4
  27     invokecc c
  28     print "_floor returned "
  29     print 2      # TODO argcP
  30     print " values, "
  31     print $P3
  32     print " and "
  33     print $P4
  34     print ".\n"
  35     .const .Sub s = "_fib_step"
  36     set_args "0,0,0", s, $P1, $P2
  37     get_results "0,0,0", $P3, $P4, $P5
  38     invokecc c
  39     print "_fib_step returned "
  40     print 3    # TODO argcP
  41     print " values, "
  42     print $P3
  43     print ", "
  44     print $P4
  45     print ", and "
  46     print $P5
  47     print ".\n"
  48 .end
  49
  50 .sub _funcall
  51     .local pmc function
  52     .local pmc argv
  53     get_params "0,0x20", function, argv
  54     print "[doing _funcall]\n"
  55     $I33 = defined function
  56     if $I33 goto doit
  57 bad_func:
  58     printerr "_funcall:  Bad function.\n"
  59     exit 0
  60 doit:
  61     set_args "0x20", argv
  62     tailcall function
  63 .end
  64
  65 ## Return quotient and remainder as two integers.
  66 .sub _floor
  67     .local pmc arg1
  68     .local pmc arg2
  69     get_params "0,0", arg1, arg2
  70     $P1 = new 'Integer'
  71     $P1 = arg1 / arg2
  72     ## truncate.
  73     $I1 = $P1
  74     $P1 = $I1
  75     $P2 = new 'Integer'
  76     $P2 = arg1 % arg2
  77     set_returns "0,0", $P1, $P2
  78     returncc
  79 .end
  80
  81 ## Return the sum and the two arguments as three integers.
  82 .sub _fib_step
  83     .local pmc arg1
  84     .local pmc arg2
  85     get_params "0,0", arg1, arg2
  86     $P1 = new 'Integer'
  87     $P1 = arg1 + arg2
  88     set_returns "0,0,0", $P1, arg1, arg2
  89     returncc
  90 .end
  91 CODE
  92 [doing _funcall]
  93 _floor returned 2 values, 6 and 2.
  94 [doing _funcall]
  95 _fib_step returned 3 values, 23, 20, and 3.
  96 OUT
  97
  98 pir_output_is( <<'CODE', <<'OUT', "tail call optimization, intermediate position" );
  99
 100 .sub _main :main
 101     $P1 = new 'Integer'
 102     $P1 = 20
 103     $P2 = new 'Integer'
 104     $P2 = 3
 105     .const .Sub f = "_floor"
 106     .const .Sub s = "_fib_step"
 107     ($P3, $P4) = _funcall(f, $P1, $P2)
 108     print "_floor returned "
 109     print 2
 110     print " values, "
 111     print $P3
 112     print " and "
 113     print $P4
 114     print ".\n"
 115     ($P3, $P4, $P5) = _funcall(s, $P1, $P2)
 116     print "_fib_step returned "
 117     print 3
 118     print " values, "
 119     print $P3
 120     print ", "
 121     print $P4
 122     print ", and "
 123     print $P5
 124     print ".\n"
 125 .end
 126
 127 .sub _funcall
 128     .param pmc function
 129     .param pmc argv :slurpy
 130
 131     print "[doing _funcall]\n"
 132     $I33 = defined function
 133     unless $I33 goto bad_func
 134 doit:
 135     .return function(argv :flat)
 136 bad_func:
 137     printerr "_funcall:  Bad function.\n"
 138     exit 0
 139 .end
 140
 141 ## Return quotient and remainder as two integers.
 142 .sub _floor
 143     .param pmc arg1
 144     .param pmc arg2
 145
 146     $P1 = new 'Integer'
 147     $P1 = arg1 / arg2
 148     ## truncate.
 149     $I1 = $P1
 150     $P1 = $I1
 151     $P2 = new 'Integer'
 152     $P2 = arg1 % arg2
 153     .return($P1, $P2)
 154 .end
 155
 156 ## Return the sum and the two arguments as three integers.
 157 .sub _fib_step
 158     .param pmc arg1
 159     .param pmc arg2
 160
 161     $P1 = new 'Integer'
 162     $P1 = arg1 + arg2
 163     .return ($P1, arg1,  arg2)
 164 .end
 165 CODE
 166 [doing _funcall]
 167 _floor returned 2 values, 6 and 2.
 168 [doing _funcall]
 169 _fib_step returned 3 values, 23, 20, and 3.
 170 OUT
 171
 172 pir_output_is( <<'CODE', <<'OUT', "tail call optimization, implicit final return" );
 173
 174 .sub _main :main
 175
 176     $P1 = new 'Integer'
 177     $P1 = 20
 178     $P2 = new 'Integer'
 179     $P2 = 3
 180     .const .Sub f = "_floor"
 181     .const .Sub s = "_fib_step"
 182     ($P3, $P4) = _funcall(f, $P1, $P2)
 183     print "_floor returned "
 184     print 2
 185     print " values, "
 186     print $P3
 187     print " and "
 188     print $P4
 189     print ".\n"
 190     ($P3, $P4, $P5) = _funcall(s, $P1, $P2)
 191     print "_fib_step returned "
 192     print 3
 193     print " values, "
 194     print $P3
 195     print ", "
 196     print $P4
 197     print ", and "
 198     print $P5
 199     print ".\n"
 200 .end
 201
 202 .sub _funcall
 203     .param pmc function
 204     .param pmc argv :slurpy
 205
 206     print "[doing _funcall]\n"
 207     $I33 = defined function
 208     if $I33 goto doit
 209 bad_func:
 210     printerr "_funcall:  Bad function.\n"
 211     exit 0
 212 doit:
 213     .return function(argv :flat)
 214 .end
 215
 216 ## Return quotient and remainder as two integers.
 217 .sub _floor
 218     .param pmc arg1
 219     .param pmc arg2
 220
 221     $P1 = new 'Integer'
 222     $P1 = arg1 / arg2
 223     ## truncate.
 224     $I1 = $P1
 225     $P1 = $I1
 226     $P2 = new 'Integer'
 227     $P2 = arg1 % arg2
 228     .return($P1, $P2)
 229 .end
 230
 231 ## Return the sum and the two arguments as three integers.
 232 .sub _fib_step
 233     .param pmc arg1
 234     .param pmc arg2
 235
 236     $P1 = new 'Integer'
 237     $P1 = arg1 + arg2
 238     .begin_return
 239     .return $P1
 240     .return arg1
 241     .return arg2
 242     .end_return
 243 .end
 244 CODE
 245 [doing _funcall]
 246 _floor returned 2 values, 6 and 2.
 247 [doing _funcall]
 248 _fib_step returned 3 values, 23, 20, and 3.
 249 OUT
 250
 251 pir_output_is( <<'CODE', <<'OUT', ":flatten in .return" );
 252
 253 .sub _main :main
 254
 255     $P1 = new 'Integer'
 256     $P1 = 20
 257     $P2 = new 'Integer'
 258     $P2 = 3
 259     .const .Sub s = "_fib_step"
 260     ($P3, $P4, $P5) = _funcall(s, $P1, $P2)
 261     print "_fib_step returned "
 262     print 3
 263     print " values, "
 264     print $P3
 265     print ", "
 266     print $P4
 267     print ", and "
 268     print $P5
 269     print ".\n"
 270 .end
 271
 272 .sub _funcall
 273     .param pmc function
 274     .param pmc argv :slurpy
 275
 276     $I33 = defined function
 277     unless $I33 goto bad_func
 278 doit:
 279     ($P35 :slurpy) = function(argv :flat)
 280         $I35 = $P35
 281         print "[got "
 282         print $I35
 283         print " results]\n"
 284     .return ($P35 :flat)
 285 bad_func:
 286     printerr "_funcall:  Bad function.\n"
 287     exit 0
 288 .end
 289
 290 ## Return the sum and the two arguments as three integers.
 291 .sub _fib_step
 292     .param pmc arg1
 293     .param pmc arg2
 294
 295     $P1 = new 'Integer'
 296     $P1 = arg1 + arg2
 297     .return ($P1, arg1,  arg2)
 298 .end
 299 CODE
 300 [got 3 results]
 301 _fib_step returned 3 values, 23, 20, and 3.
 302 OUT
 303
 304 pir_output_is( <<'CODE', <<'OUT', "new tail call syntax" );
 305 .sub main :main
 306     $S0 = foo()
 307     print $S0
 308 .end
 309
 310 .sub foo
 311     .return bar()
 312     print "never\n"
 313 .end
 314
 315 .sub bar
 316     .return ("ok\n")
 317 .end
 318 CODE
 319 ok
 320 OUT
 321
 322 pir_output_is( <<'CODE', <<'OUT', "new tail method call syntax" );
 323 .sub main :main
 324     .local pmc cl, o, n
 325     cl = newclass "Foo"
 326     addattribute cl, "n"
 327     o = new "Foo"
 328     n = new 'Integer'
 329     n = 2000   # beyond recursion limit of 1000
 330     setattribute o, [ "Foo" ], "n", n
 331     o."go"()
 332     n = getattribute o, [ "Foo" ], "n"
 333     print n
 334     print "\n"
 335 .end
 336
 337 .namespace ["Foo"]
 338 .sub go :method
 339     .local pmc n
 340     n = getattribute self, [ "Foo" ], "n"
 341     dec n
 342     unless n goto done
 343     .return self."go"()
 344 done:
 345 .end
 346
 347 CODE
 348 0
 349 OUT
 350
 351 # Local Variables:
 352 #   mode: cperl
 353 #   cperl-indent-level: 4
 354 #   fill-column: 100
 355 # End:
 356 # vim: expandtab shiftwidth=4: