Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP

Comparing changes

Choose two branches to see what's changed or to start a new pull request. If you need to, you can also compare across forks.

Open a pull request

Create a new pull request by comparing changes across two branches. If you need to, you can also compare across forks.
base: master
...
compare: lean
Checking mergeability… Don't worry, you can still create the pull request.
  • 1 commit
  • 45 files changed
  • 0 commit comments
  • 1 contributor
Commits on Feb 11, 2013
@moritz moritz rip out tge, and mostly data_json too
parrot still builds, but you cannot generate new NCI thunks. Tough luck.
e5dae26
Showing with 4 additions and 3,528 deletions.
  1. +0 −30 MANIFEST
  2. +0 −12 MANIFEST.SKIP
  3. +0 −5 compilers/README.pod
  4. +0 −8 compilers/data_json/Defines.mak
  5. +0 −146 compilers/data_json/JSON.nqp
  6. +0 −31 compilers/data_json/JSON_README.pod
  7. +0 −33 compilers/data_json/Rules.mak
  8. +0 −129 compilers/data_json/data_json.pir
  9. +0 −38 compilers/data_json/data_json/grammar.pg
  10. +0 −217 compilers/data_json/data_json/pge2pir.tg
  11. +0 −2  compilers/tge/Defines.mak
  12. +0 −23 compilers/tge/README.pod
  13. +0 −27 compilers/tge/Rules.mak
  14. +0 −159 compilers/tge/TGE.pir
  15. +0 −450 compilers/tge/TGE/Compiler.pir
  16. +0 −173 compilers/tge/TGE/Grammar.pir
  17. +0 −60 compilers/tge/TGE/Parser.pg
  18. +0 −76 compilers/tge/TGE/Rule.pir
  19. +0 −288 compilers/tge/TGE/Tree.pir
  20. +0 −146 compilers/tge/tgc.pir
  21. +0 −7 config/gen/makefiles/root.in
  22. +0 −1  docs/optable.pod
  23. +0 −2  examples/README.pod
  24. +0 −117 examples/json/postalcodes.pir
  25. +0 −33 examples/json/test.pir
  26. +0 −347 examples/nci/xlibtest.pir
  27. +0 −18 examples/tge/README.pod
  28. +0 −71 examples/tge/branch/branch.g
  29. +0 −27 examples/tge/branch/lib/Branch.pir
  30. +0 −26 examples/tge/branch/lib/Leaf.pir
  31. +0 −178 examples/tge/branch/transform.pir
  32. +0 −1  lib/Parrot/Docs/Section/Compilers.pm
  33. +0 −1  lib/Parrot/Harness/TestSets.pm
  34. +0 −1  lib/Parrot/Install.pm
  35. +0 −1  lib/Parrot/Manifest.pm
  36. +2 −67 runtime/parrot/library/distutils.pir
  37. +0 −31 t/compilers/tge/NoneGrammar.tg
  38. +0 −83 t/compilers/tge/basic.t
  39. +0 −338 t/compilers/tge/grammar.t
  40. +0 −27 t/compilers/tge/harness
  41. +0 −84 t/compilers/tge/parser.t
  42. +0 −1  t/harness.pir
  43. +0 −1  t/tools/install/testlib/dev_generated_pseudo
  44. +1 −1  tools/dev/install_dev_files.pl
  45. +1 −11 tools/install/smoke.pl
