# HG changeset patch # User Jan Vrany # Date 1415228719 0 # Node ID 0eaf09920532c24f0d630ac17ab69c7853c82e5f # Parent 5389e6fbb3bc76b16cf13be944c332759369ae85 Merged JK's work on PetitCompiler Name: PetitCompiler-JanKurs.57 Author: JanKurs Time: 05-11-2014, 05:10:47 AM UUID: 4c625efe-77fd-465d-bd63-72ead0b5d3ba Name: PetitCompiler-Tests-JanVrany.13 Author: JanVrany Time: 05-11-2014, 09:31:07 AM UUID: 189ae287-6bc1-40ba-8458-b8392c4260a0 diff -r 5389e6fbb3bc -r 0eaf09920532 compiler/Make.proto --- a/compiler/Make.proto Wed Nov 05 21:40:01 2014 +0000 +++ b/compiler/Make.proto Wed Nov 05 23:05:19 2014 +0000 @@ -34,7 +34,7 @@ # add the path(es) here:, # ********** OPTIONAL: MODIFY the next lines *** # LOCALINCLUDES=-Ifoo -Ibar -LOCALINCLUDES= -I$(INCLUDE_TOP)/stx/goodies/petitparser -I$(INCLUDE_TOP)/stx/goodies/petitparser/parsers/smalltalk -I$(INCLUDE_TOP)/stx/libbasic -I$(INCLUDE_TOP)/stx/libbasic2 +LOCALINCLUDES= -I$(INCLUDE_TOP)/stx/goodies/petitparser -I$(INCLUDE_TOP)/stx/goodies/petitparser/parsers/smalltalk -I$(INCLUDE_TOP)/stx/goodies/refactoryBrowser/parser -I$(INCLUDE_TOP)/stx/libbasic -I$(INCLUDE_TOP)/stx/libbasic2 # if you need any additional defines for embedded C code, diff -r 5389e6fbb3bc -r 0eaf09920532 compiler/PPCAbstractCharacterNode.st --- a/compiler/PPCAbstractCharacterNode.st Wed Nov 05 21:40:01 2014 +0000 +++ b/compiler/PPCAbstractCharacterNode.st Wed Nov 05 23:05:19 2014 +0000 @@ -30,39 +30,41 @@ firstCharParser ^ character asParser +! + +firstCharSet + ^ PPCharSetPredicate on: [:e | e = character ] ! ! !PPCAbstractCharacterNode methodsFor:'compiling'! body: compiler - | id | - - character ppcPrintable ifTrue: [ - id := character storeString. - ] ifFalse: [ - id := compiler idFor: character prefixed: #char. - compiler addConstant: (Character value: character asInteger) as: id . - ]. - - compiler add: '(context peek == ', id, ')'. - compiler indent. - compiler add: 'ifFalse: [ self error: ''', character asInteger asString, ' expected'' at: context position ] '. - compiler add: 'ifTrue: [ context next ].'. - compiler dedent. - - "Modified: / 30-10-2014 / 10:59:57 / Jan Vrany " + | id | + + character ppcPrintable ifTrue: [ + id := character storeString + ] ifFalse: [ + id := compiler idFor: character prefixed: #char. + compiler addConstant: (Character value: character asInteger) as: id . + ]. + + compiler add: '(context peek == ', id, ')'. + compiler indent. + compiler add: 'ifFalse: [ self error: ''', character asInteger asString, ' expected'' at: context position ] '. + compiler add: 'ifTrue: [ context next ].'. + compiler dedent. ! compileWith: compiler effect: effect id: id self start: compiler id: id. self body: compiler. - ^ self stop: compiler. + ^ self stop: compiler. ! -compileWith: compiler id: id +compileWith: compiler id: id. self start: compiler. self body: compiler. - ^ compiler stopMethod. + ^ compiler stopMethod. ! ! !PPCAbstractCharacterNode class methodsFor:'documentation'! diff -r 5389e6fbb3bc -r 0eaf09920532 compiler/PPCAbstractLiteralNode.st --- a/compiler/PPCAbstractLiteralNode.st Wed Nov 05 21:40:01 2014 +0000 +++ b/compiler/PPCAbstractLiteralNode.st Wed Nov 05 23:05:19 2014 +0000 @@ -17,6 +17,12 @@ ^ literal first asParser ! +firstCharSet + | letter | + letter := literal first. + ^ PPCharSetPredicate on: [:e | e = letter ] +! + literal ^ literal diff -r 5389e6fbb3bc -r 0eaf09920532 compiler/PPCAbstractPredicateNode.st --- a/compiler/PPCAbstractPredicateNode.st Wed Nov 05 21:40:01 2014 +0000 +++ b/compiler/PPCAbstractPredicateNode.st Wed Nov 05 23:05:19 2014 +0000 @@ -58,6 +58,10 @@ firstCharParser ^ PPPredicateObjectParser on: predicate message: 'predicate expected'. +! + +firstCharSet + ^ PPCharSetPredicate on: predicate ! ! !PPCAbstractPredicateNode methodsFor:'compiling'! diff -r 5389e6fbb3bc -r 0eaf09920532 compiler/PPCActionNode.st --- a/compiler/PPCActionNode.st Wed Nov 05 21:40:01 2014 +0000 +++ b/compiler/PPCActionNode.st Wed Nov 05 23:05:19 2014 +0000 @@ -9,7 +9,15 @@ !PPCActionNode methodsFor:'as yet unclassified'! +asFast + ^ PPCTokenActionNode new + child: child; + name: self name; + yourself +! + compileWith: compiler effect: effect id: id + | | compiler addConstant: block as: id. compiler startMethod: id. diff -r 5389e6fbb3bc -r 0eaf09920532 compiler/PPCAnyNode.st --- a/compiler/PPCAnyNode.st Wed Nov 05 21:40:01 2014 +0000 +++ b/compiler/PPCAnyNode.st Wed Nov 05 23:05:19 2014 +0000 @@ -31,6 +31,10 @@ ! +firstCharSet + ^ PPCharSetPredicate on: [:e | true ] +! + prefix ^ #any ! ! diff -r 5389e6fbb3bc -r 0eaf09920532 compiler/PPCBenchmark.st --- a/compiler/PPCBenchmark.st Wed Nov 05 21:40:01 2014 +0000 +++ b/compiler/PPCBenchmark.st Wed Nov 05 23:05:19 2014 +0000 @@ -1,7 +1,7 @@ "{ Package: 'stx:goodies/petitparser/compiler' }" Object subclass:#PPCBenchmark - instanceVariableNames:'sources report contextClass compile' + instanceVariableNames:'sources report contextClass compile parser context input' classVariableNames:'' poolDictionaries:'' category:'PetitCompiler-Benchmarks' @@ -15,6 +15,36 @@ ^ self basicNew initialize. ! ! +!PPCBenchmark class methodsFor:'benchmarking-CalipeL'! + +run + | benchmarkSuiteClass | + + benchmarkSuiteClass := Smalltalk at: #BenchmarkSuite. + benchmarkSuiteClass isNil ifTrue:[ + self error: 'CalipeL is not loaded.' + ]. + ^ (benchmarkSuiteClass class:self) run + + " + PPCBenchmark run. + " +! + +run: selector + | benchmarkSuiteClass | + + benchmarkSuiteClass := Smalltalk at: #BenchmarkSuite. + benchmarkSuiteClass isNil ifTrue:[ + self error: 'CalipeL is not loaded.' + ]. + ^ (benchmarkSuiteClass class:self selector: selector ) run + + " + PPCBenchmark run: #benchmarkRBParserC + " +! ! + !PPCBenchmark methodsFor:'benchmark support'! createContext @@ -25,31 +55,31 @@ ! initialize - super initialize. - sources := PPCBenchmarkResources new. - contextClass := PPCContext. - compile := false. + super initialize. + sources := PPCBenchmarkResources new. + contextClass := PPCContext. + compile := false. ! measure: parser on: input self measure: parser on: input name: #unknown ! -measure: parser on: input name: aString - | time result context p | +measure: aParser on: anInput name: aString + | time result p | context := self createContext. compile ifTrue: [ - p := (parser end compile: #TmpBenchmark) + p := (aParser end compile: #TmpBenchmark) ] ifFalse: [ - p := parser end. + p := aParser end. ]. - time := Time millisecondsToRun: [ result := p parse: input withContext: context ]. + time := Time millisecondsToRun: [ result := p parse: anInput withContext: context ]. self assert: result isPetitFailure not. - self reportFor: parser context: context input: input time: time name: aString. + self reportFor: aParser context: context input: anInput time: time name: aString. ! measure: parser onSources: inputs name: aString @@ -78,23 +108,24 @@ self reportFor: parser context: context input: input time: time name: #unknown ! -reportFor: parser context: context input: input time: time name: name +reportFor: aParser context: aContext input: anInput time: time name: name Transcript crShow: (self getMetaInfo: name). Transcript crShow: ' Compile: ', compile asString. Transcript crShow: ' Total time: ', time asString, ' ms'. Transcript crShow: ' Time per character: ', - (((time / input size) asFloat * 1000) asString truncateTo: 6), + (((time / anInput size) asFloat * 1000) asString truncateTo: 6), ' microseconds'. - Transcript crShow: ' Backtrack per character: ', - ((context backtrackCount / input size) asFloat asString truncateTo: 6), +" Transcript crShow: ' Backtrack per character: ', + ((aContext backtrackCount / anInput size) asFloat asString truncateTo: 6), '.'. Transcript crShow: ' Remembers per character: ', - ((context rememberCount / input size) asFloat asString truncateTo: 6), + ((aContext rememberCount / input size) asFloat asString truncateTo: 6), '.'. +" ! startSuite @@ -107,7 +138,14 @@ " self measure: self anyStar on: sources petitParserPackage. " - self measure: self anyStar on: (self changesSized: 1000*1000) name: #anyStar. + self measure: self anyStar on: (sources changesSized: 1000*1000) name: #anyStar. +! + +benchmarkAnyStarBlock +" + self measure: self anyStar on: sources petitParserPackage. +" + self measure: self anyStarBlock on: (sources changesSized: 1000*1000) name: #anyStarBlock. ! benchmarkAttributes @@ -169,7 +207,8 @@ ! benchmarkSmalltalkGrammar - | parser time input context | + | time | + parser := PPSmalltalkGrammar new. context := PPContext new. context initializeFor: parser. @@ -181,7 +220,7 @@ ! benchmarkSmalltalkGrammarCompiled - | parser time input context | + | time | parser := PPSmalltalkGrammar new compile. context := PPCContext new. context initializeFor: parser. @@ -205,7 +244,7 @@ ! benchmarkSmalltalkParser - | parser time input context | + | time | parser := PPSmalltalkParser new. context := PPContext new. context initializeFor: parser. @@ -217,7 +256,7 @@ ! benchmarkSmalltalkParserCompiled - | parser time input context | + | time | parser := PPSmalltalkParser new compile. context := PPCContext new. context initializeFor: parser. @@ -245,6 +284,31 @@ Transcript crShow: 'Time per character: ', (time / size * 1000.0) asString, ' microseconds'. ! ! +!PPCBenchmark methodsFor:'benchmarks-CalipeL'! + +benchmarkRBParserC + + + + input do: [ :source | RBParser parseMethod: source ] +! + +benchmarkSmalltalkParserC + + + + input do: [ :source | parser parse: source withContext: context ] +! + +benchmarkSmalltalkParserCompiledC + + + + + input do: [ :source | parser parse: source withContext: context ] + +! ! + !PPCBenchmark methodsFor:'meta'! getMetaInfo: key @@ -258,10 +322,7 @@ ^ { #anyStar -> '.* Parser'. #token -> 'Token Parser'. - #backtrack -> 'Backtracking Parser'. - #negate -> 'Negate Parser'. - #java -> 'Standard Java Parser'. - #smalltalkObject -> 'All Smalltalk Object methods' + #anyStarBlock -> 'context next in loop'. } ! ! @@ -271,6 +332,10 @@ ^ #any asParser star ! +anyStarBlock + ^ [ :ctx | [ctx atEnd] whileFalse: [ ctx next ] ] asParser +! + tokenParser ^ #letter asParser, (#letter asParser / #digit asParser) star trim ! ! @@ -285,6 +350,65 @@ contextClass := aClass ! ! +!PPCBenchmark methodsFor:'setup & teardown-CalipeL'! + +setupJavaSyntaxCompiledC + parser := PPJavaSyntax new compile. + context := PPCContext new. + context initializeFor: parser. + input := sources javaSourcesBig. + +" + size := input inject: 0 into: [:r :e | r + e size ]. + Transcript crShow: 'Compiled Grammar time: ', time asString. + Transcript crShow: 'Time per character: ', (time / size * 1000.0) asString, ' microseconds'. +" +! + +setupRBParserC + + input := sources smalltalkSourcesBig. +! + +setupSmalltalkParserC + + parser := PPSmalltalkParser new. + context := PPCContext new. + context initializeFor: parser. + input := sources smalltalkSourcesBig. +! + +setupSmalltalkParserCompiledC + parser := PPSmalltalkParser new compile. + context := PPCContext new. + context initializeFor: parser. + input := sources smalltalkSourcesBig. + +" + size := input inject: 0 into: [:r :e | r + e size ]. + Transcript crShow: 'Compiled Grammar time: ', time asString. + Transcript crShow: 'Time per character: ', (time / size * 1000.0) asString, ' microseconds'. +" +! + +teardownJavaSyntaxCompiledC + parser class removeFromSystem. +" + size := input inject: 0 into: [:r :e | r + e size ]. + Transcript crShow: 'Compiled Grammar time: ', time asString. + Transcript crShow: 'Time per character: ', (time / size * 1000.0) asString, ' microseconds'. +" +! + +teardownSmalltalkParserCompiledC + parser class removeFromSystem. +" + size := input inject: 0 into: [:r :e | r + e size ]. + Transcript crShow: 'Compiled Grammar time: ', time asString. + Transcript crShow: 'Time per character: ', (time / size * 1000.0) asString, ' microseconds'. +" +! ! + !PPCBenchmark methodsFor:'sources'! changesSized: size diff -r 5389e6fbb3bc -r 0eaf09920532 compiler/PPCBenchmarkResources.st --- a/compiler/PPCBenchmarkResources.st Wed Nov 05 21:40:01 2014 +0000 +++ b/compiler/PPCBenchmarkResources.st Wed Nov 05 23:05:19 2014 +0000 @@ -2,13 +2,29 @@ Object subclass:#PPCBenchmarkResources instanceVariableNames:'' - classVariableNames:'' + classVariableNames:'javaCache' poolDictionaries:'' category:'PetitCompiler-Benchmarks' ! !PPCBenchmarkResources methodsFor:'as yet unclassified'! +changesSized: size + | string changes | + changes := PharoFilesOpener default changesFileOrNil contents. + string := changes copyFrom: 1 to: size. + ^ string + +! + +javaInDirectory: directory + | files | + files := self readDirectory: directory. + files := self files: files withExtension: 'java'. + + ^ files collect: [ :f | (FileStream fileNamed: f) contents ] +! + javaLangClass ! @@ -1236,6 +1252,10 @@ ' ! +javaSourcesBig + ^ self workingJavaInDirectory: '../java-src/java/util' +! + petitParserPackage ^ ' Object subclass: #PPCharSetPredicate @@ -5163,5 +5183,34 @@ ^ ((Smalltalk allClasses copyFrom: 1 to: 30) collect: [ :c | c allMethods collect: [ :m | m sourceCode ] ]) gather: [:each | each ]. +! + +workingJavaInDirectory: directory + | sources parser | + "return only such a files, that can be parsed by PPJavaSyntax" + + javaCache ifNil: [ javaCache := Dictionary new ]. + + ^ javaCache at: directory ifAbsentPut: [ + sources := self javaInDirectory: directory. + parser := PPJavaSyntax new. + + sources select: [ :source | ([parser parse: source ] on: Error do: [ PPFailure new ]) isPetitFailure not ] + ] ! ! +!PPCBenchmarkResources methodsFor:'private utilities'! + +files: files withExtension: extension + ^ files select: [ :f | f extension = extension ] +! + +readDirectory: directory + | file | + file := directory asFileReference. + file exists ifTrue: [ + ^ file allFiles + ]. + ^ #() +! ! + diff -r 5389e6fbb3bc -r 0eaf09920532 compiler/PPCChoiceNode.st --- a/compiler/PPCChoiceNode.st Wed Nov 05 21:40:01 2014 +0000 +++ b/compiler/PPCChoiceNode.st Wed Nov 05 23:05:19 2014 +0000 @@ -20,7 +20,6 @@ compileWith: compiler effect: effect id: id | firsts guard | - compiler addVariable: 'element'. firsts := (self firstSetSuchThat: [ :e | (e isKindOf: PPCTrimmingTokenNode) or: [ e isTerminal ] ]). diff -r 5389e6fbb3bc -r 0eaf09920532 compiler/PPCCompiler.st --- a/compiler/PPCCompiler.st Wed Nov 05 21:40:01 2014 +0000 +++ b/compiler/PPCCompiler.st Wed Nov 05 23:05:19 2014 +0000 @@ -80,13 +80,16 @@ ! cleanGeneratedMethods: class - class methodsDo: [ :mthd | - mthd category = #generated ifTrue:[ - class removeSelector: mthd selector. - ] - ] - - "Modified: / 26-10-2014 / 22:07:26 / Jan Vrany " + ((Smalltalk respondsTo:#isSmalltalkX) and:[ Smalltalk isSmalltalkX ]) ifTrue:[ + class methodsDo: [ :mthd | + mthd category = #generated ifTrue:[ + class removeSelector: mthd selector. + ] + ] + ] ifFalse: [ + (class allSelectorsInProtocol: #generated) do: [ :selector | + class removeSelectorSilently: selector ]. + ] ! cleanInstVars: class @@ -237,16 +240,7 @@ ! idFor: object prefixed: prefix effect: effect - | body suffix | - ^ ids at: object ifAbsentPut: [ - suffix := self fastMode ifTrue: [ '_fast' ] ifFalse: [ '' ]. - ((object isKindOf: PPCNode) and: [object name isNotNil]) ifTrue: [ - (object name, suffix) asSymbol - ] ifFalse: [ - body := ids size asString. - (prefix asString, '_', body, suffix) asSymbol - ] - ] + ^ self idFor: object prefixed: prefix suffixed: '' effect: effect. ! idFor: object prefixed: prefix suffixed: suffix effect: effect @@ -278,47 +272,53 @@ ! compileTree: compilerTree as: name parser: parser params: params - | rPackageOrganizer | + | | + params do: [ :p | + (p key = #guards) ifTrue: [ self guards: p value ]. + ]. - params do: [ :p | - (p key = #guards) ifTrue: [ self guards: p value ]. - ]. - " - To create a new Package so that a new classes are not in PetitCompiler package. - TODO JK: This is HACK, needs some more interoperable approach - " - rPackageOrganizer := Smalltalk at: #RPackageOrganizer. - rPackageOrganizer notNil ifTrue:[ - rPackageOrganizer default registerPackageNamed: 'PetitCompiler-Generated'. - ]. + ((Smalltalk respondsTo:#isSmalltalkX) and:[ Smalltalk isSmalltalkX ]) ifTrue:[ + | rPackageOrganizer | + rPackageOrganizer := Smalltalk at: #RPackageOrganizer. + rPackageOrganizer notNil ifTrue:[ + rPackageOrganizer default registerPackageNamed: 'PetitCompiler-Generated'. + ]. - compiledParser := (Smalltalk at: name ifAbsent: [ nil ]). - compiledParser ifNil: [ + compiledParser := (Smalltalk at: name ifAbsent: [ nil ]). + compiledParser ifNil: [ PPCompiledParser subclass: name instanceVariableNames:'' classVariableNames:'' poolDictionaries:'' category:'PetitCompiler-Generated'. compiledParser := Smalltalk at: name. - ] ifNotNil: [ + ] ifNotNil: [ self clean: compiledParser - ]. - compiledParser constants removeAll. - + ]. + ] ifFalse: [ + RPackageOrganizer default registerPackageNamed: 'PetitCompiler-Generated'. + compiledParser := (Smalltalk at: name ifAbsent: [ nil ]). + compiledParser ifNil: [ + PPCompiledParser subclass: name. + compiledParser := Smalltalk at: name. + compiledParser category: 'PetitCompiler-Generated' + ] ifNotNil: [ + self clean: compiledParser + ]. + ]. + compiledParser constants removeAll. + - - self startMethod: #start. - self add: '^ '. - self callOnLine: (compilerTree compileWith: self). - self stopMethod. + self startMethod: #start. + self add: '^ '. + self callOnLine: (compilerTree compileWith: self). + self stopMethod. - self installVariablesAndMethods. + self installMethodsAndVariables: compiledParser. - compiledParser referringParser: parser. - ^ compiledParser - - "Modified: / 30-10-2014 / 23:10:57 / Jan Vrany " + compiledParser referringParser: parser. + ^ compiledParser ! copy: parser @@ -332,11 +332,9 @@ ! installVariables: class - | string | - string := class constants keys inject: '' into: [:r :e | r, ' ', e ]. - PPCompiledParser subclass: class name instanceVariableNames: string classVariableNames: '' poolDictionaries:'' category: 'PetitCompiler-Generated'. - - "Modified: / 26-10-2014 / 22:01:45 / Jan Vrany " + | string | + string := class constants keys inject: '' into: [:r :e | r, ' ', e ]. + PPCompiledParser subclass: class name instanceVariableNames: string classVariableNames: '' category: 'PetitCompiler-Generated'. ! installVariablesAndMethods diff -r 5389e6fbb3bc -r 0eaf09920532 compiler/PPCContext.st --- a/compiler/PPCContext.st Wed Nov 05 21:40:01 2014 +0000 +++ b/compiler/PPCContext.st Wed Nov 05 23:05:19 2014 +0000 @@ -268,8 +268,16 @@ ! restoreProperties: aPPContextMemento + properties ifNil: [ ^ self ]. + + properties keysDo: [ :key | + (aPPContextMemento hasProperty: key) + ifTrue: [ properties at: key put: (aPPContextMemento propertyAt: key) ] + ifFalse: [ properties removeKey: key ]. + ]. + aPPContextMemento keysAndValuesDo: [ :key :value | - self propertyAt: key put: value - ]. + properties at: key put: value + ] ! ! diff -r 5389e6fbb3bc -r 0eaf09920532 compiler/PPCContextMemento.st --- a/compiler/PPCContextMemento.st Wed Nov 05 21:40:01 2014 +0000 +++ b/compiler/PPCContextMemento.st Wed Nov 05 23:05:19 2014 +0000 @@ -105,8 +105,6 @@ ! hash - ^ position hash bitXor: properties hash. - - "Modified: / 26-10-2014 / 01:46:37 / Jan Vrany " + ^ position hash bitXor: properties hash. ! ! diff -r 5389e6fbb3bc -r 0eaf09920532 compiler/PPCGuard.st --- a/compiler/PPCGuard.st Wed Nov 05 21:40:01 2014 +0000 +++ b/compiler/PPCGuard.st Wed Nov 05 23:05:19 2014 +0000 @@ -17,6 +17,10 @@ !PPCGuard methodsFor:'accessing'! +classification + ^ classification +! + id ^ id @@ -52,19 +56,18 @@ ! compileCharacter: compiler - self assert: (classification select: [ :e | e ]) size = 1. - - classification keysAndValuesDo: [ :index :value | value ifTrue: [ - (index > 32 and: [ index < 127 ]) ifTrue: [ - compiler add: '(context peek = ', (Character value: index) storeString, ')' - ] ifFalse: [ - id := compiler idFor: (Character value: index) prefixed: #character. - compiler addConstant: (Character value: index) as: id. - compiler add: '(context peek = ', id, ')'. - ] - ] ]. + self assert: (classification select: [ :e | e ]) size = 1. + + classification keysAndValuesDo: [ :index :value | value ifTrue: [ + (index > 32 and: [ index < 127 ]) ifTrue: [ + compiler add: '(context peek = ', (Character value: index) storeString, ')' + ] ifFalse: [ + id := compiler idFor: (Character value: index) prefixed: #character. + compiler addConstant: (Character value: index) as: id. + compiler add: '(context peek = ', id, ')'. + ] + ] ]. - "Modified: / 26-10-2014 / 22:13:38 / Jan Vrany " ! compileGuard: compiler id: symbol @@ -89,7 +92,9 @@ ^ self initializeForEpsilon ]. - self classificationOn: [:char | node firstSet anySatisfy: [:e | (e firstCharParser parse: char asString) isPetitFailure not ]] + self classificationOn: [:char | node firstSet anySatisfy: [:e | (e firstCharSetCached value: char) ]] + +" self classificationOn: [ :char | node firstSet anySatisfy: [ :e | (e firstCharParser parse: char asString) isPetitFailure not ] ]" ! initializeForEpsilon diff -r 5389e6fbb3bc -r 0eaf09920532 compiler/PPCInlineNotLiteralNode.st --- a/compiler/PPCInlineNotLiteralNode.st Wed Nov 05 21:40:01 2014 +0000 +++ b/compiler/PPCInlineNotLiteralNode.st Wed Nov 05 23:05:19 2014 +0000 @@ -45,6 +45,10 @@ ^ literal first asParser not ! +firstCharSet + ^ PPCharSetPredicate on: [:e | true ] +! + printOn: aStream aStream nextPutAll: #inlined. super printOn: aStream. diff -r 5389e6fbb3bc -r 0eaf09920532 compiler/PPCListNode.st --- a/compiler/PPCListNode.st Wed Nov 05 21:40:01 2014 +0000 +++ b/compiler/PPCListNode.st Wed Nov 05 23:05:19 2014 +0000 @@ -7,6 +7,7 @@ category:'PetitCompiler-Nodes' ! + !PPCListNode methodsFor:'accessing'! children @@ -63,3 +64,10 @@ ^ retval ! ! +!PPCListNode class methodsFor:'documentation'! + +version_HG + + ^ '$Changeset: $' +! ! + diff -r 5389e6fbb3bc -r 0eaf09920532 compiler/PPCMethod.st --- a/compiler/PPCMethod.st Wed Nov 05 21:40:01 2014 +0000 +++ b/compiler/PPCMethod.st Wed Nov 05 23:05:19 2014 +0000 @@ -29,9 +29,7 @@ ! addVariable: name - (variables includes: name) ifFalse:[ variables add: name ]. - - "Modified: / 30-10-2014 / 23:00:16 / Jan Vrany " + variables add: name. ! allowInline @@ -111,12 +109,10 @@ !PPCMethod methodsFor:'initialization'! initialize - buffer := WriteStream on: ''. - indentation := 1. - variables := OrderedCollection new. - canInline := false - - "Modified: / 30-10-2014 / 22:59:46 / Jan Vrany " + buffer := WriteStream on: ''. + indentation := 1. + variables := OrderedCollection new. + canInline := false ! ! !PPCMethod class methodsFor:'documentation'! diff -r 5389e6fbb3bc -r 0eaf09920532 compiler/PPCNilNode.st --- a/compiler/PPCNilNode.st Wed Nov 05 21:40:01 2014 +0000 +++ b/compiler/PPCNilNode.st Wed Nov 05 23:05:19 2014 +0000 @@ -27,6 +27,10 @@ ^ PPFailingParser new ! +firstCharSet + ^ PPCharSetPredicate on: [:e | false ] +! + prefix ^ #nil ! ! diff -r 5389e6fbb3bc -r 0eaf09920532 compiler/PPCNode.st --- a/compiler/PPCNode.st Wed Nov 05 21:40:01 2014 +0000 +++ b/compiler/PPCNode.st Wed Nov 05 23:05:19 2014 +0000 @@ -1,12 +1,18 @@ "{ Package: 'stx:goodies/petitparser/compiler' }" Object subclass:#PPCNode - instanceVariableNames:'contextFree name' + instanceVariableNames:'contextFree name firstSet firstCharSet' classVariableNames:'' poolDictionaries:'' category:'PetitCompiler-Nodes' ! +!PPCNode class methodsFor:'as yet unclassified'! + +new + ^ self basicNew initialize +! ! + !PPCNode methodsFor:'accessing'! children @@ -69,6 +75,13 @@ ^ nil ! +firstCharSetCached + firstCharSet ifNil: [ + firstCharSet := self firstCharSet. + ]. + ^ firstCharSet +! + firstSetSuchThat: block ^ self firstSetSuchThat: block into: (OrderedCollection new) openSet: IdentitySet new. ! @@ -113,7 +126,10 @@ !PPCNode methodsFor:'as yet unclassified'! firstSet - ^ self firstSetSuchThat: [ :e | e isFirstSetTerminal ] + firstSet ifNil: [ + firstSet := self firstSetSuchThat: [ :e | e isFirstSetTerminal ]. + ]. + ^ firstSet ! name diff -r 5389e6fbb3bc -r 0eaf09920532 compiler/PPCNotCharSetPredicateNode.st --- a/compiler/PPCNotCharSetPredicateNode.st Wed Nov 05 21:40:01 2014 +0000 +++ b/compiler/PPCNotCharSetPredicateNode.st Wed Nov 05 23:05:19 2014 +0000 @@ -32,6 +32,11 @@ firstCharParser ^ (PPPredicateObjectParser on: predicate message: 'predicate not expected') not. +! + +firstCharSet + ^ firstCharSet := PPCharSetPredicate on: [:e | (predicate value:e) not ] + ! ! !PPCNotCharSetPredicateNode class methodsFor:'documentation'! diff -r 5389e6fbb3bc -r 0eaf09920532 compiler/PPCNotLiteralNode.st --- a/compiler/PPCNotLiteralNode.st Wed Nov 05 21:40:01 2014 +0000 +++ b/compiler/PPCNotLiteralNode.st Wed Nov 05 23:05:19 2014 +0000 @@ -20,6 +20,10 @@ ^ literal first asParser ! +firstCharSet + ^ PPCharSetPredicate on: [:e | e ~= literal first ] +! + literal ^ literal diff -r 5389e6fbb3bc -r 0eaf09920532 compiler/PPCNotMessagePredicateNode.st --- a/compiler/PPCNotMessagePredicateNode.st Wed Nov 05 21:40:01 2014 +0000 +++ b/compiler/PPCNotMessagePredicateNode.st Wed Nov 05 23:05:19 2014 +0000 @@ -21,6 +21,10 @@ ^ (PPPredicateObjectParser on: predicate message: 'predicate not expected') not. ! +firstCharSet + PPCharSetPredicate on: [:e | (predicate value:e) not ] +! + message ^ message diff -r 5389e6fbb3bc -r 0eaf09920532 compiler/PPCNotNode.st --- a/compiler/PPCNotNode.st Wed Nov 05 21:40:01 2014 +0000 +++ b/compiler/PPCNotNode.st Wed Nov 05 23:05:19 2014 +0000 @@ -15,8 +15,12 @@ !PPCNotNode methodsFor:'analysis'! +firstCharSet + ^ PPCharSetPredicate on: [:e | true ] +! + isFirstSetTerminal - ^ false + ^ true ! ! !PPCNotNode methodsFor:'compiling'! @@ -27,9 +31,7 @@ compiler addVariable: 'memento'. compiler add: (compiler smartRemember: child). - compiler startTokenMode. compiler call: (child compileWith: compiler). - compiler stopTokenMode. compiler add: (compiler smartRestore: child). compiler add: '^ error ifFalse: [ self error ] ifTrue: [ self clearError. nil ]'. @@ -68,6 +70,12 @@ name: self name; predicate: child predicate; yourself - ] + ]. + + "Can do the fast version, because we throw away the result and return nil" + (self allNodes anySatisfy: [ :node | node asFast ~= node ]) ifTrue: [ + changeStatus change. + self replace: child with: (child transform: [:node | node asFast]). + ] ! ! diff -r 5389e6fbb3bc -r 0eaf09920532 compiler/PPCOptimizationResult.st --- a/compiler/PPCOptimizationResult.st Wed Nov 05 21:40:01 2014 +0000 +++ b/compiler/PPCOptimizationResult.st Wed Nov 05 23:05:19 2014 +0000 @@ -26,9 +26,7 @@ !PPCOptimizationResult methodsFor:'accessing'! change - change := true. - - "Modified: / 26-10-2014 / 01:14:48 / Jan Vrany " + change := true. ! isChange diff -r 5389e6fbb3bc -r 0eaf09920532 compiler/PPCPluggableNode.st --- a/compiler/PPCPluggableNode.st Wed Nov 05 21:40:01 2014 +0000 +++ b/compiler/PPCPluggableNode.st Wed Nov 05 23:05:19 2014 +0000 @@ -50,6 +50,10 @@ ^ block asParser ! +firstCharSet + ^ PPCharSetPredicate on: [:char | (block asParser parse: char asString) isPetitFailure not ] +! + prefix ^ #plug ! ! diff -r 5389e6fbb3bc -r 0eaf09920532 compiler/PPCStarCharSetPredicateNode.st --- a/compiler/PPCStarCharSetPredicateNode.st Wed Nov 05 21:40:01 2014 +0000 +++ b/compiler/PPCStarCharSetPredicateNode.st Wed Nov 05 23:05:19 2014 +0000 @@ -40,6 +40,10 @@ ^ PPPredicateObjectParser on: predicate message: 'predicate expected'. ! +firstCharSet + ^ PPCharSetPredicate on: predicate +! + predicate ^ predicate diff -r 5389e6fbb3bc -r 0eaf09920532 compiler/PPCSymbolActionNode.st --- a/compiler/PPCSymbolActionNode.st Wed Nov 05 21:40:01 2014 +0000 +++ b/compiler/PPCSymbolActionNode.st Wed Nov 05 23:05:19 2014 +0000 @@ -10,6 +10,13 @@ !PPCSymbolActionNode methodsFor:'as yet unclassified'! +asFast + ^ PPCTokenActionNode new + child: child; + name: self name; + yourself +! + compileWith: compiler effect: effect id: id compiler startMethod: id. compiler addVariable: 'element'. diff -r 5389e6fbb3bc -r 0eaf09920532 compiler/PPCTokenNode.st --- a/compiler/PPCTokenNode.st Wed Nov 05 21:40:01 2014 +0000 +++ b/compiler/PPCTokenNode.st Wed Nov 05 23:05:19 2014 +0000 @@ -18,9 +18,7 @@ !PPCTokenNode methodsFor:'accessing'! initialize - super initialize. - - "Modified: / 26-10-2014 / 01:34:11 / Jan Vrany " + super initialize. ! rewrite: changeStatus @@ -49,18 +47,9 @@ | | compiler startMethod: id. - compiler startTokenMode. compiler addVariable: 'start'. compiler addVariable: 'end'. -" - (compiler guards and: [ (guardSet := compiler guardCharSet: self) isNil not ]) ifTrue: [ - guardSetId := (compiler idFor: guardSet prefixed: #guard). - compiler addConstant: guardSet as: guardSetId. - compiler add: 'context atEnd ifTrue: [ ^ self error ].'. - compiler add: '(', guardSetId, ' value: context peek) ifFalse: [ ^ self error ].'. - ]. -" compiler add: 'start := context position + 1.'. compiler call: (self child compileWith: compiler). compiler add: 'error ifTrue: [ ^ self ].'. @@ -70,7 +59,6 @@ start: start stop: end value: nil'. - compiler stopTokenMode. ^ compiler stopMethod. ! diff -r 5389e6fbb3bc -r 0eaf09920532 compiler/PPCTrimmingTokenNode.st --- a/compiler/PPCTrimmingTokenNode.st Wed Nov 05 21:40:01 2014 +0000 +++ b/compiler/PPCTrimmingTokenNode.st Wed Nov 05 23:05:19 2014 +0000 @@ -69,7 +69,7 @@ whitespace: anObject (anObject name isNil and: [ self child name isNotNil ]) ifTrue: [ - anObject name: self child name, '_water'. + anObject name: self child name, '_ws'. ]. children at: 1 put: anObject ! ! @@ -100,20 +100,19 @@ !PPCTrimmingTokenNode methodsFor:'as yet unclassified'! compileWith: compiler effect: effect id: id - | guardSetId guardSet | + | guard | compiler startMethod: id. - compiler startTokenMode. compiler addVariable: 'start'. compiler addVariable: 'end'. self compileWhitespace: compiler. - (compiler guards and: [ (guardSet := compiler guardCharSet: self) isNil not ]) ifTrue: [ - guardSetId := id, '_guard'. - compiler addConstant: guardSet as: guardSetId. + (compiler guards and: [(guard := PPCGuard on: self) makesSense]) ifTrue: [ compiler add: 'context atEnd ifTrue: [ ^ self error ].'. - compiler add: '(', guardSetId, ' value: context peek) ifFalse: [ ^ self error ].'. + guard id: id, '_guard'. + guard compileGuard: compiler. + compiler addOnLine: 'ifFalse: [ ^ self error ].' ]. compiler add: 'start := context position + 1.'. @@ -127,7 +126,6 @@ start: start stop: end value: nil'. - compiler stopTokenMode. ^ compiler stopMethod. ! diff -r 5389e6fbb3bc -r 0eaf09920532 compiler/PPCUnknownNode.st --- a/compiler/PPCUnknownNode.st Wed Nov 05 21:40:01 2014 +0000 +++ b/compiler/PPCUnknownNode.st Wed Nov 05 23:05:19 2014 +0000 @@ -43,6 +43,12 @@ ^ #parser ! ! +!PPCUnknownNode methodsFor:'as yet unclassified'! + +firstCharSet + ^ parser firstCharSet +! ! + !PPCUnknownNode methodsFor:'compiling'! compileWith: compiler effect: effect id: id diff -r 5389e6fbb3bc -r 0eaf09920532 compiler/bc.mak --- a/compiler/bc.mak Wed Nov 05 21:40:01 2014 +0000 +++ b/compiler/bc.mak Wed Nov 05 23:05:19 2014 +0000 @@ -34,7 +34,7 @@ -LOCALINCLUDES= -I$(INCLUDE_TOP)\stx\goodies\petitparser -I$(INCLUDE_TOP)\stx\goodies\petitparser\parsers\smalltalk -I$(INCLUDE_TOP)\stx\libbasic -I$(INCLUDE_TOP)\stx\libbasic2 +LOCALINCLUDES= -I$(INCLUDE_TOP)\stx\goodies\petitparser -I$(INCLUDE_TOP)\stx\goodies\petitparser\parsers\smalltalk -I$(INCLUDE_TOP)\stx\goodies\refactoryBrowser\parser -I$(INCLUDE_TOP)\stx\libbasic -I$(INCLUDE_TOP)\stx\libbasic2 LOCALDEFINES= STCLOCALOPT=-package=$(PACKAGE) -I. $(LOCALINCLUDES) -headerDir=. $(STCLOCALOPTIMIZATIONS) $(STCWARNINGS) $(LOCALDEFINES) -varPrefix=$(LIBNAME) diff -r 5389e6fbb3bc -r 0eaf09920532 compiler/compiler.rc --- a/compiler/compiler.rc Wed Nov 05 21:40:01 2014 +0000 +++ b/compiler/compiler.rc Wed Nov 05 23:05:19 2014 +0000 @@ -25,7 +25,7 @@ VALUE "LegalCopyright", "Copyright Claus Gittinger 1988-2014\nCopyright eXept Software AG 1998-2014\0" VALUE "ProductName", "Smalltalk/X\0" VALUE "ProductVersion", "6.2.4.0\0" - VALUE "ProductDate", "Wed, 05 Nov 2014 21:34:05 GMT\0" + VALUE "ProductDate", "Wed, 05 Nov 2014 22:51:08 GMT\0" END END diff -r 5389e6fbb3bc -r 0eaf09920532 compiler/extensions.st --- a/compiler/extensions.st Wed Nov 05 21:40:01 2014 +0000 +++ b/compiler/extensions.st Wed Nov 05 23:05:19 2014 +0000 @@ -552,6 +552,18 @@ ^ self ! ! +!PPPredicateObjectParser methodsFor:'*petitcompiler'! + +firstCharSet + ^ predicate +! ! + +!PPPredicateObjectParser methodsFor:'*petitcompiler'! + +firstCharSetCached + ^ predicate +! ! + !PPSequenceParser methodsFor:'*petitcompiler'! asCompilerNode @@ -692,6 +704,12 @@ ^ PPFailingParser new ! ! +!PPSmalltalkWhitespaceParser methodsFor:'*petitcompiler'! + +firstCharSet + ^ PPCharSetPredicate on: [:e | false ] +! ! + !PPStream methodsFor:'*petitcompiler'! peek: anInteger @@ -850,6 +868,12 @@ ^ false ! ! +!UndefinedObject methodsFor:'*petitcompiler'! + +isSeparator + ^ false +! ! + !stx_goodies_petitparser_compiler class methodsFor:'documentation'! extensionsVersion_HG diff -r 5389e6fbb3bc -r 0eaf09920532 compiler/stx_goodies_petitparser_compiler.st --- a/compiler/stx_goodies_petitparser_compiler.st Wed Nov 05 21:40:01 2014 +0000 +++ b/compiler/stx_goodies_petitparser_compiler.st Wed Nov 05 23:05:19 2014 +0000 @@ -20,16 +20,16 @@ "The last merged version is: " ^ ' - Name: PetitCompiler-JanKurs.41 + Name: PetitCompiler-JanKurs.57 Author: JanKurs - Time: 25-10-2014, 03:30:28 AM - UUID: 105186d1-1187-4ca6-8d66-3d2d47def4d3 + Time: 05-11-2014, 05:10:47 AM + UUID: 4c625efe-77fd-465d-bd63-72ead0b5d3ba Repository: http://smalltalkhub.com/mc/JanKurs/PetitParser/main ' "Created: / 03-10-2014 / 02:27:21 / Jan Vrany " - "Modified: / 26-10-2014 / 01:29:24 / Jan Vrany " + "Modified: / 05-11-2014 / 22:58:45 / Jan Vrany " ! monticelloName @@ -75,6 +75,7 @@ by searching all classes (and their packages) which are referenced by my classes." ^ #( + #'stx:goodies/refactoryBrowser/parser' "RBParser - referenced by PPCBenchmark>>benchmarkRBParserC" #'stx:libbasic2' "Stack - referenced by PPCCompiler>>initialize" ) ! @@ -285,6 +286,10 @@ UndefinedObject isAlphaNumeric UndefinedObject isDigit UndefinedObject isLetter + PPPredicateObjectParser firstCharSet + PPPredicateObjectParser firstCharSetCached + PPSmalltalkWhitespaceParser firstCharSet + UndefinedObject isSeparator ) ! ! diff -r 5389e6fbb3bc -r 0eaf09920532 compiler/tests/PPCCompilerTest.st --- a/compiler/tests/PPCCompilerTest.st Wed Nov 05 21:40:01 2014 +0000 +++ b/compiler/tests/PPCCompilerTest.st Wed Nov 05 23:05:19 2014 +0000 @@ -187,6 +187,13 @@ self assert: parser fail: 'ab'. ! +testCompileNot3 + parser := ('foo' asParser not, 'fee' asParser) compile. + + self assert: parser parse: 'fee' to: #(nil 'fee'). + self assert: parser fail: 'foo'. +! + testCompileNotLiteral parser := 'foo' asParser not compile. self assert: parser class methods size = 2. @@ -380,17 +387,15 @@ ! testSmalltalkToken - parser := (#letter asParser, (#digit asParser / #letter asParser) star) smalltalkToken compileWithParameters: {#profile -> true}. - - self assert: parser class methodDictionary size = 6. - self assert: parser parse: 'foo'. - self assert: result inputValue = 'foo'. - self assert: context invocationCount = 9. - self assert: context rememberCount = 0. - self assert: context lwRememberCount = 1. - self assert: context lwRestoreCount = 0. - - "Modified: / 30-10-2014 / 23:20:57 / Jan Vrany " + parser := (#letter asParser, (#digit asParser / #letter asParser) star) smalltalkToken compileWithParameters: {#profile -> true}. + + self assert: parser class methods size = 6. + self assert: parser parse: 'foo'. + self assert: result inputValue = 'foo'. + self assert: context invocationCount = 9. + self assert: context rememberCount = 0. + self assert: context lwRememberCount = 1. + self assert: context lwRestoreCount = 0. ! testSmalltalkToken2 @@ -419,48 +424,44 @@ ! testToken2 - parser := (#letter asParser, (#digit asParser / #letter asParser) star) token compileWithParameters: {#profile -> true}. - - self assert: parser class methodDictionary size = 5. - self assert: parser parse: 'foo'. - self assert: result inputValue = 'foo'. - self assert: context invocationCount = 7. - self assert: context rememberCount = 0. - self assert: context lwRememberCount = 1. - self assert: context lwRestoreCount = 0. - - "Modified: / 30-10-2014 / 23:21:17 / Jan Vrany " + parser := (#letter asParser, (#digit asParser / #letter asParser) star) token compileWithParameters: {#profile -> true}. + + self assert: parser class methods size = 5. + self assert: parser parse: 'foo'. + self assert: result inputValue = 'foo'. + self assert: context invocationCount = 7. + self assert: context rememberCount = 0. + self assert: context lwRememberCount = 1. + self assert: context lwRestoreCount = 0. ! testTrimmingToken - parser := (#letter asParser, (#digit asParser / #letter asParser) star) trimmingToken compileWithParameters: { #profile -> true }. + parser := (#letter asParser, (#digit asParser / #letter asParser) star) trimmingToken compileWithParameters: { #profile -> true }. - self assert: parser class methodDictionary size = 6. - - self assert: parser parse: 'foo'. - self assert: result inputValue = 'foo'. + self assert: parser class methods size = 6. + + self assert: parser parse: 'foo'. + self assert: result inputValue = 'foo'. - self assert: context invocationCount = 9. - self assert: context rememberCount = 0. - self assert: context lwRememberCount = 1. - self assert: context lwRestoreCount = 0. + self assert: context invocationCount = 9. + self assert: context rememberCount = 0. + self assert: context lwRememberCount = 1. + self assert: context lwRestoreCount = 0. - self assert: parser parse: ' foo '. - self assert: result inputValue = 'foo'. + self assert: parser parse: ' foo '. + self assert: result inputValue = 'foo'. - self assert: parser fail: '123'. + self assert: parser fail: '123'. - self assert: context invocationCount = 3. - self assert: context rememberCount = 0. - self assert: context lwRememberCount = 0. - self assert: context lwRestoreCount = 0. + self assert: context invocationCount = 3. + self assert: context rememberCount = 0. + self assert: context lwRememberCount = 0. + self assert: context lwRestoreCount = 0. - self assert: parser fail: ''. - - "Modified: / 30-10-2014 / 23:21:23 / Jan Vrany " + self assert: parser fail: ''. ! ! !PPCCompilerTest methodsFor:'tests - first set'! diff -r 5389e6fbb3bc -r 0eaf09920532 compiler/tests/PPCGuardTest.st --- a/compiler/tests/PPCGuardTest.st Wed Nov 05 21:40:01 2014 +0000 +++ b/compiler/tests/PPCGuardTest.st Wed Nov 05 23:05:19 2014 +0000 @@ -87,23 +87,33 @@ ! testMessage2 - guard := PPCGuard new initializeFor: #letter asParser / #digit asParser. + guard := PPCGuard new initializeFor: (#letter asParser / #digit asParser) asCompilerTree. self assert: guard message = #isAlphaNumeric ! +testNot + guard := PPCGuard new initializeFor: ('foo' asParser not, 'fee' asParser) asCompilerTree. + self assert: (guard classification at: $f asInteger). +! + +testNot2 + guard := PPCGuard new initializeFor: ('foo' asParser not, 'fee' asParser) asCompilerTree optimizeTree. + self assert: (guard classification at: $f asInteger). +! + testTestMessage - guard := PPCGuard new initializeFor: #letter asParser. + guard := PPCGuard new initializeFor: #letter asParser asCompilerTree. self assert: (guard testMessage: #isLetter). self assert: (guard testMessage: #isAlphaNumeric) not. - guard := PPCGuard new initializeFor: #word asParser. + guard := PPCGuard new initializeFor: #word asParser asCompilerTree. self assert: (guard testMessage: #isAlphaNumeric). - guard := PPCGuard new initializeFor: #digit asParser. + guard := PPCGuard new initializeFor: #digit asParser asCompilerTree. self assert: (guard testMessage: #isDigit). - guard := PPCGuard new initializeFor: 'a' asParser. + guard := PPCGuard new initializeFor: 'a' asParser asCompilerTree. self assert: (guard testMessage: #isDigit) not. self assert: (guard testMessage: #isLetter) not. self assert: (guard testMessage: #isAlphaNumeric) not. @@ -111,16 +121,19 @@ ! testTestSingleCharacter - guard := PPCGuard new initializeFor: $a asParser. + guard := PPCGuard new initializeFor: $a asParser asCompilerTree. + self assert: guard testSingleCharacter. + + guard := PPCGuard new initializeFor: 'foo' asParser asCompilerTree. self assert: guard testSingleCharacter. - guard := PPCGuard new initializeFor: 'foo' asParser. + guard := PPCGuard new initializeFor: ('foo' asParser / 'bar' asParser) asCompilerTree. + self assert: guard testSingleCharacter not. + + guard := PPCGuard new initializeFor: ($a asParser, (#letter asParser / #digit asParser)) asCompilerTree. self assert: guard testSingleCharacter. - guard := PPCGuard new initializeFor: ('foo' asParser / 'bar' asParser). - self assert: guard testSingleCharacter not. - - guard := PPCGuard new initializeFor: ($a asParser, (#letter asParser / #digit asParser)). + guard := PPCGuard new initializeFor: ('foo' asParser / 'fee' asParser) asCompilerTree. self assert: guard testSingleCharacter. ! ! diff -r 5389e6fbb3bc -r 0eaf09920532 compiler/tests/PPCNodeCompilingTest.st --- a/compiler/tests/PPCNodeCompilingTest.st Wed Nov 05 21:40:01 2014 +0000 +++ b/compiler/tests/PPCNodeCompilingTest.st Wed Nov 05 23:05:19 2014 +0000 @@ -92,33 +92,29 @@ ! testCompileChoice - tree := PPCChoiceNode new - children: { #digit asParser asCompilerNode. #letter asParser asCompilerNode }; - yourself. - - parser := self compileTree: tree. - - self assert: parser class methodDictionary size = 4. - - self assert: parser parse: '1' to: $1. - self assert: parser parse: 'a' to: $a. - self assert: parser fail: '_'. - - "Modified: / 30-10-2014 / 23:48:30 / Jan Vrany " + tree := PPCChoiceNode new + children: { #digit asParser asCompilerNode. #letter asParser asCompilerNode }; + yourself. + + parser := self compileTree: tree. + + self assert: parser class methods size = 4. + + self assert: parser parse: '1' to: $1. + self assert: parser parse: 'a' to: $a. + self assert: parser fail: '_'. ! testCompileLiteral - tree := PPCLiteralNode new - literal: 'foo'; - yourself. - parser := self compileTree: tree. - - self assert: parser class methodDictionary size = 2. - self assert: parser parse: 'foo' to: 'foo'. - self assert: parser parse: 'foobar' to: 'foo' end: 3. - self assert: parser fail: 'boo'. - - "Modified: / 30-10-2014 / 23:48:38 / Jan Vrany " + tree := PPCLiteralNode new + literal: 'foo'; + yourself. + parser := self compileTree: tree. + + self assert: parser class methods size = 2. + self assert: parser parse: 'foo' to: 'foo'. + self assert: parser parse: 'foobar' to: 'foo' end: 3. + self assert: parser fail: 'boo'. ! testCompileLiteral2 @@ -153,51 +149,45 @@ ! testCompileNotCharSetPredicate - tree := PPCNotCharSetPredicateNode new - predicate: (PPCharSetPredicate on: [ :e | e = $a ]); - yourself. - parser := self compileTree: tree. - - self assert: parser class methodDictionary size = 2. - self assert: parser parse: 'b' to: nil end: 0. - self assert: context invocationCount = 2. - - self assert: parser fail: 'a'. - self assert: parser parse: '' to: nil end: 0. - - "Modified: / 30-10-2014 / 23:49:49 / Jan Vrany " + tree := PPCNotCharSetPredicateNode new + predicate: (PPCharSetPredicate on: [ :e | e = $a ]); + yourself. + parser := self compileTree: tree. + + self assert: parser class methods size = 2. + self assert: parser parse: 'b' to: nil end: 0. + self assert: context invocationCount = 2. + + self assert: parser fail: 'a'. + self assert: parser parse: '' to: nil end: 0. ! testCompileNotLiteral - tree := PPCNotLiteralNode new - literal: 'foo'; - yourself. - parser := self compileTree: tree. - - self assert: parser class methodDictionary size = 2. - self assert: parser parse: 'bar' to: nil end: 0. - self assert: context invocationCount = 2. - - self assert: parser fail: 'foo'. - self assert: parser parse: '' to: nil end: 0. - - "Modified: / 30-10-2014 / 23:50:04 / Jan Vrany " + tree := PPCNotLiteralNode new + literal: 'foo'; + yourself. + parser := self compileTree: tree. + + self assert: parser class methods size = 2. + self assert: parser parse: 'bar' to: nil end: 0. + self assert: context invocationCount = 2. + + self assert: parser fail: 'foo'. + self assert: parser parse: '' to: nil end: 0. ! testCompileNotMessagePredicate - tree := PPCNotMessagePredicateNode new - message: #isDigit; - yourself. - parser := self compileTree: tree. - - self assert: parser class methodDictionary size = 2. - self assert: parser parse: 'a' to: nil end: 0. - self assert: context invocationCount = 2. - - self assert: parser fail: '1'. - self assert: parser parse: '' to: nil end: 0. - - "Modified: / 30-10-2014 / 23:50:07 / Jan Vrany " + tree := PPCNotMessagePredicateNode new + message: #isDigit; + yourself. + parser := self compileTree: tree. + + self assert: parser class methods size = 2. + self assert: parser parse: 'a' to: nil end: 0. + self assert: context invocationCount = 2. + + self assert: parser fail: '1'. + self assert: parser parse: '' to: nil end: 0. ! testCompileOptional @@ -265,34 +255,32 @@ ! testCompileStarCharSetPredicate - tree := PPCStarCharSetPredicateNode new - predicate: (PPCharSetPredicate on: [:e | e = $a ]); - yourself. - parser := self compileTree: tree. - - self assert: parser class methodDictionary size = 2. - self assert: parser parse: 'aaa1' to: #( $a $a $a) end: 3. - self assert: context invocationCount = 2. - self assert: parser parse: 'bba' to: #() end: 0. - self assert: context invocationCount = 2. - - "Modified: / 30-10-2014 / 23:50:10 / Jan Vrany " + tree := PPCStarCharSetPredicateNode new + predicate: (PPCharSetPredicate on: [:e | e = $a ]); + yourself. + parser := self compileTree: tree. + + self assert: parser class methods size = 2. + self assert: parser parse: 'aaa1' to: #( $a $a $a) end: 3. + self assert: context invocationCount = 2. + self assert: parser parse: 'bba' to: #() end: 0. + self assert: context invocationCount = 2. + ! testCompileStarMessagePredicate - tree := PPCStarMessagePredicateNode new - message: #isLetter; - yourself. - parser := self compileTree: tree. - - self assert: parser class methodDictionary size = 2. - self assert: parser parse: 'abc1' to: #( $a $b $c) end: 3. - self assert: context invocationCount = 2. - - self assert: parser parse: '123a' to: #() end: 0. - self assert: context invocationCount = 2. - - "Modified: / 30-10-2014 / 23:50:13 / Jan Vrany " + tree := PPCStarMessagePredicateNode new + message: #isLetter; + yourself. + parser := self compileTree: tree. + + self assert: parser class methods size = 2. + self assert: parser parse: 'abc1' to: #( $a $b $c) end: 3. + self assert: context invocationCount = 2. + + self assert: parser parse: '123a' to: #() end: 0. + self assert: context invocationCount = 2. + ! testCompileSymbolAction @@ -353,21 +341,19 @@ ! testCompileTokenStarMessagePredicate - - tree := PPCTokenStarMessagePredicateNode new message: #isLetter. - parser := self compileTree: tree params: {#guards -> false}. - - self assert: parser class methodDictionary size = 2. - - self assert: parser parse: 'foo' to: parser. - self assert: context invocationCount = 2. - self assert: context lwRememberCount = 0. - self assert: context lwRestoreCount = 0. - self assert: context rememberCount = 0. - - self assert: parser parse: 'foo123' to: parser end: 3. - - "Modified: / 30-10-2014 / 23:50:32 / Jan Vrany " + + tree := PPCTokenStarMessagePredicateNode new message: #isLetter. + parser := self compileTree: tree params: {#guards -> false}. + + self assert: parser class methods size = 2. + + self assert: parser parse: 'foo' to: parser. + self assert: context invocationCount = 2. + self assert: context lwRememberCount = 0. + self assert: context lwRestoreCount = 0. + self assert: context rememberCount = 0. + + self assert: parser parse: 'foo123' to: parser end: 3. ! ! !PPCNodeCompilingTest methodsFor:'tests - guard'! diff -r 5389e6fbb3bc -r 0eaf09920532 compiler/tests/stx_goodies_petitparser_compiler_tests.st --- a/compiler/tests/stx_goodies_petitparser_compiler_tests.st Wed Nov 05 21:40:01 2014 +0000 +++ b/compiler/tests/stx_goodies_petitparser_compiler_tests.st Wed Nov 05 23:05:19 2014 +0000 @@ -14,16 +14,16 @@ "The last merged version is: " ^ ' - Name: PetitCompiler-Tests-JanKurs.4 - Author: JanKurs - Time: 25-10-2014, 03:30:58 AM - UUID: 3e798fad-d5f6-4881-a583-f0bbffe27869 + Name: PetitCompiler-Tests-JanVrany.13 + Author: JanVrany + Time: 05-11-2014, 09:31:07 AM + UUID: 189ae287-6bc1-40ba-8458-b8392c4260a0 Repository: http://smalltalkhub.com/mc/JanKurs/PetitParser/main ' "Created: / 03-10-2014 / 02:27:21 / Jan Vrany " - "Modified: / 26-10-2014 / 01:28:39 / Jan Vrany " + "Modified: / 05-11-2014 / 22:59:26 / Jan Vrany " ! monticelloName diff -r 5389e6fbb3bc -r 0eaf09920532 compiler/tests/tests.rc --- a/compiler/tests/tests.rc Wed Nov 05 21:40:01 2014 +0000 +++ b/compiler/tests/tests.rc Wed Nov 05 23:05:19 2014 +0000 @@ -25,7 +25,7 @@ VALUE "LegalCopyright", "Copyright Claus Gittinger 1988-2014\nCopyright eXept Software AG 1998-2014\0" VALUE "ProductName", "Smalltalk/X\0" VALUE "ProductVersion", "6.2.4.0\0" - VALUE "ProductDate", "Wed, 05 Nov 2014 21:34:06 GMT\0" + VALUE "ProductDate", "Wed, 05 Nov 2014 22:51:10 GMT\0" END END