|
1 "{ Package: 'stx:goodies/petitparser/tests' }" |
|
2 |
|
3 "{ NameSpace: Smalltalk }" |
|
4 |
|
5 PPAbstractParserTest subclass:#PPScriptingTest |
|
6 instanceVariableNames:'' |
|
7 classVariableNames:'' |
|
8 poolDictionaries:'' |
|
9 category:'PetitTests-Tests' |
|
10 ! |
|
11 |
|
12 PPScriptingTest comment:'These are some simple demo-scripts of parser combinators for the compiler construction course. |
|
13 http://www.iam.unibe.ch/~scg/Teaching/CC/index.html' |
|
14 ! |
|
15 |
|
16 |
|
17 !PPScriptingTest methodsFor:'examples'! |
|
18 |
|
19 expressionInterpreter |
|
20 "Same as #expressionInterpreter but with semantic actions." |
|
21 |
|
22 | mul prim add dec | |
|
23 add := PPUnresolvedParser new. |
|
24 mul := PPUnresolvedParser new. |
|
25 prim := PPUnresolvedParser new. |
|
26 dec := ($0 to: $9) asParser ==> [ :token | token codePoint - $0 codePoint ]. |
|
27 add def: ((mul , $+ asParser , add) ==> [ :nodes | (nodes at: 1) + (nodes at: 3) ]) |
|
28 / mul. |
|
29 mul def: ((prim , $* asParser , mul) ==> [ :nodes | (nodes at: 1) * (nodes at: 3) ]) |
|
30 / prim. |
|
31 prim def: (($( asParser , add , $) asParser) ==> [ :nodes | nodes at: 2 ]) |
|
32 / dec. |
|
33 ^ add end |
|
34 ! |
|
35 |
|
36 expressionParser |
|
37 "Simple demo of scripting an expression parser." |
|
38 |
|
39 | mul prim add dec | |
|
40 add := PPUnresolvedParser new. |
|
41 mul := PPUnresolvedParser new. |
|
42 prim := PPUnresolvedParser new. |
|
43 dec := ($0 to: $9) asParser. |
|
44 add def: (mul , $+ asParser , add) |
|
45 / mul. |
|
46 mul def: (prim , $* asParser , mul) |
|
47 / prim. |
|
48 prim def: ($( asParser , add , $) asParser) |
|
49 / dec. |
|
50 ^ add end |
|
51 ! |
|
52 |
|
53 straightLineParser |
|
54 | goal stm stmList id char dec exp expList mulExp primExp nonzero num lower upper | |
|
55 goal := PPUnresolvedParser new. |
|
56 stmList := PPUnresolvedParser new. |
|
57 stm := PPUnresolvedParser new. |
|
58 exp := PPUnresolvedParser new. |
|
59 expList := PPUnresolvedParser new. |
|
60 mulExp := PPUnresolvedParser new. |
|
61 primExp := PPUnresolvedParser new. |
|
62 |
|
63 lower := ($a to: $z) asParser. |
|
64 upper := ($A to: $Z) asParser. |
|
65 char := lower / upper. |
|
66 nonzero := ($1 to: $9) asParser. |
|
67 dec := ($0 to: $9) asParser. |
|
68 id := char, ( char / dec ) star. |
|
69 num := $0 asParser / ( nonzero, dec star). |
|
70 |
|
71 goal def: stmList end. |
|
72 stmList def: stm , ( $; asParser, stm ) star. |
|
73 stm def: ( id, ':=' asParser, exp ) |
|
74 / ( 'print' asParser, $( asParser, expList, $) asParser ). |
|
75 exp def: mulExp, ( ( $+ asParser / $- asParser ), mulExp ) star. |
|
76 expList def: exp, ( $, asParser, exp ) star. |
|
77 mulExp def: primExp, ( ( $* asParser / $/ asParser ), primExp ) star. |
|
78 primExp def: id |
|
79 / num |
|
80 / ( $( asParser, stmList, $, asParser, exp, $) asParser ). |
|
81 ^ goal |
|
82 ! ! |
|
83 |
|
84 !PPScriptingTest methodsFor:'tests'! |
|
85 |
|
86 testExpressionInterpreter |
|
87 self |
|
88 assert: self expressionInterpreter |
|
89 parse: '2*(3+4)' |
|
90 to: 14 |
|
91 ! |
|
92 |
|
93 testExpressionParser |
|
94 self |
|
95 assert: self expressionParser |
|
96 parse: '2*(3+4)' |
|
97 to: #($2 $* ($( ($3 $+ $4) $))) |
|
98 ! |
|
99 |
|
100 testSLassign |
|
101 |
|
102 self assert: self straightLineParser |
|
103 parse: 'abc:=1' |
|
104 to: #(#($a #($b $c) ':=' #(#(#($1 #()) #()) #())) #()) |
|
105 ! |
|
106 |
|
107 testSLprint |
|
108 self |
|
109 assert: self straightLineParser |
|
110 parse: 'print(3,4)' |
|
111 to: #(('print' $( ((($3 ()) ()) () (($, ((($4 ()) ()) ())))) $)) ()) |
|
112 ! ! |
|
113 |
|
114 !PPScriptingTest class methodsFor:'documentation'! |
|
115 |
|
116 version |
|
117 ^ '$Header$' |
|
118 ! |
|
119 |
|
120 version_CVS |
|
121 ^ '$Header$' |
|
122 ! ! |
|
123 |