View
30 MANIFEST
@@ -26,13 +26,6 @@ TODO [devel]doc
VERSION [devel]
api.yaml []
compilers/README.pod []doc
-compilers/data_json/Defines.mak [data_json]
-compilers/data_json/JSON.nqp [data_json]
-compilers/data_json/JSON_README.pod []doc
-compilers/data_json/Rules.mak [data_json]
-compilers/data_json/data_json.pir [data_json]
-compilers/data_json/data_json/grammar.pg [data_json]
-compilers/data_json/data_json/pge2pir.tg [data_json]
compilers/imcc/Defines.mak [imcc]
compilers/imcc/Rules.in [imcc]
compilers/imcc/api.c [imcc]
@@ -107,16 +100,6 @@ compilers/pge/PGE/builtins.pg [pge]
compilers/pge/README.pod []doc
compilers/pge/Rules.mak [pge]
compilers/pge/STATUS [pge]
-compilers/tge/Defines.mak [tge]
-compilers/tge/README.pod []doc
-compilers/tge/Rules.mak [tge]
-compilers/tge/TGE.pir [tge]
-compilers/tge/TGE/Compiler.pir [tge]
-compilers/tge/TGE/Grammar.pir [tge]
-compilers/tge/TGE/Parser.pg [tge]
-compilers/tge/TGE/Rule.pir [tge]
-compilers/tge/TGE/Tree.pir [tge]
-compilers/tge/tgc.pir [tge]
config/README.pod []doc
config/auto/alignof.pm []
config/auto/alignof/test_c.in []
@@ -540,8 +523,6 @@ examples/io/http.pir [examples]
examples/io/httpd.pir [examples]
examples/io/post.pir [examples]
examples/io/readline.pir [examples]
-examples/json/postalcodes.pir [examples]
-examples/json/test.pir [examples]
examples/languages/abc/MAINTAINER [examples]
examples/languages/abc/README [examples]
examples/languages/abc/TODO [examples]
@@ -607,7 +588,6 @@ examples/nci/sdl_blue_rectangle.pir [examples]
examples/nci/win32api.pir [examples]
examples/nci/xlibtest.nqp [examples]
examples/nci/xlibtest.p6 [examples]
-examples/nci/xlibtest.pir [examples]
examples/nci/xlibtest.rb [examples]
examples/opengl/math.pir [examples]
examples/opengl/shapes.p6 [examples]
@@ -758,11 +738,6 @@ examples/subs/no_retval.pir [examples]
examples/subs/pasm_sub1.pasm [examples]
examples/subs/single_retval.pir [examples]
examples/tcl/tcltkdemo.pir [examples]
-examples/tge/README.pod [examples]
-examples/tge/branch/branch.g [examples]
-examples/tge/branch/lib/Branch.pir [examples]
-examples/tge/branch/lib/Leaf.pir [examples]
-examples/tge/branch/transform.pir [examples]
examples/threads/alloc_test.pir [examples]
examples/threads/chameneos.pir [examples]
examples/threads/matrix_part.winxed [examples]
@@ -1596,11 +1571,6 @@ t/compilers/pge/pge_globs.t [test]
t/compilers/pge/pge_text.t [test]
t/compilers/pge/pge_util.t [test]
t/compilers/pge/regression.t [test]
-t/compilers/tge/NoneGrammar.tg [test]
-t/compilers/tge/basic.t [test]
-t/compilers/tge/grammar.t [test]
-t/compilers/tge/harness [test]
-t/compilers/tge/parser.t [test]
t/configure/001-options.t [test]
t/configure/002-messages.t [test]
t/configure/003-steplist.t [test]
View
12 MANIFEST.SKIP
@@ -148,10 +148,6 @@
^/compilers/pge/PGE/builtins_gen\.pir/
^/compilers/pge/PGE\.pbc$
^/compilers/pge/PGE\.pbc/
-^/compilers/tge/TGE/Parser\.pir$
-^/compilers/tge/TGE/Parser\.pir/
-^/compilers/tge/tgc\.pbc$
-^/compilers/tge/tgc\.pbc/
^/config_lib\.pir$
^/config_lib\.pir/
^/core.*$
@@ -478,8 +474,6 @@
^/runtime/parrot/include/.*\.pir/
^/runtime/parrot/languages/JSON/JSON\.pir$
^/runtime/parrot/languages/JSON/JSON\.pir/
-^/runtime/parrot/languages/data_json$
-^/runtime/parrot/languages/data_json/
^/runtime/parrot/languages/winxed$
^/runtime/parrot/languages/winxed/
^/runtime/parrot/library/.*\.pbc$
@@ -832,12 +826,6 @@
^/t/benchmark/.*\.pasm/
^/t/benchmark/.*\.pir$
^/t/benchmark/.*\.pir/
-^/t/compilers/data_json/.*\.pbc$
-^/t/compilers/data_json/.*\.pbc/
-^/t/compilers/data_json/.*\.pir$
-^/t/compilers/data_json/.*\.pir/
-^/t/compilers/data_json/.*_pbcexe$
-^/t/compilers/data_json/.*_pbcexe/
^/t/compilers/imcc/.*\.pbc$
^/t/compilers/imcc/.*\.pbc/
^/t/compilers/imcc/reg/.*\.pasm$
View
5 compilers/README.pod
@@ -11,8 +11,6 @@ compilers/README.pod - Readme file for the 'compilers/' top-level directory.
This directory contains the source files for several compilers:
=over 4
-
-=item data_json - The compiler which generates a JSON representation of a PMC.
=item imcc ("Intermediate Code Compiler") - The compiler which translates PIR
source code into Parrot bytecode.
@@ -25,9 +23,6 @@ files into C source code.
=item pge ("Parrot Grammar Engine") - An implementation of Perl6 regex's for
PCT.
-=item tge ("Tree Grammar Engine") - A tool for transforming a Parrot Abstract
-Syntax Tree (PAST).
-
=back
=head1 COPYRIGHT
View
8 compilers/data_json/Defines.mak
@@ -1,8 +0,0 @@
-DATA_JSON_LIB_PBCS = runtime/parrot/languages/data_json/data_json.pbc
-
-JSON_LANG = runtime/parrot/languages/JSON/JSON.pir
-
-DATA_JSON_CLEANUPS = $(DATA_JSON_LIB_PBCS) \
- compilers/data_json/data_json.pbc \
- compilers/data_json/data_json/grammar.pir \
- compilers/data_json/data_json/pge2pir.pir
View
146 compilers/data_json/JSON.nqp
@@ -1,146 +0,0 @@
-#! parrot-nqp
-
-# Copyright (C) 2011, Parrot Foundation.
-
-# This is the start to rewrite JSON. It starts with rewriting data_json only.
-# data_json depends on the PGE. The rewrite use NQP.
-
-
-=begin Pod
-
-=for NAME
-JSON, a lightweight data-interchange format.
-
-=head1 SYNOPSIS
-
-The C<from_json> method return a PMC that containing the data structure
-for a given valid JSON (JavaScript Object Notation) string.
-For example:
-
-=begin code
-
-.sub 'main' :main
- .local pmc result
-
- load_language 'JSON'
- result = from_json( '[1,2,3]' )
-
- load_bytecode 'dumper.pbc'
- _dumper( result, 'JSON' )
-.end
-
-=end code
-
-For more information about the structure of the JSON representation, see
-the documentation at L<http://www.json.org/>.
-
-=end Pod
-
-
-INIT {
- pir::load_bytecode('P6Regex.pbc');
-}
-
-grammar JSON::Grammar is HLL::Grammar {
- rule TOP { <value> }
-
- proto token value { <...> }
-
- token value:sym<string> { <string> }
-
- token value:sym<number> {
- '-'?
- [ <[1..9]> <[0..9]>+ | <[0..9]> ]
- [ '.' <[0..9]>+ ]?
- [ <[Ee]> <[+\-]>? <[0..9]>+ ]?
-# <.worry('oh, a number!')>
- }
-
- rule value:sym<array> {
- '[' [ <value> ** ',' ]? ']'
- }
-
- rule value:sym<object> {
- '{'
- [ [ <string> ':' <value> ] ** ',' ]?
- '}'
- }
-
- rule value:sym<true> {
- 'true'
- }
-
- rule value:sym<false> {
- 'false'
- }
-
- rule value:sym<null> {
- 'null'
- }
-
- token string {
- <?["]> <quote_EXPR: ':qq'>
- }
-}
-
-
-class JSON::Actions is HLL::Actions {
- method TOP($/) {
- make PAST::Block.new($<value>.ast, :node($/));
- };
-
- method value:sym<string>($/) { make $<string>.ast; }
-
- method value:sym<number>($/) { make +$/; }
-
- method value:sym<array>($/) {
- my $past := PAST::Op.new(:pasttype<list>, :node($/));
- if $<value> {
- for $<value> { $past.push($_.ast); }
- }
- make $past;
- }
-
- method value:sym<object>($/) {
- my $past := PAST::Stmts.new( :node($/) );
- my $hashname := PAST::Compiler.unique('hash');
- my $hash := PAST::Var.new( :scope<register>, :name($hashname),
- :viviself('Hash'), :isdecl );
- my $hashreg := PAST::Var.new( :scope<register>, :name($hashname) );
- $past.'push'($hash);
- # loop through all string/value pairs, add set opcodes for each pair.
- my $n := 0;
- while $n < +$<string> {
- $past.'push'(PAST::Op.new( :pirop<set__vQ~*>, $hashreg,
- $<string>[$n].ast, $<value>[$n].ast ) );
- $n++;
- }
- # return the Hash as the result of this node
- $past.'push'($hashreg);
- make $past;
- }
-
- method value:sym<true>($/) { make 1; }
-
- method value:sym<false>($/) { make 0; }
-
- method string($/) { make $<quote_EXPR>.ast; }
-}
-
-
-class JSON::Compiler is HLL::Compiler {
- INIT {
- JSON::Compiler.language('JSON');
- JSON::Compiler.parsegrammar(JSON::Grammar);
- JSON::Compiler.parseactions(JSON::Actions);
- }
-}
-
-
-sub from_json($value) {
- my $result := JSON::Compiler.eval($value, :actions(JSON::Actions.new));
- return $result;
-}
-
-
-# vim: expandtab shiftwidth=4 ft=perl6:
View
31 compilers/data_json/JSON_README.pod
@@ -1,31 +0,0 @@
-# Copyright (C) 2011, Parrot Foundation.
-
-# This is the start to rewrite JSON. It starts with rewriting data_json only.
-# data_json depends on the PGE. The rewrite use parrot-nqp.
-
-=head1 NAME
-
-JSON, a lightweight data-interchange format.
-
-=head1 DESCRIPTION
-
-The C<from_json> method return a PMC that contains the data structure for
-a given valid JSON (JavaScript Object Notation) string. For example:
-
- .sub 'main' :main
- .local pmc result
-
- load_language 'JSON'
- result = from_json( '[1,2,3]' )
-
- load_bytecode 'dumper.pbc'
- _dumper( result, 'JSON' )
- .end
-
-To generate a JSON representation of a PMC, see
-L<runtime/parrot/library/JSON.pir>.
-
-For more information about the structure of the JSON representation, see
-the documentation at L<http://www.json.org/>.
-
-=cut
View
33 compilers/data_json/Rules.mak
@@ -1,33 +0,0 @@
-runtime/parrot/languages/data_json/data_json.pbc: compilers/data_json/data_json.pbc
- $(MKPATH) runtime/parrot/languages/data_json
- $(CP) compilers/data_json/data_json.pbc $@
-
-runtime/parrot/languages/JSON/JSON.pir: compilers/data_json/JSON.nqp $(NQP_RX)
- $(MKPATH) runtime/parrot/languages/JSON
- $(NQP_RX) --target=pir compilers/data_json/JSON.nqp > $@
- @$(ADDGENERATED) "$@" "[data_json]"
-
-compilers/data_json/data_json.pbc : \
- $(LIBRARY_DIR)/PGE.pbc \
- $(LIBRARY_DIR)/PGE/Util.pbc \
- $(LIBRARY_DIR)/TGE.pbc \
- compilers/data_json/data_json/grammar.pir \
- compilers/data_json/data_json/pge2pir.pir
- $(PARROT) -o $@ compilers/data_json/data_json.pir
- @$(ADDGENERATED) "$@" "[data_json]"
-
-compilers/data_json/data_json/grammar.pir : $(PARROT) \
- compilers/data_json/data_json/grammar.pg \
- $(LIBRARY_DIR)/PGE/Perl6Grammar.pbc \
- $(LIBRARY_DIR)/PCT/HLLCompiler.pbc
- $(PARROT) $(LIBRARY_DIR)/PGE/Perl6Grammar.pbc --output=$@ compilers/data_json/data_json/grammar.pg
-
-compilers/data_json/data_json/pge2pir.pir : $(PARROT) \
- compilers/data_json/data_json/pge2pir.tg \
- compilers/tge/tgc.pbc
- $(PARROT) compilers/tge/tgc.pbc --output=$@ compilers/data_json/data_json/pge2pir.tg
-
-# Local variables:
-# mode: makefile
-# End:
-# vim: ft=make:
View
129 compilers/data_json/data_json.pir
@@ -1,129 +0,0 @@
-# Copyright (C) 2005-2011, Parrot Foundation.
-
-=head1 NAME
-
-data_json - parse JSON, a lightweight data-interchange format.
-
-=head1 DESCRIPTION
-
-Given a valid JSON (JavaScript Object Notation) string, the compiler will
-return a sub that when called will produce the appropriate values. For
-example:
-
- .local pmc json, code, result
-
- load_language 'data_json'
- json = compreg 'data_json'
-
- code = json.'compile'('[1,2,3]')
- result = code()
-
- load_bytecode 'dumper.pbc'
- _dumper( result, 'array' )
-
-will create a PMC that C<does> C<array> containing the values 1, 2, and 3,
-and store it in the C<result>.
-
-For more information about the structure of the JSON representation, see
-the documentation at L<http://www.json.org/>.
-
-=cut
-
-.HLL 'data_json'
-
-.sub '__onload' :load
- load_bytecode 'PGE.pbc'
- load_bytecode 'PGE/Util.pbc'
- load_bytecode 'TGE.pbc'
-
- $P1 = newclass ['JSON'; 'Compiler']
- $P2 = new $P1
- compreg 'data_json', $P2
-
- $P1 = new 'Hash'
- $P1['\"'] = '"'
- $P1['\\'] = "\\"
- $P1['\/'] = '/'
- $P1['\b'] = "\b"
- $P1['\f'] = "\f"
- $P1['\n'] = "\n"
- $P1['\r'] = "\r"
- $P1['\t'] = "\t"
-
- set_root_global ['parrot'; 'data_json'], '$escapes', $P1
-.end
-
-
-.namespace ['JSON';'Compiler']
-
-.sub 'compile' :method
- .param string json_string
- .param pmc opts :slurpy :named
-
- .local pmc parse, match
- parse = get_root_global ['parrot'; 'JSON'], 'value'
-
- $P0 = get_root_global ['parrot'; 'PGE'], 'Match'
- match = $P0.'new'(json_string)
- match.'to'(0)
- match = parse(match)
- unless match goto failed
-
- .local pmc pirgrammar, pirbuilder, pir
- pirgrammar = new ['JSON'; 'PIR']
- pirbuilder = pirgrammar.'apply'(match)
- pir = pirbuilder.'get'('result')
-
- $I0 = exists opts['target']
- unless $I0 goto no_targ
- $S0 = opts['target']
- unless $S0 == 'pir' goto not_pir
- .return (pir)
- not_pir:
- no_targ:
-
- .local pmc pirc, result
- pirc = compreg 'PIR'
- result = pirc(pir)
- .return (result)
-
- failed:
- $P0 = new 'Exception'
- $P0[0] = "Invalid JSON value"
- throw $P0
-.end
-
-
-.HLL 'parrot'
-
-.sub unique_pmc_reg
- $P0 = get_root_global ['parrot';'PGE';'Util'], 'unique'
- $I0 = $P0()
- $S0 = $I0
- $S0 = concat "$P", $S0
- .return ($S0)
-.end
-
-.sub appendln
- .param pmc sb
- .param string line
- push sb, line
- push sb, "\n"
-.end
-
-.sub 'sprintf'
- .param string fmt
- .param pmc args :slurpy
- $S0 = sprintf fmt, args
- .return ($S0)
-.end
-
-.include 'compilers/data_json/data_json/grammar.pir'
-.include 'compilers/data_json/data_json/pge2pir.pir'
-
-
-# Local Variables:
-# mode: pir
-# fill-column: 100
-# End:
-# vim: expandtab shiftwidth=4 ft=pir:
View
38 compilers/data_json/data_json/grammar.pg
@@ -1,38 +0,0 @@
-# From http://www.json.org/
-
-grammar JSON;
-
-rule object { '{' <members>? '}' }
-rule array { '[' ']' | '[' <elements> ']' }
-rule string { \"<char>*\" }
-
-rule members { <string> ':' <value> [',' <string> ':' <value> ]* }
-
-rule elements { <value> [',' <value> ]* }
-
-token value {
- | <object>
- | <array>
- | <string>
- | <number>
- | true
- | false
- | null
- | <?PGE::Util::die 'not a valid JSON value'>
-}
-
-# XXX need to add "except control char" to the final charclass here.
-token char {
- | \\<["\\/bfnrt]>
- | \\u<xdigit>**{4}
- | <-[\\"]>
-}
-
-token number {
- <.ws>
- '-'?
- [ <[1..9]> <[0..9]>+ | <[0..9]> ]
- [ '.' <[0..9]>+ ]?
- [ <[Ee]> <[+\-]>? <[0..9]>+ ]?
- <.ws>
-}
View
217 compilers/data_json/data_json/pge2pir.tg
@@ -1,217 +0,0 @@
-grammar JSON::PIR is TGE::Grammar;
-
-transform result (ROOT) {
- .local pmc pir
- .local string result
-
- $S0 = tree.'get'('pir', node, 'value')
-
- pir = new 'StringBuilder'
- appendln(pir, '.sub anon :anon')
- appendln(pir, $S0)
- result = node['ret']
- $S0 = 'sprintf'(' .return (%Ss)', result)
- appendln(pir, $S0)
- appendln(pir, '.end')
-
- .return(pir)
-}
-
-transform pir (value) {
-
- .local pmc sub_node, transform_result
- .local pmc pir, result
- .local string value, type
-
- type = 'string'
- sub_node = node[type]
- unless null sub_node goto got_type
-
- type = 'number'
- sub_node = node[type]
- unless null sub_node goto got_type
-
- type = 'object'
- sub_node = node[type]
- unless null sub_node goto got_type
-
- type = 'array'
- sub_node = node[type]
- unless null sub_node goto got_type
-
- value = node
- if value == 'true' goto got_true
- if value == 'false' goto got_false
- if value == 'null' goto got_null
-
- .return ('') # should never reach this.
-
- got_type:
- pir = tree.'get'('pir', sub_node, type)
- $S0 = sub_node['ret']
- node['ret'] = $S0
- .return (pir)
-
- got_true:
- pir = new 'StringBuilder'
- result = unique_pmc_reg()
- $S0 = 'sprintf'(" %Ss = new 'Boolean', 1", result)
- appendln(pir, $S0)
- node['ret'] = result
- .return(pir)
-
- got_false:
- pir = new 'StringBuilder'
- result = unique_pmc_reg()
- $S0 = 'sprintf'(" %Ss = new 'Boolean', 0", result)
- appendln(pir, $S0)
- node['ret'] = result
- .return(pir)
-
- got_null:
- pir = new 'StringBuilder'
- result = unique_pmc_reg()
- $S0 = 'sprintf'(' null %Ss', result)
- appendln(pir, $S0)
- node['ret'] = result
- .return(pir)
-}
-
-transform pir (object) {
- .local pmc pir
- pir = new 'StringBuilder'
- .local string result, child_result, key_result
- result = unique_pmc_reg()
- $S0 = 'sprintf'(" %Ss = new 'Hash'", result)
- appendln(pir, $S0)
-
- .local pmc items
-
- items = node['members']
- if null items goto end
-
- items = items[0]
-
- .local pmc keys
- keys = items['string']
- items = items['value']
-
- .local pmc it, key_iter, child, key
- key_iter = iter keys
- it = iter items
-
- # the two iters should be in lockstep as a result of the PGE grammar
-loop:
- unless it goto end
- child = shift it
- $P0 = tree.'get'('pir', child, 'value')
- $S0 = $P0
- push pir, $S0
- child_result = child['ret']
-
- key = shift key_iter
- $P0 = tree.'get'('pir', key, 'string')
- $S0 = $P0
- push pir, $S0
- key_result = key['ret']
-
- $S0 = 'sprintf'(' %Ss[%Ss] = %Ss', result, key_result, child_result)
- appendln(pir, $S0)
-
-
- goto loop
-end:
- node['ret'] = result
-
- .return (pir)
-}
-
-transform pir (array) {
- .local pmc pir
- pir = new 'StringBuilder'
- .local string result, child_result
- result = unique_pmc_reg()
- $S0 = 'sprintf'(" %Ss = new 'ResizablePMCArray'", result)
- appendln(pir, $S0)
-
- .local pmc items
-
-
- items = node['elements']
- if null items goto end
-
- items = items['value']
-
- .local pmc it, child
- it = iter items
-loop:
- unless it goto end
- child = shift it
- $P0 = tree.'get'('pir', child, 'value')
- $S0 = $P0
- push pir, $S0
-
- child_result = child['ret']
- $S0 = 'sprintf'(' push %Ss, %Ss', result, child_result)
- appendln(pir, $S0)
- goto loop
-end:
- node['ret'] = result
-
- .return (pir)
-}
-
-transform pir (string) {
- .local pmc pir, result, children, it, child
- .local string tmp
- tmp = ''
- pir = new 'StringBuilder'
- children = node['char']
- if null children goto loop_end
- it = iter children
- loop:
- push_eh loop_end
- child = shift it
- pop_eh
- unless child goto loop_end
- $S0 = child
- $I0 = length $S0
- if $I0 == 1 goto char
- if $I0 == 2 goto escape
- unicode:
- $P1 = new 'String'
- $S1 = substr $S0, 2, 4
- $P1 = $S1
- $I0 = $P1.'to_int'(16)
- $S0 = chr $I0
- goto char
- escape:
- $P0 = get_root_global ['parrot'; 'data_json'], '$escapes'
- $S0 = $P0[$S0]
- char:
- tmp .= $S0
- goto loop
- loop_end:
-
- result = unique_pmc_reg()
- $S0 = 'sprintf'(" %Ss = new 'String'", result)
- appendln(pir, $S0)
- $P0 = get_root_global ['parrot';'PGE';'Util'], 'pir_str_escape'
- tmp = $P0(tmp)
- $S0 = 'sprintf'(' %Ss = %Ss', result, tmp)
- appendln(pir, $S0)
- node['ret'] = result
- .return(pir)
-}
-
-transform pir (number) {
- .local pmc pir, result
- pir = new 'StringBuilder'
- result = unique_pmc_reg()
- $S0 = 'sprintf'(" %Ss = new 'Integer'", result)
- appendln(pir, $S0)
- $S0 = 'sprintf'(' %Ss = %Ss', result, node)
- appendln(pir, $S0)
- node['ret'] = result
- .return(pir)
-}
View
2  compilers/tge/Defines.mak
@@ -1,2 +0,0 @@
-TGE_LIB_PBCS = $(LIBRARY_DIR)/TGE.pbc compilers/tge/tgc.pbc
-TGE_CLEANUPS = $(TGE_LIB_PBCS) compilers/tge/TGE/Parser.pir
View
23 compilers/tge/README.pod
@@ -1,23 +0,0 @@
-# Copyright (C) 2001-2012, Parrot Foundation.
-
-=pod
-
-=head1 NAME
-
-compilers/tge/README.pod - Tree Grammar Engine (TGE)
-
-=head1 DESCRIPTION
-
-TGE is a tool for transforming trees. It's most heavily used in the
-compiler tools suite, where it transforms the trees output by PGE into
-abstract syntax trees.
-
-=head1 INSTALLATION
-
-Compile TGE to bytecode and run its test suite:
-
- $ make
- $ make test
-
-=cut
-
View
27 compilers/tge/Rules.mak
@@ -1,27 +0,0 @@
-$(LIBRARY_DIR)/TGE.pbc: \
- $(LIBRARY_DIR)/PGE.pbc \
- $(LIBRARY_DIR)/PGE/Util.pbc \
- $(LIBRARY_DIR)/P6object.pbc \
- compilers/tge/TGE.pir \
- compilers/tge/TGE/Rule.pir \
- compilers/tge/TGE/Parser.pir \
- compilers/tge/TGE/Grammar.pir \
- compilers/tge/TGE/Compiler.pir \
- compilers/tge/TGE/Tree.pir
- $(PARROT) -o $@ compilers/tge/TGE.pir
- $(ADDGENERATED) "$@" "[main]"
-
-compilers/tge/tgc.pbc : compilers/tge/tgc.pir $(LIBRARY_DIR)/TGE.pbc $(LIBRARY_DIR)/Getopt/Obj.pbc
- $(PARROT) -o $@ compilers/tge/tgc.pir
- $(ADDGENERATED) "$@" "[main]"
-
-compilers/tge/TGE/Parser.pir: $(PARROT) \
- compilers/tge/TGE/Parser.pg \
- $(LIBRARY_DIR)/PGE/Perl6Grammar.pbc
- $(PARROT) $(LIBRARY_DIR)/PGE/Perl6Grammar.pbc --output=$@ compilers/tge/TGE/Parser.pg
- $(ADDGENERATED) "$@" "[tge]"
-
-# Local variables:
-# mode: makefile
-# End:
-# vim: ft=make:
View
159 compilers/tge/TGE.pir
@@ -1,159 +0,0 @@
-# Copyright (C) 2005-2009, Parrot Foundation.
-
-=head1 NAME
-
-TGE - A tree grammar engine.
-
-=head1 SYNOPSIS
-
- # define a grammar leaf.tg
- transform min (Leaf) :language('PIR') {
- $P1 = getattribute node, "value"
- .return ($P1)
- }
- ...
- # and elsewhere...
-
- .sub _main :main
- load_bytecode 'TGE.pbc'
-
- # Compile a grammar from the source grammar file
- .local pmc compiler
- compiler = new ['TGE';'Compiler']
-
- .local pmc grammar
- grammar = compiler.'compile'(source)
-
- .local pmc tree
- # ... the tree to be manipulated
-
- # Apply the grammar to the tree
- .local pmc TGI
- TGI = grammar.apply(tree)
-
- # Return the result of a particular rule on a particular tree
- .local pmc result
- result = TGI.get('min')
- # ...
- .end
-
-=head1 DESCRIPTION
-
-TGE is a tool for transforming trees. Think of it as a good
-old-fashioned substitution, but instead of taking and returning strings,
-it takes and returns trees.
-
-TGE is most heavily used in the compiler tools suite, where it
-transforms the trees output by PGE into abstract syntax trees.
-
-TGE has both a procedural interface and a syntax interface. The syntax
-interface is easiest for humans to use when constructing grammars by
-hand. The procedural interface is preferable for computer generated
-grammars.
-
-This is the syntax for tree grammar rules:
-
- transform name (pattern) {
- # action
- }
-
-The I<name> is the name of the transform rule. The I<pattern> is the type of
-node this particular transform applies to. You can have multiple transforms
-with the same name, as long as they match different patterns. The I<action> is
-a block of code that executes the transform. You can specify what language the
-action code is written in with the C<:language> modifier. At the moment, the
-only valid language is PIR. Within the block, two parameters are supplied for
-you: C<node> is the current node considered, and C<tree> is the top-level node
-for the entire tree.
-
-The C<:applyto> modifier says which node the transform applies to.
-
- transform name (pattern) :applyto('childname') {
- # action
- }
-
-By default the transform applies to the current node (generally synthesized
-attributes), but you can specify the name of a child node if the transform
-applies to a child of the current node (generally inherited attributes).
-
-=cut
-
-.namespace [ 'TGE' ]
-
-.sub '__onload_first' :load
- # use other modules
- load_bytecode 'PGE.pbc'
- load_bytecode 'PGE/Util.pbc'
-.end
-
-.include "compilers/tge/TGE/Parser.pir"
-.include "compilers/tge/TGE/Rule.pir"
-.include "compilers/tge/TGE/Tree.pir"
-.include "compilers/tge/TGE/Grammar.pir"
-.include "compilers/tge/TGE/Compiler.pir"
-
-.sub '__onload_last' :load
- # make sure we execute this sub only once
- $P0 = get_global '$!tge_loaded'
- unless null $P0 goto end
- $P0 = new 'Integer'
- assign $P0, 1
- set_global '$!tge_loaded', $P0
-
- # import <die> and <line_number> rules from PGE::Util
- $P0 = get_class ['TGE';'Parser']
- $P1 = get_hll_global ['PGE';'Util'], 'die'
- $P0.'add_method'('die', $P1)
- $P1 = get_hll_global ['PGE';'Util'], 'line_number'
- $P0.'add_method'('line_number', $P1)
-
- end:
- .return ()
-.end
-
-
-.namespace [ 'PGE';'Match' ]
-
-=over 4
-
-=item C<find_key([ key1, key2, ... ])>
-
-Find the first of C<key1>, C<key2>, etc. in the current
-Match object, and return it. Returns '' if none of
-the specified keys are found. If no keys are specified,
-then simply return the first key found.
-
-=back
-
-=cut
-
-.sub 'find_key' :method
- .param pmc keys :slurpy
- if null keys goto first_key
- unless keys goto first_key
- loop:
- unless keys goto not_found
- $S0 = shift keys
- $I0 = exists self[$S0]
- unless $I0 goto loop
- .return ($S0)
- first_key:
- $P0 = self.'hash'()
- $P1 = iter $P0
- unless $P1 goto not_found
- next:
- $S0 = shift $P1
- $P2 = $P0[$S0]
- $I0 = isa $P2, 'Capture'
- unless $I0 goto next
- .return ($S0)
- not_found:
- .return ('')
-.end
-
-
-# Local Variables:
-# mode: pir
-# fill-column: 100
-# End:
-# vim: expandtab shiftwidth=4 ft=pir:
View
450 compilers/tge/TGE/Compiler.pir
@@ -1,450 +0,0 @@
-# Copyright (C) 2005-2009, Parrot Foundation.
-
-=head1 NAME
-
-TGE::Compiler - A compiler for the grammar syntax of TGE.
-
-=head1 DESCRIPTION
-
-TGE::Compiler is a compiler for the grammar syntax of Tree Grammar Engine.
-
-=cut
-
-.namespace [ 'TGE'; 'Compiler' ]
-
-.sub __onload :load
- $P0 = get_class [ 'TGE'; 'Grammar' ]
- $P1 = subclass $P0, [ 'TGE'; 'Compiler' ]
-.end
-
-=head2 parse_grammar
-
-Take the source string for a tree grammar, and return a sensible data
-structure.
-
-=cut
-
-.sub parse_grammar :method
- .param string source
-
- # Parse the source string and build a match tree
- .local pmc match
- .local pmc start_rule
- start_rule = get_hll_global ['TGE';'Parser'], "start"
- match = start_rule(source, 'grammar'=>'TGE::Parser')
- # Verify the parse
- unless match goto err_parse # if parse fails, stop
-# say 'parse succeeded'
-# say 'Match tree dump:'
-# load_bytecode "dumper.pbc"
-# load_bytecode "PGE/Dumper.pbc"
-# '_dumper'(match, "match")
-
- # Transform the parse tree and return the result
- .local pmc tree_match
- tree_match = self.'apply'(match)
- $P5 = tree_match.'get'('result')
-# say 'Data structure dump:'
-# '_dumper'($P5, "syntax tree")
- .return($P5)
-
- err_parse:
- print "Unable to parse the tree grammar.\n"
- exit 1
- end
-.end
-
-.sub init :vtable :method
- self.'add_rule'("ROOT", "result", ".", "ROOT_result")
- self.'add_rule'("statements", "result", ".", "statements_result")
- self.'add_rule'("statement", "result", ".", "statement_result")
- self.'add_rule'("transrule", "result", ".", "transrule_result")
- self.'add_rule'("grammardec", "result", ".", "grammardec_result")
- self.'add_rule'("type", "value", ".", "type_value")
- self.'add_rule'("inherit", "value", ".", "inherit_value")
- self.'add_rule'("name", "value", ".", "name_value")
- self.'add_rule'("parent", "value", ".", "parent_value")
- self.'add_rule'("action", "value", ".", "action_value")
- self.'add_rule'("language", "value", ".", "language_value")
-.end
-
-.sub ROOT_result :method
- .param pmc tree
- .param pmc node
- $I0 = exists node["TGE::Parser::statements"]
- unless $I0 goto err_no_tree
- $P0 = node["TGE::Parser::statements"]
- $P2 = tree.'get'('result', $P0, 'statements')
- .return ($P2)
-
-err_no_tree:
- print "Top-level rule did not match.\n"
- .return ()
-.end
-
-.sub statements_result :method
- .param pmc tree
- .param pmc node
- .local pmc statements
- statements = new 'ResizablePMCArray'
-
- # Iterate over the list of statements, and generate a processed tree for
- # each statement. Return an array of all the processed statements.
- .local pmc it
- it = iter node # loop over the array
-loop_start:
- unless it goto loop_end
- $P1 = shift it
- $P2 = tree.'get'('result', $P1, 'statement')
- push statements, $P2
- goto loop_start
-loop_end:
- .return (statements)
-
-err_no_tree:
- print "This grammar contained no statements.\n"
- .return (statements)
-.end
-
-.sub statement_result :method
- .param pmc tree
- .param pmc node
- .local pmc result
-
- .local pmc it
- $P0 = node.'hash'()
- it = iter $P0 # setup iterator for node
- iter_loop:
- unless it, iter_end # while (entries) ...
- shift $S1, it # get the key of the iterator
- $P2 = it[$S1]
-
- result = tree.'get'('result', $P2, $S1)
-
- goto iter_loop
- iter_end:
-
- .return (result)
-.end
-
-.sub transrule_result :method
- .param pmc tree
- .param pmc node
- .local pmc rule
- rule = new 'Hash'
-
- .local pmc it
- $P0 = node.'hash'()
- it = iter $P0 # setup iterator for node
- iter_loop:
- unless it, iter_end # while (entries) ...
- $P3 = new 'Undef'
- shift $S1, it # get the key of the iterator
- $P2 = it[$S1]
-
- $P3 = tree.'get'('value', $P2, $S1)
-
- rule[$S1] = $P3
- goto iter_loop
- iter_end:
-
- $I0 = defined rule["parent"]
- if $I0 goto parent_defined
- rule["parent"] = "."
- parent_defined:
- rule["build"] = "rule"
- .return (rule)
-
-err_no_rule:
- print "Unable to find all the components of a rule definition\n"
- exit 1
- .return ()
-.end
-
-.sub grammardec_result :method
- .param pmc tree
- .param pmc node
- .local pmc decl
- decl = new 'Hash'
-
- .local pmc it
- $P0 = node.'hash'()
- it = iter $P0 # setup iterator for node
- iter_loop:
- unless it, iter_end # while (entries) ...
- $P3 = new 'Undef'
- shift $S1, it # get the key of the iterator
- $P2 = it[$S1]
-
- $P3 = tree.'get'('value', $P2, $S1)
-
- decl[$S1] = $P3
- goto iter_loop
- iter_end:
- decl["build"] = "grammar"
- .return (decl)
-.end
-
-# The attribute 'value' on nodes of type 'inherit'.
-.sub inherit_value :method
- .param pmc tree
- .param pmc node
- $P1 = node[0]
- $P2 = $P1['type']
- .local pmc value
- value = tree.'get'('value', $P2, 'type')
- .return (value)
-.end
-
-# The attribute 'value' on nodes of type 'type'.
-.sub type_value :method
- .param pmc tree
- .param pmc node
- .local pmc value
- value = new 'String'
- $S2 = node
- value = $S2
- .return (value)
-.end
-
-# The attribute 'value' on nodes of type 'name'.
-.sub name_value :method
- .param pmc tree
- .param pmc node
- .local pmc name
- name = new 'String'
- $P2 = node
- $S1 = $P2
- name = $S1
- .return (name)
-.end
-
-# The attribute 'value' on nodes of type 'parent'.
-.sub parent_value :method
- .param pmc tree
- .param pmc node
- .local pmc value
- value = new 'String'
- $P2 = node[0]
- $P3 = $P2[0]
- $S1 = $P3
- value = $S1
- .return (value)
-.end
-
-# The attribute 'value' on nodes of type 'action'.
-.sub action_value :method
- .param pmc tree
- .param pmc node
- .local pmc value, infile
- .local int lineno
- value = new 'StringBuilder'
- infile = get_global '$!infile'
- $P2 = node[0]
- (lineno) = $P2.'line_number'()
- push value, '#line '
- $S0 = lineno
- push value, $S0
- push value, ' '
- push value, infile
- push value, "\n"
- push value, $P2
- .return (value)
-.end
-
-# The attribute 'value' on nodes of type 'language'.
-# (This will be refactored out to a general syntax for modifiers.)
-.sub language_value :method
- .param pmc tree
- .param pmc node
- .local pmc value
- value = new 'String'
- $P2 = node[0]
- $P3 = $P2[0]
- $S1 = $P3
- value = $S1
- .return (value)
-.end
-
-=head2 precompile
-
-Compile a grammar from a source string.
-
-=cut
-
-.sub 'precompile' :method
- .param string source
- .param string infile :optional
- .param int has_infile :opt_flag
- .local pmc rule_data
- .local string outstring
- .local string header_string
-
- if has_infile goto quote_infile
- infile = ''
- goto have_infile
- quote_infile:
- infile = concat '"', infile
- infile = concat infile, '"'
- have_infile:
- $P0 = new 'String'
- $P0 = infile
- set_global '$!infile', $P0
-
- # Unnamed grammars are class 'AnonGrammar'
- .local string grammarname
- grammarname = 'AnonGrammar'
- rule_data = self.'parse_grammar'(source)
-
- # Construct grammar rules from the data structure of rule info
- .local pmc statement
- .local pmc it
- it = iter rule_data # loop over the rule info
-loop_start:
- unless it goto loop_end
- statement = shift it
- $S0 = statement['build']
- unless $S0 == 'rule' goto grammar_build
- $S1 = self.'rule_string'(statement)
- outstring .= $S1
- $S2 = self.'rule_header'(statement)
- header_string .= $S2
- goto loop_start
- grammar_build:
- $S1 = self.'grammar_string'(statement)
- outstring .= $S1
- grammarname = statement['type']
- goto loop_start
-loop_end:
-
- outstring .= "\n.sub init :vtable :method\n"
- outstring .= header_string
- outstring .= "\n.end\n"
-
- .return (outstring, grammarname)
-.end
-
-.sub 'compile' :method
- .param string source
-
- .local pmc compiler
- compiler = compreg "PIR"
-
- .local string code
- .local string grammarname
- .local pmc libloader
- .local pmc new_grammar
-
- (code, grammarname) = self.'precompile'(source)
-
- unless grammarname == 'AnonGrammar' goto named_grammar
- $P2 = new 'Hash'
- $P2['type'] = 'AnonGrammar'
- $P2['inherit'] = 'TGE::Grammar'
- $S1 = self.'grammar_string'($P2)
- code = $S1 . code
- named_grammar:
- libloader = compiler(code)
- libloader()
-
- new_grammar = new grammarname
- .return (new_grammar)
-.end
-
-.sub 'rule_header' :method
- .param pmc rule
- .local string output
- .local string type
- .local string name
- .local string parent
- type = rule["type"]
- name = rule["name"]
- parent = rule["parent"]
- output = " self.'add_rule'('"
- output .= type
- output .= "', '"
- output .= name
- output .= "', '"
- output .= parent
- output .= "', '_"
- output .= type
- output .= "_"
- output .= name
- output .= "')\n"
- .return (output)
-.end
-
-.sub 'rule_string' :method
- .param pmc rule
- .local string code
- code = "\n.sub '_"
- $S1 = rule["type"]
- code .= $S1
- code .= "_"
- $S2 = rule["name"]
- code .= $S2
- code .= "' :method\n"
- code .= " .param pmc tree\n"
- code .= " .param pmc node\n"
- $S3 = rule["action"]
- code .= $S3
- code .= "\n.end\n\n"
- .return (code)
-.end
-
-# NOTE - this code assumes that a type of '' is impossible
-# (in older versions of Parrot, it was)
-
-.sub 'grammar_string' :method
- .param pmc grammar
- .local string code
- .local string type
- .local string inherit
- type = grammar["type"]
- inherit = grammar["inherit"]
- .local string inherit_key, type_key
- inherit_key = self.'classname_key'(inherit)
- type_key = self.'classname_key'(type)
-
- code = "\n.namespace"
- code .= type_key
- no_type:
- code .= "\n\n"
- code .= ".sub '__onload' :load :init\n"
- code .= " load_bytecode 'TGE.pbc'\n"
- code .= " push_eh class_loaded\n"
- code .= " $P1 = subclass "
- code .= inherit_key
- code .= ", "
- code .= type_key
- code .= "\n"
- code .= " class_loaded:\n"
- code .= " pop_eh\n"
- code .= "\n.end\n\n"
- .return (code)
-.end
-
-.sub 'classname_key' :method
- .param string name
- .local string key
- .local pmc parts
- parts = split '::', name
-
- # If splitting on '::' doesn't break down name, try splitting on ';'.
- $I0 = elements parts
- if $I0 > 1 goto build_key
- parts = split ';', name
-
- build_key:
- key = " [ '"
- $S0 = join "'; '", parts
- key .= $S0
- key .= "' ]"
- .return (key)
-.end
-
-# Local Variables:
-# mode: pir
-# fill-column: 100
-# End:
-# vim: expandtab shiftwidth=4 ft=pir:
View
173 compilers/tge/TGE/Grammar.pir
@@ -1,173 +0,0 @@
-# Copyright (C) 2005-2008, Parrot Foundation.
-
-=head1 NAME
-
-TGE::Grammar - The base class for all tree grammars.
-
-=head1 DESCRIPTION
-
-TGE::Grammar is the base class for all of the tree grammars for the Tree
-Grammar Engine
-
-=cut
-
-.namespace [ 'TGE'; 'Grammar' ]
-
-.sub '__onload' :load
- # define the class
- .local pmc base
- newclass base, ['TGE';'Grammar']
- addattribute base, 'rules' # the rules in the grammar (an array)
- addattribute base, 'symbols' # used for tracking symbols parsed
- # (often a hash, but grammar chooses
- # implementation)
- .return ()
-.end
-
-=head2 new
-
-Create a new grammar object. [Not implemented: Optionally pass it a
-grammar specification in a string.] The grammar object holds an array
-of TGE::Rule objects, which are the semantics defined by the grammar.
-
-=cut
-
-.sub init :vtable :method
- $P1 = new 'ResizablePMCArray'
- setattribute self, 'rules', $P1
- $P2 = new 'Hash'
- setattribute self, 'symbols', $P2
-.end
-
-=head2 add_rule
-
-Add a rule to the current attribute grammar.
-
-=cut
-
-.sub 'add_rule' :method
- .param pmc type
- .param pmc name
- .param pmc parent
- .param pmc action
-
- # create a new attribute grammar rule
- .local pmc rule
- rule = new ['TGE';'Rule']
- setattribute rule, 'type', type
- setattribute rule, 'name', name
- setattribute rule, 'parent', parent
- setattribute rule, 'action', action
-
- # add the new rule to the grammar object
- $P3 = getattribute self, 'rules'
- push $P3, rule
-.end
-
-
-=head2 apply
-
-Use a precompiled grammar on a data structure. This returns an
-object on which you can call methods to fetch attributes on the
-I<top node> of the data structure.
-
-=cut
-
-.sub 'apply' :method
- .param pmc tree
- .local pmc newtree
- .local pmc visit
- newtree = new ['TGE';'Tree']
- setattribute newtree, 'data', tree
- setattribute newtree, 'grammar', self
- visit = getattribute newtree, 'visit'
- # Build up the visit hash
- .local pmc rules
- .local int index
- .local pmc currule
- .local pmc cell
- .local pmc typename
- rules = getattribute self, 'rules'
-
- index = rules
-loop:
- dec index
- if index < 0 goto end_loop
- currule = rules[index]
- typename = getattribute currule, 'type'
- $P2 = visit[typename]
- $I1 = does $P2, 'array'
- if $I1 goto array_exists
- $P2 = new 'ResizablePMCArray'
- visit[typename] = $P2
-array_exists:
- push $P2, currule
- goto loop
-end_loop:
-
- newtree.'_scan_node'(tree, 'ROOT')
- .return (newtree)
-.end
-
-=head2 add_symbol
-
-Add a symbol to the lookup table.
-
-=cut
-
-.sub 'add_symbol' :method
- .param pmc name
- .param pmc value
-
- # add the new symbol
- .local pmc symbols
- symbols = getattribute self, 'symbols'
-
- $I0 = defined symbols[name]
- if $I0 goto no_set
- symbols[name] = value
- no_set:
- .return(1)
-.end
-
-=head2 symbol_iter
-
-Return an iterator for the symbol lookup table.
-
-=cut
-
-.sub 'symbol_iter' :method
- $P1 = getattribute self, 'symbols'
- $P2 = iter $P1
-
- .return($P2)
-.end
-
-=head2 dump
-
-Produce a data dump of the current contents of the grammar object.
-
-=cut
-
-.sub 'dump' :method
- $P0 = getattribute self, 'rules'
- $I1 = $P0
-
- print "VAR1 => { \n\t 'rules' =>\n"
-LOOP:
- dec $I1
- $P1 = $P0[$I1]
- print "\t\t [\n"
- $P1.'dump'()
- print "\t\t ],\n"
- if $I1 > 0 goto LOOP
-
-
- print "\t}\n"
-.end
-
-# Local Variables:
-# mode: pir
-# fill-column: 100
-# End:
-# vim: expandtab shiftwidth=4 ft=pir:
View
60 compilers/tge/TGE/Parser.pg
@@ -1,60 +0,0 @@
-grammar TGE::Parser;
-
-token start { ^ <TGE::Parser::statements>* [ $ | <syntax_error> ] }
-
-rule statements {
- <transrule>
- | <grammardec>
-}
-
-rule grammardec {
- grammar <type> <inherit>?';'
-}
-
-rule inherit {
- is <type>
-}
-
-rule transrule {
- transform <name>
- '(' <type> ')'
- <parent>?
- <language>?
- <action>
-}
-
-rule parent {
- ':applyto' '(' \'(<-[']>*)\' ')'
-}
-
-rule language {
- ':language' '(' \'(\w+)\' ')'
-}
-
-token action {
- '{' (<-[}]>*) '}'
-}
-
-token type {
- [ '::' | ';' ]? \w+ [ ['::' | ';'] \w+ ]*
-}
-
-token name { \w+ }
-
-token ws {
- [ \s+
- | \# \N*
- | <.pod_comment>
- ]*
-}
-
-
-regex pod_comment {
- ^^ '=' [ [ cut \h*: | end [\h\N*]? ]
- | for [ \h\N+: ] \n [ \N+\n ]*:
- | \w\N*: \n .*? \n '=' [ cut \h*: | end [\h\N*:]? ]
- ]
- [\n|$]
-}
-
-token syntax_error { <?die: 'Syntax error'> }
View
76 compilers/tge/TGE/Rule.pir
@@ -1,76 +0,0 @@
-# Copyright (C) 2005-2008, Parrot Foundation.
-
-=head1 NAME
-
-TGE::Rule - a single rule in the attribute grammar
-
-=head1 DESCRIPTION
-
-A basic class to hold defined attribute grammar rules.
-
-=cut
-
-.namespace [ 'TGE'; 'Rule' ]
-
-# Possibly better named "type", "name", "parent", "action/exec",
-# "copy/value"
-
-.sub "__onload" :load
- .local pmc base
- newclass base, ['TGE';'Rule']
- addattribute base, "type" # node type that this rule applies to
- addattribute base, "name" # name of attribute being defined
- addattribute base, "parent" # where the attribute is applied
- # (current node or child node)
- addattribute base, "action" # a compiled subroutine
- addattribute base, "line" # line number in the grammar source file
- .return ()
-.end
-
-=head2 new
-
-Create a new rule object. A rule object holds the semantics for a single
-attribute grammar rule.
-
-=cut
-
-.sub __init :method
- $P0 = new 'Undef'
- $P1 = new 'Undef'
- $P2 = new 'Undef'
- $P3 = new 'Undef'
- $P4 = new 'Undef'
- $P5 = new 'Sub'
- setattribute self, "type", $P0
- setattribute self, "name", $P1
- setattribute self, "parent", $P2
- setattribute self, "line", $P4
- setattribute self, "action", $P5
-.end
-
-=head2 dump
-
-Produce a data dump of the current contents of the rule object.
-
-=cut
-
-.sub "dump" :method
- $P0 = getattribute self, "type"
- print "\t\t\t'type' => '"
- print $P0
- print "',\n"
- $P1 = getattribute self, "name"
- print "\t\t\t'name' => '"
- print $P1
- print "',\n"
- $P2 = getattribute self, "parent"
- print "\t\t\t'parent' => '"
- print $P2
- print "',\n"
-.end
-
-# Local Variables:
-# mode: pir
-# fill-column: 100
-# End:
-# vim: expandtab shiftwidth=4 ft=pir:
View
288 compilers/tge/TGE/Tree.pir
<
@@ -1,288 +0,0 @@
-# Copyright (C) 2005-2008, Parrot Foundation.
-
-=head1 NAME
-
-TGE::Tree - The top-level node of every tree.
-
-=head1 DESCRIPTION
-
-A TGE::Tree is the core object at the center of every tree transformation. You
-can think of it as something like a PGE::Match object. The first step of
-applying every tree grammar is to create a TGE::Tree object and wrap it around
-the tree being transformed. The TGE::Tree object handles result caching for
-particular transform rules on particular nodes, maintains connections between
-particular nodes and the transforms that can apply to those nodes, and will
-eventually handle indexing for faster tree searches.
-
-=cut
-
-.namespace [ 'TGE'; 'Tree' ]
-
-.sub "__onload" :load
- # define the class
- .local pmc base
- newclass base, ['TGE';'Tree']
- addattribute base, "cell" # a hash for storing values of tree nodes
- addattribute base, "visit" # arrays of rules that apply to each node type
- addattribute base, "data" # the original unmodified tree
- addattribute base, "grammar" # the current grammar object
- addattribute base, "agid" # a hash of node address => node id
- .return ()
-.end
-
-=head2 new
-
-Returns a simple initialized TGE::Tree object. Doesn't accept any
-constructor parameters.
-
-=cut
-
-.sub init :vtable :method
- $P0 = new 'Hash'
- $P1 = new 'Hash'
- $P2 = new 'Undef'
- setattribute self, "cell", $P0
- setattribute self, "visit", $P1
- setattribute self, "data", $P2
- $P3 = new 'AddrRegistry'
- setattribute self, "agid", $P3
-.end
-
-# Call all visitors for a given node
-.sub _scan_node :method
- .param pmc node
- .param pmc name :optional
- .param int got_name :opt_flag
- .local string type
-
- # If the user passed in a special name, look up visit actions for that one,
- # otherwise look them up for the type name of the node.
- if got_name goto name_from_arg
- type = typeof node
- goto name_set
-name_from_arg:
- type = name
-name_set:
-
- # Iterate over the elements of the visit hash for the given type
- .local pmc actions
- .local int index
- .local pmc currule
- $P2 = getattribute self, 'visit'
- $I2 = exists $P2[type]
- unless $I2 goto end_loop
- actions = $P2[type]
- index = actions
-loop:
- dec index
- if index < 0 goto end_loop
- currule = actions[index]
- self.'_install_action'(node, currule)
- goto loop
-end_loop:
- .return()
-.end
-
-=head2 get
-
- value = Tree.get('attrname')
-
-Fetches the value of a particular attribute from the root node of the
-grammar.
-
- value = Tree.get('attrname', node)
- value = Tree.get('attrname', node, 'type')
-
-Fetches the value of a particular attribute from the node passed in.
-When working with a tree where the nodes don't know their type (PGE
-match objects, for example), you must also tell C<get> the type of the
-node.
-
-=cut
-
-.sub get :method
- .param pmc name
- .param pmc node :optional
- .param int got_node :opt_flag
- .param pmc type :optional
- .param int got_type :opt_flag
-
- # If no node was passed in, use top level node.
- if got_node goto node_exists
- node = getattribute self, 'data'
-node_exists:
-
- .local pmc id
- id = self.'_lookup_id'(node)
-
- .local pmc cell
- $P1 = getattribute self, "cell"
- # First check to see if cell exists
- $P2 = $P1[name]
- $I1 = exists $P1[name]
- if $I1 goto name_hash_exists
- $P2 = new 'Hash'
- $P1[name] = $P2
- goto scan_name
-name_hash_exists:
- $I0 = exists $P2[id]
- cell = $P2[id]
- if $I0 goto eval_cell
-scan_name:
- if got_type goto scan_with_type
- self.'_scan_node'(node)
- goto done_scan
-scan_with_type:
- self.'_scan_node'(node,type)
-done_scan:
- # Second check to see if _scan_node defined the cell
- cell = $P2[id]
- $I0 = exists $P2[id]
- if $I0 goto eval_cell
- # Cell still not defined, grammar is unresolvable.
- print "Cannot find the attribute '"
- print name
- print "' ("
- unless got_type goto class_is_type
- print type
- print " on node "
- class_is_type:
- $S1 = typeof node
- print $S1
- print ") that you asked for.\n"
- .return ()
-eval_cell:
- $P3 = self.'_eval_cell'(cell,node)
- .return($P3)
-.end
-
-# Evaluate a thunk.
-.sub _eval_cell :method
- .param pmc cell
- .param pmc node
- .local pmc value
- $I0 = cell['thunk']
- if $I0 goto run_thunk_action
- goto return_value
-run_thunk_action:
- .local pmc grammar
- grammar = getattribute self, 'grammar'
- # the stored node (parent for inherited attributes, self for
- # synthesized attributes)
- $P1 = cell['node']
- $S0 = cell['action']
- # the action is a method on the grammar object
- value = grammar.$S0(self, $P1)
- cell['value'] = value
- cell['thunk'] = 0
-
-return_value:
- value = cell['value']
- .return (value)
-.end
-
-# Install a thunk in a particular attribute slot of a particular object.
-.sub _install_action :method
- .param pmc node
- .param pmc rule
-
- # Grab the 'cell' hash from the grammar object.
- .local pmc cell_hash
- cell_hash = getattribute self, 'cell'
-
- # Retrieve the hash within 'cell' keyed by the name of the attribute.
- # If the hash doesn't exist, create it.
- .local pmc name
- .local pmc cellattr
- name = getattribute rule, "name"
- cellattr = cell_hash[name]
- $I1 = exists cell_hash[name]
- if $I1 goto name_hash_exists
- cellattr = new 'Hash'
- cell_hash[name] = cellattr
-name_hash_exists:
-
- # Decide which node to operate on. If 'parent' was '.', then operate on
- # the node passed in, otherwise, operate on a child node named in
- # 'parent'.
- .local pmc id
- .local pmc parent
- parent = getattribute rule, 'parent'
- if parent == '.' goto use_parent_id
- .local pmc child_node
- child_node = self.'_lookup_child'(node, parent)
- id = self.'_lookup_id'(child_node)
- goto use_child_id
-use_parent_id:
- id = self.'_lookup_id'(node)
-use_child_id:
-
- # Check that the entry (by attribute name and id) in the "cell" hash
- # doesn't already exist (the grammar should only create one entry
- # for each unique node id).
- $P3 = cellattr[id]
- $I2 = exists cellattr[id]
- if $I2 goto error_defined
-
- # Create the entry in the "cell" tree that stores the action to
- # calculate the value of a given attribute in a given node. Also
- # store an empty space for the value after it has been calculated,
- # and a flag ("thunk") noting whether the action has been run.
- .local pmc thunk
- thunk = new 'Hash'
- thunk['thunk'] = 1
- $P4 = getattribute rule, "action"
- thunk['action'] = $P4
- $P5 = new 'Undef'
- thunk['value'] = $P5
- thunk['node'] = node
- cellattr[id] = thunk
-
- .return()
-error_defined:
- print "Nonlinear attribute: you have two or more ways to "
- print "assign a value to the attribute '"
- print name
- print "' on node type '"
- $S1 = typeof node
- print $S1
- print "' with rule name '"
- $P4 = getattribute rule, "action"
- print $P4
- print "' near grammar line "
- $P7 = getattribute rule, "line"
- print $P7
- print "\n"
- end
-.end
-
-# This determines the semantics of .attr.
-.sub _lookup_child :method
- .param pmc node
- .param pmc name
- $S0 = name
- $P1 = getattribute node, $S0
- .return($P1)
-.end
-
-.sub _lookup_id :method