compilers/tge/TGE/Compiler.pir

   1 # Copyright (C) 2005-2008, The Perl Foundation.
   2
   3 =head1 NAME
   4
   5 TGE::Compiler - A compiler for the grammar syntax of TGE.
   6
   7 =head1 DESCRIPTION
   8
   9 =cut
  10
  11 .namespace [ 'TGE::Compiler' ]
  12
  13 .sub __onload :load
  14     load_bytecode 'TGE.pbc'
  15
  16     $P0 = get_class 'TGE::Grammar'
  17     $P1 = subclass $P0, 'TGE::Compiler'
  18 .end
  19
  20 =head2 parse_grammar
  21
  22 Take the source string for a tree grammar, and return a sensible data
  23 structure.
  24
  25 =cut
  26
  27 .sub parse_grammar :method
  28     .param string source
  29
  30     # Parse the source string and build a match tree
  31     .local pmc match
  32     .local pmc start_rule
  33     start_rule = find_global "TGE::Parser", "start"
  34     match = start_rule(source, 'grammar'=>'TGE::Parser')
  35     # Verify the parse
  36     unless match goto err_parse    # if parse fails, stop
  37 #        say 'parse succeeded'
  38 #        say 'Match tree dump:'
  39 #        load_bytecode "dumper.pbc"
  40 #        load_bytecode "PGE/Dumper.pbc"
  41 #        '_dumper'(match, "match")
  42
  43     # Transform the parse tree and return the result
  44     .local pmc tree_match
  45     tree_match = self.apply(match)
  46     $P5 = tree_match.get('result')
  47 #        say 'Data structure dump:'
  48 #        '_dumper'($P5, "syntax tree")
  49     .return($P5)
  50
  51   err_parse:
  52     print "Unable to parse the tree grammar.\n"
  53     exit 1
  54     end
  55 .end
  56
  57 .sub init :vtable :method
  58     self.add_rule("ROOT",       "result", ".", "ROOT_result")
  59     self.add_rule("statements", "result", ".", "statements_result")
  60     self.add_rule("statement",  "result", ".", "statement_result")
  61     self.add_rule("transrule",  "result", ".", "transrule_result")
  62     self.add_rule("grammardec", "result", ".", "grammardec_result")
  63     self.add_rule("type",       "value",  ".", "type_value")
  64     self.add_rule("inherit",    "value",  ".", "inherit_value")
  65     self.add_rule("name",       "value",  ".", "name_value")
  66     self.add_rule("parent",     "value",  ".", "parent_value")
  67     self.add_rule("action",     "value",  ".", "action_value")
  68     self.add_rule("language",   "value",  ".", "language_value")
  69 .end
  70
  71 .sub ROOT_result :method
  72     .param pmc tree
  73     .param pmc node
  74     $I0 = exists node["TGE::Parser::statements"]
  75     unless $I0 goto err_no_tree
  76     $P0 = node["TGE::Parser::statements"]
  77     $P2 = tree.get('result', $P0, 'statements')
  78     .return ($P2)
  79
  80 err_no_tree:
  81    print "Top-level rule did not match.\n"
  82    .return ()
  83 .end
  84
  85 .sub statements_result :method
  86     .param pmc tree
  87     .param pmc node
  88     .local pmc statements
  89     statements = new 'ResizablePMCArray'
  90
  91     # Iterate over the list of statements, and generate a processed tree for
  92     # each statement.  Return an array of all the processed statements.
  93     .local pmc iter
  94     iter = new 'Iterator', node # loop over the array
  95     iter = 0 # start at the beginning
  96 loop_start:
  97     unless iter goto loop_end
  98     $P1 = shift iter
  99     $P2 = tree.get('result', $P1, 'statement')
 100     push statements, $P2
 101     goto loop_start
 102 loop_end:
 103     .return (statements)
 104
 105 err_no_tree:
 106     print "This grammar contained no statements.\n"
 107     .return (statements)
 108 .end
 109
 110 .sub statement_result :method
 111     .param pmc tree
 112     .param pmc node
 113     .local pmc result
 114
 115     .local pmc iter
 116     iter = new 'Iterator', node    # setup iterator for node
 117     iter = 0
 118   iter_loop:
 119     unless iter, iter_end         # while (entries) ...
 120       shift $S1, iter           # get the key of the iterator
 121       $P2 = iter[$S1]
 122
 123       result = tree.get('result', $P2, $S1)
 124
 125       goto iter_loop
 126   iter_end:
 127
 128     .return (result)
 129 .end
 130
 131 .sub transrule_result :method
 132     .param pmc tree
 133     .param pmc node
 134     .local pmc rule
 135     rule = new 'Hash'
 136
 137     .local pmc iter
 138     iter = new 'Iterator', node    # setup iterator for node
 139     iter = 0
 140   iter_loop:
 141     unless iter, iter_end         # while (entries) ...
 142       $P3 = new 'Undef'
 143       shift $S1, iter           # get the key of the iterator
 144       $P2 = iter[$S1]
 145
 146       $P3 = tree.get('value', $P2, $S1)
 147
 148       rule[$S1] = $P3
 149       goto iter_loop
 150   iter_end:
 151
 152     $I0 = defined rule["parent"]
 153     if $I0 goto parent_defined
 154     rule["parent"] = "."
 155   parent_defined:
 156     rule["build"] = "rule"
 157     .return (rule)
 158
 159 err_no_rule:
 160     print "Unable to find all the components of a rule definition\n"
 161     exit 1
 162     .return ()
 163 .end
 164
 165 .sub grammardec_result :method
 166     .param pmc tree
 167     .param pmc node
 168     .local pmc decl
 169     decl = new 'Hash'
 170
 171     .local pmc iter
 172     iter = new 'Iterator', node    # setup iterator for node
 173     iter = 0
 174   iter_loop:
 175     unless iter, iter_end         # while (entries) ...
 176       $P3 = new 'Undef'
 177       shift $S1, iter           # get the key of the iterator
 178       $P2 = iter[$S1]
 179
 180       $P3 = tree.get('value', $P2, $S1)
 181
 182       decl[$S1] = $P3
 183       goto iter_loop
 184   iter_end:
 185     decl["build"] = "grammar"
 186     .return (decl)
 187 .end
 188
 189 # The attribute 'value' on nodes of type 'inherit'.
 190 .sub inherit_value :method
 191     .param pmc tree
 192     .param pmc node
 193     $P1 = node[0]
 194     $P2 = $P1['type']
 195     .local pmc value
 196     value = tree.get('value', $P2, 'type')
 197     .return (value)
 198 .end
 199
 200 # The attribute 'value' on nodes of type 'type'.
 201 .sub type_value :method
 202     .param pmc tree
 203     .param pmc node
 204     .local pmc value
 205     value = new 'String'
 206     $S2 = node
 207     value = $S2
 208     .return (value)
 209 .end
 210
 211 # The attribute 'value' on nodes of type 'name'.
 212 .sub name_value :method
 213     .param pmc tree
 214     .param pmc node
 215     .local pmc name
 216     name = new 'String'
 217     $P2 = node
 218     $S1 = $P2
 219     name = $S1
 220     .return (name)
 221 .end
 222
 223 # The attribute 'value' on nodes of type 'parent'.
 224 .sub parent_value :method
 225     .param pmc tree
 226     .param pmc node
 227     .local pmc value
 228     value = new 'String'
 229     $P2 = node[0]
 230     $P3 = $P2[0]
 231     $S1 = $P3
 232     value = $S1
 233     .return (value)
 234 .end
 235
 236 # The attribute 'value' on nodes of type 'action'.
 237 .sub action_value :method
 238     .param pmc tree
 239     .param pmc node
 240     .local pmc value, infile
 241     .local int lineno
 242     value = new 'CodeString'
 243     infile = get_global '$!infile'
 244     $P2 = node[0]
 245     (lineno) = $P2.'line_number'()
 246     value.'emit'('#line %0 %1', lineno, infile)
 247     value .= $P2
 248     .return (value)
 249 .end
 250
 251 # The attribute 'value' on nodes of type 'language'.
 252 # (This will be refactored out to a general syntax for modifiers.)
 253 .sub language_value :method
 254     .param pmc tree
 255     .param pmc node
 256     .local pmc value
 257     value = new 'String'
 258     $P2 = node[0]
 259     $P3 = $P2[0]
 260     $S1 = $P3
 261     value = $S1
 262     .return (value)
 263 .end
 264
 265 =head2 precompile
 266
 267 Compile a grammar from a source string.
 268
 269 =cut
 270
 271 .sub 'precompile' :method
 272     .param string source
 273     .param string infile          :optional
 274     .param int has_infile      :opt_flag
 275     .local pmc rule_data
 276     .local string outstring
 277     .local string header_string
 278
 279     if has_infile goto quote_infile
 280     infile = ''
 281     goto have_infile
 282   quote_infile:
 283     infile = concat '"', infile
 284     concat infile, '"'
 285   have_infile:
 286     $P0 = new 'String'
 287     $P0 = infile
 288     set_global '$!infile', $P0
 289
 290     # Unnamed grammars are class 'AnonGrammar'
 291     .local string grammarname
 292     grammarname = 'AnonGrammar'
 293     rule_data = self.'parse_grammar'(source)
 294
 295     # Construct grammar rules from the data structure of rule info
 296     .local pmc statement
 297     .local pmc iter
 298     iter = new 'Iterator', rule_data # loop over the rule info
 299     iter = 0 # start at the beginning
 300 loop_start:
 301     unless iter goto loop_end
 302         statement = shift iter
 303         $S0 = statement['build']
 304       unless $S0 == 'rule' goto grammar_build
 305           $S1 = self.'rule_string'(statement)
 306           outstring .= $S1
 307           $S2 = self.'rule_header'(statement)
 308           header_string .= $S2
 309           goto loop_start
 310       grammar_build:
 311           $S1 = self.'grammar_string'(statement)
 312           outstring .= $S1
 313           grammarname = statement['type']
 314           goto loop_start
 315 loop_end:
 316
 317     outstring .= "\n.sub init :vtable :method\n"
 318     outstring .= header_string
 319     outstring .= "\n.end\n"
 320
 321     .return (outstring, grammarname)
 322 .end
 323
 324 .sub 'compile' :method
 325     .param string source
 326
 327     .local pmc compiler
 328     compiler = compreg "PIR"
 329
 330     .local string code
 331     .local string grammarname
 332     .local pmc libloader
 333     .local pmc new_grammar
 334
 335     (code, grammarname) = self.'precompile'(source)
 336
 337     unless grammarname == 'AnonGrammar' goto named_grammar
 338     $P2 = new 'Hash'
 339     $P2['type'] = 'AnonGrammar'
 340     $P2['inherit'] = 'TGE::Grammar'
 341     $S1 = self.'grammar_string'($P2)
 342     code = $S1 . code
 343   named_grammar:
 344     libloader = compiler(code)
 345     libloader()
 346
 347     new_grammar = new grammarname
 348     .return (new_grammar)
 349 .end
 350
 351 .sub 'rule_header' :method
 352     .param pmc rule
 353     .local string output
 354     .local string type
 355     .local string name
 356     .local string parent
 357     type = rule["type"]
 358     name = rule["name"]
 359     parent = rule["parent"]
 360     output = "    self.add_rule('"
 361     output .= type
 362     output .= "', '"
 363     output .= name
 364     output .= "', '"
 365     output .= parent
 366     output .= "',  '_"
 367     output .= type
 368     output .= "_"
 369     output .= name
 370     output .= "')\n"
 371     .return (output)
 372 .end
 373
 374 .sub 'rule_string' :method
 375     .param pmc rule
 376     .local string code
 377     code = "\n.sub '_"
 378     $S1 = rule["type"]
 379     code .= $S1
 380     code .= "_"
 381     $S2 = rule["name"]
 382     code .= $S2
 383     code .= "' :method\n"
 384     code .= "    .param pmc tree\n"
 385     code .= "    .param pmc node\n"
 386     $S3 = rule["action"]
 387     code .= $S3
 388     code .= "\n.end\n\n"
 389     .return (code)
 390 .end
 391
 392 # NOTE - this code assumes that a type of '' is impossible
 393 #        (in older versions of Parrot, it was)
 394
 395 .sub 'grammar_string' :method
 396     .param pmc grammar
 397     .local string code
 398     .local string type
 399     .local string inherit
 400     type = grammar["type"]
 401     inherit = grammar["inherit"]
 402     code = "\n.namespace"
 403     if type == '' goto no_type
 404     code .= " [ '"
 405     code .= type
 406     code .= "' ]"
 407   no_type:
 408     code .= "\n\n"
 409     code .= ".sub '__onload' :load :init\n"
 410     code .= "    load_bytecode 'TGE.pbc'\n"
 411     code .= "    push_eh class_loaded\n"
 412     code .= "    $P1 = subclass '"
 413     code .= inherit
 414     code .= "', '"
 415     code .= type
 416     code .= "'\n"
 417     code .= "    pop_eh\n"
 418     code .= "  class_loaded:\n"
 419     code .= "\n.end\n\n"
 420     .return (code)
 421 .end
 422
 423 =head1 AUTHOR
 424
 425 Allison Randal <allison@perl.org>
 426
 427 =cut
 428
 429 # Local Variables:
 430 #   mode: pir
 431 #   fill-column: 100
 432 # End:
 433 # vim: expandtab shiftwidth=4 ft=pir: