Skip to content
GitLab
Projects Groups Topics Snippets
  • /
  • Help
    • Help
    • Support
    • Community forum
    • Submit feedback
  • Register
  • Sign in
  • GHC GHC
  • Project information
    • Project information
    • Activity
    • Labels
    • Members
  • Repository
    • Repository
    • Files
    • Commits
    • Branches
    • Tags
    • Contributor statistics
    • Graph
    • Compare revisions
    • Locked files
  • Issues 5.5k
    • Issues 5.5k
    • List
    • Boards
    • Service Desk
    • Milestones
    • Iterations
  • Merge requests 638
    • Merge requests 638
  • CI/CD
    • CI/CD
    • Pipelines
    • Jobs
    • Artifacts
    • Schedules
    • Test cases
  • Deployments
    • Deployments
    • Releases
  • Packages and registries
    • Packages and registries
    • Model experiments
  • Analytics
    • Analytics
    • CI/CD
    • Code review
    • Insights
    • Issue
    • Repository
  • Wiki
    • Wiki
  • Snippets
    • Snippets
  • Activity
  • Graph
  • Create a new issue
  • Jobs
  • Commits
  • Issue Boards
Collapse sidebar
  • Glasgow Haskell CompilerGlasgow Haskell Compiler
  • GHCGHC
  • Issues
  • #5573

Returning nested unboxed tuples crashes the code generator on x86_64 Linux

Compiling the following program with GHC 7.0.3 running on a 64 bit Linux machine crashes with a GHC panic:

$ uname -a
Linux pandora 2.6.32-5-amd64 #1 SMP Fri Sep 9 20:23:16 UTC 2011 x86_64 GNU/Linux
$ ghc --version
The Glorious Glasgow Haskell Compilation System, version 7.0.3
$ cat unboxed.hs
{-# LANGUAGE MagicHash, UnboxedTuples, BangPatterns #-}

import GHC.Exts

foo :: Double# -> (# (# Double#, Double# #), Double# #)
foo x = (# (# x, x #), x #)
{-# NOINLINE foo #-}

main :: IO ()
main = print $ let !(# !(# y, z #), w #) = foo 10.0##
               in D# (y +## z +## w)
$ ghc unboxed.hs
[1 of 1] Compiling Main             ( unboxed.hs, unboxed.o )
ghc: panic! (the 'impossible' happened)
  (GHC version 7.0.3 for x86_64-unknown-linux):
	cgPanic
    sat_siH{v} [lid]
    static binds for:
    local binds for:
    x{v siq} [lid]
    SRT label foo{v rcY}_srt

Please report this as a GHC bug:  http://www.haskell.org/ghc/reportabug

The expected behavior is compiling correctly and outputting 30.0. In fact, this is what happens if we remove the NOINLINE pragma or flatten the tuple.

Compiling this program with -dcore-lint produces:

$ ghc unboxed.hs -dcore-lint
[1 of 1] Compiling Main             ( unboxed.hs, unboxed.o )
*** Core Lint errors : in result of Desugar ***
<no location info>:
    In a case alternative: ((#,#) ds_dil :: (# GHC.Prim.Double#,
                                               GHC.Prim.Double# #),
                                  w_ad4 :: GHC.Prim.Double#)
    A variable has unboxed tuple type: ds_dil
    Binder's type: (# GHC.Prim.Double#, GHC.Prim.Double# #)
*** Offending Program ***
Main.foo [InlPrag=NOINLINE]
  :: GHC.Prim.Double#
     -> (# (# GHC.Prim.Double#, GHC.Prim.Double# #), GHC.Prim.Double# #)
[LclId]
Main.foo =
  \ (x_ad1 :: GHC.Prim.Double#) -> (# (# x_ad1, x_ad1 #), x_ad1 #)

Main.main :: GHC.Types.IO ()
[LclIdX]
Main.main =
  GHC.Base.$
    @ GHC.Types.Double
    @ (GHC.Types.IO ())
    (System.IO.print @ GHC.Types.Double GHC.Float.$fShowDouble)
    (case Main.foo 10.0 of _ { (# ds_dil, w_ad4 #) ->
     case ds_dil of _ { (# y_ad2, z_ad3 #) ->
     GHC.Types.D# (GHC.Prim.+## (GHC.Prim.+## y_ad2 z_ad3) w_ad4)
     }
     })

:Main.main :: GHC.Types.IO ()
[LclIdX]
:Main.main = GHC.TopHandler.runMainIO @ () Main.main

*** End of Offense ***


<no location info>: 
Compilation had errors

GHC 6.12.1 running on a 32 Linux machine rejects the program:

$ uname -a
Linux golconda 2.6.32-5-686 #1 SMP Mon Jun 13 04:13:06 UTC 2011 i686 GNU/Linux
$ ghc --version
The Glorious Glasgow Haskell Compilation System, version 6.12.1
$ ghc unboxed.hs 

unboxed.hs:6:11:
    Couldn't match kind `(#)' against `??'
    When matching the kinds of `(# Double#, Double# #) :: (#)' and
                               `t :: ??'
      Expected type: t
      Inferred type: (# Double#, Double# #)
    In the expression: (# x, x #)

This is also not the expected behavior, as the documentation says that unboxed tuples should be able to contain an object of any type. Also, this error message is less than maximally helpful.

By the way, the reason we are trying to nest unboxed tuples in the first place is because we are experimenting with using GHC as a compilation target, and our code generator wanted to emit a long unboxed tuple. We got a nice error message saying that the length limit on unboxed tuples was 62; would we please nest them? and on trying to nest them we tripped over this.

Trac metadata
Trac field Value
Version 7.0.3
Type Bug
TypeOfFailure OtherFailure
Priority normal
Resolution Unresolved
Component Compiler
Test case
Differential revisions
BlockedBy
Related
Blocking
CC axch@mit.edu
Operating system
Architecture
To upload designs, you'll need to enable LFS and have an admin enable hashed storage. More information
Assignee
Assign to
Time tracking