Skip to content

Commit

Permalink
traces generation for Smalltalk classes
Browse files Browse the repository at this point in the history
  • Loading branch information
@tomooda
tomooda committed May 21, 2024
1 parent 398803b commit d8c5ad0
Show file tree
Hide file tree
Showing 6 changed files with 233 additions and 172 deletions.
6 changes: 6 additions & 0 deletions repository/ViennaTalk-AST-Core/ViennaFlatDocumentNode.class.st
View file
Original file line number Diff line number Diff line change
Expand Up @@ -90,6 +90,12 @@ ViennaFlatDocumentNode >> findResolverForIdentifier: aString [
^ (self lookupIdentifier: aString) ifNotNil: [ self ]
]

{ #category : 'testing' }
ViennaFlatDocumentNode >> hasStateDefinition [

^ self anySatisfy: #isViennaStateDefinitionNode
]

{ #category : 'testing' }
ViennaFlatDocumentNode >> isViennaFlatDocumentNode [

Expand Down
14 changes: 9 additions & 5 deletions repository/ViennaTalk-AST-Core/ViennaStateDefinitionNode.class.st
View file
Original file line number Diff line number Diff line change
Expand Up @@ -104,11 +104,15 @@ ViennaStateDefinitionNode >> formatWith: aViennaAbstractFormatter [
{ #category : 'private' }
ViennaStateDefinitionNode >> freeIdentifiersExcept: aSet do: aBlock [

self fieldList freeIdentifiersExcept: aSet do: aBlock.
self inv ifNotNil: [ :inv |
inv freeIdentifiersExcept: aSet do: aBlock ].
self init ifNotNil: [ :init |
init freeIdentifiersExcept: aSet do: aBlock ]
| withConstructor |
withConstructor := aSet copy
add: self identifier;
yourself.
self fieldList freeIdentifiersExcept: aSet do: aBlock.
self inv ifNotNil: [ :inv |
inv freeIdentifiersExcept: withConstructor do: aBlock ].
self init ifNotNil: [ :init |
init freeIdentifiersExcept: withConstructor do: aBlock ]
]

{ #category : 'testing' }
Expand Down
2 changes: 1 addition & 1 deletion repository/ViennaTalk-Parser-UI/ViennaLiveTranslationEditor.class.st
View file
Original file line number Diff line number Diff line change
Expand Up @@ -204,7 +204,7 @@ ViennaLiveTranslationEditor >> viennaItIn: aTextModel [
parser := ViennaVDMParser new.
codeFromSource := targetText text asString.
aTextModel withAdapterDo: [ :a |
a widgetDo: [ :widget | editor := widget widget textMorph editor ] ].
a widgetDo: [ :widget | editor := widget textMorph editor ] ].
editor lineSelectAndEmptyCheck: [ ^ '' ].
ast := parser expression end / parser statement end / parser type end
parse: (aTextModel text asString
Expand Down
235 changes: 130 additions & 105 deletions repository/ViennaTalk-Transpiler-Core/ViennaVDM2Smalltalk.class.st
View file
Original file line number Diff line number Diff line change
Expand Up @@ -253,14 +253,21 @@ ViennaVDM2Smalltalk >> blockStatement: aViennaNode env: aDictionary [

{ #category : 'code generation-statements' }
ViennaVDM2Smalltalk >> callStatement: aViennaNode env: aDictionary [
| callee args |
callee := self generate: aViennaNode first env: aDictionary.
args := self generate: aViennaNode second env: aDictionary.
^ args
ifEmpty: [ callee , ' value' ]
ifNotEmpty: [ args size <= 4
ifTrue: [ callee , ' value: ' , (' value: ' join: args) ]
ifFalse: [ callee , 'valueWithArguments: {' , (' . ' join: args) , '}' ] ]

| callee args |
callee := self
generate: aViennaNode name
env: aDictionary.
args := self
generate: aViennaNode expressionList
env: aDictionary.
^ args ifEmpty: [ callee , ' value' ] ifNotEmpty: [
args size <= 4
ifTrue: [
callee , ' value: ' , (' value: ' join: args) ]
ifFalse: [
callee , 'valueWithArguments: {'
, (' . ' join: args) , '}' ] ]
]

{ #category : 'code generation-expressions' }
Expand Down Expand Up @@ -2690,27 +2697,31 @@ ViennaVDM2Smalltalk >> recordTypeDefinition: aViennaNode env: aDictionary [
{ #category : 'private' }
ViennaVDM2Smalltalk >> reorderDefinitions: aCollectionOfViennaNode [

| originalDefs boundVars freeVars newDefs |
aCollectionOfViennaNode size <= 1 ifTrue: [
^ aCollectionOfViennaNode ].
originalDefs := Array withAll: aCollectionOfViennaNode.
boundVars := (originalDefs collect: [ :def |
def -> def uniqueBoundIdentifiers ]) asDictionary.
freeVars := (originalDefs collect: [ :def |
def -> def uniqueFreeIdentifiers ]) asDictionary.
newDefs := OrderedCollection new: originalDefs size.
[ originalDefs notEmpty ] whileTrue: [
| allBoundVars index |
allBoundVars := Set new: 1024.
originalDefs do: [ :def | allBoundVars addAll: (boundVars at: def) ].
index := (1 to: originalDefs size)
detect: [ :i |
((freeVars at: (originalDefs at: i)) contains: [ :var |
allBoundVars includes: var ]) not ]
ifNone: [ ^ self error: 'Cyclic definition' ].
newDefs add: (originalDefs at: index).
originalDefs := originalDefs copyWithoutIndex: index ].
^ newDefs asArray
| originalDefs boundVars freeVars newDefs |
aCollectionOfViennaNode size <= 1 ifTrue: [
^ aCollectionOfViennaNode ].
originalDefs := Array withAll: aCollectionOfViennaNode.
boundVars := (originalDefs collect: [ :def |
def -> def uniqueBoundIdentifiers ])
asDictionary.
freeVars := (originalDefs collect: [ :def |
def -> def uniqueFreeIdentifiers ])
asDictionary.
newDefs := OrderedCollection new: originalDefs size.
[ originalDefs notEmpty ] whileTrue: [
| allBoundVars index |
allBoundVars := Set new: 1024.
originalDefs do: [ :def |
allBoundVars addAll: (boundVars at: def) ].
index := (1 to: originalDefs size)
detect: [ :i |
((freeVars at: (originalDefs at: i))
contains: [ :var |
allBoundVars includes: var ]) not ]
ifNone: [ ^ self error: 'Cyclic definition' ].
newDefs add: (originalDefs at: index).
originalDefs := originalDefs copyWithoutIndex: index ].
^ newDefs asArray
]

{ #category : 'code generation-expressions' }
Expand Down Expand Up @@ -3133,75 +3144,86 @@ ViennaVDM2Smalltalk >> source: aString [
{ #category : 'code generation-definitions' }
ViennaVDM2Smalltalk >> stateDefinition: aViennaNode env: aDictionary [

| constructor fieldListNode invNode initNode vars vals recordNode initConstructor expressionListNode patternVar |
constructor := aViennaNode identifier.
fieldListNode := aViennaNode fieldList.
invNode := aViennaNode inv.
initNode := aViennaNode init.
vars := fieldListNode collect: #identifier.
initNode ifNil: [
^ self error: 'initalisation is required in state definition' ].
recordNode := initNode expression expression2.
initConstructor := recordNode name identifier.
expressionListNode := recordNode expressionList.
initConstructor = constructor ifFalse: [
^ self error:
'Constructor must be the same name as state definition: '
, constructor , ', ' , initConstructor ].
vars size = expressionListNode size ifFalse: [
^ self error:
'Number of state variables and number of arguments must agree: '
, vars size printString , ', '
, expressionListNode size printString ].
vals := expressionListNode collect: [ :node |
self generate: node env: aDictionary ].
^ {
((self stringStreamContents: [ :stream |
vars with: vals do: [ :var :val |
stream
nextPutAll: (self noCheckAssignment: var be: val);
nextPutAll: '.' , String cr ] ]) asViennaTracingString:
initNode).
((self stringStreamContents: [ :stream |
stream
nextPutAll: initConstructor;
nextPutAll: ' := ViennaCompositeType constructorName: ';
nextPutAll: initConstructor storeString;
nextPutAll: ' withAll: {';
nextPutAll:
(' . ' join: (self generate: fieldListNode env: aDictionary));
nextPutAll: '}' ]) asViennaTracingString: aViennaNode).
((self stringStreamContents: [ :stream |
patternVar := initNode first first first.
stream
nextPutAll: 'init_';
nextPutAll: initConstructor;
nextPutAll: ' := ';
nextPutAll: (self generate: initNode first env: aDictionary) ])
asViennaTracingString: initNode).
(invNode ifNotNil: [
(self stringStreamContents: [ :stream |
stream
nextPutAll: 'inv_';
nextPutAll: constructor;
nextPutAll: ' := ';
nextPutAll: (self generate: invNode first env: aDictionary) ])
asViennaTracingString: invNode ]).
(self stringStreamContents: [ :stream |
stream
nextPutAll:
(aDictionary at: constructor ifAbsent: [ constructor ]);
nextPutAll: ' applyTo: {';
nextPutAll: (' . ' join: vars);
nextPutAll: '}' ]).
(self stringStreamContents: [ :stream |
vars
do: [ :var |
stream
nextPutAll: var;
nextPutAll: ' := _state at: ';
nextPutAll: var storeString ]
separatedBy: [ stream nextPutAll: '. ' ] ]) }
| constructor fieldListNode invNode initNode vars vals recordNode initConstructor expressionListNode patternVar |
constructor := aViennaNode identifier.
fieldListNode := aViennaNode fieldList.
invNode := aViennaNode inv.
initNode := aViennaNode init.
vars := fieldListNode collect: #identifier.
initNode ifNil: [
^ self error:
'initalisation is required in state definition' ].
recordNode := initNode expression expression2.
initConstructor := recordNode name identifier.
expressionListNode := recordNode expressionList.
initConstructor = constructor ifFalse: [
^ self error:
'Constructor must be the same name as state definition: '
, constructor , ', ' , initConstructor ].
vars size = expressionListNode size ifFalse: [
^ self error:
'Number of state variables and number of arguments must agree: '
, vars size printString , ', '
, expressionListNode size printString ].
vals := expressionListNode collect: [ :node |
self generate: node env: aDictionary ].
^ {
((self stringStreamContents: [ :stream |
vars with: vals do: [ :var :val |
stream
nextPutAll:
(self noCheckAssignment: var be: val);
nextPutAll: '.' , String cr ] ])
asViennaTracingString: initNode).
((self stringStreamContents: [ :stream |
stream
nextPutAll: initConstructor;
nextPutAll:
' := ViennaCompositeType constructorName: ';
nextPutAll: initConstructor storeString;
nextPutAll: ' withAll: {';
nextPutAll:
(' . ' join:
(self
generate: fieldListNode
env: aDictionary));
nextPutAll: '}' ]) asViennaTracingString:
aViennaNode).
((self stringStreamContents: [ :stream |
patternVar := initNode first first first.
stream
nextPutAll: 'init_';
nextPutAll: initConstructor;
nextPutAll: ' := ';
nextPutAll:
(self generate: initNode first env: aDictionary) ])
asViennaTracingString: initNode).
(invNode ifNotNil: [
(self stringStreamContents: [ :stream |
stream
nextPutAll: 'inv_';
nextPutAll: constructor;
nextPutAll: ' := ';
nextPutAll:
(self generate: invNode first env: aDictionary) ])
asViennaTracingString: invNode ]).
(self stringStreamContents: [ :stream |
stream
nextPutAll:
(aDictionary
at: constructor
ifAbsent: [ constructor ]);
nextPutAll: ' applyTo: {';
nextPutAll: (' . ' join: vars);
nextPutAll: '}' ]).
(self stringStreamContents: [ :stream |
vars
do: [ :var |
stream
nextPutAll: var;
nextPutAll: ' := _state at: ';
nextPutAll: var storeString ]
separatedBy: [ stream nextPutAll: '. ' ] ]) }
]

{ #category : 'utilities' }
Expand Down Expand Up @@ -3404,13 +3426,16 @@ ViennaVDM2Smalltalk >> traceLetDefBinding: aViennaNode env: aDictionary [
{ #category : 'code generation-traces' }
ViennaVDM2Smalltalk >> traceRepeatDefinition: aViennaNode env: aDictionary [

| trace |
trace := self generate: aViennaNode traceCoreDefinition.
^ aViennaNode traceRepeatPattern
ifNotNil: [ :repeatPattern |
'(ViennaRepeatCombinatorialGenerator range: '
, repeatPattern range storeString , 'with: ' , trace , ')' ]
ifNil: [ trace ]
| trace |
trace := self
generate: aViennaNode traceCoreDefinition
env: aDictionary.
^ aViennaNode traceRepeatPattern
ifNotNil: [ :repeatPattern |
'(ViennaRepeatCombinatorialGenerator range: '
, repeatPattern range storeString , 'with: ' , trace
, ')' ]
ifNil: [ trace ]
]

{ #category : 'code generation-traces' }
Expand Down
48 changes: 31 additions & 17 deletions repository/ViennaTalk-Transpiler-Core/ViennaVDM2SmalltalkClass.class.st
View file
Original file line number Diff line number Diff line change
Expand Up @@ -39,12 +39,19 @@ ViennaVDM2SmalltalkClass >> buildEnv: aViennaNode [

{ #category : 'code generation-statements' }
ViennaVDM2SmalltalkClass >> callStatement: aViennaNode env: aDictionary [
| callee args |
callee := self generate: aViennaNode first env: aDictionary.
args := self generate: aViennaNode second env: aDictionary.
^ args
ifEmpty: [ callee , ' value' ]
ifNotEmpty: [ '(', callee , ' value: ', (' value: ' join: args), ')' ]

| callee args |
callee := self
generate: aViennaNode name
env: aDictionary.
args := self
generate: aViennaNode expressionList
env: aDictionary.
^ args
ifEmpty: [ callee , ' value' ]
ifNotEmpty: [
'(' , callee , ' value: ' , (' value: ' join: args)
, ')' ]
]

{ #category : 'utilities' }
Expand Down Expand Up @@ -1076,17 +1083,24 @@ ViennaVDM2SmalltalkClass >> module: aViennaNode env: aDictionary [
{ #category : 'code generation-traces' }
ViennaVDM2SmalltalkClass >> namedTrace: aViennaNode env: aDictionary [

| name body theClass |
name := aViennaNode identifier.
body := self
generate: aViennaNode traceDefinitionList
env: aDictionary.
theClass := classes at: (aViennaNode module ifNotNil: #identifier).
self
defineMethod: name , String cr , body
in: theClass
protocol: 'traces'
node: aViennaNode
| name body theClass |
name := aViennaNode identifier.
body := self stringStreamContents: [ :stream |
stream
nextPutAll: '|_generator | _generator := ';
nextPutAll:
(self
generate: aViennaNode traceDefinitionList
env: aDictionary);
nextPutAll:
'. [self init. _generator next: Dictionary new] whileTrue' ].
theClass := classes at:
(aViennaNode module ifNotNil: #identifier).
self
defineMethod: name , String cr , body
in: theClass
protocol: 'traces'
node: aViennaNode
]

{ #category : 'code generation-definitions' }
Expand Down
Loading

0 comments on commit d8c5ad0

Please sign in to comment.