More aggressive inlining of things.

cabal.project

@@ -13,6 +13,7 @@ packages:
   formats/icc/
   formats/nitf/haskell/
   formats/vlq_128/atto/
+  formats/vlq_128/ddl-hs/
   talos/
   daedalus-language-server/
   standalone/cabal-pack/

daedalus-core/src/Daedalus/Core/TH/TypeDecls.hs

@@ -91,7 +91,9 @@ compileStruct name as fields =
      hasIs <- traverse (hasInstance ty cname fs) fs
 
      cvtIs <- [d| instance RTS.Convert $ty $ty where
-                    convert = id |]
+                    convert = id
+                    {-# INLINE convert #-}
+                |]
 
      pure (dataD : cvtIs ++ concat hasIs)
 
@@ -111,7 +113,9 @@ compileStruct name as fields =
                   Just t  -> snd <$> t
     in
     [d| instance R.HasField $lab $ty $ft where
-          getField = $def |]
+          getField = $def
+          {-# INLINE getField #-}
+      |]
 
 
 compileUnion ::
@@ -134,7 +138,9 @@ compileUnion name as cons =
      let ty = mkT tname as
      hasIs <- traverse (hasInstance ty) fs
      cvtIs <- [d| instance RTS.Convert $ty $ty where
-                    convert = id |]
+                    convert = id
+                    {-# INLINE convert #-}
+                |]
 
      pure (dataD : cvtIs ++ concat hasIs)
 
@@ -144,7 +150,8 @@ compileUnion name as cons =
   hasInstance ty (l,mb) =
     [d| instance R.HasField $(lab l) $ty $ft where
           getField = $def
-    |]
+          {-# INLINE getField #-}
+      |]
     where
     (ft,def) = case mb of
                  Nothing -> ([t| () |], [e| const () |])
