Author: pmichaud
Date: Thu Oct 27 09:58:29 2005
New Revision: 9595
Added:
trunk/examples/pge/
trunk/examples/pge/README
trunk/examples/pge/all.pir
trunk/examples/pge/p6parse.pir
trunk/examples/pge/perl6.pir
trunk/examples/pge/simple.pir
Modified:
trunk/MANIFEST
Log:
Added examples/pge with some shift-reduce parsing.
Modified: trunk/MANIFEST
==============================================================================
--- trunk/MANIFEST (original)
+++ trunk/MANIFEST Thu Oct 27 09:58:29 2005
@@ -592,6 +592,11 @@ examples/pasm/cat.pasm
examples/pasm/fact.pasm [main]doc
examples/pasm/hello.pasm [main]doc
examples/pasm/lexical.pasm [main]doc
+examples/pge/README [main]doc
+examples/pge/all.pir [main]doc
+examples/pge/p6parse.pir [main]doc
+examples/pge/perl6.pir [main]doc
+examples/pge/simple.pir [main]doc
examples/pir/circle.pir [main]doc
examples/pir/euclid.pir [main]doc
examples/pir/hanoi.pir [main]doc
Added: trunk/examples/pge/README
==============================================================================
--- (empty file)
+++ trunk/examples/pge/README Thu Oct 27 09:58:29 2005
@@ -0,0 +1,28 @@
+This is a short README until I have time to write a longer
+one.
+
+Files in this directory:
+
+ all.pir - program that demonstrates a variety of parses using PGE.
+ Includes:
+ simple.pir - parser for simple mathematical expressions (<Simple::expr>)
+ p6parse.pir - Perl 6 expression parser (<Perl6::expr>)
+
+
+Start by running "all.pir". To parse simple mathematical expressions
+(e.g., "r = sqrt(a*b + 5)"), enter
+
+ rule <Simple::expr>
+
+and then enter mathematical expressions after that.
+
+To parse Perl 6 expressions, enter
+
+ rule <Perl6::expr>
+
+and then type in p6 expressions to see the resulting parse.
+
+Note that this is all a work in progress, so some features might
+not be working yet.
+
+Pm
Added: trunk/examples/pge/all.pir
==============================================================================
--- (empty file)
+++ trunk/examples/pge/all.pir Thu Oct 27 09:58:29 2005
@@ -0,0 +1,96 @@
+.sub "main" :main
+ .local pmc p6rule
+ .local pmc stdin
+ .local string x
+ .local pmc cmdpat, cmd, arg
+ .local pmc rulesub, rulepir, ruleexp
+ .local pmc match
+ .local pmc dumper
+ .local int istrace
+
+ load_bytecode "PGE.pbc"
+ load_bytecode "dumper.imc"
+ load_bytecode "PGE/Dumper.pir"
+ load_bytecode "PGE/Util.pir"
+
+ "loadexpr"("Simple", "expr")
+ "loadexpr"("Perl6", "expr")
+
+ p6rule = find_global "PGE", "p6rule"
+ cmdpat = p6rule("^(rule|next|trace|pir)\\s*(.*)$")
+ dumper = find_global "_dumper"
+ null istrace
+ null rulesub
+ null rulepir
+ null ruleexp
+ null match
+
+ read_loop:
+ $S0 = <<"PROMPT"
+
+Enter \"rule <pattern>\" target string, \"next\",
+\"pir\", \"exp\", or \"trace\"
+PROMPT
+ print $S0
+ stdin = getstdin
+ x = readline stdin
+ $I0 = length x
+ if $I0 < 1 goto end
+ chopn x, 1
+ $P0 = cmdpat(x)
+ unless $P0 goto do_match
+ cmd = $P0[0]
+ arg = $P0[1]
+ if cmd == "rule" goto cmd_rule
+ if cmd == "next" goto cmd_next
+ if cmd == "trace" goto cmd_trace
+ if cmd == "pir" goto cmd_pir
+ do_match:
+ if_null rulesub, nopattern
+ match = rulesub(x)
+ match_result:
+ unless match goto match_fail
+ print "match succeeded\n"
+ dumper(match, "$/")
+ goto read_loop
+ match_fail:
+ print "match failed\n"
+ goto read_loop
+ nopattern:
+ print "no pattern entered\n"
+ goto read_loop
+ cmd_next:
+ match."next"()
+ goto match_result
+ cmd_rule:
+ (rulesub, rulepir, ruleexp) = p6rule(arg)
+ goto read_loop
+ cmd_trace:
+ istrace = not istrace
+ trace istrace
+ if istrace goto trace_on
+ print "Tracing is now off\n"
+ goto read_loop
+ trace_on:
+ print "Tracing is now on\n"
+ goto read_loop
+ cmd_pir:
+ print rulepir
+ goto read_loop
+ end:
+.end
+
+.sub "loadexpr"
+ .param string namespace
+ .param string name
+ $P0 = find_global namespace, "__onload"
+ $P0()
+ print "loaded "
+ print namespace
+ print "::"
+ print name
+ print "\n"
+.end
+
+.include "simple.pir"
+.include "p6parse.pir"
Added: trunk/examples/pge/p6parse.pir
==============================================================================
--- (empty file)
+++ trunk/examples/pge/p6parse.pir Thu Oct 27 09:58:29 2005
@@ -0,0 +1,131 @@
+.namespace [ "Perl6" ]
+
+.sub "__onload"
+ .local pmc optable
+ .local pmc term
+ .local pmc p6rule
+ .local string op
+
+ $I0 = find_type "PGE::OPTable"
+ optable = new $I0
+ store_global "Perl6", "$optable", optable
+
+ $S0 = <<"P6_GRAMMAR"
+grammar Perl6;
+
+rule sigil { <[EMAIL PROTECTED]&]> }
+rule name { <?ident> [ \\:\\: <?ident> ]* }
+rule integer { \\d+ }
+rule term { <sigil><name> | <name> | <integer> }
+
+P6_GRAMMAR
+
+ $P0 = find_global "PGE", "compile_rules"
+ $P0($S0)
+
+ optable.addtok("infix:+")
+ optable.addtok("infix:-", "infix:+")
+ optable.addtok("infix:~", "infix:+")
+ optable.addtok("infix:+|", "infix:+")
+ optable.addtok("infix:+^", "infix:+")
+ optable.addtok("infix:~|", "infix:+")
+ optable.addtok("infix:~^", "infix:+")
+
+ optable.addtok("infix:*", ">infix:+")
+ optable.addtok("infix:/", "infix:*")
+ optable.addtok("infix:%", "infix:*")
+ optable.addtok("infix:x", "infix:*")
+ optable.addtok("infix:xx", "infix:*")
+ optable.addtok("infix:+<", "infix:*")
+ optable.addtok("infix:+>", "infix:*")
+ optable.addtok("infix:~&", "infix:*")
+ optable.addtok("infix:~<", "infix:*")
+ optable.addtok("infix:~>", "infix:*")
+
+ optable.addtok("prefix:!", ">infix:*")
+ optable.addtok("prefix:+", "prefix:!")
+ optable.addtok("prefix:-", "prefix:!")
+ optable.addtok("prefix:~", "prefix:!")
+ optable.addtok("prefix:?", "prefix:!")
+ optable.addtok("prefix:*", "prefix:!")
+ optable.addtok("prefix:**", "prefix:!")
+ optable.addtok("prefix:+^", "prefix:!")
+ optable.addtok("prefix:~^", "prefix:!")
+ optable.addtok("prefix:?^", "prefix:!")
+ optable.addtok("prefix:\\", "prefix:!")
+
+ optable.addtok("infix:**", ">prefix:!")
+
+ optable.addtok("postfix:++", ">infix:**")
+ optable.addtok("postfix:--", "postfix:++")
+ optable.addtok("prefix:++", "postfix:++")
+ optable.addtok("prefix:--", "postfix:++")
+
+ optable.addtok("infix:.", ">postfix:++")
+ optable.addtok("infix:.+", "infix:.")
+ optable.addtok("infix:.?", "infix:.")
+ optable.addtok("infix:.*", "infix:.")
+ optable.addtok("postcircumfix:.( )", "infix:.", "nullterm")
+ optable.addtok("postcircumfix:( )", "infix:.", "nows,nullterm")
+ optable.addtok("postcircumfix:.[ ]", "infix:.", "nullterm")
+ optable.addtok("postcircumfix:[ ]", "infix:.", "nows,nullterm")
+ optable.addtok("postcircumfix:.{ }", "infix:.", "nullterm")
+ optable.addtok("postcircumfix:{ }", "infix:.", "nows,nullterm")
+
+ term = find_global "Perl6", "term"
+ optable.addtok("term:", ">infix:.", "left", term)
+ optable.addtok("circumfix:( )", "term:")
+
+ optable.addtok("infix:&", "<infix:+")
+ optable.addtok("infix:|", "<infix:&")
+ optable.addtok("infix:^", "infix:|")
+
+ optable.addtok("prefix:rand", "<infix:|", "nullterm")
+ optable.addtok("prefix:abs", "prefix:rand", "nullterm")
+
+ optable.addtok("infix:=>", "<prefix:rand")
+ optable.addtok("infix:but", "infix:=>")
+ optable.addtok("infix:does", "infix:=>")
+ optable.addtok("infix:cmp", "infix:=>")
+ optable.addtok("infix:<=>", "infix:=>")
+ optable.addtok("infix:..", "infix:=>")
+ optable.addtok("infix:^..", "infix:=>")
+ optable.addtok("infix:..^", "infix:=>")
+ optable.addtok("infix:^..^", "infix:=>")
+
+ optable.addtok("infix:==", "<infix:=>")
+ optable.addtok("infix:!=", "infix:==")
+ optable.addtok("infix:<", "infix:==")
+ optable.addtok("infix:>", "infix:==")
+ optable.addtok("infix:<=", "infix:==")
+ optable.addtok("infix:>=", "infix:==")
+ optable.addtok("infix:~~", "infix:==")
+ optable.addtok("infix:!~", "infix:==")
+ optable.addtok("infix:eq", "infix:==")
+ optable.addtok("infix:ne", "infix:==")
+ optable.addtok("infix:lt", "infix:==")
+ optable.addtok("infix:le", "infix:==")
+ optable.addtok("infix:gt", "infix:==")
+ optable.addtok("infix:ge", "infix:==")
+ optable.addtok("infix:=:=", "infix:==")
+
+ optable.addtok("infix:&&", "<infix:==")
+ optable.addtok("infix:||", "<infix:&&")
+ optable.addtok("infix:^^", "infix:||")
+ optable.addtok("infix://", "infix:||")
+
+ optable.addtok("ternary:?? !!", "<infix:||", "right")
+
+ optable.addtok("infix:=", "<ternary:?? !!", "right")
+ optable.addtok("infix::=", "infix:=", "right")
+ optable.addtok("infix:::=", "infix:=", "right")
+
+.end
+
+.sub "expr"
+ .param pmc mob
+ .local pmc optable
+ optable = find_global "Perl6", "$optable"
+ $P0 = optable."parse"(mob)
+ .return ($P0)
+.end
Added: trunk/examples/pge/perl6.pir
==============================================================================
--- (empty file)
+++ trunk/examples/pge/perl6.pir Thu Oct 27 09:58:29 2005
@@ -0,0 +1 @@
+Coming soon.
Added: trunk/examples/pge/simple.pir
==============================================================================
--- (empty file)
+++ trunk/examples/pge/simple.pir Thu Oct 27 09:58:29 2005
@@ -0,0 +1,47 @@
+.namespace [ "Simple" ]
+
+.sub "__onload"
+ .local pmc optable
+ .local pmc term
+ .local pmc p6rule
+ .local string op
+
+ $I0 = find_type "PGE::OPTable"
+ optable = new $I0
+ store_global "Simple", "$optable", optable
+
+ p6rule = find_global "PGE", "p6rule"
+ term = p6rule("\\d+ | <ident>", "Simple", "term")
+
+ optable.addtok("infix:+")
+ optable.addtok("infix:-", "infix:+")
+
+ optable.addtok("infix:*", ">infix:+")
+ optable.addtok("infix:/", "infix:*")
+ optable.addtok("infix:%", "infix:*")
+
+ optable.addtok("prefix:+", ">infix:*")
+ optable.addtok("prefix:-", "prefix:+")
+ optable.addtok("prefix:!", "prefix:+")
+
+ optable.addtok("infix:**", ">prefix:+")
+
+ optable.addtok("postcircumfix:( )", ">infix:**", "nullterm")
+
+ optable.addtok("term:", ">postcircumfix:( )", "left", term)
+ optable.addtok("circumfix:( )", "term:")
+
+ optable.addtok("infix:==", "<infix:+")
+ optable.addtok("infix:!=", "infix:==")
+
+ optable.addtok("ternary:? :", "<infix:==", "right")
+ optable.addtok("infix:=", "<ternary:? :", "right")
+.end
+
+.sub "expr"
+ .param pmc mob
+ .local pmc optable
+ optable = find_global "Simple", "$optable"
+ $P0 = optable."parse"(mob)
+ .return ($P0)
+.end
