#2696: forall not recognized in RULES
---------------------------------+------------------------------------------
    Reporter:  conal             |       Owner:                  
        Type:  bug               |      Status:  new             
    Priority:  normal            |   Component:  Compiler        
     Version:  6.11              |    Severity:  normal          
    Keywords:                    |    Testcase:                  
Architecture:  Unknown/Multiple  |          Os:  Unknown/Multiple
---------------------------------+------------------------------------------
 {{{
 {-# LANGUAGE GADTs, TypeFamilies, TypeOperators
   -- , ScopedTypeVariables
    #-}
 {-# OPTIONS_GHC -Wall -frewrite-rules #-}

 -- ScopedTypeVariables works around a 6.10 bug.  The forall keyword is
 -- supposed to be recognized in a RULES pragma, but it's not.
 --
 -- This bug was introduced between ghc 6.9.20080622 and 6.10.0.20081007.

 -- | Mapping from all elements of @a@ to the results of some function
 class HasTrie a where
     -- | Representation of trie with domain type @a@
     data (:->:) a :: * -> *
     -- Create the trie for the entire domain of a function
     trie   :: (a  ->  b) -> (a :->: b)
     -- | Convert a trie to a function, i.e., access a field of the trie
     untrie :: (a :->: b) -> (a  ->  b)

 {-# RULES
 "trie/untrie"   forall t. trie (untrie t) = t
 "untrie/trie"   forall f. untrie (trie f) = f
  #-}
 }}}

-- 
Ticket URL: <http://hackage.haskell.org/trac/ghc/ticket/2696>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler
_______________________________________________
Glasgow-haskell-bugs mailing list
[email protected]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs

Reply via email to