Cleanup and formatting

Author: harpocrates

language-rust.cabal

@@ -29,7 +29,12 @@ flag enableQuasiquotes
 
 library
   hs-source-dirs:      src
+
   ghc-options:         -Wall
+                       -Wincomplete-patterns
+                       -Wincomplete-uni-patterns
+                       -Wmissing-signatures
+
   build-tools:         alex, happy
   default-language:    Haskell2010
 
@@ -58,7 +63,6 @@ library
                      , FlexibleInstances
                      , OverloadedStrings
                      , OverloadedLists
-                     , StandaloneDeriving
                      , DeriveFunctor
                      , DeriveGeneric
                      , DeriveAnyClass

src/Language/Rust/Data/InputStream.hs

@@ -13,11 +13,20 @@ These are the only functions that need to be implemented in order to use the par
 
 module Language.Rust.Data.InputStream (
   -- * InputStream type
-  InputStream, countLines, inputStreamEmpty,
+  InputStream,
+  countLines,
+  inputStreamEmpty,
+  
   -- * Introduction forms
-  readInputStream, hReadInputStream, inputStreamFromString,
+  readInputStream,
+  hReadInputStream,
+  inputStreamFromString,
+  
   -- * Elimination forms
-  inputStreamToString, takeByte, takeChar, takeChars,
+  inputStreamToString,
+  takeByte,
+  takeChar,
+  takeChars,
 ) where
 
 import Data.Word (Word8)
@@ -75,7 +84,7 @@ countLines :: InputStream -> Int
 -- | Opaque input type.
 newtype InputStream = IS BS.ByteString
 takeByte bs = (BS.head (coerce bs), coerce (BS.tail (coerce bs)))
-takeChar bs = let Just res = BE.uncons (coerce bs) in coerce res
+takeChar bs = maybe (error "takeChar: no char left") coerce (BE.uncons (coerce bs))
 inputStreamEmpty = BS.null . coerce
 takeChars n = BE.toString . BE.take n . coerce
 readInputStream f = coerce <$> BS.readFile f

src/Language/Rust/Data/Position.hs

@@ -9,13 +9,30 @@ Portability : portable
 
 Everything to do with describing a position or a contiguous region in a file.
 -}
