diff --git a/haskell-src-exts.cabal b/haskell-src-exts.cabal --- a/haskell-src-exts.cabal +++ b/haskell-src-exts.cabal @@ -1,5 +1,5 @@ Name: haskell-src-exts -Version: 0.5.3 +Version: 0.5.4 License: BSD3 License-File: LICENSE Author: Niklas Broberg diff --git a/src/Language/Haskell/Exts.hs b/src/Language/Haskell/Exts.hs --- a/src/Language/Haskell/Exts.hs +++ b/src/Language/Haskell/Exts.hs @@ -5,10 +5,11 @@ , module Language.Haskell.Exts.Pretty , module Language.Haskell.Exts.Extension , module Language.Haskell.Exts.Fixity - , parseFileContents - , parseFileContentsWithMode , parseFile + , parseFileWithMode , parseFileWithExts + , parseFileContents + , parseFileContentsWithMode , readExtensions ) where @@ -23,16 +24,10 @@ import Language.Preprocessor.Unlit parseFile :: FilePath -> IO (ParseResult Module) -parseFile fp = do - fc <- readFile fp - let md = delit fp $ ppContents fc - exts = case readExtensions md of - Just exts -> exts - Nothing -> [] - return $ parseModuleWithMode (ParseMode fp exts preludeFixities) md +parseFile fp = parseFileWithMode (defaultParseMode { parseFilename = fp }) fp parseFileWithExts :: [Extension] -> FilePath -> IO (ParseResult Module) -parseFileWithExts exts fp = parseFileWithMode (ParseMode fp exts preludeFixities) fp +parseFileWithExts exts fp = parseFileWithMode (defaultParseMode { extensions = exts, parseFilename = fp }) fp parseFileWithMode :: ParseMode -> FilePath -> IO (ParseResult Module) parseFileWithMode p fp = readFile fp >>= (return . parseFileContentsWithMode p) @@ -41,8 +36,13 @@ parseFileContents = parseFileContentsWithMode defaultParseMode parseFileContentsWithMode :: ParseMode -> String -> ParseResult Module -parseFileContentsWithMode p rawStr = parseModuleWithMode p (delit filename $ ppContents rawStr) - where filename = parseFilename p +parseFileContentsWithMode p@(ParseMode fn exts ign _) rawStr = + let md = delit fn $ ppContents rawStr + plusExts = case (ign, readExtensions md) of + (False,Just exts) -> exts + _ -> [] + in parseModuleWithMode (p { extensions = exts ++ plusExts }) md + readExtensions :: String -> Maybe [Extension] readExtensions str = case getTopPragmas str of diff --git a/src/Language/Haskell/Exts/ParseMonad.hs b/src/Language/Haskell/Exts/ParseMonad.hs --- a/src/Language/Haskell/Exts/ParseMonad.hs +++ b/src/Language/Haskell/Exts/ParseMonad.hs @@ -96,6 +96,9 @@ parseFilename :: String, -- | list of extensions enabled extensions :: [Extension], + -- | if @True@, the parser won't look for further extensions + -- in LANGUAGE pragmas in source files + ignoreLanguagePragmas :: Bool, -- | list of fixities to be aware of fixities :: [Fixity] } @@ -107,6 +110,7 @@ defaultParseMode = ParseMode { parseFilename = ".hs", extensions = [], + ignoreLanguagePragmas = False, fixities = preludeFixities } diff --git a/src/Language/Haskell/Exts/ParseUtils.hs b/src/Language/Haskell/Exts/ParseUtils.hs --- a/src/Language/Haskell/Exts/ParseUtils.hs +++ b/src/Language/Haskell/Exts/ParseUtils.hs @@ -107,6 +107,11 @@ checkPContext :: PType -> P PContext checkPContext (TyTuple Boxed ts) = mapM checkAssertion ts +checkPContext (TyCon (Special UnitCon)) = + return [] +checkPContext (TyParen t) = do + c <- checkAssertion t + return [c] checkPContext t = do c <- checkAssertion t return [c] @@ -263,6 +268,13 @@ checkPat (App f x) args = do x <- checkPat x [] checkPat f (x:args) +checkPat (InfixApp l op r) args + | op == (QVarOp (UnQual (Symbol "!"))) = do + -- We must have BangPatterns on + checkEnabled BangPatterns + let (e,es) = splitBang r [] + ps <- mapM checkPattern (BangPat e:es) + checkPat l (ps++args) checkPat e [] = case e of Var (UnQual x) -> return (PVar x) Lit l -> return (PLit l) @@ -276,12 +288,12 @@ case (l,r) of (Var (UnQual n@(Ident _)), Lit (Int k)) -> return (PNPlusK n k) _ -> patFail "" - QVarOp (UnQual (Symbol "!")) -> do +{- QVarOp (UnQual (Symbol "!")) -> do -- We must have BangPatterns on checkEnabled BangPatterns let (e,es) = splitBang r [] ps <- mapM checkPattern (BangPat e:es) - checkPat l ps + checkPat l ps -} _ -> patFail "" Tuple es -> do ps <- mapM (\e -> checkPat e []) es @@ -623,8 +635,9 @@ -- Check Equation Syntax checkValDef :: SrcLoc -> PExp -> Maybe S.Type -> Rhs -> Binds -> P Decl -checkValDef srcloc lhs optsig rhs whereBinds = - case isFunLhs lhs [] of +checkValDef srcloc lhs optsig rhs whereBinds = do + mlhs <- isFunLhs lhs [] + case mlhs of Just (f,es) -> do ps <- mapM checkPattern es case optsig of -- only pattern bindings can have signatures @@ -636,12 +649,21 @@ -- A variable binding is parsed as an PatBind. -isFunLhs :: PExp -> [PExp] -> Maybe (Name, [PExp]) -isFunLhs (InfixApp l (QVarOp (UnQual op)) r) es = Just (op, l:r:es) -isFunLhs (App (Var (UnQual f)) e) es = Just (f, e:es) -isFunLhs (App (Paren f) e) es = isFunLhs f (e:es) +isFunLhs :: PExp -> [PExp] -> P (Maybe (Name, [PExp])) +isFunLhs (InfixApp l (QVarOp (UnQual op)) r) es + | op == (Symbol "!") = do + exts <- getExtensions + if BangPatterns `elem` exts + then let (b,bs) = splitBang r [] + in isFunLhs l (BangPat b : bs ++ es) + else return $ Just (op, l:r:es) -- It's actually a definition of the operator ! + | otherwise = return $ Just (op, l:r:es) +isFunLhs (App (Var (UnQual f)) e) es = return $ Just (f, e:es) +--isFunLhs (App (Paren f) e) es = isFunLhs f (e:es) isFunLhs (App f e) es = isFunLhs f (e:es) -isFunLhs _ _ = Nothing +isFunLhs (Var (UnQual f)) es@(_:_) = return $ Just (f, es) +isFunLhs (Paren f) es@(_:_) = isFunLhs f es +isFunLhs _ _ = return Nothing -- Separating between signature declarations and value definitions in -- a post-processing step diff --git a/src/Language/Haskell/Exts/Pretty.hs b/src/Language/Haskell/Exts/Pretty.hs --- a/src/Language/Haskell/Exts/Pretty.hs +++ b/src/Language/Haskell/Exts/Pretty.hs @@ -685,7 +685,8 @@ Unboxed -> hashParenList ds prettyPrec _ (TyList t) = brackets $ pretty t prettyPrec p (TyApp a b) = - {- | a == list_tycon = brackets $ pretty b -- special case + {- + | a == list_tycon = brackets $ pretty b -- special case | otherwise = -} parensIf (p > prec_btype) $ myFsep [pretty a, ppAType b] prettyPrec _ (TyVar name) = pretty name