[Cuis] Brainstorming question: what non-trivial uses can you think of for an object-based parser? (strings not invited)
Edgar J. De Cleene
edgardec2005 at gmail.com
Fri May 22 01:57:05 CDT 2015
On 5/22/15, 1:49 AM, "Phil (list)" <pbpublist at gmail.com> wrote:
> So forgetting about all applications involving strings, what real world
> uses can you think of where an object parser might come in handy? You
> have all of the capabilities that a parser brings to bear in terms of
> pattern matching and being able to speculatively introspect objects in
> its search, but on any arbitrary collection or stream of objects. Keep
> in mind that anything coming in over the wire (i.e. network) has already
> been serialized so reconstituting it as an object graph seems
> inefficient and of questionable value if the sole purpose in doing so is
> to perform a task you could have easily done in it's default text/binary
> form... but maybe I'm looking at it wrong.
I using a serialized ReferenceStream saved as .obj which I use for forced
compatibility between Squeak. Pharo and Cuis.
Works for roughly compatible classes,
But we could use to map objects between forks.
See the attached for Squeak 4.6.
I use the SqueakLight idea of Object lookForClass: for not enough smart DNU
look in a class repository which could be created in Dropbox or Git or
whatever external place for any fork.
See
http://squeakros.org/4dot6
http://squeakros.org/4dot5
http://squeakros.org/4dot4
http://squeakros.org/3dot10
http://squeakros.org/3dot9
http://squeakros.org/3dot8
http://squeakros.org/Pharo2dot0
Combining this rough idea with OMeta think maybe could made smart
export/import between forks.
Edgar
-------------- next part --------------
'From SqueakRosCore4dot5 of 20 May 2013 [latest update: #12550] on 26 April 2015 at 4:25:41 pm'!
!Object methodsFor: 'error handling' stamp: 'edc 7/31/2008 06:39'!
dpsTraceUntilRoot: anObject
| reportString context count |
Transcript open.
reportString := (anObject respondsTo: #asString)
ifTrue: [anObject asString] ifFalse: [anObject printString].
(Smalltalk at: #Decompiler ifAbsent: [nil])
ifNil:
[Transcript cr; show: reportString]
ifNotNil:
[context := thisContext.
count := 1.
[Transcript cr.
Transcript show: count printString, ': '.
reportString notNil
ifTrue:
[Transcript show: context home class name
, '/' , context sender selector, ' (' , reportString , ')'.
context := context sender.
reportString := nil]
ifFalse:
[(context notNil and: [(context := context sender) notNil])
ifTrue: [Transcript show: context receiver class name , '/' , context selector.
count := count + 1]].
context sender notNil]whileTrue]! !
!Object methodsFor: 'evaluating' stamp: 'edc 7/18/2005 10:51'!
ancestors
| nonMetaClass classList |
nonMetaClass := self theNonMetaClass.
classList := OrderedCollection new.
nonMetaClass allSuperclasses reverseDo:
[:aClass |
classList add: aClass name.
].
^ classList! !
!Object methodsFor: 'evaluating' stamp: 'edc 7/18/2005 10:51'!
othersClassList
|classList metodosSospechosos |
classList := Set new.
metodosSospechosos := self methodDict .
metodosSospechosos isEmpty
ifFalse: [metodosSospechosos
collect: [:cm | cm literals
select: [:any | any isVariableBinding]
thenCollect: [:each | (Smalltalk at: each key ifAbsent:[])
ifNotNil: [ classList add: each key]]]].
metodosSospechosos := self class methodDict .
metodosSospechosos isEmpty
ifFalse: [metodosSospechosos
collect: [:cm | cm literals
select: [:any | any isVariableBinding]
thenCollect: [:each | (Smalltalk at: each key ifAbsent:[])
ifNotNil: [classList add: each key]]]].
classList remove: self name ifAbsent: [].
^classList
! !
!Object methodsFor: 'objects from disk' stamp: 'edc 9/6/2008 19:40'!
fileOutCompressed
| unzipped zipped buffer aFileName |
aFileName := self class name asFileName. "do better?"
aFileName := UIManager default
request: 'File name?' translated initialAnswer: aFileName.
aFileName size == 0 ifTrue: [^ Beeper beep].
Cursor write
showWhile: [unzipped := RWBinaryOrTextStream on: ''.
unzipped fileOutClass: nil andObject: self.
unzipped reset.
zipped := FileDirectory default newFileNamed: aFileName , 'obz'.
zipped binary.
zipped := GZipWriteStream on: zipped.
buffer := ByteArray new: 50000.
'Compressing ' , self name
displayProgressAt: Sensor cursorPoint
from: 0
to: unzipped size
during: [:bar |
[unzipped atEnd]
whileFalse: [bar value: unzipped position.
zipped
nextPutAll: (unzipped nextInto: buffer)].
zipped close.
unzipped close]]! !
!Object methodsFor: 'objects from disk' stamp: 'edc 6/20/2011 11:41'!
saveOnFileNamed: aString
"Ask the user for a filename and save myself on a
SmartReferenceStream file. Writes out the version and class structure.
The file is fileIn-able. UniClasses will be filed out.
This save objects as .obj"
| aFileName fileStream |
aString isEmpty
ifTrue: [^ self error: 'name is missing'].
aFileName := aString , '.obj'.
fileStream := ReferenceStream fileNamed: aFileName .
fileStream nextPut: self.
fileStream close.
! !
!Object methodsFor: 'sources managment' stamp: 'edc 2/12/2008 07:43'!
createDirIfnotExists: aDirName
(FileDirectory default directoryExists:aDirName)
ifFalse: [FileDirectory default createDirectory: aDirName].
^FileDirectory default directoryNamed: aDirName! !
!Object methodsFor: 'sources managment' stamp: 'edc 10/4/2014 02:32'!
createSources
" Object new createSources"
| unzipped nameToUse zipped dir |
ProtoObject allSubclassesWithLevelDo:[:cl :l|
dir := self createDirIfnotExists:cl category asString.
Cursor write showWhile: [nameToUse := cl printString, FileDirectory dot,'.st' .
(dir fileExists: nameToUse) ifFalse:[
unzipped :=RWBinaryOrTextStream on: ''.
unzipped header; timeStamp.
cl fileOutOn: unzipped moveSource: false toFile: 0.
unzipped trailer.
unzipped reset.
zipped := dir newFileNamed: nameToUse.
zipped close.
unzipped close]]] startingLevel: 0! !
!Object methodsFor: 'sources managment' stamp: 'edc 4/25/2015 10:06'!
organizerExport
"Object organizerExport"
| obj |
obj := Dictionary new.
ProtoObject
allSubclassesDoGently: [:cl | (cl name endsWith: 'class' ) ifFalse:[
obj at: cl name put: cl category]].
self saveOnFileNamed: 'Organizer4dot6'
! !
!FileContentsBrowser methodsFor: 'accessing' stamp: 'edc 4/26/2015 09:03'!
systemOrganizer
^ systemOrganizer! !
!Object class methodsFor: 'instance creation' stamp: 'edc 4/26/2015 08:42'!
lookForClass: aClass
| path inputStream fcb superPseudo pseudo cat |
Missing4dot6
ifNil: [inputStream := ( FileStream oldFileNamed: '/Users/edgardecleene/Dropbox/SqueakRos/4dot6/Organizer4dot6.obj') binary.
Smalltalk at: #Missing4dot6 put: (self readObject: inputStream) ].
cat := Missing4dot6
at: aClass
ifAbsent: [self error].
path := '/Users/edgardecleene/Dropbox/SqueakRos/4dot6/' , cat , '/' , aClass asString , '.st'.
FileContentsBrowser browseFileL: path.
inputStream := (FileStream oldFileNamed: path ) contentsOfEntireFile .
fcb := FilePackage new fullName: aClass;
fileInFrom: (ReadWriteStream with: inputStream contents).
pseudo := fcb classes at: aClass.
superPseudo := pseudo definition copyUpTo: Character space.
Smalltalk
at: superPseudo asSymbol
ifAbsent: [self lookForClass: superPseudo].
self halt
! !
!Object class methodsFor: 'objects from disk' stamp: 'edc 7/1/2011 10:17'!
readAndInspect: inputStream
| o rr |
rr _ ReferenceStream on: inputStream.
o _ rr next.
rr close.
o inspect! !
!Object class methodsFor: 'objects from disk' stamp: 'edc 1/10/2014 10:16'!
readObject: inputStream
| o rr |
rr _ ReferenceStream on: inputStream.
o _ rr next.
rr close.
^o! !
!Object class methodsFor: '*services-extras' stamp: 'edc 2/14/2008 08:24'!
fileReaderServicesForFile: fullName suffix: suffix
| services |
services _ OrderedCollection new.
(fullName asLowercase endsWith: '.obj')
ifTrue: [ services add: self serviceLoadObject ].
^services! !
!Object class methodsFor: '*services-extras' stamp: 'edc 7/27/2008 08:11'!
readCompressedObject: aFileStream
self readAndInspect: (MultiByteBinaryOrTextStream with: (GZipReadStream on: aFileStream) upToEnd) reset! !
!Object class methodsFor: '*services-extras' stamp: 'edc 7/27/2008 07:40'!
serviceCompressedObject
"Answer a service for opening a saved Object"
^ (SimpleServiceEntry
provider: Object
label: 'gz saved Object'
selector: #readCompressedObject:
description: 'open a gz Object'
buttonLabel: 'object')
argumentGetter: [:fileList |
fileList readOnlyStream]! !
!Object class methodsFor: '*services-extras' stamp: 'edc 2/14/2008 08:26'!
serviceLoadObject
"Answer a service for opening a saved Object"
^ (SimpleServiceEntry
provider: self
label: 'saved Object'
selector: #readAndInspect:
description: 'open a Object'
buttonLabel: 'object')
argumentGetter: [:fileList | fileList readOnlyStream]! !
!FileContentsBrowser class methodsFor: 'instance creation' stamp: 'edc 4/26/2015 08:42'!
browseFileL: aFilename
"Open a file contents browser on a file of the given name"
aFilename ifNil: [^ Beeper beep].
self browseFilesL: (Array with: aFilename)! !
!FileContentsBrowser class methodsFor: 'instance creation' stamp: 'edc 4/26/2015 16:21'!
browseFilesL: fileList
| browser cl myPackage cat realClass exCat oldCat |
Cursor wait showWhile: [ | organizer packageDict |
packageDict := Dictionary new.
organizer := SystemOrganizer defaultList: Array new.
fileList do: [:fileName | | package |
package := FilePackage fromFileNamed: fileName.
packageDict
at: package packageName
put: package.
organizer
classifyAll: package classes keys
under: package packageName].
(browser := self systemOrganizer: organizer)
packages: packageDict].
browser removeUnmodifiedMethods.
myPackage := browser packages at: browser packages keys first.
cl := myPackage classes at: myPackage classes keys first.
exCat := cl organization categories .
realClass := Smalltalk at: cl name.
oldCat := realClass organization categories .
self halt.
Transcript clear.
cl selectorsDo:[:selector| cat := cl whichCategoryIncludesSelector: selector.
MCMcmUpdater skipPackages do: [:packageName |
(cat includesSubString: packageName ) ifTrue: [Transcript show: cat;cr.
cl removeMethod: selector
]]].
self halt.
! !
!FilePackage reorganize!
('*monticello' classDefinition:with: doIts)
('accessing' classAt: classes fixClassOrder fullName: fullPackageName packageInfo packageName removeClass: removeDoIts renameClass:to:)
('change record types' classComment: doIt: method: preamble:)
('conflict checker' checkForMoreRecentUpdateThanChangeSet:pseudoClass:selector: conflictsWithUpdatedMethods findUpdateChangeSetMatching:)
('fileIn/fileOut' askForDoits fileIn fileInDoits fileOut fileOutDoits: fileOutOn:)
('initialize' fromFileNamed: fromFileNamed:encoding: initialize)
('reading' fileInFrom: fromStream:named:)
('private' getClass: metaClassDefinition:with: msgClassComment:with: possibleSystemSource: removedMethod:with: sampleMethod)
!
!Object reorganize!
('*Etoys-tiles')
('*Etoys-viewer')
('*Morphic-Explorer' hasContentsInExplorer)
('*MorphicExtras-PartsBin' descriptionForPartsBin)
('*MorphicExtras-Undo' capturedState commandHistory purgeAllCommands redoFromCapturedState: refineRedoTarget:selector:arguments:in: refineUndoTarget:selector:arguments:in: rememberCommand: rememberUndoableAction:named: undoFromCapturedState:)
('*Protocols')
('*Tools-Debugger' canonicalArgumentName)
('*Tools-Explorer' exploreAndYourself exploreWithLabel:)
('*Tools-MessageSets' browseAllCallsOn: browseAllImplementorsOf:)
('*Tools-multi-window support' canHaveUnacceptedEdits)
('*monticello' isConflict)
('*morphic' asDraggableMorph asMorph asStringMorph asTextMorph openAsMorph)
('*services-base')
('*system-support' oopAge oopTimestamp systemNavigation)
('*tools-browser' browse browseHierarchy)
('*universes')
('accessing' addInstanceVarNamed:withValue: at: at:modify: at:put: basicAddInstanceVarNamed:withValue: basicAt: basicAt:put: basicSize bindWithTemp: enclosedSetElement ifNil:ifNotNilDo: ifNotNilDo: ifNotNilDo:ifNil: in: presenter readFromString: size yourself)
('associating' ->)
('binding' bindingOf:)
('breakpoint' break)
('casing' caseOf: caseOf:otherwise:)
('class membership' class inheritsFromAnyIn: isKindOf: isKindOf:orOf: isMemberOf: respondsTo: xxxClass)
('comparing' closeTo: hash identityHashPrintString literalEqual: = ~=)
('converting' adaptToFloat:andCompare: adaptToFloat:andSend: adaptToFraction:andCompare: adaptToFraction:andSend: adaptToInteger:andCompare: adaptToInteger:andSend: adaptToScaledDecimal:andCompare: asActionSequence asActionSequenceTrappingErrors asOrderedCollection asSetElement asString asStringOrText as: complexContents mustBeBoolean mustBeBooleanIn: printDirectlyToDisplay withoutListWrapper)
('copying' clone copy copyAddedStateFrom: copyFrom: copySameFrom: copyTwoLevel deepCopy initialDeepCopierSize postCopy shallowCopy veryDeepCopy veryDeepCopySibling veryDeepCopyUsing: veryDeepCopyWith: veryDeepFixupWith: veryDeepInner:)
('debugging' haltIf: needsWork)
('debugging-haltOnce' checkHaltCountExpired clearHaltOnce decrementAndCheckHaltCount decrementHaltCount doExpiredHaltCount doExpiredHaltCount: doExpiredInspectCount haltOnCount: haltOnce haltOnceEnabled haltOnce: halt:onCount: hasHaltCount inspectOnCount: inspectOnce inspectUntilCount: removeHaltCount setHaltCountTo: setHaltOnce toggleHaltOnce)
('dependents access' addDependent: breakDependents canDiscardEdits dependents evaluate:wheneverChangeIn: hasUnacceptedEdits myDependents myDependents: release removeDependent:)
('drag and drop' acceptDroppingMorph:event:inMorph: dragAnimationFor:transferMorph: dragPassengerFor:inMorph: dragTransferType dragTransferTypeForMorph: wantsDroppedMorph:event:inMorph:)
('error handling' assert: assert:descriptionBlock: assert:description: backwardCompatibilityOnly: caseError confirm: confirm:orCancel: deprecated: deprecated:block: doesNotUnderstand: dpsTrace: dpsTrace:levels: dpsTrace:levels:withContext: dpsTraceUntilRoot: error error: explicitRequirement halt halt: handles: notifyWithLabel: notify: notify:at: primitiveFailed primitiveFailed: requirement shouldBeImplemented shouldNotImplement subclassResponsibility traitConflict)
('evaluating' ancestors othersClassList value valueWithArguments:)
('events' actionsWithReceiver:forEvent: renameActionsWithReceiver:forEvent:toEvent:)
('events-accessing' actionForEvent: actionForEvent:ifAbsent: actionMap actionSequenceForEvent: actionsDo: createActionMap hasActionForEvent: setActionSequence:forEvent: updateableActionMap)
('events-registering' when:evaluate: when:send:to: when:send:to:withArguments: when:send:to:with:)
('events-removing' releaseActionMap removeActionsForEvent: removeActionsSatisfying: removeActionsSatisfying:forEvent: removeActionsWithReceiver: removeActionsWithReceiver:forEvent: removeAction:forEvent:)
('events-triggering' triggerEvent: triggerEvent:ifNotHandled: triggerEvent:withArguments: triggerEvent:withArguments:ifNotHandled: triggerEvent:with: triggerEvent:with:ifNotHandled:)
('filter streaming' byteEncode: drawOnCanvas: elementSeparator encodePostscriptOn: flattenOnStream: fullDrawPostscriptOn: putOn: writeOnFilterStream:)
('finalization' actAsExecutor executor finalizationRegistry finalize hasMultipleExecutors retryWithGC:until: toFinalizeSend:to:with:)
('flagging' isThisEverCalled isThisEverCalled: logEntry logExecution logExit)
('futures' future future: futureDo:at:args: futureSend:at:args:)
('graph model' addModelYellowButtonMenuItemsTo:forMorph:hand: hasModelYellowButtonMenuItems)
('inspecting' basicInspect inspect inspectorClass)
('locales' localeChanged)
('macpal' codeStrippedOut: contentsChanged currentEvent currentHand currentWorld flash instanceVariableValues isUniversalTiles objectRepresented refusesToAcceptCode scriptPerformer slotInfo)
('message handling' executeMethod: perform: perform:orSendTo: perform:with:with:with:with: perform:withArguments: perform:withArguments:inSuperclass: perform:withEnoughArguments: perform:with: perform:with:with: perform:with:with:with: withArgs:executeMethod: with:executeMethod: with:with:executeMethod: with:with:with:executeMethod: with:with:with:with:executeMethod:)
('objects from disk' comeFullyUpOnReload: convertToCurrentVersion:refStream: fileOutCompressed fixUponLoad:seg: indexIfCompact objectForDataStream: readDataFrom:size: saveOnFile saveOnFileNamed: storeDataOn:)
('printing' fullPrintString isLiteral longPrintOn: longPrintOn:limitedTo:indent: longPrintString longPrintStringLimitedTo: nominallyUnsent: printOn: printString printStringLimitedTo: printWithClosureAnalysisOn: reportableSize storeOn: storeString stringForReadout stringRepresentation)
('scripting' adaptedToWorld: defaultFloatPrecisionFor: evaluateUnloggedForSelf: methodInterfacesForCategory:inVocabulary:limitClass: methodInterfacesForInstanceVariablesCategoryIn: methodInterfacesForScriptsCategoryIn: selfWrittenAsIll selfWrittenAsIm selfWrittenAsMe selfWrittenAsMy selfWrittenAsThis)
('sources managment' createDirIfnotExists: createSources organizerExport)
('system primitives' asOop becomeForward: becomeForward:copyHash: className creationStamp instVarAt: instVarAt:put: instVarNamed: instVarNamed:put: oopString primitiveChangeClassTo: rootStubInImageSegment: someObject)
('testing' beViewed belongsToUniClass costumes haltIfNil hasLiteralSuchThat: isArray isBehavior isBlock isCharacter isClosure isCollection isColor isColorForm isCompiledMethod isComplex isContext isDictionary isFloat isForm isFraction isHeap isInteger isInterval isMessageSend isMethodContext isMethodProperties isMorph isMorphicEvent isMorphicModel isNumber isPlayer isPoint isPrimitiveCostume isPseudoContext isRectangle isScriptEditorMorph isSketchMorph isStream isString isSymbol isSystemWindow isText isTextView isTrait isTransparent isVariableBinding isWebBrowser isWindowForModel: knownName name nameForViewer notNil renameInternal: renameTo: shouldBePrintedAsLiteral shouldBePrintedAsLiteralVisiting: showDiffs stepAt:in: stepIn: stepTime stepTimeIn: vocabularyDemanded wantsDiffFeedback wantsSteps wantsStepsIn:)
('thumbnail' iconOrThumbnailOfSize:)
('tracing' chasePointers explorePointers inboundPointers inboundPointersExcluding: outboundPointers outboundPointersDo:)
('updating' changed changed: changed:with: handledListVerification noteSelectionIndex:for: okToChange okToClose updateListsAndCodeIn: update: update:with: windowIsClosing)
('user interface' addModelItemsToWindowMenu: addModelMenuItemsTo:forMorph:hand: asExplorerString defaultBackgroundColor defaultLabelForInspector eToyStreamedRepresentationNotifying: explore fullScreenSize inform: initialExtent inspectWithLabel: launchPartVia: launchPartVia:label: launchTileToRefer modelSleep modelWakeUp modelWakeUpIn: mouseUpBalk: notYetImplemented windowActiveOnFirstClick windowReqNewLabel:)
('private' errorImproperStore errorNonIntegerIndex errorNotIndexable errorSubscriptBounds: primitiveError: species storeAt:inTempFrame:)
!
More information about the Cuis
mailing list