haskell-src-exts 0.5.3 → 0.5.4

raw patch · 5 files changed

+50/−23 lines, 5 files

Files

• haskell-src-exts.cabal +1/−1
• src/Language/Haskell/Exts.hs +12/−12
• src/Language/Haskell/Exts/ParseMonad.hs +4/−0
• src/Language/Haskell/Exts/ParseUtils.hs +31/−9
• src/Language/Haskell/Exts/Pretty.hs +2/−1

@@ -1,5 +1,5 @@ Name:                   haskell-src-exts-Version:                0.5.3+Version:                0.5.4 License:                BSD3 License-File:           LICENSE Author:                 Niklas Broberg

@@ -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

@@ -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 = "<unknown>.hs",         extensions = [],+        ignoreLanguagePragmas = False,         fixities = preludeFixities         } 

@@ -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

@@ -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