SystemOrganization addCategory: #PetitMSE! PPCompositeParser subclass: #PPMSEGrammar instanceVariableNames: 'elements element attributeValue attribute elementName primitive reference id string number boolean integerReference nameReference open close simpleName natural e' classVariableNames: '' poolDictionaries: '' category: 'PetitMSE'! !PPMSEGrammar commentStamp: '' prior: 0! This defines a parser for the MSE format. Instance Variables: elements element elementName elementId ! PPMSEGrammar subclass: #PPMSEArrayParser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitMSE'! !PPMSEArrayParser methodsFor: 'accessing' stamp: 'tg 7/27/2010 22:26'! attribute ^ super attribute ==> [:token | Array with: (token at: 2) with: (token at: 3) ]! ! !PPMSEArrayParser methodsFor: 'accessing' stamp: 'TudorGirba 2/28/2011 13:55'! attributeValue ^ super attributeValue ==> [ :tokens | (tokens size > 1 or: [ tokens isEmpty ]) ifTrue: [ tokens ] ifFalse: [ tokens first ]]! ! !PPMSEArrayParser methodsFor: 'values' stamp: 'tg 7/28/2010 00:20'! boolean ^ super boolean ==> [:token | token value = 'true' ifTrue: [true] ifFalse: [token value = 'false' ifTrue: [false] ifFalse: [nil]]] ! ! !PPMSEArrayParser methodsFor: 'accessing' stamp: 'tg 7/27/2010 22:26'! element ^ super element ==> [:token | Array with: (token at: 2) with: (token at: 3) with: (token at: 4) ]! ! !PPMSEArrayParser methodsFor: 'accessing' stamp: 'TudorGirba 2/14/2011 10:29'! elementName ^ super elementName ==> [:token | token value ]! ! !PPMSEArrayParser methodsFor: 'accessing' stamp: 'tg 7/27/2010 22:26'! elements ^ super elements ==> [:token | token second ]! ! !PPMSEArrayParser methodsFor: 'accessing' stamp: 'tg 7/28/2010 00:08'! id ^ super id ==> [:token | Array with: 'id' with: (token at: 3) value asNumber ]! ! !PPMSEArrayParser methodsFor: 'values' stamp: 'tg 7/28/2010 07:59'! integerReference ^ super integerReference ==> [:token | Array with: 'ref' with: token "(token at: 3) asNumber" ]! ! !PPMSEArrayParser methodsFor: 'values' stamp: 'tg 7/28/2010 07:57'! nameReference ^ super nameReference ==> [:token | Array with: 'ref' with: token ]! ! !PPMSEArrayParser methodsFor: 'values' stamp: 'TudorGirba 2/14/2011 11:16'! natural ^ super natural ==> [ :token | token value asNumber ]! ! !PPMSEArrayParser methodsFor: 'values' stamp: 'TudorGirba 3/1/2011 13:48'! number ^ super number ==> [ :token | (token value copyReplaceAll: 'E' with: 'e') asNumber ]! ! !PPMSEArrayParser methodsFor: 'values' stamp: 'tg 7/27/2010 22:27'! primitive ^ super primitive! ! !PPMSEArrayParser methodsFor: 'accessing' stamp: 'TudorGirba 2/14/2011 10:48'! simpleName ^ super simpleName ==> [:token | token value ]! ! !PPMSEArrayParser methodsFor: 'values' stamp: 'TudorGirba 2/14/2011 11:27'! string ^ super string ==> [:token | token second copyReplaceAll: '''''' with: '''' ]! ! PPMSEArrayParser subclass: #PPMSEPrettyPrinter instanceVariableNames: 'stream' classVariableNames: '' poolDictionaries: '' category: 'PetitMSE'! !PPMSEPrettyPrinter class methodsFor: 'as yet unclassified' stamp: 'TudorGirba 3/10/2011 00:55'! ignoredNames ^ super ignoredNames , #(stream)! ! !PPMSEPrettyPrinter methodsFor: 'as yet unclassified' stamp: 'TudorGirba 3/10/2011 00:55'! element ^ super element ==> [:token | stream cr; nextPutAll: token printString ]! ! !PPMSEPrettyPrinter methodsFor: 'as yet unclassified' stamp: 'TudorGirba 3/10/2011 00:56'! elements ^ super elements ==> [:token | stream contents ]! ! !PPMSEPrettyPrinter methodsFor: 'as yet unclassified' stamp: 'TudorGirba 3/10/2011 00:54'! initialize super initialize. stream := String new writeStream.! ! !PPMSEGrammar methodsFor: 'grammar' stamp: 'TudorGirba 2/14/2011 10:55'! attribute ^ (open , simpleName , attributeValue , close) trim! ! !PPMSEGrammar methodsFor: 'grammar' stamp: 'TudorGirba 2/14/2011 10:46'! attributeValue ^ (primitive / reference / element) star! ! !PPMSEGrammar methodsFor: 'basic' stamp: 'TudorGirba 2/14/2011 11:19'! boolean ^ ('true' asParser / 'false' asParser) flatten trim! ! !PPMSEGrammar methodsFor: 'basic' stamp: 'TudorGirba 2/14/2011 10:41'! close ^ $) asParser trim! ! !PPMSEGrammar methodsFor: 'basic' stamp: 'TudorGirba 2/28/2011 07:33'! e ^ ($e asParser / $E asParser) , ($- asParser / $+ asParser) optional , natural! ! !PPMSEGrammar methodsFor: 'grammar' stamp: 'TudorGirba 2/14/2011 10:42'! element ^ (open , elementName , id optional , attribute star , close) trim! ! !PPMSEGrammar methodsFor: 'basic' stamp: 'TudorGirba 2/14/2011 11:47'! elementName ^ (#word asParser star flatten , ( $. asParser , #word asParser star flatten ) optional) token trim! ! !PPMSEGrammar methodsFor: 'grammar' stamp: 'TudorGirba 2/14/2011 11:38'! elements ^ open , element star , close! ! !PPMSEGrammar methodsFor: 'grammar' stamp: 'TudorGirba 2/14/2011 10:44'! id ^ open , 'id:' asParser , #digit asParser star token trim , close! ! !PPMSEGrammar methodsFor: 'grammar' stamp: 'TudorGirba 2/14/2011 11:39'! integerReference ^ (open , 'ref:' asParser , natural trim , close) token trim! ! !PPMSEGrammar methodsFor: 'grammar' stamp: 'TudorGirba 2/14/2011 11:39'! nameReference ^ open , 'ref:' asParser , elementName trim , close! ! !PPMSEGrammar methodsFor: 'basic' stamp: 'TudorGirba 2/14/2011 11:15'! natural ^ #digit asParser plus flatten trim! ! !PPMSEGrammar methodsFor: 'basic' stamp: 'TudorGirba 2/28/2011 07:31'! number ^ ($- asParser optional , natural , ($. asParser , natural , e optional) optional) flatten trim! ! !PPMSEGrammar methodsFor: 'basic' stamp: 'TudorGirba 2/14/2011 10:41'! open ^ $( asParser trim! ! !PPMSEGrammar methodsFor: 'basic' stamp: 'tg 7/27/2010 10:43'! primitive ^ string / number / boolean" , unlimited"! ! !PPMSEGrammar methodsFor: 'grammar' stamp: 'tg 7/28/2010 07:51'! reference ^ integerReference / nameReference! ! !PPMSEGrammar methodsFor: 'basic' stamp: 'TudorGirba 2/14/2011 11:05'! simpleName ^ #word asParser star flatten trim! ! !PPMSEGrammar methodsFor: 'accessing' stamp: 'tg 7/25/2010 17:59'! start ^ elements end! ! !PPMSEGrammar methodsFor: 'basic' stamp: 'TudorGirba 2/14/2011 11:27'! string ^ ($' asParser , ('''''' asParser / $' asParser negate) star flatten , $' asParser) trim! ! PPCompositeParserTest subclass: #PPMSEGrammarTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitMSE'! PPMSEGrammarTest subclass: #PPMSEArrayParserTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitMSE'! !PPMSEArrayParserTest methodsFor: 'accessing' stamp: 'tg 7/27/2010 22:33'! parserClass ^ PPMSEArrayParser! ! !PPMSEArrayParserTest methodsFor: 'tests' stamp: 'TudorGirba 2/14/2011 10:32'! testElementName super testElementName. self assert: result = 'ABC.XYZ'! ! !PPMSEArrayParserTest methodsFor: 'tests-start' stamp: 'tg 7/25/2010 20:10'! testEmpty self assert: '()' is: #(). self assert: '( )' is: #(). self assert: ' ( ) ' is: #()! ! !PPMSEArrayParserTest methodsFor: 'tests-basic' stamp: 'TudorGirba 2/28/2011 13:50'! testNatural super testNatural. self assert: result = 123! ! !PPMSEArrayParserTest methodsFor: 'tests-basic' stamp: 'TudorGirba 2/14/2011 11:14'! testNaturalWithSpace super testNaturalWithSpace. self assert: result = 123! ! !PPMSEArrayParserTest methodsFor: 'tests-basic' stamp: 'TudorGirba 3/1/2011 13:49'! testNumberWithE super testNumberWithE. self assert: result = -1.2345! ! !PPMSEArrayParserTest methodsFor: 'tests-start' stamp: 'tg 7/28/2010 00:04'! testOneElement self assert: '((X))' is: #(('X' nil #())). self assert: '((X.Y))' is: #(('X.Y' nil #())). ! ! !PPMSEArrayParserTest methodsFor: 'tests-start' stamp: 'tg 7/27/2010 21:18'! testOneElementWithBooleanAttribute self assert: '((X.Y (attribute true)))' is: #(('X.Y' nil #(('attribute' true))))! ! !PPMSEArrayParserTest methodsFor: 'tests-start' stamp: 'tg 7/27/2010 21:17'! testOneElementWithId self assert: '((FAMIX.Class (id: 1)))' is: #(('FAMIX.Class' #('id' 1) #())). self assert: '( ( FAMIX.Class (id: 1) ) )' is: #(('FAMIX.Class' #('id' 1) #())). self assert: '( ( FAMIX.Class (id: 1) ) )' is: #(('FAMIX.Class' #('id' 1) #())). self assert: '( (FAMIX.Class (id: 1) ) )' is: #(('FAMIX.Class' #('id' 1) #()))! ! !PPMSEArrayParserTest methodsFor: 'tests-start' stamp: 'tg 8/2/2010 01:12'! testOneElementWithMultipleSubElements self assert: '((X (sub (Y) (Z))))' is: #(#('X' nil #(#('sub' #(#('Y' nil #()) #('Z' nil #())))))). ! ! !PPMSEArrayParserTest methodsFor: 'tests-start' stamp: 'tg 7/27/2010 21:01'! testOneElementWithNumericAttribute self assert: '((X.Y (attribute 2)))' is: #(('X.Y' nil #(('attribute' 2)))). self assert: '((X.Y (attribute 2.1)))' is: #(('X.Y' nil #(('attribute' 2.1)))). self assert: '((X.Y (attribute 1234.567)))' is: #(('X.Y' nil #(('attribute' 1234.567))))! ! !PPMSEArrayParserTest methodsFor: 'tests-start' stamp: 'tg 7/27/2010 21:21'! testOneElementWithStringAttribute self assert: '((FAMIX.Class (name ''Something'')))' is: #(('FAMIX.Class' nil #(('name' 'Something')))). self assert: '((FAMIX.Class (attribute ''as:.,>