compilers/tge/TGE/Compiler.pir

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