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,263
    • Issues 5,263
    • List
    • Boards
    • Service Desk
    • Milestones
    • Iterations
  • Merge requests 570
    • Merge requests 570
  • 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
  • #5596
Closed
Open
Issue created Oct 31, 2011 by guest@trac-guest

"f c = a $ b c", "f = a . b" does not.

the following code produces a type error, and i think it shouldn't:

{-# LANGUAGE ScopedTypeVariables, MultiParamTypeClasses #-}
module Main
where

import Control.Monad.ST
import Data.STRef
import Text.Parsec


type P v a = ParsecT TokStream () (ST v) a

data TokStream = TokStream [Char]

instance Stream TokStream (ST v) Char where
    uncons (TokStream []) = return Nothing
    uncons (TokStream (t:ts)) = return (Just (t, TokStream ts))

c :: P v ()
c = return ()

works :: [Char] -> Either ParseError ()
works toks = runST $ f $ TokStream toks
    where
      f :: forall v . TokStream -> ST v (Either ParseError ())
      f = runPT c () "<sourcefile>"

doesnt :: [Char] -> Either ParseError ()
doesnt = runST . f . TokStream
    where
      f :: forall v . TokStream -> ST v (Either ParseError ())
      f = runPT c () "<sourcefile>"

doesnt should be equivalent to works, but works works and doesnt doesn't. the type error:

    Couldn't match expected type `forall s.
                                  ST s (Either ParseError ())'
                with actual type `ST v0 (Either ParseError ())'
    Expected type: TokStream -> forall s. ST s (Either ParseError ())
      Actual type: TokStream -> ST v0 (Either ParseError ())
    In the first argument of `(.)', namely `f'
    In the second argument of `(.)', namely `f . TokStream'

I tried this on 7.2.1 and 7.0.3. may be related to tickets 4347 or 4310, but I don't know enough about the ghc type engine to tell.

Trac metadata
Trac field Value
Version 7.2.1
Type Bug
TypeOfFailure OtherFailure
Priority normal
Resolution Unresolved
Component Compiler (Type checker)
Test case
Differential revisions
BlockedBy
Related
Blocking
CC
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