Skip to content

Navigation Menu

Sign in
Appearance settings

Search code, repositories, users, issues, pull requests...

Provide feedback

We read every piece of feedback, and take your input very seriously.

Saved searches

Use saved searches to filter your results more quickly
Sign up
Appearance settings

Commit 9c255bb

Browse files
App capability setup, fixes, improvements (#13)
* update estg deps * remove application specific dap capability setup code from the library * put dap capability setup code to application ; add dummy code for hover support (via evaluate requet) ; fix reset object lifetimes - it should not be called in threads request ; make ext stg syntax highlighed (workaround) * fix: disable placeholder code to make vscode extension compile
1 parent 05c8995 commit 9c255bb

File tree

5 files changed

+57
-28
lines changed

5 files changed

+57
-28
lines changed

‎dap-extension/src/extension.ts

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -26,7 +26,7 @@ export function activate(context: vscode.ExtensionContext) {
2626
// The code you place here will be executed every time your command is executed
2727
// Display a message box to the user
2828
vscode.debug.activeDebugSession?.customRequest('garbageCollect');
29-
window.showInformationMessage('Running garbage collection...');
29+
//window.showInformationMessage('Running garbage collection...');
3030
}));
3131

3232
runDebugger (context, new MockDebugAdapterServerDescriptorFactory());

‎dap/exe/Main.hs

Lines changed: 34 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -88,10 +88,24 @@ getConfig = do
8888
let
8989
hostDefault = "127.0.0.1"
9090
portDefault = 4711
91+
capabilities = defaultCapabilities
92+
{ supportsConfigurationDoneRequest = True
93+
, supportsHitConditionalBreakpoints = True
94+
, supportsEvaluateForHovers = False
95+
, supportsModulesRequest = True
96+
, additionalModuleColumns = [ defaultColumnDescriptor
97+
{ columnDescriptorAttributeName = "Extra"
98+
, columnDescriptorLabel = "Label"
99+
}
100+
]
101+
, supportsValueFormattingOptions = True
102+
, supportTerminateDebuggee = True
103+
, supportsLoadedSourcesRequest = True
104+
}
91105
ServerConfig
92106
<$> do fromMaybe hostDefault <$> lookupEnv "DAP_HOST"
93107
<*> do fromMaybe portDefault . (readMaybe =<<) <$> do lookupEnv "DAP_PORT"
94-
<*> pure defaultCapabilities
108+
<*> pure capabilities
95109
<*> pure True
96110
----------------------------------------------------------------------------
97111
-- | VSCode arguments are custom for attach
@@ -211,15 +225,6 @@ handleDebuggerExceptions e = do
211225
sendTerminatedEvent (TerminatedEvent False)
212226
sendExitedEvent (ExitedEvent 1)
213227

