PPScriptingTest.st
changeset 20 46d4542c5f5e
parent 4 90de244a7fa2
child 193 ab4c4dcb60f3
equal deleted inserted replaced
19:4247b85d8584 20:46d4542c5f5e
    13 
    13 
    14 
    14 
    15 !PPScriptingTest methodsFor:'examples'!
    15 !PPScriptingTest methodsFor:'examples'!
    16 
    16 
    17 expressionInterpreter
    17 expressionInterpreter
    18 	"Same as #expressionInterpreter but with semantic actions."
    18         "Same as #expressionInterpreter but with semantic actions."
    19 
    19         
    20 	| mul prim add dec |
    20         | mul prim add dec |
    21 	add := PPUnresolvedParser new.
    21         add := PPUnresolvedParser new.
    22 	mul := PPUnresolvedParser new.
    22         mul := PPUnresolvedParser new.
    23 	prim := PPUnresolvedParser new.
    23         prim := PPUnresolvedParser new.
    24 	dec := ($0 ppMinus: $9) ==> [ :token | token codePoint - $0 codePoint ].
    24         dec := ($0 ppMinus: $9) ==> [ :token | token codePoint - $0 codePoint ].
    25 	add def: ((mul , $+ asParser , add) ==> [ :nodes | (nodes at: 1) + (nodes at: 3) ])
    25         add def: ((mul , $+ asParser , add) ==> [ :nodes | (nodes at: 1) + (nodes at: 3) ])
    26 		/ mul.
    26                 / mul.
    27 	mul def: ((prim , $* asParser , mul) ==> [ :nodes | (nodes at: 1) * (nodes at: 3) ])
    27         mul def: ((prim , $* asParser , mul) ==> [ :nodes | (nodes at: 1) * (nodes at: 3) ])
    28 		/ prim.
    28                 / prim.
    29 	prim def: (($( asParser , add , $) asParser) ==> [ :nodes | nodes at: 2 ])
    29         prim def: (($( asParser , add , $) asParser) ==> [ :nodes | nodes at: 2 ])
    30 		/ dec.
    30                 / dec.
    31 	^ add end
    31         ^ add end
    32 
    32 
    33     "Modified: / 19-12-2010 / 18:13:51 / Jan Kurs <kurs.jan@post.cz>"
    33     "Modified: / 19-12-2010 / 18:13:51 / Jan Kurs <kurs.jan@post.cz>"
    34 !
    34 !
    35 
    35 
    36 expressionParser
    36 expressionParser
    37 	"Simple demo of scripting an expression parser."
    37         "Simple demo of scripting an expression parser."
    38 
    38         
    39 	| mul prim add dec |
    39         | mul prim add dec |
    40 	add := PPUnresolvedParser new.
    40         add := PPUnresolvedParser new.
    41 	mul := PPUnresolvedParser new.
    41         mul := PPUnresolvedParser new.
    42 	prim := PPUnresolvedParser new.
    42         prim := PPUnresolvedParser new.
    43 	dec := ($0 ppMinus: $9).
    43         dec := ($0 ppMinus: $9).
    44 	add def: (mul , $+ asParser , add)
    44         add def: (mul , $+ asParser , add)
    45 		/ mul.
    45                 / mul.
    46 	mul def: (prim , $* asParser , mul)
    46         mul def: (prim , $* asParser , mul)
    47 		/ prim.
    47                 / prim.
    48 	prim def: ($( asParser , add , $) asParser)
    48         prim def: ($( asParser , add , $) asParser)
    49 		/ dec.
    49                 / dec.
    50 	^ add end
    50         ^ add end
    51 
    51 
    52     "Modified: / 19-12-2010 / 18:14:18 / Jan Kurs <kurs.jan@post.cz>"
    52     "Modified: / 19-12-2010 / 18:14:18 / Jan Kurs <kurs.jan@post.cz>"
    53 !
    53 !
    54 
    54 
    55 straightLineParser
    55 straightLineParser
    56 	| goal stm stmList id char dec exp expList mulExp primExp nonzero num lower upper |
    56         | goal stm stmList id char dec exp expList mulExp primExp nonzero num lower upper |
    57 	goal := PPUnresolvedParser new.
    57         goal := PPUnresolvedParser new.
    58 	stmList := PPUnresolvedParser new.
    58         stmList := PPUnresolvedParser new.
    59 	stm := PPUnresolvedParser new.
    59         stm := PPUnresolvedParser new.
    60 	exp := PPUnresolvedParser new.
    60         exp := PPUnresolvedParser new.
    61 	expList := PPUnresolvedParser new.
    61         expList := PPUnresolvedParser new.
    62 	mulExp := PPUnresolvedParser new.
    62         mulExp := PPUnresolvedParser new.
    63 	primExp := PPUnresolvedParser new.
    63         primExp := PPUnresolvedParser new.
       
    64         
       
    65         lower := $a ppMinus: $z.
       
    66         upper := $A ppMinus: $Z.
       
    67         char := lower / upper.
       
    68         nonzero := $1 ppMinus: $9.
       
    69         dec := $0 ppMinus: $9.
       
    70         id := char, ( char / dec ) star.
       
    71         num := $0 asParser / ( nonzero, dec star).
    64 
    72 
    65 	lower := $a ppMinus: $z.
    73         goal def: stmList end.
    66 	upper := $A ppMinus: $Z.
    74         stmList def: stm , ( $; asParser, stm ) star.
    67 	char := lower / upper.
    75         stm def: ( id, ':=' asParser, exp )
    68 	nonzero := $1 ppMinus: $9.
    76                 / ( 'print' asParser, $( asParser, expList, $) asParser ). 
    69 	dec := $0 ppMinus: $9.
    77         exp def: mulExp, ( ( $+ asParser / $- asParser ), mulExp ) star.
    70 	id := char, ( char / dec ) star.
    78         expList def: exp, ( $, asParser, exp ) star.
    71 	num := $0 asParser / ( nonzero, dec star).
    79         mulExp def: primExp, ( ( $* asParser / $/ asParser ), primExp ) star.
    72 
    80         primExp def: id
    73 	goal def: stmList end.
    81                 / num
    74 	stmList def: stm , ( $; asParser, stm ) star.
    82                 / ( $( asParser, stmList, $, asParser, exp, $) asParser ).
    75 	stm def: ( id, ':=' asParser, exp )
    83         ^ goal
    76 		/ ( 'print' asParser, $( asParser, expList, $) asParser ).
       
    77 	exp def: mulExp, ( ( $+ asParser / $- asParser ), mulExp ) star.
       
    78 	expList def: exp, ( $, asParser, exp ) star.
       
    79 	mulExp def: primExp, ( ( $* asParser / $/ asParser ), primExp ) star.
       
    80 	primExp def: id
       
    81 		/ num
       
    82 		/ ( $( asParser, stmList, $, asParser, exp, $) asParser ).
       
    83 	^ goal
       
    84 
    84 
    85     "Modified: / 19-12-2010 / 18:15:14 / Jan Kurs <kurs.jan@post.cz>"
    85     "Modified: / 19-12-2010 / 18:15:14 / Jan Kurs <kurs.jan@post.cz>"
    86 ! !
    86 ! !
    87 
    87 
    88 !PPScriptingTest methodsFor:'tests'!
    88 !PPScriptingTest methodsFor:'tests'!
    89 
    89 
    90 testExpressionInterpreter
    90 testExpressionInterpreter
    91 	self
    91 	self 
    92 		assert: self expressionInterpreter
    92 		assert: self expressionInterpreter
    93 		parse: '2*(3+4)'
    93 		parse: '2*(3+4)'
    94 		to: 14
    94 		to: 14
    95 !
    95 !
    96 
    96 
   100 		parse: '2*(3+4)'
   100 		parse: '2*(3+4)'
   101 		to: #($2 $* ($( ($3 $+ $4) $)))
   101 		to: #($2 $* ($( ($3 $+ $4) $)))
   102 !
   102 !
   103 
   103 
   104 testSLassign
   104 testSLassign
   105 
   105 	
   106 	self assert: self straightLineParser
   106 	self assert: self straightLineParser
   107 		parse: 'abc:=1'
   107 		parse: 'abc:=1'
   108 		to: #(#($a #($b $c) ':=' #(#(#($1 #()) #()) #())) #())
   108 		to: #(#($a #($b $c) ':=' #(#(#($1 #()) #()) #())) #())
   109 !
   109 !
   110 
   110 
   111 testSLprint
   111 testSLprint
   112 	self
   112 	self 
   113 		assert: self straightLineParser
   113 		assert: self straightLineParser
   114 		parse: 'print(3,4)'
   114 		parse: 'print(3,4)'
   115 		to: #(('print' $( ((($3 ()) ()) () (($, ((($4 ()) ()) ())))) $)) ())
   115 		to: #(('print' $( ((($3 ()) ()) () (($, ((($4 ()) ()) ())))) $)) ())
   116 ! !
   116 ! !
   117 
   117 
   118 !PPScriptingTest class methodsFor:'documentation'!
   118 !PPScriptingTest class methodsFor:'documentation'!
   119 
   119 
       
   120 version
       
   121     ^ '$Header: /cvs/stx/stx/goodies/petitparser/PPScriptingTest.st,v 1.3 2012-05-04 22:00:57 vrany Exp $'
       
   122 !
       
   123 
       
   124 version_CVS
       
   125     ^ '$Header: /cvs/stx/stx/goodies/petitparser/PPScriptingTest.st,v 1.3 2012-05-04 22:00:57 vrany Exp $'
       
   126 !
       
   127 
   120 version_SVN
   128 version_SVN
   121     ^ '$Id: PPScriptingTest.st,v 1.2 2012-01-13 11:22:50 cg Exp $'
   129     ^ '§Id: PPScriptingTest.st 5 2010-12-19 17:38:27Z kursjan §'
   122 ! !
   130 ! !