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