214-
pathToName path =
215-
case splitFileName (cs path) of
216-
(init -> moduleName, takeExtension -> ".ghccore") ->
217-
cs (moduleName <> ".core")
218-
(init -> moduleName, takeExtension -> ".stgbin") ->
219-
cs (moduleName <> ".stg")
220-
(init -> moduleName, takeExtension -> ext) ->
221-
cs (moduleName <> ext)
222-
223228
----------------------------------------------------------------------------
224229
-- | Clears the currently known breakpoint set
225230
clearBreakpoints :: Adaptor ESTG ()
@@ -431,7 +436,6 @@ talk CommandSource = do
431436
sendSourceResponse (SourceResponse source Nothing)
432437
----------------------------------------------------------------------------
433438
talk CommandThreads = do
434-
resetObjectLifetimes
435439
allThreads <- IntMap.toList . ssThreads <$> getStgState
436440
sendThreadsResponse
437441
[ Thread
@@ -481,6 +485,18 @@ talk CommandSetExceptionBreakpoints = sendSetExceptionBreakpointsResponse []
481485
talk CommandSetFunctionBreakpoints = sendSetFunctionBreakpointsResponse []
482486
talk CommandSetInstructionBreakpoints = sendSetInstructionBreakpointsResponse []
483487
----------------------------------------------------------------------------
488+
talk CommandEvaluate = do
489+
EvaluateArguments {..} <- getArguments
490+
sendEvaluateResponse EvaluateResponse
491+
{ evaluateResponseResult = "evaluated value for " <> evaluateArgumentsExpression
492+
, evaluateResponseType = "evaluated type for " <> evaluateArgumentsExpression
493+
, evaluateResponsePresentationHint = Nothing
494+
, evaluateResponseVariablesReference = 1
495+
, evaluateResponseNamedVariables = Just 1
496+
, evaluateResponseIndexedVariables = Nothing
497+
, evaluateResponseMemoryReference = Nothing
498+
}
499+
----------------------------------------------------------------------------
484500
talk cmd = logInfo $ BL8.pack ("GOT cmd " <> show cmd)
485501
----------------------------------------------------------------------------
486502

@@ -620,13 +636,15 @@ generateScopesForTopStackFrame frameIdDesc closureId env = do
620636
scopeVarablesRef <- getVariablesRef $ VariablesRef_StackFrameVariables frameIdDesc
621637
setVariables scopeVarablesRef
622638
[ defaultVariable
623-
{ variableName = cs binderName <> (if binderScope ==ModulePublicthen""else cs ('_':show u))
639+
{ variableName = displayName
624640
, variableValue = cs variableValue
625641
, variableType = Just (cs variableType)
642+
, variableEvaluateName = Just $ displayName <> " evaluate"
626643
}
627644
| (Id (Binder{..}), (_, atom)) <- M.toList env
628645
, let (variableType, variableValue) = getAtomTypeAndValue atom
629646
BinderId u = binderId
647+
displayName = if binderScope == ModulePublic then cs binderName else cs (show u)
630648
]
631649
pure
632650
[ defaultScope
@@ -656,13 +674,15 @@ generateScopes frameIdDesc stackCont@(CaseOf _ closureId env _ _ _) = do
656674
-- DMJ: for now everything is local.
657675
-- Inspect StaticOrigin to put things top-level, or as arguments, where applicable
658676
[ defaultVariable
659-
{ variableName = cs binderName <> (if binderScope ==ModulePublicthen""else cs ('_':show u))
677+
{ variableName = displayName
660678
, variableValue = cs variableValue
661679
, variableType = Just (cs variableType)
680+
, variableEvaluateName = Just $ displayName <> " evaluate"
662681
}
663682
| (Id (Binder{..}), (_, atom)) <- M.toList env
664683
, let (variableType, variableValue) = getAtomTypeAndValue atom
665684
BinderId u = binderId
685+
displayName = if binderScope == ModulePublic then cs binderName else cs (show u)
666686
]
667687
pure
668688
[ defaultScope
@@ -1101,7 +1121,7 @@ getSourceName qualifiedModuleName = \case
11011121
GhcStg -> cs qualifiedModuleName <> ".ghcstg"
11021122
Cmm -> cs qualifiedModuleName <> ".cmm"
11031123
Asm -> cs qualifiedModuleName <> ".s"
1104-
ExtStg -> cs qualifiedModuleName <> ".stgbin"
1124+
ExtStg -> cs qualifiedModuleName <> ".stgbin.hs"
11051125
FFICStub -> cs qualifiedModuleName <> "_stub.c"
11061126
FFIHStub -> cs qualifiedModuleName <> "_stub.h"
11071127
ForeignC -> cs qualifiedModuleName

‎dap/src/DAP/Types.hs

Lines changed: 7 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -685,10 +685,10 @@ defaultCapabilities :: Capabilities
685685
defaultCapabilities = capabilities
686686
where
687687
capabilities = Capabilities
688-
{ supportsConfigurationDoneRequest = True
688+
{ supportsConfigurationDoneRequest = False
689689
, supportsFunctionBreakpoints = False
690690
, supportsConditionalBreakpoints = False
691-
, supportsHitConditionalBreakpoints = True
691+
, supportsHitConditionalBreakpoints = False
692692
, supportsEvaluateForHovers = False
693693
, exceptionBreakpointFilters = []
694694
, supportsStepBack = False
@@ -698,21 +698,17 @@ defaultCapabilities = capabilities
698698
, supportsStepInTargetsRequest = False
699699
, supportsCompletionsRequest = False
700700
, completionTriggerCharacters = []
701-
, supportsModulesRequest = True
702-
, additionalModuleColumns = [ defaultColumnDescriptor
703-
{ columnDescriptorAttributeName = "Extra"
704-
, columnDescriptorLabel = "Label"
705-
}
706-
]
701+
, supportsModulesRequest = False
702+
, additionalModuleColumns = []
707703
, supportedChecksumAlgorithms = []
708704
, supportsRestartRequest = False
709705
, supportsExceptionOptions = False
710-
, supportsValueFormattingOptions = True
706+
, supportsValueFormattingOptions = False
711707
, supportsExceptionInfoRequest = False
712-
, supportTerminateDebuggee = True
708+
, supportTerminateDebuggee = False
713709
, supportSuspendDebuggee = False
714710
, supportsDelayedStackTraceLoading = False
715-
, supportsLoadedSourcesRequest = True
711+
, supportsLoadedSourcesRequest = False
716712
, supportsLogPoints = False
717713
, supportsTerminateThreadsRequest = False
718714
, supportsSetExpression = False

‎dap/stack.yaml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -12,7 +12,7 @@ extra-deps:
1212
commit: ac9616b94cb8c4a9e07188d19979a6225ebd5a10
1313

1414
- git: https://github.com/grin-compiler/ghc-whole-program-compiler-project
15-
commit: d1bfe40f3b30dfb6059f51272a77633e81b499c8
15+
commit: 8a854a42a3e48a43aa471e5db244ea04eeb1474b
1616
subdirs:
1717
- external-stg
1818
- external-stg-syntax

‎dap/test/Main.hs

Lines changed: 14 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -134,10 +134,23 @@ withServer :: IO () -> IO ()
134134
withServer test = withAsync server (const test)
135135
where
136136
server = runDAPServer config mockServerTalk
137+
capabilities = defaultCapabilities
138+
{ supportsConfigurationDoneRequest = True
139+
, supportsHitConditionalBreakpoints = True
140+
, supportsModulesRequest = True
141+
, additionalModuleColumns = [ defaultColumnDescriptor
142+
{ columnDescriptorAttributeName = "Extra"
143+
, columnDescriptorLabel = "Label"
144+
}
145+
]
146+
, supportsValueFormattingOptions = True
147+
, supportTerminateDebuggee = True
148+
, supportsLoadedSourcesRequest = True
149+
}
137150
config = ServerConfig
138151
{ host = testHost
139152
, port = testPort
140-
, serverCapabilities = defaultCapabilities
153+
, serverCapabilities = capabilities
141154
, debugLogging = False
142155
}
143156

0 commit comments

Comments
(0)

AltStyle によって変換されたページ (->オリジナル) /