--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/parsers/smalltalk/PPSmalltalkTokenParser.st Tue Oct 07 09:42:03 2014 +0100
@@ -0,0 +1,65 @@
+"{ Package: 'stx:goodies/petitparser/parsers/smalltalk' }"
+
+PPTokenParser subclass:#PPSmalltalkTokenParser
+ instanceVariableNames:''
+ classVariableNames:'SeparatorPredicate'
+ poolDictionaries:''
+ category:'PetitSmalltalk-Core'
+!
+
+PPSmalltalkTokenParser comment:'A parser that knows how to skip comments and whitespace in Smalltalk and how to instantiate tokens.'
+!
+
+
+!PPSmalltalkTokenParser class methodsFor:'initialization'!
+
+initialize
+ SeparatorPredicate := PPCharSetPredicate on: [ :char | char isSeparator ]
+! !
+
+!PPSmalltalkTokenParser methodsFor:'parsing'!
+
+parseComments: anArray on: aPPContext
+ | start comments |
+ comments := anArray.
+ [ [ aPPContext atEnd not and: [ SeparatorPredicate value: aPPContext uncheckedPeek ] ]
+ whileTrue: [ aPPContext next ].
+ aPPContext atEnd not and: [ aPPContext uncheckedPeek = $" ] ] whileTrue: [
+ aPPContext next.
+ start := aPPContext position.
+ aPPContext upTo: $".
+ comments := comments copyWith: (start to: aPPContext position) ].
+ ^ comments
+!
+
+parseOn: aPPContext
+ | memento comments token |
+ memento := aPPContext remember.
+ comments := self
+ parseComments: #()
+ on: aPPContext.
+ token := super parseOn: aPPContext.
+ token isPetitFailure ifTrue: [
+ aPPContext restore: memento.
+ ^ token ].
+ comments := self
+ parseComments: comments
+ on: aPPContext.
+ ^ token comments: comments
+! !
+
+!PPSmalltalkTokenParser methodsFor:'private'!
+
+defaultTokenClass
+ ^ PPSmalltalkToken
+! !
+
+!PPSmalltalkTokenParser class methodsFor:'documentation'!
+
+version_HG
+
+ ^ '$Changeset: <not expanded> $'
+! !
+
+
+PPSmalltalkTokenParser initialize!