compilers/pct/src/POST/Compiler.pir

   1 =head1 NAME
   2
   3 POST::Compiler - Compiler for POST trees
   4
   5 =head1 DESCRIPTION
   6
   7 POST::Compiler defines a compiler that converts a POST tree into
   8 PIR or an Eval PMC (bytecode).
   9
  10 =head1 METHODS
  11
  12 =over
  13
  14 =cut
  15
  16 .namespace [ 'POST::Compiler' ]
  17
  18 .sub '__onload' :load :init
  19     .local pmc p6meta, cproto
  20     p6meta = new 'P6metaclass'
  21     cproto = p6meta.'new_class'('POST::Compiler', 'parent'=>'PCT::HLLCompiler', 'attr'=>'$!code')
  22     cproto.'language'('POST')
  23     $P1 = split ' ', 'pir evalpmc'
  24     cproto.'stages'($P1)
  25
  26     $P0 = new 'String'
  27     set_global '$?NAMESPACE', $P0
  28     .return ()
  29 .end
  30
  31
  32 .sub 'to_pir' :method
  33     .param pmc post
  34     .param pmc adverbs         :slurpy :named
  35
  36     .local pmc newself
  37     newself = new 'POST::Compiler'
  38
  39     ##  start with empty code
  40     .local pmc code
  41     code = new 'CodeString'
  42     newself.'code'(code)
  43
  44     ##  if the root node isn't a Sub, wrap it
  45     $I0 = isa post, 'POST::Sub'
  46     if $I0 goto have_sub
  47     $P0 = get_hll_global ['POST'], 'Sub'
  48     post = $P0.'new'(post, 'name'=>'anon')
  49   have_sub:
  50
  51     ##  now generate the pir
  52     newself.'pir'(post)
  53
  54     ##  and return whatever code was generated
  55     .return newself.'code'()
  56 .end
  57
  58
  59 =item code([str])
  60
  61 Get/set the code generated by this compiler.
  62
  63 =cut
  64
  65 .sub 'code' :method
  66     .param pmc code            :optional
  67     .param int has_code        :opt_flag
  68
  69     if has_code goto set_code
  70     code = getattribute self, '$!code'
  71     .return (code)
  72   set_code:
  73     setattribute self, '$!code', code
  74     .return (code)
  75 .end
  76
  77
  78 =item pir_children(node)
  79
  80 Return generated PIR for C<node> and all of its children.
  81
  82 =cut
  83
  84 .sub 'pir_children' :method
  85     .param pmc node
  86     .local pmc code, iter
  87     code = new 'CodeString'
  88     iter = node.'iterator'()
  89   iter_loop:
  90     unless iter goto iter_end
  91     .local pmc cpost
  92     cpost = shift iter
  93     $P0 = self.'pir'(cpost)
  94     code .= $P0
  95     goto iter_loop
  96   iter_end:
  97     .return (code)
  98 .end
  99
 100
 101 =item pir(Any node)
 102
 103 Return generated pir for any POST::Node.  Returns
 104 the generated pir of C<node>'s children.
 105
 106 =cut
 107
 108 .sub 'pir' :method :multi(_,_)
 109     .param pmc node
 110     .return self.'pir_children'(node)
 111 .end
 112
 113
 114 =item pir(POST::Op node)
 115
 116 Return pir for an operation node.
 117
 118 =cut
 119
 120 .sub 'pir' :method :multi(_,['POST::Op'])
 121     .param pmc node
 122
 123     ##  determine the type of operation
 124     .local string pirop
 125     pirop = node.'pirop'()
 126
 127     ##  determine if we're storing result
 128     .local string result
 129     result = node.'result'()
 130     unless result goto have_result
 131     concat result, ' = '
 132   have_result:
 133
 134     ##  get list of arguments to operation
 135     .local pmc arglist
 136     arglist = node.'list'()
 137
 138     ##  get format and arguments based on pirop
 139     .local string fmt, name, invocant
 140     if pirop == 'call' goto pirop_call
 141     if pirop == 'callmethod' goto pirop_callmethod
 142     if pirop == 'return' goto pirop_return
 143     if pirop == 'tailcall' goto pirop_tailcall
 144     if pirop == 'inline' goto pirop_inline
 145
 146   pirop_opcode:
 147     fmt = "    %n %,"
 148     name = pirop
 149     goto pirop_emit
 150
 151   pirop_call:
 152     fmt = "    %r%n(%,)"
 153     name = shift arglist
 154     goto pirop_emit
 155
 156   pirop_callmethod:
 157     fmt = "    %r%i.%n(%,)"
 158     name = shift arglist
 159     invocant = shift arglist
 160     goto pirop_emit
 161
 162   pirop_return:
 163     fmt = "    .return (%,)"
 164     goto pirop_emit
 165
 166   pirop_tailcall:
 167     name = shift arglist
 168     fmt = '    .return %n(%,)'
 169     goto pirop_emit
 170
 171   pirop_inline:
 172     fmt = node.'inline'()
 173     result = node.'result'()
 174     goto pirop_emit
 175
 176   pirop_emit:
 177     .local pmc code
 178     code = new 'CodeString'
 179     code.'emit'(fmt, arglist :flat, 'r'=>result, 'n'=>name, 'i'=>invocant, 't'=>result)
 180     .return (code)
 181 .end
 182
 183
 184 =item pir(POST::Label node)
 185
 186 Generate a label.
 187
 188 =cut
 189
 190 .sub 'pir' :method :multi(_, ['POST::Label'])
 191     .param pmc node
 192     .local string code, value
 193     value = node.'result'()
 194     code = '  '
 195     code .= value
 196     code .= ":\n"
 197     .return (code)
 198 .end
 199
 200
 201 =item pir(POST::Sub node)
 202
 203 Generate PIR for C<node>, storing the result into the compiler's
 204 C<$!code> attribute and returning any code needed to look up
 205 the sub.
 206
 207 =cut
 208
 209 .sub 'pir' :method :multi(_, ['POST::Sub'])
 210     .param pmc node
 211
 212     .local pmc code
 213     code = new 'CodeString'
 214
 215     .local string name, pirflags
 216     name = node.'name'()
 217     pirflags = node.'pirflags'()
 218
 219   pirflags_lexid:
 220     $I0 = index pirflags, ':lexid('
 221     if $I0 >= 0 goto pirflags_lexid_done
 222     .local string lexid
 223     lexid = code.'unique'()
 224     node.'lexid'(lexid)
 225     pirflags = concat pirflags, ' :lexid("'
 226     pirflags .= lexid
 227     pirflags .= '")'
 228   pirflags_lexid_done:
 229
 230   pirflags_method:
 231     $I0 = index pirflags, ':method'
 232     if $I0 >= 0 goto pirflags_method_done
 233     $S0 = node.'blocktype'()
 234     if $S0 != 'method' goto pirflags_method_done
 235     pirflags = concat pirflags, ' :method'
 236   pirflags_method_done:
 237
 238     .local pmc outerpost, outername
 239     outername = new 'Undef'
 240     outerpost = node.'outer'()
 241     if null outerpost goto pirflags_done
 242     unless outerpost goto pirflags_done
 243     ##  FIXME: RT#47956
 244     ##  PIR doesn't compile properly if :outer points to a sub
 245     ##  with :init/:load flags on it.
 246     $I0 = index pirflags, ':init'
 247     if $I0 >= 0 goto pirflags_done
 248     $I0 = index pirflags, ':load'
 249     if $I0 >= 0 goto pirflags_done
 250     $S0 = outerpost.'pirflags'()
 251     $I0 = index $S0, ':init'
 252     if $I0 >= 0 goto pirflags_done
 253     $I0 = index $S0, ':load'
 254     if $I0 >= 0 goto pirflags_done
 255     outername = outerpost.'lexid'()
 256     $S0 = code.'escape'(outername)
 257     pirflags = concat pirflags, ' :outer('
 258     concat pirflags, $S0
 259     concat pirflags, ')'
 260   pirflags_done:
 261
 262     .local pmc outerns, ns, nskey
 263     outerns = get_global '$?NAMESPACE'
 264     nskey = outerns
 265     ns = node.'namespace'()
 266     unless ns goto have_ns
 267     nskey = code.'key'(ns)
 268     set_global '$?NAMESPACE', nskey
 269   have_ns:
 270
 271   subpir_start:
 272     $P0 = node.'compiler'()
 273     unless $P0 goto subpir_post
 274   subpir_compiler:
 275     $P0 = node.'compiler_args'()
 276     if $P0 goto have_compiler_args
 277     $P0 = new 'Hash'
 278   have_compiler_args:
 279     $P0 = self.'hll_pir'(node, 'name'=>name, 'namespace'=>ns, 'pirflags'=>pirflags, $P0 :named :flat)
 280     code .= $P0
 281     goto subpir_done
 282
 283   subpir_post:
 284     code.'emit'("\n.namespace %0", nskey)
 285     $S0 = code.'escape'(name)
 286     code.'emit'(".sub %0 %1", $S0, pirflags)
 287     .local pmc paramlist
 288     paramlist = node['paramlist']
 289     if null paramlist goto paramlist_done
 290     .local pmc iter
 291     iter = new 'Iterator', paramlist
 292   param_loop:
 293     unless iter goto paramlist_done
 294     $P0 = shift iter
 295     if null $P0 goto param_loop
 296     code .= $P0
 297     goto param_loop
 298   paramlist_done:
 299
 300     $P0 = self.'pir_children'(node)
 301     code .= $P0
 302     code.'emit'(".end\n\n")
 303
 304   subpir_done:
 305     $P0 = self.'code'()
 306     code .= $P0
 307     self.'code'(code)
 308
 309     set_global '$?NAMESPACE', outerns
 310
 311     code = new 'CodeString'
 312     .return (code)
 313 .end
 314
 315 .sub 'hll_pir' :method
 316     .param pmc node
 317     .param pmc options         :slurpy :named
 318
 319     options['target'] = 'pir'
 320     options['grammar'] = ''
 321     .local pmc source, compiler, pir
 322     source = node[0]
 323     $S0 = node.'compiler'()
 324     compiler = compreg $S0
 325     $I0 = isa compiler, 'Sub'
 326     if $I0 goto compiler_sub
 327     .return compiler.'compile'(source, options :flat :named)
 328   compiler_sub:
 329     .return compiler(source, options :flat :named)
 330 .end
 331
 332 =back
 333
 334 =head1 AUTHOR
 335
 336 Patrick Michaud <pmichaud@pobox.com> is the author and maintainer.
 337 Please send patches and suggestions to the Parrot porters or
 338 Perl 6 compilers mailing lists.
 339
 340 =head1 HISTORY
 341
 342 2007-11-21  Significant refactor as part of Parrot Compiler Toolkit
 343
 344 =head1 COPYRIGHT
 345
 346 Copyright (C) 2006-2008, The Perl Foundation.
 347
 348 =cut
 349
 350 # Local Variables:
 351 #   mode: pir
 352 #   fill-column: 100
 353 # End:
 354 # vim: expandtab shiftwidth=4 ft=pir: