X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcEnv.lhs;h=58bda528cfedf6f6f65da9f0f84594b365a11db3;hb=2eeaaa6f9eb206ad3473c151556629a2e2624f78;hp=4f48f7fde58d3294ed032fb4a655f0371daf1bdc;hpb=5822cb8d13aa3c05d2b46b4510c13d94b902eb21;p=ghc-hetmet.git diff --git a/compiler/typecheck/TcEnv.lhs b/compiler/typecheck/TcEnv.lhs index 4f48f7f..58bda52 100644 --- a/compiler/typecheck/TcEnv.lhs +++ b/compiler/typecheck/TcEnv.lhs @@ -3,6 +3,13 @@ % \begin{code} +{-# OPTIONS -w #-} +-- The above warning supression flag is a temporary kludge. +-- While working on this module you are encouraged to remove it and fix +-- any warnings in the module. See +-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings +-- for details + module TcEnv( TyThing(..), TcTyThing(..), TcId, @@ -546,12 +553,12 @@ thLevel (Brack l _ _) = l checkWellStaged :: SDoc -- What the stage check is for - -> ThLevel -- Binding level + -> ThLevel -- Binding level (increases inside brackets) -> ThStage -- Use stage -> TcM () -- Fail if badly staged, adding an error checkWellStaged pp_thing bind_lvl use_stage - | bind_lvl <= use_lvl -- OK! - = returnM () + | use_lvl >= bind_lvl -- OK! Used later than bound + = returnM () -- E.g. \x -> [| $(f x) |] | bind_lvl == topLevel -- GHC restriction on top level splices = failWithTc $ @@ -559,7 +566,7 @@ checkWellStaged pp_thing bind_lvl use_stage nest 2 (ptext SLIT("is used in a top-level splice, and must be imported, not defined locally"))] | otherwise -- Badly staged - = failWithTc $ + = failWithTc $ -- E.g. \x -> $(f x) ptext SLIT("Stage error:") <+> pp_thing <+> hsep [ptext SLIT("is bound at stage") <+> ppr bind_lvl, ptext SLIT("but used at stage") <+> ppr use_lvl] @@ -628,30 +635,20 @@ iDFunId info = instanceDFunId (iSpec info) data InstBindings = VanillaInst -- The normal case - (LHsBinds Name) -- Bindings + (LHsBinds Name) -- Bindings for the instance methods [LSig Name] -- User pragmas recorded for generating -- specialised instances | NewTypeDerived -- Used for deriving instances of newtypes, where the -- witness dictionary is identical to the argument -- dictionary. Hence no bindings, no pragmas. - (Maybe [PredType]) - -- Nothing => The newtype-derived instance involves type variables, - -- and the dfun has a type like df :: forall a. Eq a => Eq (T a) - -- Just (r:scs) => The newtype-defined instance has no type variables - -- so the dfun is just a constant, df :: Eq T - -- In this case we need to know waht the rep dict, r, and the - -- superclasses, scs, are. (In the Nothing case these are in the - -- dict fun's type.) - -- Invariant: these PredTypes have no free variables - -- NB: In both cases, the representation dict is the *first* dict. pprInstInfo info = vcat [ptext SLIT("InstInfo:") <+> ppr (idType (iDFunId info))] pprInstInfoDetails info = pprInstInfo info $$ nest 2 (details (iBinds info)) where - details (VanillaInst b _) = pprLHsBinds b - details (NewTypeDerived _) = text "Derived from the representation type" + details (VanillaInst b _) = pprLHsBinds b + details NewTypeDerived = text "Derived from the representation type" simpleInstInfoClsTy :: InstInfo -> (Class, Type) simpleInstInfoClsTy info = case instanceHead (iSpec info) of