t/compilers/tge/grammar.t

   1 #!perl
   2 # Copyright (C) 2005-2006, The Perl Foundation.
   3 # $Id$
   4
   5 use strict;
   6 use warnings;
   7 use lib qw(t . lib ../lib ../../lib ../../../lib);
   8
   9 use Test::More;
  10 use Parrot::Test tests => 3;
  11
  12 =head1 NAME
  13
  14 tge/grammar.t - TGE::Parser tests
  15
  16 =head1 SYNOPSIS
  17
  18     $ prove t/compilers/tge/grammar.t
  19
  20 =head1 DESCRIPTION
  21
  22 This is a test script to try out constructing a tree grammar from a tree
  23 grammar syntax file, and using the constructed grammar to transform a
  24 tree of the specified type.
  25
  26 =cut
  27
  28 pir_output_is( <<'CODE', <<'OUT', 'test compiling anonymous and named grammars' );
  29
  30 .sub _main :main
  31     load_bytecode 'TGE.pbc'
  32
  33     # Compile a grammar from the source
  34     .local pmc grammar
  35     $P1 = new 'TGE::Compiler'
  36     grammar = $P1.'compile'(<<'GRAMMAR')
  37     transform min (Leaf) :language('PIR') {
  38         $P1 = getattribute node, "value"
  39        .return ($P1)
  40     }
  41 GRAMMAR
  42     $S1 = typeof grammar
  43     say $S1
  44
  45     # Add the grammar keyword and recompile
  46     grammar = $P1.'compile'(<<'GRAMMAR')
  47     grammar TreeMin is TGE::Grammar;
  48     transform min (Leaf) :language('PIR') {
  49         $P1 = getattribute node, "value"
  50        .return ($P1)
  51     }
  52 GRAMMAR
  53     $S1 = typeof grammar
  54     say $S1
  55
  56     # Add a POD comment and recompile
  57     .local string source
  58     source = "=head NAME\n\n TreeMin2\n\n=cut\n\n"
  59     source .= <<'GRAMMAR'
  60     grammar TreeMin2 is TGE::Grammar;
  61     transform min (Leaf) :language('PIR') {
  62         $P1 = getattribute node, "value"
  63        .return ($P1)
  64     }
  65 GRAMMAR
  66     grammar = $P1.'compile'(source)
  67     $S1 = typeof grammar
  68     say $S1
  69 .end
  70 CODE
  71 AnonGrammar
  72 TreeMin
  73 TreeMin2
  74 OUT
  75
  76 pir_output_is( <<'CODE', <<'OUT', 'complete example: Branch/Leaf tree grammar' );
  77
  78 .sub _main :main
  79     .param pmc argv
  80
  81     load_bytecode 'TGE.pbc'
  82
  83     # Load the grammar in a string
  84     .local string source
  85     source = <<'GRAMMAR'
  86     grammar TreeMin is TGE::Grammar;
  87
  88     transform min (Leaf) :language('PIR') {
  89         $P1 = getattribute node, "value"
  90        .return ($P1)
  91     }
  92
  93     transform min (Branch) :language('PIR') {
  94         .local pmc left
  95         .local pmc right
  96         .local pmc min
  97         .local pmc left_val
  98         .local pmc right_val
  99
 100         left = getattribute node, "left"
 101         left_val = tree.get('min', left)
 102         right = getattribute node, "right"
 103         right_val = tree.get('min', right)
 104
 105         min = left_val
 106         if min <= right_val goto got_min
 107         min = right_val
 108       got_min:
 109        .return (min)
 110     }
 111
 112     # find the global minimum and propagate it back down the tree
 113     transform gmin (ROOT) :language('PIR') {
 114         .local pmc gmin
 115         gmin = new 'Integer'
 116         gmin = tree.get('min', node)
 117         .return (gmin)
 118     }
 119
 120     transform gmin (Branch) :applyto('left') :language('PIR') {
 121         .local pmc gmin
 122         gmin = tree.get('gmin', node)
 123         .return (gmin)
 124     }
 125
 126     transform gmin (Branch) :applyto('right') :language('PIR') {
 127         .local pmc gmin
 128         gmin = tree.get('gmin', node)
 129         .return (gmin)
 130     }
 131
 132     # reconstruct the tree with every leaf replaced with the minimum
 133     # value
 134     transform result (Leaf) :language('PIR') {
 135         .local pmc newnode
 136
 137         newnode = new 'Leaf'
 138         $P1 = tree.get('gmin', node)
 139         setattribute newnode, 'value', $P1
 140         .return(newnode)
 141     }
 142
 143     transform result (Branch) :language('PIR') {
 144         .local pmc newnode
 145         .local pmc left_child
 146         .local pmc right_child
 147         newnode = new 'Branch'
 148         left_child = getattribute node, 'left'
 149         right_child = getattribute node, 'right'
 150         $P1 = tree.get('result', left_child)
 151         $P2 = tree.get('result', right_child)
 152
 153         setattribute newnode, 'left', $P1
 154         setattribute newnode, 'right', $P2
 155         .return(newnode)
 156     }
 157 GRAMMAR
 158
 159     # Compile a grammar from the source
 160     .local pmc grammar
 161     $P1 = new 'TGE::Compiler'
 162     grammar = $P1.'compile'(source)
 163
 164     # Build up the tree for testing
 165     .local pmc tree
 166     tree = buildtree()
 167
 168     # Apply the grammar to the test tree
 169     .local pmc AGI
 170     AGI = grammar.apply(tree)
 171
 172     # Retrieve the value of a top level attribute
 173     $P4 = AGI.get('gmin')
 174     print "the global minimum attribute value is: "
 175     print $P4
 176     print " of type: "
 177     $S4 = typeof $P4
 178     print $S4
 179     print "\n"
 180
 181     # Rerieve the transformed tree
 182     $P5 = AGI.get('result')
 183
 184     $P6 = getattribute tree, 'left'
 185     $P7 = getattribute $P6, 'left'
 186     $P8 = getattribute $P7, 'value'
 187     print "before transform, the value of the left-most leaf is: "
 188     print $P8
 189     print "\n"
 190
 191     $P6 = getattribute $P5, 'left'
 192     $P7 = getattribute $P6, 'left'
 193     $P8 = getattribute $P7, 'value'
 194     print "after transform, the value of the left-most leaf is: "
 195     print $P8
 196     print "\n"
 197
 198     $P10 = getattribute tree, 'right'
 199     $P11 = getattribute $P10, 'right'
 200     $P12 = getattribute $P11, 'right'
 201     $P13 = getattribute $P12, 'value'
 202     print "before transform, the value of the right-most leaf is: "
 203     print $P13
 204     print "\n"
 205
 206     $P10 = getattribute $P5, 'right'
 207     $P11 = getattribute $P10, 'right'
 208     $P12 = getattribute $P11, 'right'
 209     $P13 = getattribute $P12, 'value'
 210     print "after transform, the value of the right-most leaf is: "
 211     print $P13
 212     print "\n"
 213
 214     end
 215
 216   err_parse:
 217     print "Unable to parse the tree grammar.\n"
 218     end
 219 .end
 220
 221 # ----------------------------------
 222 .sub buildtree
 223     # Create Leaf class
 224     newclass $P1, "Leaf"
 225     addattribute $P1, "value"   # the value of the leaf node
 226
 227     # Create Branch class
 228     newclass $P2, "Branch"
 229     addattribute $P2, "left"            # left child
 230     addattribute $P2, "right"           # right child
 231
 232     $P0 = build_Leaf(5)
 233     $P1 = build_Leaf(9)
 234     $P2 = build_Branch($P0, $P1)
 235
 236     $P3 = build_Leaf(1)
 237     $P4 = build_Branch($P3, $P2)
 238
 239     $P5 = build_Leaf(2)
 240     $P6 = build_Leaf(3)
 241     $P7 = build_Branch($P5, $P6)
 242
 243     $P8 = build_Branch($P7, $P4)
 244
 245     .return($P8)
 246 .end
 247
 248 .sub build_Leaf
 249     .param int value
 250     .local pmc newnode
 251     newnode = new 'Leaf'
 252     $P1 = new 'Integer'
 253     $P1 = value
 254     setattribute newnode, 'value', $P1
 255     .return(newnode)
 256 .end
 257
 258 .sub build_Branch
 259     .param pmc left_child
 260     .param pmc right_child
 261     .local pmc newnode
 262     newnode = new 'Branch'
 263     setattribute newnode, 'left', left_child
 264     setattribute newnode, 'right', right_child
 265     .return(newnode)
 266 .end
 267
 268 CODE
 269 the global minimum attribute value is: 1 of type: Integer
 270 before transform, the value of the left-most leaf is: 2
 271 after transform, the value of the left-most leaf is: 1
 272 before transform, the value of the right-most leaf is: 9
 273 after transform, the value of the right-most leaf is: 1
 274 OUT
 275
 276 TODO: {
 277     local $TODO = "unresolved bug";
 278
 279     pir_output_is(
 280         <<'CODE', <<'OUT', 'two rules of the same name can apply to the same node, when called with a different dummy type' );
 281
 282 .sub _main :main
 283     load_bytecode 'TGE.pbc'
 284
 285     # Load the grammar in a string
 286     .local string source
 287     source = <<'GRAMMAR'
 288     grammar TreeMin is TGE::Grammar;
 289
 290     transform tiddlywinks (ROOT) :language('PIR') {
 291         say 'in tiddlywinks'
 292         tree.'get'('twister', node, 'pingpong')
 293         tree.'get'('twister', node, 'pongpong')
 294     }
 295     transform twister (pingpong) :language('PIR') {
 296         say 'in first twister'
 297     }
 298     transform twister (pongpong) :language('PIR') {
 299         say 'in second twister'
 300     }
 301 GRAMMAR
 302
 303
 304     .local object testing
 305     testing = new 'Hash'
 306
 307     # Compile a grammar from the source
 308     .local pmc grammar
 309     $P1 = new 'TGE::Compiler'
 310     grammar = $P1.'compile'(source)
 311
 312     # Apply the grammar to the test tree
 313     .local pmc AGI
 314     AGI = grammar.apply(testing)
 315
 316     # Retrieve the value of a top level attribute
 317     $P4 = AGI.get('tiddlywinks')
 318     end
 319 .end
 320
 321 CODE
 322 in tiddlywinks
 323 in first twister
 324 in second twister
 325 OUT
 326 }
 327
 328 =head1 AUTHOR
 329
 330 Allison Randal <allison@perl.org>
 331
 332 =cut
 333
 334 # Local Variables:
 335 #   mode: cperl
 336 #   cperl-indent-level: 4
 337 #   fill-column: 100
 338 # End:
 339 # vim: expandtab shiftwidth=4: