"{ 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 := ($0 - $9) ==> [ :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
!

expressionParser
	"Simple demo of scripting an expression parser."
	
	| mul prim add dec |
	add := PPUnresolvedParser new.
	mul := PPUnresolvedParser new.
	prim := PPUnresolvedParser new.
	dec := ($0 - $9).
	add def: (mul , $+ asParser , add)
		/ mul.
	mul def: (prim , $* asParser , mul)
		/ prim.
	prim def: ($( asParser , add , $) asParser)
		/ dec.
	^ add end
!

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 := $a - $z.
	upper := $A - $Z.
	char := lower / upper.
	nonzero := $1 - $9.
	dec := $0 - $9.
	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
! !

!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_SVN
    ^ '$Id: PPScriptingTest.st,v 1.4 2014-03-04 14:34:23 cg Exp $'
! !