@@ -169,17 +176,23 @@ compileBitdata name univ def =
 
      cvtIs <- [d| instance RTS.Convert $ty $ty where
                     convert = id
+                    {-# INLINE convert #-}
 
                   instance RTS.Bitdata $ty where
                     type instance BDWidth $ty = $(TH.litT (TH.numTyLit w))
                     fromBits = $(TH.conE cname)
+                    {-# INLINE fromBits #-}
                     toBits $(TH.conP cname [[p| x |]]) = x
+                    {-# INLINE toBits #-}
 
                   instance RTS.Convert $ty $repT where
                     convert = toBits
+                    {-# INLINE convert #-}
+
 
                   instance RTS.Convert $repT $ty where
                     convert = fromBits
+                    {-# INLINE convert #-}
                 |]
 
      hasIs <- case def of
@@ -207,17 +220,22 @@ compileBitdata name univ def =
                  getField $p = RTS.fromBits (
                                  RTS.convert
                                     ($(TH.varE x) `RTS.shiftr` RTS.UInt amt)
-                                 :: $wt) |]
+                                 :: $wt)
+                 {-# INLINE getField #-}
+             |]
 
 
   hasInstanceUnion ty (l,t) =
     do let lty = TH.litT (TH.strTyLit (Text.unpack l))
        ft <- compileMonoType t
        [d| instance R.HasField $lty $ty $(pure ft) where
               getField = RTS.fromBits . RTS.toBits
+              {-# INLINE getField #-}
 
            instance RTS.Convert $(pure ft) $ty where
-              convert = fromBits . toBits |]
+              convert = fromBits . toBits
+              {-# INLINE convert #-}
+          |]
 
 
 

rts-hs-data/src/Daedalus/RTS/Convert.hs

@@ -21,85 +21,105 @@ instance Bitdata () where
   type instance BDWidth () = 0
   toBits _    = UInt 0
   fromBits  _ = ()
+  {-# INLINE toBits #-}
+  {-# INLINE fromBits #-}
 
-instance Convert () () where convert = id
+instance Convert () () where
+  convert = id
+  {-# INLINE convert #-}
 
 -- Bool ------------------------------------------------------------------------
 instance Bitdata Bool where
   type instance BDWidth Bool = 1
   toBits b          = if b then UInt 1 else UInt 0
   fromBits (UInt x) = x /= 0
+  {-# INLINE toBits #-}
+  {-# INLINE fromBits #-}
 
-instance Convert Bool Bool where convert = id
+instance Convert Bool Bool where
+  convert = id
+  {-# INLINE convert #-}
 
 -- Maybe -----------------------------------------------------------------------
-instance (a ~ b) => Convert (Maybe a) (Maybe b) where convert = id
+instance (a ~ b) => Convert (Maybe a) (Maybe b) where
+  convert = id
+  {-# INLINE convert #-}
 
 -- Vector ----------------------------------------------------------------------
-instance (a ~ b) => Convert (Vector a) (Vector b) where convert = id
+instance (a ~ b) => Convert (Vector a) (Vector b) where
+  convert = id
+  {-# INLINE convert #-}
 
 -- Map -------------------------------------------------------------------------
-instance (a ~ b, x ~ y) => Convert (Map a x) (Map b y) where convert = id
+instance (a ~ b, x ~ y) => Convert (Map a x) (Map b y) where
+  convert = id
+  {-# INLINE convert #-}
 
 
 -- Float -----------------------------------------------------------------------
 instance Bitdata Float where
   type instance BDWidth Float = 32
   toBits    = floatToWord
   fromBits  = wordToFloat
+  {-# INLINE toBits #-}
+  {-# INLINE fromBits #-}
 
-instance Convert Float Float        where convert = id
-instance Convert Float Double       where convert = float2Double
-instance Convert Float Integer      where convert = truncate
+instance Convert Float Float        where convert = id; {-# INLINE convert #-}
+instance Convert Float Double       where convert = float2Double; {-# INLINE convert #-}
+instance Convert Float Integer      where convert = truncate; {-# INLINE convert #-}
 instance SizeType n =>
-         Convert Float (UInt n)     where convert = lit . convert
+         Convert Float (UInt n)     where convert = lit . convert; {-# INLINE convert #-}
 instance SizeType n =>
-         Convert Float (SInt n)     where convert = lit . convert
+         Convert Float (SInt n)     where convert = lit . convert; {-# INLINE convert #-}
 
 -- Double ----------------------------------------------------------------------
 instance Bitdata Double where
   type instance BDWidth Double = 64
   toBits    = doubleToWord
   fromBits  = wordToDouble
+  {-# INLINE toBits #-}
+  {-# INLINE fromBits #-}
 
-instance Convert Double Float       where convert = double2Float
-instance Convert Double Double      where convert = id
-instance Convert Double Integer     where convert = truncate
+instance Convert Double Float       where convert = double2Float; {-# INLINE convert #-}
+instance Convert Double Double      where convert = id; {-# INLINE convert #-}
+instance Convert Double Integer     where convert = truncate; {-# INLINE convert #-}
 instance SizeType n =>
-         Convert Double (UInt n)    where convert = lit . convert
+         Convert Double (UInt n)    where convert = lit . convert; {-# INLINE convert #-}
 instance SizeType n =>
-         Convert Double (SInt n)    where convert = lit . convert
+         Convert Double (SInt n)    where convert = lit . convert; {-# INLINE convert #-}
 
 -- Integer ---------------------------------------------------------------------
-instance Convert Integer Float      where convert = fromInteger
-instance Convert Integer Double     where convert = fromInteger
-instance Convert Integer Integer    where convert = id
+instance Convert Integer Float      where convert = fromInteger; {-# INLINE convert #-}
+instance Convert Integer Double     where convert = fromInteger; {-# INLINE convert #-}
+instance Convert Integer Integer    where convert = id; {-# INLINE convert #-}
 instance SizeType n =>
-         Convert Integer (UInt n)   where convert = lit
+         Convert Integer (UInt n)   where convert = lit; {-# INLINE convert #-}
 instance SizeType n =>
-         Convert Integer (SInt n)   where convert = lit
+         Convert Integer (SInt n)   where convert = lit; {-# INLINE convert #-}
 
 
 -- UInt ------------------------------------------------------------------------
 instance Bitdata (UInt n) where
   type instance BDWidth (UInt n) = n
   toBits   = id
   fromBits = id
+  {-# INLINE toBits #-}
+  {-# INLINE fromBits #-}
 
 instance SizeType n =>
-         Convert (UInt n) Float     where convert = fromInteger . asInt
+         Convert (UInt n) Float     where convert = fromInteger . asInt; {-# INLINE convert #-}
 
 instance SizeType n =>
-         Convert (UInt n) Double    where convert = fromInteger . asInt
+         Convert (UInt n) Double    where convert = fromInteger . asInt; {-# INLINE convert #-}
 
 instance SizeType n =>
-         Convert (UInt n) Integer   where convert = asInt
+         Convert (UInt n) Integer   where convert = asInt; {-# INLINE convert #-}
 
 instance ConvertU m n (m <=? n) =>
-         Convert (UInt m) (UInt n)  where convert = cvtU
+         Convert (UInt m) (UInt n)  where convert = cvtU; {-# INLINE convert #-}
 
 instance (SizeType m, SizeType n) =>
-         Convert (UInt m) (SInt n)  where convert = lit . asInt
+         Convert (UInt m) (SInt n)  where convert = lit . asInt; {-# INLINE convert #-}
 
 
 class (extending ~ (m <=? n)) => ConvertU m n (extending :: Bool) where
@@ -108,10 +128,12 @@ class (extending ~ (m <=? n)) => ConvertU m n (extending :: Bool) where
 instance ((m <=? n) ~ 'True, SizeType m, SizeType n) =>
   ConvertU m n 'True where
   cvtU (UInt x) = UInt (fromIntegral x)
+  {-# INLINE cvtU #-}
 
 instance ((m <=? n) ~ 'False, SizeType m, SizeType n) =>
   ConvertU m n 'False where
   cvtU (UInt x) = toUInt (fromIntegral x)
+  {-# INLINE cvtU #-}
 
 
 
@@ -121,21 +143,23 @@ instance Bitdata (SInt n) where
   type instance BDWidth (SInt n) = n
   toBits (SInt n)   = toUInt (fromIntegral n)
   fromBits (UInt n) = toSInt (fromIntegral n)
+  {-# INLINE toBits #-}
+  {-# INLINE fromBits #-}
 
 instance SizeType n =>
-         Convert (SInt n) Float     where convert = fromInteger . asInt
+         Convert (SInt n) Float     where convert = fromInteger . asInt; {-# INLINE convert #-}
 
 instance SizeType n =>
-         Convert (SInt n) Double    where convert = fromInteger . asInt
+         Convert (SInt n) Double    where convert = fromInteger . asInt; {-# INLINE convert #-}
 
 instance SizeType n =>
-         Convert (SInt n) Integer   where convert = asInt
+         Convert (SInt n) Integer   where convert = asInt; {-# INLINE convert #-}
 
 instance (SizeType m, SizeType n) =>
-         Convert (SInt m) (UInt n)  where convert = lit . asInt
+         Convert (SInt m) (UInt n)  where convert = lit . asInt; {-# INLINE convert #-}
 
 instance (SizeType m, SizeType n) =>
-         Convert (SInt m) (SInt n)  where convert = lit . asInt
+         Convert (SInt m) (SInt n)  where convert = lit . asInt; {-# INLINE convert #-}
 
 
 

rts-hs-data/src/Daedalus/RTS/HasInputs.hs

@@ -10,13 +10,16 @@ class HasInputs a where
   getInputs :: a -> Map ShortByteString ByteString
 
 instance HasInputs () where
-  getInputs _ = Map.empty
+  getInputs = const Map.empty
+  {-# INLINE getInputs #-}
 
 instance HasInputs a => HasInputs [a] where
   getInputs = Map.unions . map getInputs
+  {-# INLINE getInputs #-}
 
 instance HasInputs a => HasInputs (Maybe a) where
   getInputs = maybe Map.empty getInputs
+  {-# INLINE getInputs #-}
 
 
 

rts-hs-data/src/Daedalus/RTS/Input.hs

@@ -81,10 +81,12 @@ instance Show Input where
 -- | The name of the input
 inputName :: Input -> ShortByteString
 inputName = iiName . inputInfo
+{-# INLINE inputName #-}
 
 -- | Original bytes from the input
 inputTopBytes :: Input -> ByteString
 inputTopBytes = iiBytes . inputInfo
+{-# INLINE inputTopBytes #-}
 
 -- | How many bytes remain in the input.
 inputLength :: Input -> Int
@@ -173,6 +175,7 @@ newInputFromFile mb =
 
 instance HasInputs Input where
   getInputs i = Map.singleton (inputName i) (inputTopBytes i)
+  {-# INLINE getInputs #-}
 
 instance ToJSON Input where
   toJSON inp =

rts-hs-data/src/Daedalus/RTS/Iterator.hs

@@ -8,24 +8,29 @@ newtype Iterator t = Iterator [(ITKey t, ITVal t)]
 
 iteratorDone :: Iterator t -> Bool
 iteratorDone (Iterator x) = null x
+{-# INLINE iteratorDone #-}
 
 iteratorUncons :: Iterator t -> (ITKey t, ITVal t, Iterator t)
 iteratorUncons (Iterator xs) =
   case xs of
     (k,v) : more -> (k,v,Iterator more)
     _            -> error "Iterator finished"
+{-# INLINE iteratorUncons #-}
 
 iteratorKey :: Iterator t -> ITKey t
 iteratorKey it = case iteratorUncons it of
                    (k,_,_) -> k
+{-# INLINE iteratorKey #-}
 
 iteratorVal :: Iterator t -> ITVal t
 iteratorVal it = case iteratorUncons it of
                    (_,v,_) -> v
+{-# INLINE iteratorVal #-}
 
 iteratorNext :: Iterator t -> Iterator t
 iteratorNext it = case iteratorUncons it of
                     (_,_,next) -> next
+{-# INLINE iteratorNext #-}
 
 
 class HasIterators t where
@@ -40,13 +45,14 @@ instance Vec.VecElem a => HasIterators (Vec.Vector a) where
 
   newIterator v = Iterator (keys `zip` Vec.toList v)
     where keys = [ Num.UInt i | i <- [ 0 .. ] ]
+  {-# INLINE newIterator #-}
 
 instance HasIterators (Map.Map k v) where
   type ITKey (Map.Map k v) = k
   type ITVal (Map.Map k v) = v
 
   newIterator mp = Iterator (Map.toList mp)
-
+  {-# INLINE newIterator #-}