mirrors/compiler-explorer
1
0
Fork 0
mirror of https://github.com/compiler-explorer/compiler-explorer.git synced 2025-12-27 11:44:09 -05:00
Code Issues Packages Projects Releases Wiki Activity

Add GHC Core and Cmm views #3571 (#3593)

Browse Source
This commit is contained in:
A S E
2022-05-04 13:28:49 +01:00
committed by GitHub
parent 19ddc3384e
commit d4cd96eb26
11 changed files with 516 additions and 19 deletions
Download Patch File Download Diff File Expand all files Collapse all files

42
lib/base-compiler.js
View File

@@ -889,10 +889,18 @@ export class BaseCompiler {
return outputFilename.replace(path.extname(outputFilename), '.mir');
}
getHaskellCoreOutputFilename(inputFilename) {
return inputFilename.replace(path.extname(inputFilename), '.dump-simpl');
}
getHaskellStgOutputFilename(inputFilename) {
return inputFilename.replace(path.extname(inputFilename), '.dump-stg-final');
}
getHaskellCmmOutputFilename(inputFilename) {
return inputFilename.replace(path.extname(inputFilename), '.dump-cmm');
}
// Currently called for getting macro expansion and HIR.
// It returns the content of the output file created after using -Z unpretty=<unprettyOpt>.
// The outputFriendlyName is a free form string used in case of error.
@@ -940,22 +948,20 @@ export class BaseCompiler {
return [{text: 'Internal error; unable to open output path'}];
}
async processHaskellStgOutput(inputFilename, output) {
const stgPath = this.getHaskellStgOutputFilename(inputFilename);
async processHaskellExtraOutput(outpath, output) {
if (output.code !== 0) {
return [{text: 'Failed to run compiler to get Haskell STG'}];
return [{text: 'Failed to run compiler to get Haskell Core'}];
}
if (await fs.exists(stgPath)) {
const content = await fs.readFile(stgPath, 'utf-8');
if (await fs.exists(outpath)) {
const content = await fs.readFile(outpath, 'utf-8');
// output file starts with
//
// ==================== Final STG: ====================
// 2022-04-27 16:48:25.411966835 UTC
// ==================== <HEADER> ====================
//
// we want to drop this to make the output nicer
return content
.split('\n')
.slice(4)
.slice(3)
.map(line => ({
text: line,
}));
@@ -1447,7 +1453,9 @@ export class BaseCompiler {
const makeRustMir = backendOptions.produceRustMir && this.compiler.supportsRustMirView;
const makeRustMacroExp = backendOptions.produceRustMacroExp && this.compiler.supportsRustMacroExpView;
const makeRustHir = backendOptions.produceRustHir && this.compiler.supportsRustHirView;
const makeHaskellCore = backendOptions.produceHaskellCore && this.compiler.supportsHaskellCoreView;
const makeHaskellStg = backendOptions.produceHaskellStg && this.compiler.supportsHaskellStgView;
const makeHaskellCmm = backendOptions.produceHaskellCmm && this.compiler.supportsHaskellCmmView;
const makeGccDump =
backendOptions.produceGccDump && backendOptions.produceGccDump.opened && this.compiler.supportsGccDump;
@@ -1488,7 +1496,15 @@ export class BaseCompiler {
: '';
const rustMirResult = makeRustMir ? await this.processRustMirOutput(outputFilename, asmResult) : '';
const haskellStgResult = makeHaskellStg ? await this.processHaskellStgOutput(inputFilename, asmResult) : '';
const haskellCoreResult = makeHaskellCore
? await this.processHaskellExtraOutput(this.getHaskellCoreOutputFilename(inputFilename), asmResult)
: '';
const haskellStgResult = makeHaskellStg
? await this.processHaskellExtraOutput(this.getHaskellStgOutputFilename(inputFilename), asmResult)
: '';
const haskellCmmResult = makeHaskellCmm
? await this.processHaskellExtraOutput(this.getHaskellCmmOutputFilename(inputFilename), asmResult)
: '';
asmResult.dirPath = dirPath;
asmResult.compilationOptions = options;
@@ -1554,10 +1570,18 @@ export class BaseCompiler {
asmResult.hasRustHirOutput = true;
asmResult.rustHirOutput = rustHirResult;
}
if (haskellCoreResult) {
asmResult.hasHaskellCoreOutput = true;
asmResult.haskellCoreOutput = haskellCoreResult;
}
if (haskellStgResult) {
asmResult.hasHaskellStgOutput = true;
asmResult.haskellStgOutput = haskellStgResult;
}
if (haskellCmmResult) {
asmResult.hasHaskellCmmOutput = true;
asmResult.haskellCmmOutput = haskellCmmResult;
}
return this.checkOutputFileAndDoPostProcess(asmResult, outputFilename, filters);
}

18
lib/compilers/haskell.js
View File

@@ -35,14 +35,30 @@ export class HaskellCompiler extends BaseCompiler {
constructor(info, env) {
super(info, env);
this.compiler.supportsHaskellCoreView = true;
this.compiler.supportsHaskellStgView = true;
this.compiler.supportsHaskellCmmView = true;
}
optionsForBackend(backendOptions, outputFilename) {
const opts = super.optionsForBackend(backendOptions, outputFilename);
const anydump =
backendOptions.produceHaskellCore || backendOptions.produceHaskellStg || backendOptions.produceHaskellCmm;
if (anydump) {
// -dsupress-all to make tidier output
opts.push('-dsuppress-all', '-ddump-to-file', '-dumpdir', path.dirname(outputFilename));
}
if (backendOptions.produceHaskellCore && this.compiler.supportsHaskellCoreView) {
opts.push('-ddump-simpl');
}
if (backendOptions.produceHaskellStg && this.compiler.supportsHaskellStgView) {
opts.push('-ddump-to-file', '-dumpdir', path.dirname(outputFilename), '-ddump-stg-final');
opts.push('-ddump-stg-final');
}
if (backendOptions.produceHaskellCmm && this.compiler.supportsHaskellCmmView) {
opts.push('-ddump-cmm');
}
return opts;
}

42
static/components.js
View File

@@ -338,6 +338,27 @@ module.exports = {
},
};
},
getHaskellCoreView: function () {
return {
type: 'component',
componentName: 'haskellCore',
componentState: {},
};
},
getHaskellCoreViewWith: function (id, source, haskellCoreOutput, compilerName, editorid, treeid) {
return {
type: 'component',
componentName: 'haskellCore',
componentState: {
id: id,
source: source,
haskellCoreOutput: haskellCoreOutput,
compilerName: compilerName,
editorid: editorid,
treeid: treeid,
},
};
},
getHaskellStgView: function () {
return {
type: 'component',
@@ -359,6 +380,27 @@ module.exports = {
},
};
},
getHaskellCmmView: function () {
return {
type: 'component',
componentName: 'haskellCmm',
componentState: {},
};
},
getHaskellCmmViewWith: function (id, source, haskellCmmOutput, compilerName, editorid, treeid) {
return {
type: 'component',
componentName: 'haskellCmm',
componentState: {
id: id,
source: source,
haskellCmmOutput: haskellCmmOutput,
compilerName: compilerName,
editorid: editorid,
treeid: treeid,
},
};
},
getGnatDebugTreeView: function () {
return {

21
static/hub.ts
View File

@@ -46,7 +46,9 @@ import {DeviceAsm as DeviceView} from './panes/device-view';
import {GnatDebug as GnatDebugView} from './panes/gnatdebug-view';
import {RustMir as RustMirView} from './panes/rustmir-view';
import {RustHir as RustHirView} from './panes/rusthir-view';
import {HaskellCore as HaskellCoreView} from './panes/haskellcore-view';
import {HaskellStg as HaskellStgView} from './panes/haskellstg-view';
import {HaskellCmm as HaskellCmmView} from './panes/haskellcmm-view';
import {GccDump as GCCDumpView} from './panes/gccdump-view';
import {Cfg as CfgView} from './panes/cfg-view';
import {Conformance as ConformanceView} from './panes/conformance-view';
@@ -95,9 +97,15 @@ export class Hub {
layout.registerComponent(Components.getIrView().componentName, (c, s) => this.irViewFactory(c, s));
layout.registerComponent(Components.getDeviceView().componentName, (c, s) => this.deviceViewFactory(c, s));
layout.registerComponent(Components.getRustMirView().componentName, (c, s) => this.rustMirViewFactory(c, s));
layout.registerComponent(Components.getHaskellCoreView().componentName, (c, s) =>
this.haskellCoreViewFactory(c, s)
);
layout.registerComponent(Components.getHaskellStgView().componentName, (c, s) =>
this.haskellStgViewFactory(c, s)
);
layout.registerComponent(Components.getHaskellCmmView().componentName, (c, s) =>
this.haskellCmmViewFactory(c, s)
);
// eslint-disable-next-line max-len
layout.registerComponent(Components.getGnatDebugTreeView().componentName, (c, s) =>
this.gnatDebugTreeViewFactory(c, s)
@@ -467,12 +475,25 @@ export class Hub {
return new RustHirView(this, container, state);
}
public haskellCoreViewFactory(
container: GoldenLayout.Container,
state: ConstructorParameters<typeof HaskellCoreView>[2]
): HaskellCoreView {
return new HaskellCoreView(this, container, state);
}
public haskellStgViewFactory(
container: GoldenLayout.Container,
state: ConstructorParameters<typeof HaskellStgView>[2]
): HaskellStgView {
return new HaskellStgView(this, container, state);
}
public haskellCmmViewFactory(
container: GoldenLayout.Container,
state: ConstructorParameters<typeof HaskellCmmView>[2]
): HaskellCmmView {
return new HaskellCmmView(this, container, state);
}
public gccDumpViewFactory(container: GoldenLayout.Container, state: any): any /* typeof GccDumpView */ {
return new GCCDumpView(this, container, state);

90
static/panes/compiler.js
View File

@@ -330,6 +330,17 @@ Compiler.prototype.initPanerButtons = function () {
);
}, this);
var createHaskellCoreView = _.bind(function () {
return Components.getHaskellCoreViewWith(
this.id,
this.source,
this.lastResult.haskellCoreOutput,
this.getCompilerName(),
this.sourceEditorId,
this.sourceTreeId
);
}, this);
var createHaskellStgView = _.bind(function () {
return Components.getHaskellStgViewWith(
this.id,
@@ -341,6 +352,17 @@ Compiler.prototype.initPanerButtons = function () {
);
}, this);
var createHaskellCmmView = _.bind(function () {
return Components.getHaskellCmmViewWith(
this.id,
this.source,
this.lastResult.haskellCmmOutput,
this.getCompilerName(),
this.sourceEditorId,
this.sourceTreeId
);
}, this);
var createGccDumpView = _.bind(function () {
return Components.getGccDumpViewWith(
this.id,
@@ -497,6 +519,18 @@ Compiler.prototype.initPanerButtons = function () {
}, this)
);
this.container.layoutManager
.createDragSource(this.haskellCoreButton, createHaskellCoreView)
._dragListener.on('dragStart', togglePannerAdder);
this.haskellCoreButton.click(
_.bind(function () {
var insertPoint =
this.hub.findParentRowOrColumn(this.container) || this.container.layoutManager.root.contentItems[0];
insertPoint.addChild(createHaskellCoreView);
}, this)
);
this.container.layoutManager
.createDragSource(this.haskellStgButton, createHaskellStgView)
._dragListener.on('dragStart', togglePannerAdder);
@@ -509,6 +543,18 @@ Compiler.prototype.initPanerButtons = function () {
}, this)
);
this.container.layoutManager
.createDragSource(this.haskellCmmButton, createHaskellCmmView)
._dragListener.on('dragStart', togglePannerAdder);
this.haskellCmmButton.click(
_.bind(function () {
var insertPoint =
this.hub.findParentRowOrColumn(this.container) || this.container.layoutManager.root.contentItems[0];
insertPoint.addChild(createHaskellCmmView);
}, this)
);
this.container.layoutManager
.createDragSource(this.rustMacroExpButton, createRustMacroExpView)
._dragListener.on('dragStart', togglePannerAdder);
@@ -888,7 +934,9 @@ Compiler.prototype.compile = function (bypassCache, newTools) {
produceRustMir: this.rustMirViewOpen,
produceRustMacroExp: this.rustMacroExpViewOpen,
produceRustHir: this.rustHirViewOpen,
produceHaskellCore: this.haskellCoreViewOpen,
produceHaskellStg: this.haskellStgViewOpen,
produceHaskellCmm: this.haskellCmmViewOpen,
},
filters: this.getEffectiveFilters(),
tools: this.getActiveTools(newTools),
@@ -1512,6 +1560,21 @@ Compiler.prototype.onRustMirViewClosed = function (id) {
}
};
Compiler.prototype.onHaskellCoreViewOpened = function (id) {
if (this.id === id) {
this.haskellCoreButton.prop('disabled', true);
this.haskellCoreViewOpen = true;
this.compile();
}
};
Compiler.prototype.onHaskellCoreViewClosed = function (id) {
if (this.id === id) {
this.haskellCoreButton.prop('disabled', false);
this.haskellCoreViewOpen = false;
}
};
Compiler.prototype.onHaskellStgViewOpened = function (id) {
if (this.id === id) {
this.haskellStgButton.prop('disabled', true);
@@ -1527,6 +1590,21 @@ Compiler.prototype.onHaskellStgViewClosed = function (id) {
}
};
Compiler.prototype.onHaskellCmmViewOpened = function (id) {
if (this.id === id) {
this.haskellCmmButton.prop('disabled', true);
this.haskellCmmViewOpen = true;
this.compile();
}
};
Compiler.prototype.onHaskellCmmViewClosed = function (id) {
if (this.id === id) {
this.haskellCmmButton.prop('disabled', false);
this.haskellCmmViewOpen = false;
}
};
Compiler.prototype.onGnatDebugTreeViewOpened = function (id) {
if (this.id === id) {
this.gnatDebugTreeButton.prop('disabled', true);
@@ -1729,7 +1807,9 @@ Compiler.prototype.initButtons = function (state) {
this.rustMirButton = this.domRoot.find('.btn.view-rustmir');
this.rustMacroExpButton = this.domRoot.find('.btn.view-rustmacroexp');
this.rustHirButton = this.domRoot.find('.btn.view-rusthir');
this.haskellCoreButton = this.domRoot.find('.btn.view-haskellCore');
this.haskellStgButton = this.domRoot.find('.btn.view-haskellStg');
this.haskellCmmButton = this.domRoot.find('.btn.view-haskellCmm');
this.gccDumpButton = this.domRoot.find('.btn.view-gccdump');
this.cfgButton = this.domRoot.find('.btn.view-cfg');
this.executorButton = this.domRoot.find('.create-executor');
@@ -1974,7 +2054,9 @@ Compiler.prototype.updateButtons = function () {
this.irButton.prop('disabled', this.irViewOpen);
this.deviceButton.prop('disabled', this.deviceViewOpen);
this.rustMirButton.prop('disabled', this.rustMirViewOpen);
this.haskellStgButton.prop('disabled', this.haskellStgrViewOpen);
this.haskellCoreButton.prop('disabled', this.haskellCoreViewOpen);
this.haskellStgButton.prop('disabled', this.haskellStgViewOpen);
this.haskellCmmButton.prop('disabled', this.haskellCmmViewOpen);
this.rustMacroExpButton.prop('disabled', this.rustMacroExpViewOpen);
this.rustHirButton.prop('disabled', this.rustHirViewOpen);
this.cfgButton.prop('disabled', this.cfgViewOpen);
@@ -1992,7 +2074,9 @@ Compiler.prototype.updateButtons = function () {
this.rustMirButton.toggle(!!this.compiler.supportsRustMirView);
this.rustMacroExpButton.toggle(!!this.compiler.supportsRustMacroExpView);
this.rustHirButton.toggle(!!this.compiler.supportsRustHirView);
this.haskellCoreButton.toggle(!!this.compiler.supportsHaskellCoreView);
this.haskellStgButton.toggle(!!this.compiler.supportsHaskellStgView);
this.haskellCmmButton.toggle(!!this.compiler.supportsHaskellCmmView);
this.cfgButton.toggle(!!this.compiler.supportsCfg);
this.gccDumpButton.toggle(!!this.compiler.supportsGccDump);
this.gnatDebugTreeButton.toggle(!!this.compiler.supportsGnatDebugViews);
@@ -2106,8 +2190,12 @@ Compiler.prototype.initListeners = function () {
this.eventHub.on('rustMacroExpViewClosed', this.onRustMacroExpViewClosed, this);
this.eventHub.on('rustHirViewOpened', this.onRustHirViewOpened, this);
this.eventHub.on('rustHirViewClosed', this.onRustHirViewClosed, this);
this.eventHub.on('haskellCoreViewOpened', this.onHaskellCoreViewOpened, this);
this.eventHub.on('haskellCoreViewClosed', this.onHaskellCoreViewClosed, this);
this.eventHub.on('haskellStgViewOpened', this.onHaskellStgViewOpened, this);
this.eventHub.on('haskellStgViewClosed', this.onHaskellStgViewClosed, this);
this.eventHub.on('haskellCmmViewOpened', this.onHaskellCmmViewOpened, this);
this.eventHub.on('haskellCmmViewClosed', this.onHaskellCmmViewClosed, this);
this.eventHub.on('outputOpened', this.onOutputOpened, this);
this.eventHub.on('outputClosed', this.onOutputClosed, this);

27
static/panes/haskellcmm-view.interfaces.ts Normal file
View File

@@ -0,0 +1,27 @@
// Copyright (c) 2022, Compiler Explorer Authors
// All rights reserved.
//
// Redistribution and use in source and binary forms, with or without
// modification, are permitted provided that the following conditions are met:
//
// * Redistributions of source code must retain the above copyright notice,
// this list of conditions and the following disclaimer.
// * Redistributions in binary form must reproduce the above copyright
// notice, this list of conditions and the following disclaimer in the
// documentation and/or other materials provided with the distribution.
//
// THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
// AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
// IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
// ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
// LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
// CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
// SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
// INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
// CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
// ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
// POSSIBILITY OF SUCH DAMAGE.
export interface HaskellCmmState {
haskellCmmOutput: any;
}

118
static/panes/haskellcmm-view.ts Normal file
View File

@@ -0,0 +1,118 @@
// Copyright (c) 2022, Compiler Explorer Authors
// All rights reserved.
//
// Redistribution and use in source and binary forms, with or without
// modification, are permitted provided that the following conditions are met:
//
// * Redistributions of source code must retain the above copyright notice,
// this list of conditions and the following disclaimer.
// * Redistributions in binary form must reproduce the above copyright
// notice, this list of conditions and the following disclaimer in the
// documentation and/or other materials provided with the distribution.
//
// THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
// AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
// IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
// ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
// LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
// CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
// SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
// INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
// CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
// ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
// POSSIBILITY OF SUCH DAMAGE.
import _ from 'underscore';
import * as monaco from 'monaco-editor';
import {Container} from 'golden-layout';
import {MonacoPane} from './pane';
import {MonacoPaneState} from './pane.interfaces';
import {HaskellCmmState} from './haskellcmm-view.interfaces';
import {ga} from '../analytics';
import {extendConfig} from '../monaco-config';
import {Hub} from '../hub';
export class HaskellCmm extends MonacoPane<monaco.editor.IStandaloneCodeEditor, HaskellCmmState> {
constructor(hub: Hub, container: Container, state: HaskellCmmState & MonacoPaneState) {
super(hub, container, state);
if (state.haskellCmmOutput) {
this.showHaskellCmmResults(state.haskellCmmOutput);
}
}
override getInitialHTML(): string {
return $('#haskellCmm').html();
}
override createEditor(editorRoot: HTMLElement): monaco.editor.IStandaloneCodeEditor {
return monaco.editor.create(
editorRoot,
extendConfig({
language: 'haskell',
readOnly: true,
glyphMargin: true,
lineNumbersMinChars: 3,
})
);
}
override registerOpeningAnalyticsEvent(): void {
ga.proxy('send', {
hitType: 'event',
eventCategory: 'OpenViewPane',
eventAction: 'HaskellCmm',
});
}
override getDefaultPaneName(): string {
return 'GHC Cmm Viewer';
}
override registerCallbacks(): void {
const throttleFunction = _.throttle(event => this.onDidChangeCursorSelection(event), 500);
this.editor.onDidChangeCursorSelection(event => throttleFunction(event));
this.eventHub.emit('haskellCmmViewOpened', this.compilerInfo.compilerId);
this.eventHub.emit('requestSettings');
}
override onCompileResult(compilerId: number, compiler: any, result: any): void {
if (this.compilerInfo.compilerId !== compilerId) return;
if (result.hasHaskellCmmOutput) {
this.showHaskellCmmResults(result.haskellCmmOutput);
} else if (compiler.supportsHaskellCmmView) {
this.showHaskellCmmResults([{text: '<No output>'}]);
}
}
override onCompiler(compilerId: number, compiler: any, options: any, editorId?: number, treeId?: number): void {
if (this.compilerInfo.compilerId === compilerId) {
this.compilerInfo.compilerName = compiler ? compiler.name : '';
this.compilerInfo.editorId = editorId;
this.compilerInfo.treeId = treeId;
this.updateTitle();
if (compiler && !compiler.supportsHaskellCmmView) {
this.showHaskellCmmResults([{text: '<GHC Cmm output is not supported for this compiler>'}]);
}
}
}
showHaskellCmmResults(result: Record<'text', string>[]): void {
this.editor.getModel()?.setValue(result.length ? _.pluck(result, 'text').join('\n') : '<No GHC Cmm generated>');
if (!this.isAwaitingInitialResults) {
if (this.selection) {
this.editor.setSelection(this.selection);
this.editor.revealLinesInCenter(this.selection.selectionStartLineNumber, this.selection.endLineNumber);
}
this.isAwaitingInitialResults = true;
}
}
override close(): void {
this.eventHub.unsubscribe();
this.eventHub.emit('haskellCmmViewClosed', this.compilerInfo.compilerId);
this.editor.dispose();
}
}

27
static/panes/haskellcore-view.interfaces.ts Normal file
View File

@@ -0,0 +1,27 @@
// Copyright (c) 2022, Compiler Explorer Authors
// All rights reserved.
//
// Redistribution and use in source and binary forms, with or without
// modification, are permitted provided that the following conditions are met:
//
// * Redistributions of source code must retain the above copyright notice,
// this list of conditions and the following disclaimer.
// * Redistributions in binary form must reproduce the above copyright
// notice, this list of conditions and the following disclaimer in the
// documentation and/or other materials provided with the distribution.
//
// THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
// AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
// IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
// ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
// LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
// CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
// SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
// INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
// CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
// ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
// POSSIBILITY OF SUCH DAMAGE.
export interface HaskellCoreState {
haskellCoreOutput: any;
}

120
static/panes/haskellcore-view.ts Normal file
View File

@@ -0,0 +1,120 @@
// Copyright (c) 2022, Compiler Explorer Authors
// All rights reserved.
//
// Redistribution and use in source and binary forms, with or without
// modification, are permitted provided that the following conditions are met:
//
// * Redistributions of source code must retain the above copyright notice,
// this list of conditions and the following disclaimer.
// * Redistributions in binary form must reproduce the above copyright
// notice, this list of conditions and the following disclaimer in the
// documentation and/or other materials provided with the distribution.
//
// THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
// AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
// IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
// ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
// LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
// CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
// SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
// INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
// CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
// ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
// POSSIBILITY OF SUCH DAMAGE.
import _ from 'underscore';
import * as monaco from 'monaco-editor';
import {Container} from 'golden-layout';
import {MonacoPane} from './pane';
import {MonacoPaneState} from './pane.interfaces';
import {HaskellCoreState} from './haskellcore-view.interfaces';
import {ga} from '../analytics';
import {extendConfig} from '../monaco-config';
import {Hub} from '../hub';
export class HaskellCore extends MonacoPane<monaco.editor.IStandaloneCodeEditor, HaskellCoreState> {
constructor(hub: Hub, container: Container, state: HaskellCoreState & MonacoPaneState) {
super(hub, container, state);
if (state.haskellCoreOutput) {
this.showHaskellCoreResults(state.haskellCoreOutput);
}
}
override getInitialHTML(): string {
return $('#haskellCore').html();
}
override createEditor(editorRoot: HTMLElement): monaco.editor.IStandaloneCodeEditor {
return monaco.editor.create(
editorRoot,
extendConfig({
language: 'haskell',
readOnly: true,
glyphMargin: true,
lineNumbersMinChars: 3,
})
);
}
override registerOpeningAnalyticsEvent(): void {
ga.proxy('send', {
hitType: 'event',
eventCategory: 'OpenViewPane',
eventAction: 'HaskellCore',
});
}
override getDefaultPaneName(): string {
return 'GHC Core Viewer';
}
override registerCallbacks(): void {
const throttleFunction = _.throttle(event => this.onDidChangeCursorSelection(event), 500);
this.editor.onDidChangeCursorSelection(event => throttleFunction(event));
this.eventHub.emit('haskellCoreViewOpened', this.compilerInfo.compilerId);
this.eventHub.emit('requestSettings');
}
override onCompileResult(compilerId: number, compiler: any, result: any): void {
if (this.compilerInfo.compilerId !== compilerId) return;
if (result.hasHaskellCoreOutput) {
this.showHaskellCoreResults(result.haskellCoreOutput);
} else if (compiler.supportsHaskellCoreView) {
this.showHaskellCoreResults([{text: '<No output>'}]);
}
}
override onCompiler(compilerId: number, compiler: any, options: any, editorId?: number, treeId?: number): void {
if (this.compilerInfo.compilerId === compilerId) {
this.compilerInfo.compilerName = compiler ? compiler.name : '';
this.compilerInfo.editorId = editorId;
this.compilerInfo.treeId = treeId;
this.updateTitle();
if (compiler && !compiler.supportsHaskellCoreView) {
this.showHaskellCoreResults([{text: '<GHC Core output is not supported for this compiler>'}]);
}
}
}
showHaskellCoreResults(result: Record<'text', string>[]): void {
this.editor
.getModel()
?.setValue(result.length ? _.pluck(result, 'text').join('\n') : '<No GHC Core generated>');
if (!this.isAwaitingInitialResults) {
if (this.selection) {
this.editor.setSelection(this.selection);
this.editor.revealLinesInCenter(this.selection.selectionStartLineNumber, this.selection.endLineNumber);
}
this.isAwaitingInitialResults = true;
}
}
override close(): void {
this.eventHub.unsubscribe();
this.eventHub.emit('haskellCoreViewClosed', this.compilerInfo.compilerId);
this.editor.dispose();
}
}

10
static/panes/haskellstg-view.ts
View File

@@ -67,7 +67,7 @@ export class HaskellStg extends MonacoPane<monaco.editor.IStandaloneCodeEditor,
}
override getDefaultPaneName(): string {
return 'Haskell STG viewer';
return 'GHC STG Viewer';
}
override registerCallbacks(): void {
@@ -93,15 +93,13 @@ export class HaskellStg extends MonacoPane<monaco.editor.IStandaloneCodeEditor,
this.compilerInfo.treeId = treeId;
this.updateTitle();
if (compiler && !compiler.supportsHaskellStgView) {
this.showHaskellStgResults([{text: '<Haskell STG output is not supported for this compiler>'}]);
this.showHaskellStgResults([{text: '<GHC STG output is not supported for this compiler>'}]);
}
}
}
showHaskellStgResults(result: any[]): void {
this.editor
.getModel()
?.setValue(result.length ? _.pluck(result, 'text').join('\n') : '<No Haskell STG generated>');
showHaskellStgResults(result: Record<'text', string>[]): void {
this.editor.getModel()?.setValue(result.length ? _.pluck(result, 'text').join('\n') : '<No GHC STG generated>');
if (!this.isAwaitingInitialResults) {
if (this.selection) {

20
views/templates.pug
View File

@@ -116,9 +116,15 @@
button.dropdown-item.btn.btn-sm.btn-light.view-rusthir(title="Show Rust HIR")
span.dropdown-icon.fas.fa-arrows-alt
| Rust HIR output
button.dropdown-item.btn.btn-sm.btn-light.view-haskellStg(title="Show Haskell STG Intermediate Representation")
button.dropdown-item.btn.btn-sm.btn-light.view-haskellCore(title="Show GHC Core Intermediate Representation")
span.dropdown-icon.fas.fa-water
| Haskell STG output
| GHC Core output
button.dropdown-item.btn.btn-sm.btn-light.view-haskellStg(title="Show GHC STG Intermediate Representation")
span.dropdown-icon.fas.fa-water
| GHC STG output
button.dropdown-item.btn.btn-sm.btn-light.view-haskellCmm(title="Show GHC Cmm Intermediate Representation")
span.dropdown-icon.fas.fa-water
| GHC Cmm output
button.dropdown-item.btn.btn-sm.btn-light.view-gccdump(title="Show Tree/RTL dump (GCC only)")
span.dropdown-icon.fas.fa-tree
| GCC Tree/RTL output
@@ -336,11 +342,21 @@
include font-size
.monaco-placeholder
#haskellCore
.top-bar.btn-toolbar.bg-light(role="toolbar")
include font-size
.monaco-placeholder
#haskellStg
.top-bar.btn-toolbar.bg-light(role="toolbar")
include font-size
.monaco-placeholder
#haskellCmm
.top-bar.btn-toolbar.bg-light(role="toolbar")
include font-size
.monaco-placeholder
#rustmacroexp
.top-bar.btn-toolbar.bg-light(role="toolbar")
include font-size