compilers/pct/src/POST/Compiler.pir

   1 # $Id$
   2
   3 =head1 NAME
   4
   5 POST::Compiler - Compiler for POST trees
   6
   7 =head1 DESCRIPTION
   8
   9 POST::Compiler defines a compiler that converts a POST tree into
  10 PIR or an Eval PMC (bytecode).
  11
  12 =head1 METHODS
  13
  14 =over
  15
  16 =cut
  17
  18 .namespace [ 'POST';'Compiler' ]
  19
  20 .sub '__onload' :load :init
  21     .local pmc p6meta, cproto
  22     p6meta = new 'P6metaclass'
  23     cproto = p6meta.'new_class'('POST::Compiler', 'parent'=>'PCT::HLLCompiler')
  24     cproto.'language'('POST')
  25     $P1 = split ' ', 'pir evalpmc'
  26     cproto.'stages'($P1)
  27
  28     $P0 = new 'String'
  29     set_global '$?HLL', $P0
  30     null $P0
  31     set_global '$?NAMESPACE', $P0
  32     .return ()
  33 .end
  34
  35
  36 =item C<escape(string str)>
  37
  38 Returns an escaped value of C<str> suitable for including in PIR.
  39 If the string contains any non-ASCII characters, then it's
  40 prefixed with 'unicode:'.  (This method just delegates to
  41 PAST::Compiler.escape, which does the same thing.)
  42
  43 =cut
  44
  45 .sub 'escape' :method
  46     .param string str
  47     $P0 = get_hll_global ['PAST'], 'Compiler'
  48     .tailcall $P0.'escape'(str)
  49 .end
  50
  51 =item C<key_pir( string name1 [, string name2, ...] )>
  52
  53 Constructs a PIR key using the strings passed as arguments.
  54 For example, C<key('Foo', 'Bar')> returns C<["Foo";"Bar"]>.
  55
  56 =cut
  57
  58 .sub 'key_pir' :method
  59     .param pmc args            :slurpy
  60     .local string out, sep
  61     out = '['
  62     sep = ''
  63   args_loop:
  64     unless args goto args_done
  65     $P0 = shift args
  66     if null $P0 goto args_loop
  67     $I0 = does $P0, 'array'
  68     if $I0 goto args_array
  69   args_string:
  70     $S0 = self.'escape'($P0)
  71     concat out, sep
  72     concat out, $S0
  73     sep = ';'
  74     goto args_loop
  75   args_array:
  76     splice args, $P0, 0, 0
  77     goto args_loop
  78   args_done:
  79     concat out, ']'
  80     .return (out)
  81 .end
  82
  83
  84 .sub 'to_pir' :method
  85     .param pmc post
  86     .param pmc adverbs         :slurpy :named
  87
  88     .local pmc newself
  89     newself = new ['POST';'Compiler']
  90
  91     .local pmc innerpir, line
  92     innerpir = new 'StringBuilder'
  93     .lex '$CODE', innerpir
  94     line = box 0
  95     .lex '$LINE', line
  96
  97     ##  if the root node isn't a Sub, wrap it
  98     $I0 = isa post, ['POST';'Sub']
  99     if $I0 goto have_sub
 100     $P0 = get_hll_global ['POST'], 'Sub'
 101     post = $P0.'new'(post, 'name'=>'anon')
 102   have_sub:
 103
 104     ##  now generate the pir
 105     newself.'pir'(post)
 106
 107     ##  and return whatever code was generated
 108     .return (innerpir)
 109 .end
 110
 111
 112 =item pir_children(node)
 113
 114 Return generated PIR for C<node> and all of its children.
 115
 116 =cut
 117
 118 .sub 'pir_children' :method
 119     .param pmc node
 120     .local pmc line
 121     line = find_caller_lex '$LINE'
 122     .lex '$LINE', line
 123
 124     .local pmc iter
 125     iter = node.'iterator'()
 126   iter_loop:
 127     unless iter goto iter_end
 128     .local pmc cpost, pos, source
 129     cpost = shift iter
 130     pos = cpost['pos']
 131     if null pos goto done_subline
 132     source = cpost['source']
 133     if null source goto done_subline
 134     line = self.'lineof'(source, pos, 'cache'=>1)
 135     inc line
 136   done_subline:
 137     self.'pir'(cpost)
 138     goto iter_loop
 139   iter_end:
 140 .end
 141
 142
 143 =item pir(Any node)
 144
 145 Return generated pir for any POST::Node.  Returns
 146 the generated pir of C<node>'s children.
 147
 148 =cut
 149
 150 .sub 'pir' :method :multi(_,_)
 151     .param pmc node
 152     self.'pir_children'(node)
 153 .end
 154
 155
 156 =item pir(POST::Op node)
 157
 158 Return pir for an operation node.
 159
 160 =cut
 161
 162 .sub 'pir' :method :multi(_,['POST';'Op'])
 163     .param pmc node
 164
 165     ##  determine the type of operation
 166     .local string pirop
 167     pirop = node.'pirop'()
 168
 169     ##  determine if we're storing result
 170     .local string result
 171     result = node.'result'()
 172     unless result goto have_result
 173     concat result, ' = '
 174   have_result:
 175
 176     ##  get list of arguments to operation
 177     .local pmc arglist
 178     arglist = node.'list'()
 179
 180     ##  get format and arguments based on pirop
 181     .local string fmt, name, invocant
 182     if pirop == 'call' goto pirop_call
 183     if pirop == 'callmethod' goto pirop_callmethod
 184     if pirop == 'return' goto pirop_return
 185     if pirop == 'yield' goto pirop_yield
 186     if pirop == 'tailcall' goto pirop_tailcall
 187     if pirop == 'inline' goto pirop_inline
 188
 189   pirop_opcode:
 190     fmt = "    %n %,\n"
 191     name = pirop
 192     goto pirop_emit
 193
 194   pirop_call:
 195     fmt = "    %r%n(%,)\n"
 196     name = shift arglist
 197     goto pirop_emit
 198
 199   pirop_callmethod:
 200     fmt = "    %r%i.%n(%,)\n"
 201     name = shift arglist
 202     invocant = shift arglist
 203     goto pirop_emit
 204
 205   pirop_return:
 206     fmt = "    .return (%,)\n"
 207     goto pirop_emit
 208
 209   pirop_yield:
 210     fmt = "    .yield (%,)\n"
 211     goto pirop_emit
 212
 213   pirop_tailcall:
 214     name = shift arglist
 215     fmt = "    .tailcall %n(%,)\n"
 216     goto pirop_emit
 217
 218   pirop_inline:
 219     fmt = node.'inline'()
 220     concat fmt, "\n"
 221     result = node.'result'()
 222     goto pirop_emit
 223
 224   pirop_emit:
 225     .local pmc subpir, subline, line
 226     subpir  = find_caller_lex '$SUBPIR'
 227     subline = find_caller_lex '$SUBLINE'
 228     line    = find_caller_lex '$LINE'
 229     if subline == line goto done_line
 230     subpir.'append_format'(".annotate 'line', %0\n", line)
 231     assign subline, line
 232   done_line:
 233     subpir.'append_format'(fmt, arglist :flat, 'r'=>result, 'n'=>name, 'i'=>invocant, 't'=>result)
 234 .end
 235
 236
 237 =item pir(POST::Label node)
 238
 239 Generate a label.
 240
 241 =cut
 242
 243 .sub 'pir' :method :multi(_, ['POST';'Label'])
 244     .param pmc node
 245     .local pmc subpir, value
 246     value = node.'result'()
 247     subpir = find_caller_lex '$SUBPIR'
 248     subpir.'append_format'("  %0:\n", value)
 249 .end
 250
 251
 252 =item pir(POST::Sub node)
 253
 254 Generate PIR for C<node>, storing the result into the compiler's
 255 C<$!code> attribute and returning any code needed to look up
 256 the sub.
 257
 258 =cut
 259
 260 .sub 'pir' :method :multi(_, ['POST';'Sub'])
 261     .param pmc node
 262
 263     .local pmc subpir, subline, innerpir
 264     subpir = new 'StringBuilder'
 265     .lex '$SUBPIR', subpir
 266     subline = box -1
 267     .lex '$SUBLINE', subline
 268     innerpir = new 'StringBuilder'
 269     .lex '$CODE', innerpir
 270
 271     .local string name, pirflags
 272     name = node.'name'()
 273     pirflags = node.'pirflags'()
 274
 275   pirflags_subid:
 276     $I0 = index pirflags, ':subid('
 277     if $I0 >= 0 goto pirflags_subid_done
 278     .local string subid
 279     subid = node.'subid'()
 280     pirflags = concat pirflags, ' :subid("'
 281     pirflags .= subid
 282     pirflags .= '")'
 283   pirflags_subid_done:
 284
 285   pirflags_method:
 286     $I0 = index pirflags, ':method'
 287     if $I0 >= 0 goto pirflags_method_done
 288     $S0 = node.'blocktype'()
 289     if $S0 != 'method' goto pirflags_method_done
 290     pirflags = concat pirflags, ' :method'
 291   pirflags_method_done:
 292
 293     .local pmc outerpost, outername
 294     outername = new 'Undef'
 295     outerpost = node.'outer'()
 296     if null outerpost goto pirflags_done
 297     unless outerpost goto pirflags_done
 298     outername = outerpost.'subid'()
 299     $S0 = self.'escape'(outername)
 300     pirflags = concat pirflags, ' :outer('
 301     concat pirflags, $S0
 302     concat pirflags, ')'
 303   pirflags_done:
 304
 305     .local pmc outerhll, hll
 306     outerhll = get_global '$?HLL'
 307     hll = node.'hll'()
 308     if hll goto have_hll
 309     hll = outerhll
 310   have_hll:
 311     set_global '$?HLL', hll
 312
 313     .local pmc outerns, ns, nskey
 314     outerns = get_global '$?NAMESPACE'
 315     ns = outerns
 316     $P0 = node.'namespace'()
 317     unless $P0 goto have_ns
 318     ns = $P0
 319   have_ns:
 320     set_global '$?NAMESPACE', ns
 321     nskey = self.'key_pir'(ns)
 322
 323     .local pmc multi
 324     multi = node.'multi'()
 325     unless multi goto no_multi
 326
 327     .local pmc parts, m_iter
 328     parts  = new ['ResizableStringArray']
 329     m_iter = iter multi
 330   multi_iter:
 331     unless m_iter goto multi_iter_done
 332     $P0 = shift m_iter
 333     $S0 = $P0
 334     if $S0 == "_" goto push_part
 335     $S0 = self.'key_pir'($P0)
 336   push_part:
 337     push parts, $S0
 338     goto multi_iter
 339
 340   multi_iter_done:
 341     pirflags = concat pirflags, ' :multi('
 342     $S0 = join ',', parts
 343     pirflags = concat pirflags, $S0
 344     pirflags = concat pirflags, ')'
 345   no_multi:
 346
 347   subpir_start:
 348     $P0 = node['loadinit']
 349     if null $P0 goto loadinit_done
 350     self.'pir'($P0)
 351   loadinit_done:
 352
 353     $P0 = node.'compiler'()
 354     unless $P0 goto subpir_post
 355   subpir_compiler:
 356     $P0 = node.'compiler_args'()
 357     if $P0 goto have_compiler_args
 358     $P0 = new 'Hash'
 359   have_compiler_args:
 360     $P0 = self.'hll_pir'(node, 'name'=>name, 'namespace'=>ns, 'pirflags'=>pirflags, $P0 :named :flat)
 361     subpir .= $P0
 362     goto subpir_done
 363
 364   subpir_post:
 365     unless hll goto subpir_ns
 366     $P0 = self.'escape'(hll)
 367     subpir.'append_format'("\n.HLL %0\n", $P0)
 368   subpir_ns:
 369     subpir.'append_format'("\n.namespace %0\n", nskey)
 370   subpir_directives:
 371     $S0 = node['directives']
 372     unless $S0 goto subpir_decl
 373     subpir.'append_format'("%0", $S0)
 374   subpir_decl:
 375     $S0 = self.'escape'(name)
 376     subpir.'append_format'(".sub %0 %1\n", $S0, pirflags)
 377     .local pmc paramlist
 378     paramlist = node['paramlist']
 379     if null paramlist goto paramlist_done
 380     .local pmc it
 381     it = iter paramlist
 382   param_loop:
 383     unless it goto paramlist_done
 384     $P0 = shift it
 385     if null $P0 goto param_loop
 386     subpir .= $P0
 387     goto param_loop
 388   paramlist_done:
 389
 390     self.'pir_children'(node)
 391     subpir.'append_format'(".end\n\n")
 392
 393   subpir_done:
 394     .local pmc outerpir
 395     outerpir = find_caller_lex '$CODE'
 396     outerpir .= subpir
 397     outerpir .= innerpir
 398
 399     set_global '$?NAMESPACE', outerns
 400     set_global '$?HLL', outerhll
 401 .end
 402
 403
 404 .sub 'hll_pir' :method
 405     .param pmc node
 406     .param pmc options         :slurpy :named
 407
 408     options['target'] = 'pir'
 409     $P0 = node.'subid'()
 410     options['subid'] = $P0
 411     .local pmc source, compiler, pir
 412     source = node[0]
 413     $S0 = node.'compiler'()
 414     compiler = compreg $S0
 415     $I0 = isa compiler, 'Sub'
 416     if $I0 goto compiler_sub
 417     .tailcall compiler.'compile'(source, options :flat :named)
 418   compiler_sub:
 419     .tailcall compiler(source, options :flat :named)
 420 .end
 421
 422 =back
 423
 424 =head1 AUTHOR
 425
 426 Patrick Michaud <pmichaud@pobox.com> is the author and maintainer.
 427 Please send patches and suggestions to the Parrot porters or
 428 Perl 6 compilers mailing lists.
 429
 430 =head1 HISTORY
 431
 432 2007-11-21  Significant refactor as part of Parrot Compiler Toolkit
 433
 434 =head1 COPYRIGHT
 435
 436 Copyright (C) 2006-2008, Parrot Foundation.
 437
 438 =cut
 439
 440 # Local Variables:
 441 #   mode: pir
 442 #   fill-column: 100
 443 # End:
 444 # vim: expandtab shiftwidth=4 ft=pir: