Skip to content

GitLab

  • Projects
  • Groups
  • Snippets
  • Help
    • Loading...
  • Help
    • Help
    • Support
    • Community forum
    • Submit feedback
  • Sign in / Register
GHC
GHC
  • Project overview
    • Project overview
    • Details
    • Activity
    • Releases
  • Repository
    • Repository
    • Files
    • Commits
    • Branches
    • Tags
    • Contributors
    • Graph
    • Compare
    • Locked Files
  • Issues 4,385
    • Issues 4,385
    • List
    • Boards
    • Labels
    • Service Desk
    • Milestones
    • Iterations
  • Merge Requests 373
    • Merge Requests 373
  • Requirements
    • Requirements
    • List
  • CI / CD
    • CI / CD
    • Pipelines
    • Jobs
    • Schedules
    • Test Cases
  • Operations
    • Operations
    • Incidents
    • Environments
  • Analytics
    • Analytics
    • CI / CD
    • Code Review
    • Insights
    • Issue
    • Repository
    • Value Stream
  • Wiki
    • Wiki
  • Snippets
    • Snippets
  • Members
    • Members
  • Activity
  • Graph
  • Create a new issue
  • Jobs
  • Commits
  • Issue Boards
Collapse sidebar
  • Glasgow Haskell Compiler
  • GHCGHC
  • Issues
  • #14677

Closed
Open
Opened Jan 16, 2018 by Simon Peyton Jones@simonpjDeveloper

Code generator does not correctly tag a pointer

See also #15155, #16559 (closed)

Consider

data T a = MkT ![a]

The pointer stored in a MkT constructor should always be correctly tagged, never tagged with un-evaluated 00. C.f. Commentary/Rts/HaskellExecution/PointerTagging

But this invariant is broken. Example taken from #14626, #14677-39.

Trac14626_1.hs

module Trac14626_1 where

data Style = UserStyle Int
           | PprDebug

data SDC = SDC !Style !Int

defaultUserStyle :: Bool -> Style
defaultUserStyle True = UserStyle 123
defaultUserStyle False = PprDebug

Trac14626_2.hs

module Trac14626_2 where

import Trac14626_1

f :: Int -> SDC
f x = SDC (defaultUserStyle (x > 1)) x

Compiling with ghc Trac14626_1 Trac14626_2 -ddump-simpl -O results in a similar scenario than the one described by Heisenbug:

-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
defaultUserStyle2
defaultUserStyle2 = I# 123#

-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
defaultUserStyle1
defaultUserStyle1 = UserStyle defaultUserStyle2

-- RHS size: {terms: 7, types: 2, coercions: 0, joins: 0/0}
defaultUserStyle
defaultUserStyle
  = \ ds_dZ7 ->
      case ds_dZ7 of {
        False -> PprDebug;
        True -> defaultUserStyle1
      }

Our UserStyle 123 constant has been lifted to top-level, just like in Heisenbugs example.

Now looking at the Core of f

f
f = \ x_a1dk ->
      case x_a1dk of { I# x1_a2gV ->
      case ># x1_a2gV 1# of {
        __DEFAULT -> SDC PprDebug x1_a2gV;
        1# -> SDC defaultUserStyle1 x1_a2gV
      }
      }

(Note how f doesn't scrutinise defaultUserStyle1)

Looking at the CMM for f we can see

           ... 
           if (%MO_S_Le_W64(_s2hT::I64, 1)) goto c2ip; else goto c2is;
       c2ip:
           I64[Hp - 16] = SDC_con_info;
           P64[Hp - 8] = PprDebug_closure+2;
           I64[Hp] = _s2hT::I64;
           R1 = Hp - 15;
           Sp = Sp + 8;
           call (P64[Sp])(R1) args: 8, res: 0, upd: 8;
       c2is:
           I64[Hp - 16] = SDC_con_info;
           P64[Hp - 8] = defaultUserStyle1_closure; -- defaultUserStyle1 isn't tagged!
           I64[Hp] = _s2hT::I64;
           R1 = Hp - 15;
           Sp = Sp + 8;
           call (P64[Sp])(R1) args: 8, res: 0, upd: 8;

When generating code for f the code generator wants to know the LambdaFormInfo (the closure type) of defaultUserStyle1.

Since defaultUserStyle1 is defined in another module we end up calling mkLFImported in StgCmmClosure which ultimatively gives an LFUnknown which always gets a DynTag 0 from lfDynTag.

I think we lack a bit of information here to give defaultUserStyle1 the correct LFCon lambda form. Maybe top-level binders should know its LambdaForm and include them in their interfaces.

Trac metadata
Trac field Value
Version 8.2.2
Type Bug
TypeOfFailure OtherFailure
Priority normal
Resolution Unresolved
Component Compiler
Test case
Differential revisions
BlockedBy
Related
Blocking
CC
Operating system
Architecture
Edited Mar 10, 2020 by Ömer Sinan Ağacan
Assignee
Assign to
None
Milestone
None
Assign milestone
Time tracking
None
Due date
None
Reference: ghc/ghc#14677