carpentry/gt4carp
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Finally, an IDE

Browse Source
This commit is contained in:
Veit Heller
2022-06-13 22:13:31 +02:00
parent ee5c032d90
commit 7fbab0e2a0
6 changed files with 302 additions and 5 deletions
Download Patch File Download Diff File Expand all files Collapse all files

5
src/Carp-AST/CarpExpressionNode.class.st
View File

@@ -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 ]

9
src/Carp-AST/CarpVariableNode.class.st
View File

@@ -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

13
src/Carp-Parser/CarpListNode.class.st
View File

@@ -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 [

68
src/Carp/CarpExecutionResult.class.st Normal file
View File

@@ -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 [
<gtView>
| v |
v := aView forward
title: 'Value';
priority: 1;
object: value.
view ifNotNil: [ v view: view ].
^ v
]
{ #category : #accessing }
CarpExecutionResult >> gtWarningsFor: aView [
<gtView>
^ 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
]

180
src/Carp/CarpTypeSignature.class.st Normal file
View File

@@ -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: '<StaticLifetime>')
ifTrue: [ verticalContainer
addChild: (BrLabel new
aptitude: BrGlamorousLabelAptitude new
+ (GtExplainerExplanationAptitude new explanationModel: '<StaticLifetime>')
+ (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: '<StaticLifetime>';
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 [
<gtView>
^ aView explicit
title: 'Signature';
priority: 1;
stencil: [ self explainSignature ]
]
{ #category : #accessing }
CarpTypeSignature >> model: aModel [
model := aModel
]

32
src/Carp/GtCarpCoderModel.class.st
View File

@@ -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 }