diff options
| -rw-r--r-- | CONTRIBUTORS.md | 1 | ||||
| -rw-r--r-- | lib/base-compiler.js | 34 | ||||
| -rw-r--r-- | lib/compilers/haskell.js | 28 | ||||
| -rw-r--r-- | static/components.js | 21 | ||||
| -rw-r--r-- | static/hub.ts | 11 | ||||
| -rw-r--r-- | static/panes/compiler.js | 44 | ||||
| -rw-r--r-- | static/panes/haskellstg-view.interfaces.ts | 27 | ||||
| -rw-r--r-- | static/panes/haskellstg-view.ts | 120 | ||||
| -rw-r--r-- | views/templates.pug | 8 |
9 files changed, 286 insertions, 8 deletions
diff --git a/CONTRIBUTORS.md b/CONTRIBUTORS.md index eaa82439e..eb62d2318 100644 --- a/CONTRIBUTORS.md +++ b/CONTRIBUTORS.md @@ -116,3 +116,4 @@ From oldest to newest contributor, we would like to thank: - [Ankur Saini](https://github.com/Arsenic-ATG) - [m8mble](https://github.com/m8mble) - [Anders-T](https://github.com/anders-torbjornsen) +- [Adam Sandberg Eriksson](https://github.com/adamse) diff --git a/lib/base-compiler.js b/lib/base-compiler.js index 7f0c64e65..a5875e090 100644 --- a/lib/base-compiler.js +++ b/lib/base-compiler.js @@ -891,6 +891,10 @@ export class BaseCompiler { return outputFilename.replace(path.extname(outputFilename), '.mir'); } + getHaskellStgOutputFilename(inputFilename) { + return inputFilename.replace(path.extname(inputFilename), '.dump-stg-final'); + } + // 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. @@ -938,6 +942,29 @@ export class BaseCompiler { return [{text: 'Internal error; unable to open output path'}]; } + async processHaskellStgOutput(inputFilename, output) { + const stgPath = this.getHaskellStgOutputFilename(inputFilename); + if (output.code !== 0) { + return [{text: 'Failed to run compiler to get Haskell STG'}]; + } + if (await fs.exists(stgPath)) { + const content = await fs.readFile(stgPath, 'utf-8'); + // output file starts with + // + // ==================== Final STG: ==================== + // 2022-04-27 16:48:25.411966835 UTC + // + // we want to drop this to make the output nicer + return content + .split('\n') + .slice(4) + .map(line => ({ + text: line, + })); + } + return [{text: 'Internal error; unable to open output path'}]; + } + getIrOutputFilename(inputFilename) { return inputFilename.replace(path.extname(inputFilename), '.ll'); } @@ -1422,6 +1449,7 @@ 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 makeHaskellStg = backendOptions.produceHaskellStg && this.compiler.supportsHaskellStgView; const makeGccDump = backendOptions.produceGccDump && backendOptions.produceGccDump.opened && this.compiler.supportsGccDump; @@ -1462,6 +1490,8 @@ export class BaseCompiler { : ''; const rustMirResult = makeRustMir ? await this.processRustMirOutput(outputFilename, asmResult) : ''; + const haskellStgResult = makeHaskellStg ? await this.processHaskellStgOutput(inputFilename, asmResult) : ''; + asmResult.dirPath = dirPath; asmResult.compilationOptions = options; asmResult.downloads = downloads; @@ -1526,6 +1556,10 @@ export class BaseCompiler { asmResult.hasRustHirOutput = true; asmResult.rustHirOutput = rustHirResult; } + if (haskellStgResult) { + asmResult.hasHaskellStgOutput = true; + asmResult.haskellStgOutput = haskellStgResult; + } return this.checkOutputFileAndDoPostProcess(asmResult, outputFilename, filters); } diff --git a/lib/compilers/haskell.js b/lib/compilers/haskell.js index e55bb37a4..413185a2e 100644 --- a/lib/compilers/haskell.js +++ b/lib/compilers/haskell.js @@ -22,28 +22,40 @@ // ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE // POSSIBILITY OF SUCH DAMAGE. -import { BaseCompiler } from '../base-compiler'; +import path from 'path'; -import { ClangParser } from './argument-parsers'; +import {BaseCompiler} from '../base-compiler'; + +import {ClangParser} from './argument-parsers'; export class HaskellCompiler extends BaseCompiler { static get key() { return 'haskell'; } + constructor(info, env) { + super(info, env); + this.compiler.supportsHaskellStgView = true; + } + + optionsForBackend(backendOptions, outputFilename) { + const opts = super.optionsForBackend(backendOptions, outputFilename); + + if (backendOptions.produceHaskellStg && this.compiler.supportsHaskellStgView) { + opts.push('-ddump-to-file', '-dumpdir', path.dirname(outputFilename), '-ddump-stg-final'); + } + return opts; + } + optionsForFilter(filters, outputFilename) { const options = ['-g', '-o', this.filename(outputFilename)]; - if (!filters.binary) - options.unshift('-S'); + if (!filters.binary) options.unshift('-S'); return options; } getSharedLibraryPathsAsArguments(libraries) { const libPathFlag = this.compiler.libpathFlag || '-L'; - return [ - libPathFlag + '.', - ...this.getSharedLibraryPaths(libraries).map(path => libPathFlag + path), - ]; + return [libPathFlag + '.', ...this.getSharedLibraryPaths(libraries).map(path => libPathFlag + path)]; } getArgumentParser() { diff --git a/static/components.js b/static/components.js index 27929410a..c95b7c6bd 100644 --- a/static/components.js +++ b/static/components.js @@ -338,6 +338,27 @@ module.exports = { }, }; }, + getHaskellStgView: function () { + return { + type: 'component', + componentName: 'haskellStg', + componentState: {}, + }; + }, + getHaskellStgViewWith: function (id, source, haskellStgOutput, compilerName, editorid, treeid) { + return { + type: 'component', + componentName: 'haskellStg', + componentState: { + id: id, + source: source, + haskellStgOutput: haskellStgOutput, + compilerName: compilerName, + editorid: editorid, + treeid: treeid, + }, + }; + }, getGnatDebugTreeView: function () { return { diff --git a/static/hub.ts b/static/hub.ts index b72676575..e2d86f88e 100644 --- a/static/hub.ts +++ b/static/hub.ts @@ -46,6 +46,7 @@ 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 {HaskellStg as HaskellStgView} from './panes/haskellstg-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'; @@ -94,6 +95,9 @@ 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.getHaskellStgView().componentName, (c, s) => + this.haskellStgViewFactory(c, s) + ); // eslint-disable-next-line max-len layout.registerComponent(Components.getGnatDebugTreeView().componentName, (c, s) => this.gnatDebugTreeViewFactory(c, s) @@ -463,6 +467,13 @@ export class Hub { return new RustHirView(this, container, state); } + public haskellStgViewFactory( + container: GoldenLayout.Container, + state: ConstructorParameters<typeof HaskellStgView>[2] + ): HaskellStgView { + return new HaskellStgView(this, container, state); + } + public gccDumpViewFactory(container: GoldenLayout.Container, state: any): any /* typeof GccDumpView */ { return new GCCDumpView(this, container, state); } diff --git a/static/panes/compiler.js b/static/panes/compiler.js index 57870eb12..dfb49f6ef 100644 --- a/static/panes/compiler.js +++ b/static/panes/compiler.js @@ -330,6 +330,17 @@ Compiler.prototype.initPanerButtons = function () { ); }, this); + var createHaskellStgView = _.bind(function () { + return Components.getHaskellStgViewWith( + this.id, + this.source, + this.lastResult.haskellStgOutput, + this.getCompilerName(), + this.sourceEditorId, + this.sourceTreeId + ); + }, this); + var createGccDumpView = _.bind(function () { return Components.getGccDumpViewWith( this.id, @@ -487,6 +498,18 @@ Compiler.prototype.initPanerButtons = function () { ); this.container.layoutManager + .createDragSource(this.haskellStgButton, createHaskellStgView) + ._dragListener.on('dragStart', togglePannerAdder); + + this.haskellStgButton.click( + _.bind(function () { + var insertPoint = + this.hub.findParentRowOrColumn(this.container) || this.container.layoutManager.root.contentItems[0]; + insertPoint.addChild(createHaskellStgView); + }, this) + ); + + this.container.layoutManager .createDragSource(this.rustMacroExpButton, createRustMacroExpView) ._dragListener.on('dragStart', togglePannerAdder); @@ -865,6 +888,7 @@ Compiler.prototype.compile = function (bypassCache, newTools) { produceRustMir: this.rustMirViewOpen, produceRustMacroExp: this.rustMacroExpViewOpen, produceRustHir: this.rustHirViewOpen, + produceHaskellStg: this.haskellStgViewOpen, }, filters: this.getEffectiveFilters(), tools: this.getActiveTools(newTools), @@ -1488,6 +1512,21 @@ Compiler.prototype.onRustMirViewClosed = function (id) { } }; +Compiler.prototype.onHaskellStgViewOpened = function (id) { + if (this.id === id) { + this.haskellStgButton.prop('disabled', true); + this.haskellStgViewOpen = true; + this.compile(); + } +}; + +Compiler.prototype.onHaskellStgViewClosed = function (id) { + if (this.id === id) { + this.haskellStgButton.prop('disabled', false); + this.haskellStgViewOpen = false; + } +}; + Compiler.prototype.onGnatDebugTreeViewOpened = function (id) { if (this.id === id) { this.gnatDebugTreeButton.prop('disabled', true); @@ -1690,6 +1729,7 @@ 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.haskellStgButton = this.domRoot.find('.btn.view-haskellStg'); this.gccDumpButton = this.domRoot.find('.btn.view-gccdump'); this.cfgButton = this.domRoot.find('.btn.view-cfg'); this.executorButton = this.domRoot.find('.create-executor'); @@ -1934,6 +1974,7 @@ 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.rustMacroExpButton.prop('disabled', this.rustMacroExpViewOpen); this.rustHirButton.prop('disabled', this.rustHirViewOpen); this.cfgButton.prop('disabled', this.cfgViewOpen); @@ -1951,6 +1992,7 @@ Compiler.prototype.updateButtons = function () { this.rustMirButton.toggle(!!this.compiler.supportsRustMirView); this.rustMacroExpButton.toggle(!!this.compiler.supportsRustMacroExpView); this.rustHirButton.toggle(!!this.compiler.supportsRustHirView); + this.haskellStgButton.toggle(!!this.compiler.supportsHaskellStgView); this.cfgButton.toggle(!!this.compiler.supportsCfg); this.gccDumpButton.toggle(!!this.compiler.supportsGccDump); this.gnatDebugTreeButton.toggle(!!this.compiler.supportsGnatDebugViews); @@ -2064,6 +2106,8 @@ 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('haskellStgViewOpened', this.onHaskellStgViewOpened, this); + this.eventHub.on('haskellStgViewClosed', this.onHaskellStgViewClosed, this); this.eventHub.on('outputOpened', this.onOutputOpened, this); this.eventHub.on('outputClosed', this.onOutputClosed, this); diff --git a/static/panes/haskellstg-view.interfaces.ts b/static/panes/haskellstg-view.interfaces.ts new file mode 100644 index 000000000..d52552541 --- /dev/null +++ b/static/panes/haskellstg-view.interfaces.ts @@ -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 HaskellStgState { + haskellStgOutput: any; +} diff --git a/static/panes/haskellstg-view.ts b/static/panes/haskellstg-view.ts new file mode 100644 index 000000000..a9e0b44dc --- /dev/null +++ b/static/panes/haskellstg-view.ts @@ -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 {HaskellStgState} from './haskellstg-view.interfaces'; + +import {ga} from '../analytics'; +import {extendConfig} from '../monaco-config'; +import {Hub} from '../hub'; + +export class HaskellStg extends MonacoPane<monaco.editor.IStandaloneCodeEditor, HaskellStgState> { + constructor(hub: Hub, container: Container, state: HaskellStgState & MonacoPaneState) { + super(hub, container, state); + if (state.haskellStgOutput) { + this.showHaskellStgResults(state.haskellStgOutput); + } + } + + override getInitialHTML(): string { + return $('#haskellStg').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: 'HaskellStg', + }); + } + + override getDefaultPaneName(): string { + return 'Haskell STG viewer'; + } + + override registerCallbacks(): void { + const throttleFunction = _.throttle(event => this.onDidChangeCursorSelection(event), 500); + this.editor.onDidChangeCursorSelection(event => throttleFunction(event)); + this.eventHub.emit('haskellStgViewOpened', this.compilerInfo.compilerId); + this.eventHub.emit('requestSettings'); + } + + override onCompileResult(compilerId: number, compiler: any, result: any): void { + if (this.compilerInfo.compilerId !== compilerId) return; + if (result.hasHaskellStgOutput) { + this.showHaskellStgResults(result.haskellStgOutput); + } else if (compiler.supportsHaskellStgView) { + this.showHaskellStgResults([{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.supportsHaskellStgView) { + this.showHaskellStgResults([{text: '<Haskell 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>'); + + 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('haskellStgViewClosed', this.compilerInfo.compilerId); + this.editor.dispose(); + } +} diff --git a/views/templates.pug b/views/templates.pug index cbd4dd139..697c17f13 100644 --- a/views/templates.pug +++ b/views/templates.pug @@ -116,6 +116,9 @@ 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") + span.dropdown-icon.fas.fa-water + | Haskell STG 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 @@ -333,6 +336,11 @@ include font-size .monaco-placeholder + #haskellStg + .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 |