parsers/smalltalk/PPSmalltalkWhitespaceParser.st
author Jan Vrany <jan.vrany@fit.cvut.cz>
Sat, 01 Nov 2014 00:30:28 +0000
changeset 403 7063d523b064
parent 390 17ba167b8ee1
child 417 3c0a91182e65
permissions -rw-r--r--
Removed autoload attribut for tests. As all classes are in a test package, when package is loaded likely tests are required, so load them right away.

"{ Package: 'stx:goodies/petitparser/parsers/smalltalk' }"

PPParser subclass:#PPSmalltalkWhitespaceParser
	instanceVariableNames:'separator'
	classVariableNames:''
	poolDictionaries:''
	category:'PetitSmalltalk-Core'
!


!PPSmalltalkWhitespaceParser methodsFor:'analysis'!

isNullable
	^ true
! !

!PPSmalltalkWhitespaceParser methodsFor:'initialization'!

initialize
	super initialize.
	separator := PPCharSetPredicate on: [ :char | char isSeparator ].
! !

!PPSmalltalkWhitespaceParser methodsFor:'parsing'!

parseOn: aPPContext
	[ [aPPContext atEnd not and: [ separator value: aPPContext uncheckedPeek ] ]
		whileTrue: [ aPPContext next ].
		
	 aPPContext atEnd not and: [ aPPContext uncheckedPeek = $" ] ] whileTrue: [
		aPPContext next.
		aPPContext upTo: $".
	].
! !

!PPSmalltalkWhitespaceParser class methodsFor:'documentation'!

version_HG

    ^ '$Changeset: <not expanded> $'
! !