diff --git a/src/Carp-AST/CarpExpressionNode.class.st b/src/Carp-AST/CarpExpressionNode.class.st index 402d974..43cd960 100644 --- a/src/Carp-AST/CarpExpressionNode.class.st +++ b/src/Carp-AST/CarpExpressionNode.class.st @@ -16,6 +16,11 @@ CarpExpressionNode >> acceptVisitor: anExpressionVisitor [ ^ anExpressionVisitor visitExpression: self ] +{ #category : #accessing } +CarpExpressionNode >> isDefinition [ + ^ false +] + { #category : #accessing } CarpExpressionNode >> isQuoted [ ^ parent ifNil: [ false ] ifNotNil: [ parent isQuoted ] diff --git a/src/Carp-AST/CarpVariableNode.class.st b/src/Carp-AST/CarpVariableNode.class.st index 28d1447..c1a9e75 100644 --- a/src/Carp-AST/CarpVariableNode.class.st +++ b/src/Carp-AST/CarpVariableNode.class.st @@ -13,6 +13,15 @@ CarpVariableNode >> acceptVisitor: anExpressionVisitor [ ^ anExpressionVisitor visitVariable: self ] +{ #category : #accessing } +CarpVariableNode >> isDefinitionPredicate [ + ^ {'defdynamic'. + 'defndynamic'. + 'defmacro'. + 'defn'. + 'def'} includes: self value source +] + { #category : #accessing } CarpVariableNode >> toPharo [ ^ value source asSymbol diff --git a/src/Carp-Parser/CarpListNode.class.st b/src/Carp-Parser/CarpListNode.class.st index 923271d..2b9affa 100644 --- a/src/Carp-Parser/CarpListNode.class.st +++ b/src/Carp-Parser/CarpListNode.class.st @@ -21,6 +21,14 @@ CarpListNode >> compositeNodeVariables [ ^ #( #expressions ) ] +{ #category : #accessing } +CarpListNode >> definitionVariable [ + ^ (self expressions size > 1 + and: [ self expressions first isDefinitionPredicate ]) + ifTrue: [ self expressions second ] + ifFalse: [ nil ] +] + { #category : #generated } CarpListNode >> expressions [ @@ -41,6 +49,11 @@ CarpListNode >> initialize [ expressions := OrderedCollection new: 2. ] +{ #category : #accessing } +CarpListNode >> isDefinition [ + ^ self definitionVariable isNotNil +] + { #category : #generated } CarpListNode >> leftParen [ diff --git a/src/Carp/CarpExecutionResult.class.st b/src/Carp/CarpExecutionResult.class.st new file mode 100644 index 0000000..d789092 --- /dev/null +++ b/src/Carp/CarpExecutionResult.class.st @@ -0,0 +1,68 @@ +Class { + #name : #CarpExecutionResult, + #superclass : #Object, + #instVars : [ + 'value', + 'warnings', + 'view' + ], + #category : #'Carp-Execution' +} + +{ #category : #'instance creation' } +CarpExecutionResult class >> from: aCarpResult [ + ^ self new + value: (aCarpResult at: #value); + warnings: (aCarpResult at: #warnings) +] + +{ #category : #accessing } +CarpExecutionResult >> gtValueFor: aView [ + + | v | + v := aView forward + title: 'Value'; + priority: 1; + object: value. + view ifNotNil: [ v view: view ]. + ^ v +] + +{ #category : #accessing } +CarpExecutionResult >> gtWarningsFor: aView [ + + ^ aView list + title: 'Warnings'; + priority: 2; + items: [ warnings ] +] + +{ #category : #accessing } +CarpExecutionResult >> parse [ + value := CarpParser parse: value +] + +{ #category : #accessing } +CarpExecutionResult >> transformValue: aBlock [ + value := aBlock value: value +] + +{ #category : #accessing } +CarpExecutionResult >> value [ + ^ value +] + +{ #category : #accessing } +CarpExecutionResult >> value: aValue [ + value := aValue +] + +{ #category : #accessing } +CarpExecutionResult >> view: aView [ + view := aView +] + +{ #category : #accessing } +CarpExecutionResult >> warnings: aCollection [ + warnings := aCollection +] diff --git a/src/Carp/CarpTypeSignature.class.st b/src/Carp/CarpTypeSignature.class.st new file mode 100644 index 0000000..278d822 --- /dev/null +++ b/src/Carp/CarpTypeSignature.class.st @@ -0,0 +1,180 @@ +Class { + #name : #CarpTypeSignature, + #superclass : #Object, + #instVars : [ + 'signature', + 'model', + 'tooltipsContainer' + ], + #category : #'Carp-Coder' +} + +{ #category : #'instance creation' } +CarpTypeSignature class >> on: aValue using: aModel [ + ^ self new + fromAST: aValue; + model: aModel +] + +{ #category : #accessing } +CarpTypeSignature >> elementsList [ + | tokens verticalContainer docsRegex | + tokens := signature value source findTokens: ' () []'. + docsRegex := 'Documentation\: (.*)' asRegexIgnoringCase. + + verticalContainer := BrVerticalPane new + fitContent; + padding: (BlInsets all: 10). + + tokens + do: [ :each | + | res | + res := model bindAndExecuteRaw: '(info ' , each , ')'. + (docsRegex search: (res at: #value)) + ifTrue: [ | docs | + docs := docsRegex subexpression: 2. + verticalContainer + addChild: (BrLabel new + aptitude: BrGlamorousLabelAptitude new + + (GtExplainerExplanationAptitude new explanationModel: each) + + (BrStyleCommonAptitude new + hovered: [ :aStyle | + aStyle background: BrGlamorousColors textHighlightColor. + aStyle + do: [ tooltipsContainer + text: docs; + visibility: BlVisibility visible ] + after: [ tooltipsContainer + text: '' asRopedText; + visibility: BlVisibility gone ] ]); + geometry: (BlRoundedRectangleGeometry cornerRadius: 4); + text: each; + padding: (BlInsets all: 5)) ] ]. + + (tokens includes: '') + ifTrue: [ verticalContainer + addChild: (BrLabel new + aptitude: BrGlamorousLabelAptitude new + + (GtExplainerExplanationAptitude new explanationModel: '') + + (BrStyleCommonAptitude new + hovered: [ :aStyle | + aStyle background: BrGlamorousColors textHighlightColor. + aStyle + do: [ tooltipsContainer + text: 'is the default static lifetime of values (this lifetime includes the entire program run).'; + visibility: BlVisibility visible ] + after: [ tooltipsContainer + text: '' asRopedText; + visibility: BlVisibility gone ] ]); + geometry: (BlRoundedRectangleGeometry cornerRadius: 4); + text: ''; + padding: (BlInsets all: 5)) ]. + + ^ verticalContainer asScrollableElement + constraintsDo: [ :c | + c horizontal fitContent. + c vertical matchParent ]; + background: Color white; + aptitude: BrShadowAptitude new +] + +{ #category : #accessing } +CarpTypeSignature >> explainSignature [ + | mainContainer coderElement leftContainer rightContainer rightContainerLabel leftContainerLabel tooltipsTarget coder elementsContainer editor | + mainContainer := BrHorizontalPane new + matchParent; + padding: (BlInsets all: 5). + mainContainer explainer isExplanationHolder: true. + + leftContainer := BrVerticalPane new + hFitContent; + vMatchParent; + padding: (BlInsets all: 5); + margin: (BlInsets right: 20). + + rightContainer := BrVerticalPane new + matchParent; + padding: (BlInsets all: 5). + + tooltipsContainer := BrEditor new + text: '' asRopedText; + padding: (BlInsets all: 10); + margin: (BlInsets + top: 10 + right: 0 + bottom: 0 + left: 0); + constraintsDo: [ :c | c horizontal matchParent ]; + visibility: BlVisibility gone; + border: (BlBorder paint: BrGlamorousColors textHighlightColor width: 2); + aptitude: BrShadowAptitude + BrGlamorousEditorAptitude; + vFitContent; + background: BrGlamorousColors textHighlightColor. + + tooltipsTarget := BrButton new + constraintsDo: [ :c | c ignoreByLayout ]; + size: 0 @ 0; + elevation: (BlRelativeElevation elevation: 10); + geometry: BlCircleGeometry new. + + elementsContainer := self elementsList. + + leftContainerLabel := BrLabel new + text: ('Type Elements:' asRopedText + glamorousRegularFont; + foreground: Color gray); + aptitude: BrGlamorousLabelAptitude; + hFitContent; + margin: (BlInsets + top: 0 + right: 0 + bottom: 5 + left: 0). + rightContainerLabel := BrLabel new + text: ('Type:' asRopedText + glamorousRegularFont; + foreground: Color gray); + aptitude: BrGlamorousLabelAptitude; + margin: (BlInsets + top: 0 + right: 0 + bottom: 5 + left: 5). + + editor := BrEditorElement new + constraintsDo: [ :c | + c horizontal matchParent. + c vertical matchParent ]; + editor: (BrTextEditor new text: signature value source asRopedText glamorousCodeFont). + + leftContainer addChild: leftContainerLabel. + leftContainer addChild: elementsContainer. + + rightContainer addChild: rightContainerLabel. + rightContainer addChild: editor. + rightContainer addChild: tooltipsContainer. + + mainContainer addChild: leftContainer. + mainContainer addChild: rightContainer. + + ^ mainContainer +] + +{ #category : #accessing } +CarpTypeSignature >> fromAST: anASTNode [ + signature := anASTNode +] + +{ #category : #accessing } +CarpTypeSignature >> gtLiveFor: aView [ + + ^ aView explicit + title: 'Signature'; + priority: 1; + stencil: [ self explainSignature ] +] + +{ #category : #accessing } +CarpTypeSignature >> model: aModel [ + model := aModel +] diff --git a/src/Carp/GtCarpCoderModel.class.st b/src/Carp/GtCarpCoderModel.class.st index b3eddc7..5ce05fe 100644 --- a/src/Carp/GtCarpCoderModel.class.st +++ b/src/Carp/GtCarpCoderModel.class.st @@ -45,7 +45,7 @@ GtCarpCoderModel >> bindAndExecute: sourceString [ returnedVarNames: varNames. res := self bindAndExecuteRaw: sourceString. - (res at: #result) = 'success' ifTrue: [ ^ res at: #value ]. + (res at: #result) = 'success' ifTrue: [ ^ CarpExecutionResult from: res ]. exception := (PharoLinkRemoteError new application: application; command: commandFactory command; @@ -112,7 +112,8 @@ GtCarpCoderModel >> initializeAddOns: addOns [ | source | source := '(expand ''' , sourceCode currentSourceText value text , ')'. anElement phlow - spawnObject: (CarpParser parse: (aCoderUIModel coder bindAndExecute: source)) ]. + spawnObject: ((self bindAndExecute: source) parse view: #gtSourceFor:) ] + id: #'source-coder--macro-expand-action'. addOns addMainAction: 'Build and Run' translated icon: BrGlamorousVectorIcons refresh @@ -120,8 +121,13 @@ GtCarpCoderModel >> initializeAddOns: addOns [ | source | source := '' , sourceCode currentSourceText value text , '(build) (run)'. anElement phlow - spawnObject: (CarpCliOutput text: ((aCoderUIModel coder bindAndExecuteRaw: source) at: 'value')) ] - id: #'source-coder--macro-expand-action' + spawnObject: (CarpCliOutput text: ((self bindAndExecuteRaw: source) at: 'value')) ] + id: #'source-coder--build-and-run-action'. + addOns + addMainAction: 'Infer Type' translated + icon: BrGlamorousVectorIcons inspect + action: [ :aCoderUIModel :anElement | self inspectTypeSpawningOn: anElement phlow] + id: #'source-coder--type-infer-action' ] { #category : #accessing } @@ -133,6 +139,21 @@ GtCarpCoderModel >> initializeShortcuts: addOns [ addShortcut: GtSourceCoderDoItAndInspectShortcut new ] +{ #category : #accessing } +GtCarpCoderModel >> inspectTypeSpawningOn: aPhlow [ + | source ast | + source := sourceCode currentSourceText value text. + ast := CarpParser parse: source. + + (ast expressions size = 1 and: [ ast expressions first isDefinition ]) + ifTrue: [ self bindAndExecute: source asString. + source := ast expressions first definitionVariable value source ]. + + source := '(def *type-infer-this* ' , source + , ') (defdynamic *type-infer-result* (type *type-infer-this*)) (def *type-infer-this* 0) *type-infer-result*'. + aPhlow spawnObject: ((self bindAndExecute: source) parse transformValue: [:aValue | CarpTypeSignature on: aValue expressions first using: self]) +] + { #category : #accessing } GtCarpCoderModel >> newCompletionStrategy [ ^ GtCompletionStrategy new @@ -145,7 +166,8 @@ GtCarpCoderModel >> pharoBindings: anObject [ { #category : #accessing } GtCarpCoderModel >> primitiveEvaluate: aSourceString inContext: aGtSourceCoderEvaluationContext onFailDo: anEvaluationFailBlock [ - ^ (CarpParser parse: (self bindAndExecute: aSourceString)) expressions first toPharo + ^ (self bindAndExecute: aSourceString) parse + transformValue: [ :aValue | aValue expressions first toPharo ] ] { #category : #accessing }