Add GHC Core and Cmm views #3571 (#3593)gh-2762

11 files changed, 516 insertions, 19 deletions

diff --git a/lib/base-compiler.js b/lib/base-compiler.js
index 5662e5609..e03619e08 100644
--- a/lib/base-compiler.js
+++ b/lib/base-compiler.js
@@ -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);
     }
diff --git a/lib/compilers/haskell.js b/lib/compilers/haskell.js
index 413185a2e..a6c1a8f6b 100644
--- a/lib/compilers/haskell.js
+++ b/lib/compilers/haskell.js
@@ -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;
     }
diff --git a/static/components.js b/static/components.js
index 091c13f0b..0ff641b94 100644
--- a/static/components.js
+++ b/static/components.js
@@ -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 {
diff --git a/static/hub.ts b/static/hub.ts
index 873aa8a83..019789956 100644
--- a/static/hub.ts
+++ b/static/hub.ts
@@ -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);
diff --git a/static/panes/compiler.js b/static/panes/compiler.js
index 0539cd852..4ea2713a8 100644
--- a/static/panes/compiler.js
+++ b/static/panes/compiler.js
@@ -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,
@@ -498,6 +520,18 @@ Compiler.prototype.initPanerButtons = function () {
     );
 
     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);
 
@@ -510,6 +544,18 @@ Compiler.prototype.initPanerButtons = function () {
     );
 
     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);
 
diff --git a/static/panes/haskellcmm-view.interfaces.ts b/static/panes/haskellcmm-view.interfaces.ts
new file mode 100644
index 000000000..e8eae892e
--- /dev/null
+++ b/static/panes/haskellcmm-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 HaskellCmmState {
+    haskellCmmOutput: any;
+}
diff --git a/static/panes/haskellcmm-view.ts b/static/panes/haskellcmm-view.ts
new file mode 100644
index 000000000..8cfa136d7
--- /dev/null
+++ b/static/panes/haskellcmm-view.ts
@@ -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();
+    }
+}
diff --git a/static/panes/haskellcore-view.interfaces.ts b/static/panes/haskellcore-view.interfaces.ts
new file mode 100644
index 000000000..25a094621
--- /dev/null
+++ b/static/panes/haskellcore-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 HaskellCoreState {
+    haskellCoreOutput: any;
+}
diff --git a/static/panes/haskellcore-view.ts b/static/panes/haskellcore-view.ts
new file mode 100644
index 000000000..1049819f9
--- /dev/null
+++ b/static/panes/haskellcore-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 {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();
+    }
+}
diff --git a/static/panes/haskellstg-view.ts b/static/panes/haskellstg-view.ts
index a9e0b44dc..dbf6263c3 100644
--- a/static/panes/haskellstg-view.ts
+++ b/static/panes/haskellstg-view.ts
@@ -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) {
diff --git a/views/templates.pug b/views/templates.pug
index 697c17f13..54ebead12 100644
--- a/views/templates.pug
+++ b/views/templates.pug
@@ -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