runtime/parrot/library/PGE/Perl6Grammar.pir

   1 =head1 TITLE
   2
   3 Perl6Grammar - compiler for Perl 6 grammars
   4
   5 =head1 SYNOPSIS
   6
   7 Command-line:
   8
   9     parrot Perl6Grammar.pir [options] file ...
  10
  11 From PIR:
  12
  13     .local string grammar_source
  14     .local pmc pgc
  15
  16     pgc = compreg 'PGE::Perl6Grammar'
  17
  18     # Compile grammar_source to PIR
  19     $P1 = pgc(grammar_source, 'target' => 'PIR')
  20
  21     # Compile and install grammar_source
  22     $P1 = pgc(grammar_source)
  23
  24 =head1 DESCRIPTION
  25
  26 This program takes a set of parser rules (i.e., a parser grammar)
  27 specified in the input C<FILE>s, and compiles it into the PIR code
  28 needed to execute the grammar.  This PIR code is then suitable for
  29 inclusion or compilation into other larger programs.
  30
  31 =head2 Options
  32
  33 =over 4
  34
  35 =item --output=OUTFILE
  36
  37 Send the output to OUTFILE.  By default, output is directed to
  38 the standard output.
  39
  40 =item --encoding=ENCODING
  41
  42 Encoding to use when reading input files.  Defaults to 'ascii', but
  43 can also be set to 'iso-8859-1' or 'utf8'.
  44
  45 =back
  46
  47 =head2 Functions
  48
  49 =over 4
  50
  51 =item C<main(PMC args)>
  52
  53 Processes command line arguments, reads input files, dispatches
  54 to appropriate PIR-generating subroutines, and then sends
  55 the output to the correct output file.
  56
  57 =cut
  58
  59 .namespace [ 'PGE::Perl6Grammar::Compiler' ]
  60
  61 .sub 'main' :main
  62     .param pmc args
  63     .local pmc pgc
  64
  65     pgc = compreg 'PGE::Perl6Grammar'
  66     pgc.'command_line'(args, 'target'=>'PIR', 'combine'=>1)
  67     .return ()
  68 .end
  69
  70
  71 .sub '__onload' :load :init
  72     load_bytecode 'PGE.pbc'
  73     load_bytecode 'PGE/Text.pbc'
  74     load_bytecode 'PGE/Util.pbc'
  75     load_bytecode 'PCT/HLLCompiler.pbc'
  76
  77     .local pmc p6regex
  78     p6regex = compreg 'PGE::Perl6Regex'
  79
  80     $S0 = "<.ident> [ '::' <.ident> ]*"
  81     p6regex($S0, 'grammar'=>'PGE::Perl6Grammar', 'name'=>'name')
  82
  83     $S0 = "[ '#' \\N* | \\s+ | <.pod_comment> ]* :::"
  84     p6regex($S0, 'grammar'=>'PGE::Perl6Grammar', 'name'=>'ws')
  85
  86     $S0 = <<'      END_POD_COMMENT_RULE'
  87       ^^ '=' [ [ cut \h*: | end [\h\N*]? ]
  88            | for [ \h\N+: ] \n [ \N+\n ]*:
  89            | \w\N*: \n .*? \n '=' [ cut \h*: | end [\h\N*:]? ]
  90            ]
  91            [\n|$]
  92       END_POD_COMMENT_RULE
  93     p6regex($S0, 'grammar'=>'PGE::Perl6Grammar', 'name'=>'pod_comment')
  94
  95     $S0 = <<'      END_ARG_RULE'
  96       $<category>:=[\w+\:]?
  97       [  \' (<-[']>*:) \'
  98       | '"' (<-["]>*:) '"'
  99       | '(' (<-[)]>*:) ')'
 100       | '<' (<-[>]>*:) '>'
 101       | '«' (<-[»]>*:) '»'
 102       | (\S+)
 103       ]
 104       END_ARG_RULE
 105     p6regex($S0, 'grammar'=>'PGE::Perl6Grammar', 'name'=>'arg')
 106
 107     $S0 = <<'      STMT_PARSE'
 108         $<cmd>:=(grammar) <name> [ 'is' $<inherit>:=<name> ]? ';'?
 109       | $<cmd>:=(regex|token|rule)
 110           $<name>:=<arg>
 111           $<optable>:=(is optable)?
 112           [ \{<regex>\} | <?PGE::Util::die: 'unable to parse regex'> ]
 113       | [multi]? $<cmd>:=(proto)
 114           $<name>:=<arg>
 115           ( is $<trait>:=[\w+]['('<arg>')']? )*
 116           [ \{ <-[}]>*: \} | ';' | <?PGE::Util::die: 'missing proto/sub body'> ]
 117       | [$|<PGE::Util::die: unrecognized statement>]
 118       STMT_PARSE
 119     $P0 = p6regex($S0, 'grammar'=>'PGE::Perl6Grammar', 'name'=>'statement', 'w'=>1)
 120
 121     ##  Add the PGE::Perl6Regex's regex method to PGE::Perl6Grammar
 122     $P0 = get_hll_global ['PGE::Perl6Regex'], 'regex'
 123     $P1 = get_class ['PGE::Perl6Grammar']
 124     $P1.'add_method'('regex', $P0)
 125
 126     ##   create the PGE::Perl6Grammar compiler object
 127     .local pmc pgc
 128     $P99 = subclass 'PCT::HLLCompiler', 'PGE::Perl6Grammar::Compiler'
 129     pgc = new [ 'PGE::Perl6Grammar::Compiler' ]
 130     pgc.'language'('PGE::Perl6Grammar')
 131 .end
 132
 133
 134 .sub 'compile' :method
 135     .param pmc source
 136     .param pmc adverbs         :slurpy :named
 137
 138     .local pmc nstable, namespace
 139     nstable = new 'Hash'
 140     namespace = new 'String'
 141     $P0 = new 'Hash'
 142     $P1 = new 'CodeString'
 143     $P0['optable'] = $P1
 144     $P1 = new 'CodeString'
 145     $P0['rule'] = $P1
 146     nstable[''] = $P0
 147
 148     # get our initial match object
 149     .local pmc match
 150     $P0 = get_hll_global ['PGE'], 'Match'
 151     match = $P0.'new'(source, 'grammar'=>'PGE::Perl6Grammar')
 152
 153     .local pmc stmtrule
 154     stmtrule = get_hll_global ['PGE::Perl6Grammar'], 'statement'
 155
 156   stmt_loop:
 157     match = stmtrule(match)
 158     unless match goto stmt_end
 159     unless match > '' goto stmt_end
 160     $S0 = match['cmd']
 161     concat $S0, '_stmt'
 162     $P0 = find_name $S0
 163     $P0(match, namespace, nstable)
 164     goto stmt_loop
 165   stmt_end:
 166
 167     .local pmc initpir, rulepir, iter, ns
 168     .local string namespace
 169     initpir = new 'CodeString'
 170     rulepir = new 'CodeString'
 171     iter = new 'Iterator', nstable
 172   iter_loop:
 173     unless iter goto iter_end
 174     namespace = shift iter
 175     ns = iter[namespace]
 176     $P0 = ns['rule']
 177     rulepir .= $P0
 178     if namespace == 'PGE::Grammar' goto ns_optable
 179     if namespace == '' goto ns_optable
 180     .local string inherit
 181     inherit = ns['inherit']
 182     $S0 = initpir.unique('onload_')
 183     initpir.emit(<<'        CODE', namespace, inherit, $S0)
 184           ## namespace %0
 185           push_eh %2
 186           .local pmc p6meta
 187           p6meta = get_hll_global 'P6metaclass'
 188           p6meta.'new_class'('%0', 'parent'=>'%1')
 189           pop_eh
 190         %2:
 191         CODE
 192   ns_optable:
 193     $P0 = ns['optable']
 194     if $P0 == '' goto iter_loop
 195     initpir.emit("          optable = new 'PGE::OPTable'")
 196     initpir.emit("          set_hll_global ['%0'], '$optable', optable", namespace)
 197     initpir .= $P0
 198     goto iter_loop
 199   iter_end:
 200
 201     .local pmc out
 202     out = new 'CodeString'
 203     if initpir == '' goto out_rule
 204     out.emit("      .sub '__onload' :load :init")
 205     out.emit("          .local pmc optable")
 206     out .= initpir
 207     out.emit("          .return ()")
 208     out.emit("      .end")
 209   out_rule:
 210     out .= rulepir
 211
 212     .local string target
 213     target = adverbs['target']
 214     target = downcase target
 215     if target != 'pir' goto compile_pir
 216     .return (out)
 217
 218   compile_pir:
 219     $P0 = compreg 'PIR'
 220     .return $P0(out)
 221 .end
 222
 223
 224 .sub 'grammar_stmt'
 225     .param pmc stmt
 226     .param pmc namespace
 227     .param pmc nstable
 228
 229     ##   get the grammar name
 230     .local string name, inherit
 231     name = stmt['name']
 232     inherit = 'PGE::Grammar'
 233     $P0 = stmt['inherit']
 234     if null $P0 goto have_inherit
 235     inherit = $P0[0]
 236   have_inherit:
 237
 238     ##   set the new namespace, and create any nstable entries
 239     ##   if needed.
 240     assign namespace, name
 241     name = clone name
 242     $I0 = exists nstable[name]
 243     if $I0 goto end
 244     .local pmc ns
 245     ns = new 'Hash'
 246     ns['inherit'] = inherit
 247     $P1 = new 'CodeString'
 248     ns['optable'] = $P1
 249     $P1 = new 'CodeString'
 250     ns['rule'] = $P1
 251     nstable[name] = ns
 252
 253   end:
 254     .return ()
 255 .end
 256
 257 .sub 'regex_stmt'
 258     .param pmc stmt
 259     .param pmc namespace
 260     .param pmc nstable
 261
 262     ##   get the regex name
 263     .local string name
 264     $P0 = stmt['name']
 265     $S0 = $P0['category']
 266     $S1 = $P0[0]
 267     name = concat $S0, $S1
 268
 269     ##   set compile adverbs
 270     .local pmc adverbs
 271     adverbs = new 'Hash'
 272     adverbs['grammar'] = namespace
 273     adverbs['name'] = name
 274
 275     ##   handle options for 'token' and 'rule' commands
 276     $S0 = stmt['cmd']
 277     if $S0 == 'regex' goto with_adverbs
 278     adverbs['ratchet'] = 1
 279     if $S0 == 'token' goto with_adverbs
 280     adverbs['words'] = 1
 281   with_adverbs:
 282
 283     $I0 = exists stmt['optable']
 284     if $I0 goto rulepir_optable
 285     ##   compile the rule to pir
 286     .local pmc p6regex, regex, rulepir
 287     p6regex = compreg 'PGE::Perl6Regex'
 288     regex = stmt['regex']
 289     rulepir = p6regex(regex, 'target'=>'PIR', adverbs :flat :named)
 290     goto with_rulepir
 291   rulepir_optable:
 292     ##   this is a special rule generated via the 'is optable' trait
 293     rulepir = new 'CodeString'
 294     rulepir.emit(<<'      END', namespace, name)
 295       .namespace [ "%0" ]
 296       .sub "%1"
 297         .param pmc mob
 298         .param pmc adverbs :named :slurpy
 299         $P0 = get_hll_global ["%0"], "$optable"
 300         .return $P0.'parse'(mob, 'rulename'=>"%1", adverbs :named :flat)
 301       .end
 302       END
 303   with_rulepir:
 304
 305     ##   add to set of rules
 306     .local pmc code
 307     $P0 = nstable[namespace]
 308     code = $P0['rule']
 309     code.emit("\n## <%0::%1>\n", namespace, name)
 310     code .= rulepir
 311     .return ()
 312 .end
 313
 314 .sub 'token_stmt'
 315     .param pmc stmt
 316     .param pmc namespace
 317     .param pmc nstable
 318     .return 'regex_stmt'(stmt, namespace, nstable)
 319 .end
 320
 321 .sub 'rule_stmt'
 322     .param pmc stmt
 323     .param pmc namespace
 324     .param pmc nstable
 325     .return 'regex_stmt'(stmt, namespace, nstable)
 326 .end
 327
 328
 329 .sub 'proto_stmt'
 330     .param pmc stmt
 331     .param pmc namespace
 332     .param pmc nstable
 333
 334     .local string name
 335     $P0 = stmt['name']
 336     $S0 = $P0['category']
 337     $S1 = $P0[0]
 338     name = concat $S0, $S1
 339
 340     .local pmc optable
 341     $P0 = nstable[namespace]
 342     optable = $P0['optable']
 343
 344     ##   build the list of traits
 345     .local pmc iter
 346     .local string traitlist
 347     $P0 = stmt[0]
 348     iter = new 'Iterator', $P0
 349     traitlist = ''
 350   trait_loop:
 351     unless iter goto trait_end
 352     .local pmc t
 353     t = shift iter
 354     .local string trait, arg
 355     trait = t['trait']
 356     $P0 = t['arg']
 357     if null $P0 goto trait_arg_null
 358     ##   convert parsed arg to single string
 359     $P0 = $P0[0]
 360     $S0 = $P0['category']
 361     $S1 = $P0[0]
 362     arg = concat $S0, $S1
 363     if arg == '' goto trait_arg_null
 364     ##   args starting with & are symbol lookups
 365     $S0 = substr arg, 0, 1
 366     if $S0 != '&' goto trait_arg
 367     arg = substr arg, 1
 368     goto trait_sub
 369   trait_arg:
 370     if trait == 'parsed' goto trait_sub
 371     arg = optable.'escape'(arg)
 372     goto trait_arg_done
 373   trait_sub:
 374     optable.emit("          $P0 = get_hll_global ['%0'], '%1'", namespace, arg)
 375     arg = '$P0'
 376     goto trait_arg_done
 377   trait_arg_null:
 378     arg = '1'
 379   trait_arg_done:
 380     concat traitlist, ", '"
 381     concat traitlist, trait
 382     concat traitlist, "'=>"
 383     concat traitlist, arg
 384     goto trait_loop
 385   trait_end:
 386     name = optable.'escape'(name)
 387     optable.emit("          optable.newtok(%0%1)", name, traitlist)
 388   .return ()
 389 .end
 390
 391 # Local Variables:
 392 #   mode: pir
 393 #   fill-column: 100
 394 # End:
 395 # vim: expandtab shiftwidth=4 ft=pir: