author | Jan Vrany <jan.vrany@fit.cvut.cz> |
Sun, 05 Oct 2014 00:29:07 +0100 | |
changeset 382 | 1825151d6455 |
parent 380 | 8fe3cb4e607f |
child 385 | 44a36ed4e484 |
permissions | -rw-r--r-- |
382
1825151d6455
Added target `mcz` to export .mcz package out of Smalltalk/X package.
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
380
diff
changeset
|
1 |
"{ Package: 'stx:goodies/petitparser/tests' }" PPAbstractParserTest subclass:#PPScriptingTest instanceVariableNames:'' classVariableNames:'' poolDictionaries:'' category:'PetitTests-Tests' ! PPScriptingTest comment:'These are some simple demo-scripts of parser combinators for the compiler construction course. http://www.iam.unibe.ch/~scg/Teaching/CC/index.html' ! !PPScriptingTest methodsFor:'examples'! expressionInterpreter "Same as #expressionInterpreter but with semantic actions." | mul prim add dec | add := PPUnresolvedParser new. mul := PPUnresolvedParser new. prim := PPUnresolvedParser new. dec := (Interval from: $0 to: $9) asParser ==> [ :token | token codePoint - $0 codePoint ]. add def: ((mul , $+ asParser , add) ==> [ :nodes | (nodes at: 1) + (nodes at: 3) ]) / mul. mul def: ((prim , $* asParser , mul) ==> [ :nodes | (nodes at: 1) * (nodes at: 3) ]) / prim. prim def: (($( asParser , add , $) asParser) ==> [ :nodes | nodes at: 2 ]) / dec. ^ add end "Modified: / 05-10-2014 / 00:02:58 / Jan Vrany <jan.vrany@fit.cvut.cz>" ! expressionParser "Simple demo of scripting an expression parser." | mul prim add dec | add := PPUnresolvedParser new. mul := PPUnresolvedParser new. prim := PPUnresolvedParser new. dec := (Interval from: $0 to: $9) asParser. add def: (mul , $+ asParser , add) / mul. mul def: (prim , $* asParser , mul) / prim. prim def: ($( asParser , add , $) asParser) / dec. ^ add end "Modified: / 05-10-2014 / 00:03:01 / Jan Vrany <jan.vrany@fit.cvut.cz>" ! straightLineParser | goal stm stmList id char dec exp expList mulExp primExp nonzero num lower upper | goal := PPUnresolvedParser new. stmList := PPUnresolvedParser new. stm := PPUnresolvedParser new. exp := PPUnresolvedParser new. expList := PPUnresolvedParser new. mulExp := PPUnresolvedParser new. primExp := PPUnresolvedParser new. lower := (Interval from: $a to: $z) asParser. upper := (Interval from: $A to: $Z) asParser. char := lower / upper. nonzero := (Interval from: $1 to: $9) asParser. dec := (Interval from: $0 to: $9) asParser. id := char, ( char / dec ) star. num := $0 asParser / ( nonzero, dec star). goal def: stmList end. stmList def: stm , ( $; asParser, stm ) star. stm def: ( id, ':=' asParser, exp ) / ( 'print' asParser, $( asParser, expList, $) asParser ). exp def: mulExp, ( ( $+ asParser / $- asParser ), mulExp ) star. expList def: exp, ( $, asParser, exp ) star. mulExp def: primExp, ( ( $* asParser / $/ asParser ), primExp ) star. primExp def: id / num / ( $( asParser, stmList, $, asParser, exp, $) asParser ). ^ goal "Modified: / 05-10-2014 / 00:03:11 / Jan Vrany <jan.vrany@fit.cvut.cz>" ! ! !PPScriptingTest methodsFor:'tests'! testExpressionInterpreter self assert: self expressionInterpreter parse: '2*(3+4)' to: 14 ! testExpressionParser self assert: self expressionParser parse: '2*(3+4)' to: #($2 $* ($( ($3 $+ $4) $))) ! testSLassign self assert: self straightLineParser parse: 'abc:=1' to: #(#($a #($b $c) ':=' #(#(#($1 #()) #()) #())) #()) ! testSLprint self assert: self straightLineParser parse: 'print(3,4)' to: #(('print' $( ((($3 ()) ()) () (($, ((($4 ()) ()) ())))) $)) ()) ! ! !PPScriptingTest class methodsFor:'documentation'! version ^ '$Header: /cvs/stx/stx/goodies/petitparser/PPScriptingTest.st,v 1.4 2014-03-04 14:34:23 cg Exp $' ! version_CVS ^ '$Header: /cvs/stx/stx/goodies/petitparser/PPScriptingTest.st,v 1.4 2014-03-04 14:34:23 cg Exp $' ! version_HG ^ '$Changeset: <not expanded> $' ! version_SVN ^ '$Id: PPScriptingTest.st,v 1.4 2014-03-04 14:34:23 cg Exp $' ! ! |