429 lines
9.9 KiB
Smalltalk
429 lines
9.9 KiB
Smalltalk
Class {
|
|
#name : 'PPCContext',
|
|
#superclass : 'PPStream',
|
|
#instVars : [
|
|
'root',
|
|
'properties',
|
|
'globals',
|
|
'furthestFailure',
|
|
'compiledParser',
|
|
'ws',
|
|
'waterPosition',
|
|
'columns'
|
|
],
|
|
#category : 'PetitCompiler-Context'
|
|
}
|
|
|
|
{ #category : 'as yet unclassified' }
|
|
PPCContext class >> new [
|
|
^ self basicNew initialize
|
|
]
|
|
|
|
{ #category : 'as yet unclassified' }
|
|
PPCContext class >> on: aPPParser stream: aStream [
|
|
^ self basicNew
|
|
initialize;
|
|
root: aPPParser;
|
|
stream: aStream asPetitStream;
|
|
yourself
|
|
]
|
|
|
|
{ #category : 'converting' }
|
|
PPCContext >> asCompiledParserContext [
|
|
^ self
|
|
]
|
|
|
|
{ #category : 'whitespace' }
|
|
PPCContext >> atWs [
|
|
^ position == ws
|
|
]
|
|
|
|
{ #category : 'indentation' }
|
|
PPCContext >> column [
|
|
^ self columns at: (position + 1)
|
|
]
|
|
|
|
{ #category : 'indentation' }
|
|
PPCContext >> columns [
|
|
| column tmpPosition |
|
|
|
|
columns isNil ifTrue: [
|
|
tmpPosition := position.
|
|
columns := Array new: readLimit + 1.
|
|
column := 1.
|
|
|
|
0 to: readLimit do: [ :index |
|
|
position := index.
|
|
self isStartOfLine ifTrue: [ column := 1 ].
|
|
columns at: (index + 1) put: column.
|
|
column := column + 1.
|
|
].
|
|
|
|
position := tmpPosition.
|
|
].
|
|
^ columns
|
|
]
|
|
|
|
{ #category : 'initialization' }
|
|
PPCContext >> compiledParser [
|
|
^ compiledParser
|
|
]
|
|
|
|
{ #category : 'initialization' }
|
|
PPCContext >> compiledParser: anObject [
|
|
compiledParser := anObject
|
|
]
|
|
|
|
{ #category : 'failures' }
|
|
PPCContext >> furthestFailure [
|
|
^ furthestFailure
|
|
]
|
|
|
|
{ #category : 'accessing-globals' }
|
|
PPCContext >> globalAt: aKey [
|
|
"Answer the global property value associated with aKey."
|
|
|
|
^ self globalAt: aKey ifAbsent: [ self error: 'Property not found' ]
|
|
]
|
|
|
|
{ #category : 'accessing-globals' }
|
|
PPCContext >> globalAt: aKey ifAbsent: aBlock [
|
|
"Answer the global property value associated with aKey or, if aKey isn't found, answer the result of evaluating aBlock."
|
|
|
|
^ globals isNil
|
|
ifTrue: [ aBlock value ]
|
|
ifFalse: [ globals at: aKey ifAbsent: aBlock ]
|
|
]
|
|
|
|
{ #category : 'accessing-globals' }
|
|
PPCContext >> globalAt: aKey ifAbsentPut: aBlock [
|
|
"Answer the global property associated with aKey or, if aKey isn't found store the result of evaluating aBlock as new value."
|
|
|
|
^ self globalAt: aKey ifAbsent: [ self globalAt: aKey put: aBlock value ]
|
|
]
|
|
|
|
{ #category : 'accessing-globals' }
|
|
PPCContext >> globalAt: aKey put: anObject [
|
|
"Set the global property at aKey to be anObject. If aKey is not found, create a new entry for aKey and set is value to anObject. Answer anObject."
|
|
|
|
^ (globals ifNil: [ globals := Dictionary new: 1 ])
|
|
at: aKey put: anObject
|
|
]
|
|
|
|
{ #category : 'whitespace' }
|
|
PPCContext >> goUpTo: char [
|
|
[ position < readLimit ] whileTrue: [
|
|
(collection at: position + 1) == char ifTrue: [ position := position + 1. ^ char ] .
|
|
position := position + 1.
|
|
]
|
|
|
|
]
|
|
|
|
{ #category : 'gt' }
|
|
PPCContext >> gtIndentStack: composite [
|
|
<gtInspectorPresentationOrder: 40>
|
|
|
|
composite list
|
|
title: 'Indent Stack';
|
|
display: [ :context | context indentStack contents ]
|
|
]
|
|
|
|
{ #category : 'gt' }
|
|
PPCContext >> gtProperties: composite [
|
|
<gtInspectorPresentationOrder: 40>
|
|
|
|
composite table
|
|
title: 'Properties';
|
|
column: 'Key' evaluated: [ :each | each key printString ];
|
|
column: 'Value' evaluated: [ :each | each value printString ];
|
|
display: [ :node | (node properties ifNil: [ Dictionary new ]) associations ]
|
|
]
|
|
|
|
{ #category : 'accessing-globals' }
|
|
PPCContext >> hasGlobal: aKey [
|
|
"Test if the global property aKey is present."
|
|
|
|
^ globals notNil and: [ globals includesKey: aKey ]
|
|
]
|
|
|
|
{ #category : 'accessing-properties' }
|
|
PPCContext >> hasProperties [
|
|
^ properties isNil not and: [ properties isEmpty not ]
|
|
]
|
|
|
|
{ #category : 'accessing-properties' }
|
|
PPCContext >> hasProperty: aKey [
|
|
"Test if the property aKey is present."
|
|
|
|
^ properties notNil and: [ properties includesKey: aKey ]
|
|
]
|
|
|
|
{ #category : 'ruby' }
|
|
PPCContext >> heredocId [
|
|
^ self globalAt: #heredocId ifAbsent: nil
|
|
]
|
|
|
|
{ #category : 'ruby' }
|
|
PPCContext >> heredocId: value [
|
|
self globalAt: #heredocId put: value
|
|
]
|
|
|
|
{ #category : 'memoization' }
|
|
PPCContext >> identifier [
|
|
^ collection
|
|
]
|
|
|
|
{ #category : 'indentation' }
|
|
PPCContext >> indentStack [
|
|
^ self propertyAt: #indentStack ifAbsentPut: [ IndentStack new ]
|
|
]
|
|
|
|
{ #category : 'initialization' }
|
|
PPCContext >> initialize [
|
|
super initialize.
|
|
rc := 0.
|
|
"Note a failure at -1"
|
|
furthestFailure := PPFailure new position: -1; yourself.
|
|
]
|
|
|
|
{ #category : 'initialization' }
|
|
PPCContext >> initializeFor: parser [
|
|
rc := 0.
|
|
root := parser.
|
|
]
|
|
|
|
{ #category : 'accessing-globals' }
|
|
PPCContext >> invoke: parser [
|
|
^ parser parseOn: self
|
|
]
|
|
|
|
{ #category : 'profiling' }
|
|
PPCContext >> islandInvoke [
|
|
]
|
|
|
|
{ #category : 'profiling' }
|
|
PPCContext >> islandMemoHit [
|
|
]
|
|
|
|
{ #category : 'profiling' }
|
|
PPCContext >> islandMemoized [
|
|
]
|
|
|
|
{ #category : 'memoization' }
|
|
PPCContext >> lwRemember [
|
|
|
|
^ position
|
|
]
|
|
|
|
{ #category : 'memoization' }
|
|
PPCContext >> lwRestore: aPPContextMemento [
|
|
|
|
position := aPPContextMemento.
|
|
]
|
|
|
|
{ #category : 'failures' }
|
|
PPCContext >> noteFailure: aPPFailure [
|
|
(aPPFailure position > furthestFailure position)
|
|
ifTrue: [ furthestFailure := aPPFailure ].
|
|
]
|
|
|
|
{ #category : 'accessing-globals' }
|
|
PPCContext >> peek2 [
|
|
position = readLimit ifTrue: [ ^ nil ].
|
|
^ collection at: (position + 1)
|
|
]
|
|
|
|
{ #category : 'ruby' }
|
|
PPCContext >> percentStringEnd [
|
|
^ self globalAt: #percentStringEnd ifAbsent: nil
|
|
]
|
|
|
|
{ #category : 'ruby' }
|
|
PPCContext >> percentStringStart: value [
|
|
| endValue |
|
|
endValue := value.
|
|
(value == $[) ifTrue: [ endValue := $] ].
|
|
(value == $() ifTrue: [ endValue := $) ].
|
|
(value == ${) ifTrue: [ endValue := $} ].
|
|
|
|
self globalAt: #percentStringStart put: value.
|
|
self globalAt: #percentStringEnd put: endValue
|
|
]
|
|
|
|
{ #category : 'accessing-properties' }
|
|
PPCContext >> properties [
|
|
^ properties ifNil: [ properties := Dictionary new ]
|
|
]
|
|
|
|
{ #category : 'accessing-properties' }
|
|
PPCContext >> propertyAt: aKey [
|
|
"Answer the property value associated with aKey."
|
|
|
|
^ self propertyAt: aKey ifAbsent: [ self error: 'Property not found' ]
|
|
]
|
|
|
|
{ #category : 'accessing-properties' }
|
|
PPCContext >> propertyAt: aKey ifAbsent: aBlock [
|
|
"Answer the property value associated with aKey or, if aKey isn't found, answer the result of evaluating aBlock."
|
|
|
|
^ properties isNil
|
|
ifTrue: [ aBlock value ]
|
|
ifFalse: [ properties at: aKey ifAbsent: aBlock ]
|
|
]
|
|
|
|
{ #category : 'accessing-properties' }
|
|
PPCContext >> propertyAt: aKey ifAbsentPut: aBlock [
|
|
"Answer the property associated with aKey or, if aKey isn't found store the result of evaluating aBlock as new value."
|
|
|
|
^ self propertyAt: aKey ifAbsent: [ self propertyAt: aKey put: aBlock value ]
|
|
]
|
|
|
|
{ #category : 'accessing-properties' }
|
|
PPCContext >> propertyAt: aKey put: anObject [
|
|
"Set the property at aKey to be anObject. If aKey is not found, create a new entry for aKey and set is value to anObject. Answer anObject."
|
|
|
|
^ (properties ifNil: [ properties := Dictionary new: 1 ])
|
|
at: aKey put: anObject
|
|
]
|
|
|
|
{ #category : 'memoization' }
|
|
PPCContext >> remember [
|
|
| memento |
|
|
memento := PPCContextMemento new
|
|
position: position;
|
|
yourself.
|
|
|
|
self rememberProperties: memento.
|
|
^ memento
|
|
]
|
|
|
|
{ #category : 'memoization' }
|
|
PPCContext >> rememberProperties: aPPContextMemento [
|
|
properties ifNil: [ ^ self ].
|
|
|
|
properties keysAndValuesDo: [ :key :value |
|
|
aPPContextMemento propertyAt: key put: value
|
|
].
|
|
]
|
|
|
|
{ #category : 'accessing-globals' }
|
|
PPCContext >> removeGlobal: aKey [
|
|
"Remove the property with aKey. Answer the property or raise an error if aKey isn't found."
|
|
|
|
^ self removeGlobal: aKey ifAbsent: [ self error: 'Property not found' ]
|
|
]
|
|
|
|
{ #category : 'accessing-globals' }
|
|
PPCContext >> removeGlobal: aKey ifAbsent: aBlock [
|
|
"Remove the global property with aKey. Answer the value or, if aKey isn't found, answer the result of evaluating aBlock."
|
|
|
|
| answer |
|
|
globals isNil ifTrue: [ ^ aBlock value ].
|
|
answer := globals removeKey: aKey ifAbsent: aBlock.
|
|
globals isEmpty ifTrue: [ globals := nil ].
|
|
^ answer
|
|
]
|
|
|
|
{ #category : 'accessing-properties' }
|
|
PPCContext >> removeProperty: aKey [
|
|
"Remove the property with aKey. Answer the property or raise an error if aKey isn't found."
|
|
|
|
^ self removeProperty: aKey ifAbsent: [ self error: 'Property not found' ]
|
|
]
|
|
|
|
{ #category : 'accessing-properties' }
|
|
PPCContext >> removeProperty: aKey ifAbsent: aBlock [
|
|
"Remove the property with aKey. Answer the value or, if aKey isn't found, answer the result of evaluating aBlock."
|
|
|
|
| answer |
|
|
properties isNil ifTrue: [ ^ aBlock value ].
|
|
answer := properties removeKey: aKey ifAbsent: aBlock.
|
|
properties isEmpty ifTrue: [ properties := nil ].
|
|
^ answer
|
|
]
|
|
|
|
{ #category : 'initialization' }
|
|
PPCContext >> reset [
|
|
properties := nil.
|
|
globals := nil.
|
|
waterPosition := nil.
|
|
ws := nil
|
|
]
|
|
|
|
{ #category : 'memoization' }
|
|
PPCContext >> restore: aPPContextMemento [
|
|
"
|
|
position := aPPContextMemento.
|
|
"
|
|
position := aPPContextMemento position.
|
|
|
|
self restoreProperties: aPPContextMemento.
|
|
|
|
]
|
|
|
|
{ #category : 'memoization' }
|
|
PPCContext >> 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 |
|
|
properties at: key put: value
|
|
]
|
|
]
|
|
|
|
{ #category : 'acessing' }
|
|
PPCContext >> root [
|
|
^ root
|
|
]
|
|
|
|
{ #category : 'whitespace' }
|
|
PPCContext >> setWs [
|
|
^ ws := position
|
|
]
|
|
|
|
{ #category : 'acessing' }
|
|
PPCContext >> stream [
|
|
^ self
|
|
]
|
|
|
|
{ #category : 'acessing' }
|
|
PPCContext >> stream: aStream [
|
|
collection := aStream collection.
|
|
position := aStream position.
|
|
readLimit := collection size.
|
|
newlines := nil.
|
|
columns := nil.
|
|
ws := nil.
|
|
]
|
|
|
|
{ #category : 'islands' }
|
|
PPCContext >> waterPosition [
|
|
"^ self globalAt: #waterPosition ifAbsentPut: [ nil ]"
|
|
^ waterPosition
|
|
]
|
|
|
|
{ #category : 'islands' }
|
|
PPCContext >> waterPosition: value [
|
|
" ^ self globalAt: #waterPosition put: value"
|
|
waterPosition := value
|
|
]
|
|
|
|
{ #category : 'profiling' }
|
|
PPCContext >> waterToken [
|
|
]
|
|
|
|
{ #category : 'whitespace' }
|
|
PPCContext >> ws [
|
|
^ ws
|
|
]
|
|
|
|
{ #category : 'whitespace' }
|
|
PPCContext >> ws: anInteger [
|
|
ws := anInteger
|
|
]
|