286 lines
6.7 KiB
Smalltalk
286 lines
6.7 KiB
Smalltalk
Class {
|
|
#name : 'PPProfilingContext',
|
|
#superclass : 'PPContext',
|
|
#instVars : [
|
|
'invocations',
|
|
'totalSize',
|
|
'positions',
|
|
'parsers',
|
|
'events',
|
|
'fEvents',
|
|
'fPositions',
|
|
'fParsers',
|
|
'colors',
|
|
'lastStreamIndex'
|
|
],
|
|
#category : 'PetitCompiler-Context'
|
|
}
|
|
|
|
{ #category : 'converting' }
|
|
PPProfilingContext >> asEventMorph [
|
|
^ self asEventMorph: events asIdentitySet asArray
|
|
]
|
|
|
|
{ #category : 'converting' }
|
|
PPProfilingContext >> asEventMorph: eventArray [
|
|
| width height canvas morph |
|
|
|
|
fPositions := OrderedCollection new.
|
|
fEvents := OrderedCollection new.
|
|
fParsers := OrderedCollection new.
|
|
"for the last stream only"
|
|
|
|
((lastStreamIndex + 1) to: events size) do: [ :index | | e |
|
|
e := events at: index.
|
|
(eventArray includes: e) ifTrue: [
|
|
fPositions addLast: (self positions at: index).
|
|
fParsers addLast: (self parsers at: index).
|
|
fEvents addLast: e.
|
|
]
|
|
].
|
|
|
|
|
|
width := self stream size + 1 min: 4096.
|
|
height := fPositions size min: 32768.
|
|
canvas := FormCanvas extent: width @ height.
|
|
|
|
self contents keysAndValuesDo: [ :index :char |
|
|
char isSeparator
|
|
ifFalse: [ canvas line: index @ 1 to: index @ height color: Color paleYellow lighter ] ].
|
|
|
|
|
|
1 to: height do: [ :index |
|
|
canvas form
|
|
colorAt: (fPositions at: index) @ index
|
|
put: (self colorForEvent: (fEvents at: index)) ].
|
|
morph := canvas form asMorph.
|
|
|
|
morph on: #mouseMove
|
|
send: #mouseDown:with:
|
|
to: self.
|
|
^ morph
|
|
]
|
|
|
|
{ #category : 'converting' }
|
|
PPProfilingContext >> asFrequencyTable [
|
|
| bag total result |
|
|
bag := parsers asBag.
|
|
result := OrderedCollection new.
|
|
bag isEmpty ifTrue: [ ^ result ].
|
|
total := 100.0 / bag size.
|
|
bag sortedCounts
|
|
do: [ :each | result addLast: (Array with: each value with: each key with: total * each key) ].
|
|
^ result
|
|
]
|
|
|
|
{ #category : 'converting' }
|
|
PPProfilingContext >> asReportTable [
|
|
^ {
|
|
#'backtrack per character' -> (self restoreCount / (self totalSize + 1.0)).
|
|
#'total stream size' -> self streamSize.
|
|
#'remember count' -> self rememberCount.
|
|
#'restore count' -> self restoreCount.
|
|
}
|
|
]
|
|
|
|
{ #category : 'converting' }
|
|
PPProfilingContext >> colorForEvent: event [
|
|
| eventSet |
|
|
colors isNil ifTrue: [
|
|
eventSet := events asIdentitySet asArray.
|
|
colors := RTMultiLinearColorForIdentity new objects: eventSet.
|
|
].
|
|
^ colors rtValue: event
|
|
|
|
" event == #islandInvoke ifTrue: [ ^ Color purple lighter ].
|
|
event == #islandMemoized ifTrue: [ ^ Color red lighter ].
|
|
event == #islandMemoHit ifTrue: [ ^ Color green darker ].
|
|
event == #waterToken ifTrue: [ ^ Color blue ].
|
|
event == #remember ifTrue: [ ^ Color green ].
|
|
event == #restore ifTrue: [ ^ Color red ].
|
|
^ Color yellow."
|
|
]
|
|
|
|
{ #category : 'reporting' }
|
|
PPProfilingContext >> countFor: event [
|
|
^ (events asBag select: [ :e | e == event ]) size
|
|
]
|
|
|
|
{ #category : 'private' }
|
|
PPProfilingContext >> event: value [
|
|
positions addLast: self position.
|
|
parsers addLast: self parser.
|
|
events addLast: value.
|
|
]
|
|
|
|
{ #category : 'accessing' }
|
|
PPProfilingContext >> events [
|
|
^ events
|
|
]
|
|
|
|
{ #category : 'gt' }
|
|
PPProfilingContext >> eventsIn: composite [
|
|
<gtInspectorPresentationOrder: 30>
|
|
composite morph
|
|
title: 'Parsing Events';
|
|
display: [:result :sample :context :parser |
|
|
| morph |
|
|
morph := ScrollPane new.
|
|
morph color: Color white.
|
|
morph scroller addMorph: self asEventMorph.
|
|
morph ]
|
|
]
|
|
|
|
{ #category : 'gt' }
|
|
PPProfilingContext >> gtReport: composite [
|
|
<gtInspectorPresentationOrder: 40>
|
|
composite table
|
|
title: 'Report';
|
|
column: 'Info' evaluated: [ :each | each key printString ];
|
|
column: 'Value' evaluated: [ :each | each value printString ];
|
|
display: [:context | context asReportTable ].
|
|
]
|
|
|
|
{ #category : 'initialization' }
|
|
PPProfilingContext >> initialize [
|
|
super initialize.
|
|
|
|
events := OrderedCollection new.
|
|
positions := OrderedCollection new.
|
|
parsers := OrderedCollection new.
|
|
colors := nil.
|
|
totalSize := 0.
|
|
]
|
|
|
|
{ #category : 'gt' }
|
|
PPProfilingContext >> islandEventsIn: composite [
|
|
<gtInspectorPresentationOrder: 30>
|
|
composite morph
|
|
title: 'Island Events';
|
|
display: [:result :sample :context :parser |
|
|
| morph |
|
|
morph := ScrollPane new.
|
|
morph color: Color white.
|
|
morph scroller addMorph:
|
|
(self asEventMorph: #(#islandInvoke #islandMemoHit #islandMemoized #waterToken)).
|
|
morph ]
|
|
]
|
|
|
|
{ #category : 'events' }
|
|
PPProfilingContext >> islandInvoke [
|
|
self event: #islandInvoke
|
|
]
|
|
|
|
{ #category : 'events' }
|
|
PPProfilingContext >> islandMemoHit [
|
|
self event: #islandMemoHit
|
|
]
|
|
|
|
{ #category : 'events' }
|
|
PPProfilingContext >> islandMemoized [
|
|
self event: #islandMemoized
|
|
]
|
|
|
|
{ #category : 'converting' }
|
|
PPProfilingContext >> mouseDown: anEvent with: aMorph [
|
|
| location event |
|
|
location := anEvent position.
|
|
(location y < fEvents size and: [ location y > 0 ]) ifTrue: [
|
|
event := fEvents at: location y.
|
|
Transcript cr; show: event; show: ': '; show: (fParsers at: location y).
|
|
]
|
|
]
|
|
|
|
{ #category : 'events' }
|
|
PPProfilingContext >> next [
|
|
self event: #step.
|
|
^ super next
|
|
]
|
|
|
|
{ #category : 'events' }
|
|
PPProfilingContext >> next: number [
|
|
self event: #step.
|
|
^ super next: number
|
|
]
|
|
|
|
{ #category : 'private' }
|
|
PPProfilingContext >> parser [
|
|
^ (thisContext findContextSuchThat: [ :ctxt | ctxt receiver isKindOf: PPParser ])
|
|
ifNil: [ nil ]
|
|
ifNotNil: [ :aContext | aContext receiver ].
|
|
]
|
|
|
|
{ #category : 'accessing' }
|
|
PPProfilingContext >> parsers [
|
|
^ parsers
|
|
]
|
|
|
|
{ #category : 'accessing' }
|
|
PPProfilingContext >> positions [
|
|
^ positions
|
|
]
|
|
|
|
{ #category : 'events' }
|
|
PPProfilingContext >> remember [
|
|
self event: #remember.
|
|
^ super remember
|
|
]
|
|
|
|
{ #category : 'reporting' }
|
|
PPProfilingContext >> rememberCount [
|
|
^ (events asBag select: [ :e | e == #remember ]) size
|
|
]
|
|
|
|
{ #category : 'initialization' }
|
|
PPProfilingContext >> reset [
|
|
super reset
|
|
|
|
]
|
|
|
|
{ #category : 'events' }
|
|
PPProfilingContext >> restore: whatever [
|
|
self event: #restore.
|
|
^ super restore: whatever
|
|
]
|
|
|
|
{ #category : 'reporting' }
|
|
PPProfilingContext >> restoreCount [
|
|
^ (events asBag select: [ :e | e == #restore ]) size
|
|
]
|
|
|
|
{ #category : 'accessing' }
|
|
PPProfilingContext >> stream: aStream [
|
|
totalSize := totalSize + aStream size.
|
|
lastStreamIndex := events size.
|
|
^ super stream: aStream
|
|
]
|
|
|
|
{ #category : 'accessing' }
|
|
PPProfilingContext >> streamSize [
|
|
^ stream size
|
|
]
|
|
|
|
{ #category : 'gt' }
|
|
PPProfilingContext >> tallyIn: composite [
|
|
<gtInspectorPresentationOrder: 30>
|
|
|
|
composite table
|
|
title: 'Tally';
|
|
column: 'Parser' evaluated: [ :each | each first displayName ];
|
|
column: 'Count' evaluated: [ :each | each second printString ];
|
|
column: 'Percentage (%)' evaluated: [ :each | each third printString ];
|
|
display: [ self asFrequencyTable ];
|
|
noSelection;
|
|
showOnly: 50
|
|
]
|
|
|
|
{ #category : 'accessing' }
|
|
PPProfilingContext >> totalSize [
|
|
^ totalSize
|
|
]
|
|
|
|
{ #category : 'events' }
|
|
PPProfilingContext >> waterToken [
|
|
self event: #waterToken
|
|
]
|