-{-# LANGUAGE CPP, DeriveDataTypeable, DeriveGeneric, DeriveAnyClass #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DeriveAnyClass #-}
 
 module Language.Rust.Data.Position (
   -- * Positions in files
-  Position(..), prettyPosition, maxPos, minPos, initPos, incPos, retPos, incOffset,
+  Position(..),
+  prettyPosition,
+  maxPos,
+  minPos,
+  initPos,
+  incPos,
+  retPos,
+  incOffset,
+
   -- * Spans in files
-  Span(..), prettySpan, subsetOf, (#), Spanned(..), Located(..),
+  Span(..),
+  unspan,
+  prettySpan,
+  subsetOf,
+  (#),
+  Spanned(..),
+  Located(..),
 ) where
 
 import GHC.Generics (Generic)
@@ -24,8 +41,6 @@ import Data.Data (Data)
 import Data.Typeable (Typeable)
 import Control.DeepSeq (NFData)
 
-import Data.Ord (comparing)
-import Data.List (maximumBy, minimumBy)
 import Data.List.NonEmpty (NonEmpty(..))
 import Data.Monoid (Monoid(..))
 import Data.Semigroup (Semigroup(..))
@@ -43,7 +58,7 @@ data Position = Position {
 
 -- | Pretty print a 'Position'
 prettyPosition :: Position -> String
-prettyPosition NoPosition = "$"
+prettyPosition NoPosition = "???"
 prettyPosition (Position _ r c) = show r ++ ":" ++ show c
 
 -- | Maximum of two positions, bias for actual positions.
@@ -54,10 +69,11 @@ prettyPosition (Position _ r c) = show r ++ ":" ++ show c
 -- >>> maxPos NoPosition (Position 30 5 8)
 -- Position 30 5 8
 --
+{-# INLINE maxPos #-}
 maxPos :: Position -> Position -> Position
 maxPos NoPosition p2 = p2
 maxPos p1 NoPosition = p1
-maxPos p1 p2 = maximumBy (comparing absoluteOffset) [p1,p2]
+maxPos p1@(Position a1 _ _) p2@(Position a2 _ _) = if a1 > a2 then p1 else p2
 
 -- | Maximum and minimum positions, bias for actual positions.
 --
@@ -67,69 +83,84 @@ maxPos p1 p2 = maximumBy (comparing absoluteOffset) [p1,p2]
 -- >>> minPos NoPosition (Position 30 5 8)
 -- Position 30 5 8
 --
+{-# INLINE minPos #-}
 minPos :: Position -> Position -> Position
 minPos NoPosition p2 = p2
 minPos p1 NoPosition = p1
-minPos p1 p2 = minimumBy (comparing absoluteOffset) [p1,p2]
+minPos p1@(Position a1 _ _) p2@(Position a2 _ _) = if a1 < a2 then p1 else p2
 
 -- | Starting position in a file.
+{-# INLINE initPos #-}
 initPos :: Position
 initPos = Position 0 1 0
 
 -- | Advance columnn a certain number of times.
+{-# INLINE incPos #-}
 incPos :: Position -> Int -> Position
 incPos NoPosition _ = NoPosition
 incPos p@Position{ absoluteOffset = a, col = c } offset = p { absoluteOffset = a + offset, col = c + offset }
 
 -- | Advance to the next line.
+{-# INLINE retPos #-}
 retPos :: Position -> Position
 retPos NoPosition = NoPosition
 retPos (Position a r _) = Position { absoluteOffset = a + 1, row = r + 1, col = 1 }
 
 -- | Advance only the absolute offset, not the row and column information. Only use this if you
 -- know what you are doing!
+{-# INLINE incOffset #-}
 incOffset :: Position -> Int -> Position
 incOffset NoPosition _ = NoPosition
 incOffset p@Position{ absoluteOffset = a } offset = p { absoluteOffset = a + offset }
 
 -- | Spans represent a contiguous region of code, delimited by two 'Position's. The endpoints are
 -- inclusive. Analogous to the information encoded in a selection.
-data Span = Span {
-#if __GLASGOW_HASKELL__ >= 820 
-    lo, hi :: {-# UNPACK #-} !Position
-#else
-    lo, hi ::                !Position
-#endif
-  } deriving (Eq, Show, Data, Typeable, Generic, NFData)
+data Span = Span { lo, hi :: !Position }
+  deriving (Eq, Show, Data, Typeable, Generic, NFData)
 
 -- | Check if a span is a subset of another span
 subsetOf :: Span -> Span -> Bool
 Span l1 h1 `subsetOf` Span l2 h2 = minPos l1 l2 == l1 && maxPos h1 h2 == h2
 
 -- | Convenience function lifting '<>' to work on all 'Located' things
+{-# INLINE (#) #-}
 (#) :: (Located a, Located b) => a -> b -> Span
 left # right = spanOf left <> spanOf right
 
 -- | smallest covering 'Span'
 instance Semigroup Span where
-  Span l1 h1 <> Span l2 h2 = Span (minPos l1 l2) (maxPos h1 h2)
+  {-# INLINE (<>) #-}
+  Span l1 h1 <> Span l2 h2 = Span (l1 `minPos` l2) (h1 `maxPos` h2)
 
 instance Monoid Span where
+  {-# INLINE mempty #-}
   mempty = Span NoPosition NoPosition
+
+  {-# INLINE mappend #-}
   mappend = (<>) 
 
 -- | Pretty print a 'Span'
 prettySpan :: Span -> String
 prettySpan (Span lo' hi') = show lo' ++ " - " ++ show hi'
 
 -- | A "tagging" of something with a 'Span' that describes its extent.
-data Spanned a = Spanned { unspan :: a, span :: {-# UNPACK #-} !Span } deriving (Data, Typeable, Generic, NFData)
+data Spanned a = Spanned a {-# UNPACK #-} !Span
+  deriving (Data, Typeable, Generic, NFData)
+
+-- | Extract the wrapped value from 'Spanned'
+{-# INLINE unspan #-}
+unspan :: Spanned a -> a
+unspan (Spanned x _) = x
 
 instance Functor Spanned where
+  {-# INLINE fmap #-}
   fmap f (Spanned x s) = Spanned (f x) s
 
 instance Applicative Spanned where
+  {-# INLINE pure #-}
   pure x = Spanned x mempty
+  
+  {-# INLINE (<*>) #-}
   Spanned f s1 <*> Spanned x s2 = Spanned (f x) (s1 <> s2)
 
 instance Monad Spanned where
@@ -149,18 +180,25 @@ class Located a where
   spanOf :: a -> Span
 
 instance Located Span where
+  {-# INLINE spanOf #-}
   spanOf = id
 
 instance Located (Spanned a) where
+  {-# INLINE spanOf #-}
   spanOf (Spanned _ s) = s
 
 instance Located a => Located (Maybe a) where
+  {-# INLINE spanOf #-}
   spanOf = foldMap spanOf
 
+-- | /O(n)/ time complexity
 instance Located a => Located [a] where
+  {-# INLINE spanOf #-}
   spanOf = foldMap spanOf
 
+-- | /O(n)/ time complexity
 instance Located a => Located (NonEmpty a) where
+  {-# INLINE spanOf #-}
   spanOf = foldMap spanOf
 
 

src/Language/Rust/Parser/Literals.hs

@@ -27,8 +27,8 @@ import Text.Read (readMaybe)
 
 -- | Parse a valid 'LitTok' into a 'Lit'.
 translateLit :: LitTok -> Suffix -> a -> Lit a
-translateLit (ByteTok s)         = let Just (w8,"") = unescapeByte False s in Byte w8
-translateLit (CharTok s)         = let Just (c,"")  = unescapeChar False s in Char c
+translateLit (ByteTok s)         = Byte (unescapeByte' s)
+translateLit (CharTok s)         = Char (unescapeChar' s)
 translateLit (FloatTok s)        = Float (unescapeFloat s) 
 translateLit (StrTok s)          = Str (unfoldr (unescapeChar True) s) Cooked
 translateLit (StrRawTok s n)     = Str s (Raw n)
@@ -88,6 +88,18 @@ unescapeByte multiline ('\\':c:cs) = case c of
 unescapeByte _ (c:cs) = Just (toEnum $ fromEnum c, cs)
 unescapeByte _ [] = fail "unescape byte: empty string"
 
+-- | Given a string Rust representation of a character, parse it into a character
+unescapeChar' :: String -> Char
+unescapeChar' s = case unescapeChar False s of
+                    Just (c, "") -> c
+                    _ -> error "unescape char: bad character literal"
+
+-- | Given a string Rust representation of a byte, parse it into a byte
+unescapeByte' :: String -> Word8
+unescapeByte' s = case unescapeByte False s of
+                    Just (w8, "") -> w8
+                    _ -> error "unescape byte: bad byte literal"
+
 -- | Given a string Rust representation of an integer, parse it into a number
 unescapeInteger :: Num a => String -> (IntRep,a)
 unescapeInteger ('0':'b':cs@(_:_)) | all (`elem` "_01") cs = (Bin, numBase 2 (filter (/= '_') cs))

src/Language/Rust/Pretty.hs

@@ -88,6 +88,7 @@ instance Pretty (Item a)           where prettyUnresolved = PP.unAnnotate . pret
 instance Pretty (Lifetime a)       where prettyUnresolved = PP.unAnnotate . prettyAnnUnresolved
 instance Pretty (LifetimeDef a)    where prettyUnresolved = PP.unAnnotate . prettyAnnUnresolved
 instance Pretty (Lit a)            where prettyUnresolved = PP.unAnnotate . prettyAnnUnresolved
+instance Pretty (Mac a)            where prettyUnresolved = PP.unAnnotate . prettyAnnUnresolved
 instance Pretty (Nonterminal a)    where prettyUnresolved = PP.unAnnotate . prettyAnnUnresolved
 instance Pretty (Pat a)            where prettyUnresolved = PP.unAnnotate . prettyAnnUnresolved
 instance Pretty (Path a)           where prettyUnresolved = PP.unAnnotate . prettyAnnUnresolved
@@ -127,6 +128,7 @@ instance PrettyAnnotated Item           where prettyAnnUnresolved = printItem
 instance PrettyAnnotated Lifetime       where prettyAnnUnresolved = printLifetime
 instance PrettyAnnotated LifetimeDef    where prettyAnnUnresolved = printLifetimeDef
 instance PrettyAnnotated Lit            where prettyAnnUnresolved = printLit
+instance PrettyAnnotated Mac            where prettyAnnUnresolved = printMac Paren
 instance PrettyAnnotated Nonterminal    where prettyAnnUnresolved = printNonterminal
 instance PrettyAnnotated Pat            where prettyAnnUnresolved = printPat
 instance PrettyAnnotated Path           where prettyAnnUnresolved = flip printPath False