Skip to content
GitLab
Projects Groups Snippets
  • /
  • Help
    • Help
    • Support
    • Community forum
    • Submit feedback
  • Sign in / Register
  • GHC GHC
  • Project information
    • Project information
    • Activity
    • Labels
    • Members
  • Repository
    • Repository
    • Files
    • Commits
    • Branches
    • Tags
    • Contributors
    • Graph
    • Compare
    • Locked Files
  • Issues 5,413
    • Issues 5,413
    • List
    • Boards
    • Service Desk
    • Milestones
    • Iterations
  • Merge requests 601
    • Merge requests 601
  • CI/CD
    • CI/CD
    • Pipelines
    • Jobs
    • Schedules
    • Test Cases
  • Deployments
    • Deployments
    • Releases
  • Analytics
    • Analytics
    • Value stream
    • 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
  • #1204
Closed
Open
Issue created Mar 06, 2007 by nominolo@gmail.com@trac-nominolo

Associated types don't work with record updates

(I couldn't find a more descriptive title, feel free to change it) When instantiating associated types with records, record update doesn't seem to work (at least in indirect uses). I think it should. If this is supposed to fail, then a more helpful error message might be very useful.

Here's the code:

{-# OPTIONS -findexed-types #-}
module Bug where

------------------------------------------------------------------------------

class C c where
  data D1 c

class C c => D c where
  works :: Int -> D1 c -> D1 c
  buggy :: Int -> D1 c -> D1 c 
  buggy2 :: Int -> D1 c -> D1 c

------------------------------------------------------------------------------

data FooC = FooC

instance C FooC where
  data D1 FooC = D1F { moo :: Int }
  
instance D FooC where
  works x d = d  -- d unchanged, so OK

  buggy x d@(D1F { moo = k }) = 
    d { moo = k + x }  -- d is updated wrong type--why?

  buggy2 x d@(D1F { moo = k }) =
    (d :: D1 FooC) { moo = k + x } -- type annotation doesn't work

GHC Output:

$ ghc67 -v -c Bug67.hs
Glasgow Haskell Compiler, Version 6.7.20070303, for Haskell 98, compiled by GHC version 6.7.20070303
Using package config file: /usr/local/lib/ghc-6.7.20070303/package.conf
wired-in package base mapped to base-2.0
wired-in package rts mapped to rts-1.0
wired-in package haskell98 mapped to haskell98-1.0
wired-in package template-haskell mapped to template-haskell-2.0
Hsc static flags: -static
Created temporary directory: /tmp/ghc422_0
*** Checking old interface for main:Bug:
*** Parser:
*** Renamer/typechecker:

Bug67.hs:25:4:
    Couldn't match expected type `D1 FooC'
	   against inferred type `(Bug.:R2D1)'
    In the expression: d {moo = k + x}
    In the definition of `buggy':
	buggy x (d@(D1F {moo = k})) = d {moo = k + x}
    In the definition for method `buggy'

Bug67.hs:28:4:
    Couldn't match expected type `D1 FooC'
	   against inferred type `(Bug.:R2D1)'
    In the expression: (d :: D1 FooC) {moo = k + x}
    In the definition of `buggy2':
	buggy2 x (d@(D1F {moo = k})) = (d :: D1 FooC) {moo = k + x}
    In the definition for method `buggy2'
Trac metadata
Trac field Value
Version 6.7
Type Bug
TypeOfFailure OtherFailure
Priority normal
Resolution Unresolved
Component Compiler
Test case
Differential revisions
BlockedBy
Related
Blocking
CC
Operating system Unknown
Architecture Unknown
To upload designs, you'll need to enable LFS and have an admin enable hashed storage. More information
Assignee
Assign to
Time tracking