Add an inlining pass.

Author: kffaxen

feldspar-compiler.cabal

@@ -41,10 +41,12 @@ library
     Feldspar.Compiler
     Feldspar.Compiler.Imperative.ArrayOps
     Feldspar.Compiler.Imperative.Representation
+    Feldspar.Compiler.Imperative.DeadFunElim
     Feldspar.Compiler.Imperative.ExternalProgram
     Feldspar.Compiler.Imperative.FromCore
     Feldspar.Compiler.Imperative.FromCore.Interpretation
     Feldspar.Compiler.Imperative.Frontend
+    Feldspar.Compiler.Imperative.Inline
     Feldspar.Compiler.Backend.C.CodeGeneration
     Feldspar.Compiler.Backend.C.Library
     Feldspar.Compiler.Backend.C.MachineLowering

src/Feldspar/Compiler.hs

@@ -19,6 +19,7 @@ module Feldspar.Compiler
     , Target(..)
     , c99PlatformOptions
     , c99OpenMpPlatformOptions
+    , c99InlineOptions
     , tic64xPlatformOptions
     , feldsparCIncludes
     ) where

src/Feldspar/Compiler/Backend/C/Options.hs

@@ -56,6 +56,7 @@ data Platform = Platform {
     values          :: [(Type, ShowValue)],
     includes        :: [String],
     varFloating     :: Bool,
+    pInline         :: Bool,
     codeGenerator   :: String
 } deriving (Show)
 

src/Feldspar/Compiler/Backend/C/Platforms.hs

@@ -34,6 +34,7 @@ module Feldspar.Compiler.Backend.C.Platforms
     , c99
     , c99OpenMp
     , c99Wool
+    , c99Inline
     , tic64x
     , extend
     ) where
@@ -45,7 +46,7 @@ import Feldspar.Compiler.Imperative.Representation
 import Feldspar.Compiler.Imperative.Frontend
 
 availablePlatforms :: [Platform]
-availablePlatforms = [ c99, c99OpenMp, c99Wool, ba, tic64x ]
+availablePlatforms = [ c99, c99OpenMp, c99Wool, c99Inline, ba, tic64x ]
 
 platformFromName :: String -> Platform
 platformFromName str = head $ [pf | pf <- availablePlatforms, name pf == str]
@@ -86,6 +87,7 @@ c99 = Platform {
         , "<stdbool.h>"
         , "<complex.h>"],
     varFloating = True,
+    pInline = False,
     codeGenerator = "c"
 }
 
@@ -100,8 +102,14 @@ c99Wool = c99 { name = "c99Wool"
               , varFloating = False
               }
 
+c99Inline :: Platform
+c99Inline = c99 { name = "c99i"
+                , pInline = True
+                }
+
 ba :: Platform
 ba = c99 { name = "ba"
+         , pInline = True
          , codeGenerator = "ba"
          }
 
@@ -133,6 +141,7 @@ tic64x = Platform {
     includes = [ "feldspar_tic64x.h", "feldspar_array.h", "<c6x.h>", "<string.h>"
                , "<math.h>"],
     varFloating = True,
+    pInline = False,
     codeGenerator = "c"
 }
 

src/Feldspar/Compiler/Compiler.hs

@@ -43,6 +43,7 @@ module Feldspar.Compiler.Compiler (
   , sicsOptions3
   , c99PlatformOptions
   , c99OpenMpPlatformOptions
+  , c99InlineOptions
   , tic64xPlatformOptions
   , SplitModule(..)
   , CompiledModule(..)
@@ -64,6 +65,7 @@ import Feldspar.Compiler.Backend.C.MachineLowering
 import Feldspar.Compiler.Backend.C.Tic64x
 import Feldspar.Compiler.Imperative.FromCore
 import Feldspar.Compiler.Imperative.ArrayOps
+import Feldspar.Compiler.Imperative.Inline
 import Feldspar.Compiler.Imperative.Representation
 import Feldspar.Core.Middleend.PassManager
 import Control.Monad (when)
@@ -121,7 +123,7 @@ compileToCCore name opts prg = compileToCCore' opts mod
 compileToCCore' :: Options -> Module () -> SplitModule
 compileToCCore' opts m = compileSplitModule opts $ splitModule mod
       where
-        mod = adaptTic64x opts $ rename opts False $ arrayOps opts m
+        mod = adaptTic64x opts $ rename opts False $inline opts $ arrayOps opts m
 
 genIncludeLines :: Options -> Maybe String -> String
 genIncludeLines opts mainHeader = concatMap include incs ++ "\n\n"
@@ -151,6 +153,9 @@ c99PlatformOptions              = defaultOptions
 c99OpenMpPlatformOptions :: Options
 c99OpenMpPlatformOptions        = defaultOptions { platform = c99OpenMp }
 
+c99InlineOptions :: Options
+c99InlineOptions                = defaultOptions { platform = c99Inline }
+
 tic64xPlatformOptions :: Options
 tic64xPlatformOptions           = defaultOptions { platform = tic64x }
 
@@ -165,6 +170,7 @@ sicsOptions3 = defaultOptions { platform = c99Wool, frontendOpts = defaultFeldOp
 
 data BackendPass = BPFromCore
                  | BPArrayOps
+                 | BPInline
                  | BPRename
                  | BPAdapt
                  | BPSplit
@@ -189,6 +195,7 @@ backend :: PassCtrl BackendPass -> Options -> String -> UntypedFeld -> ([String]
 backend ctrl opts name = evalPasses 0
                        $ codegen (codeGenerator $ platform opts) ctrl opts
                        . pc BPRename   (rename opts False)
+                       . pc BPInline   (inline opts)
                        . pc BPArrayOps (arrayOps opts)
                        . pt BPFromCore (fst . fromCoreUT opts (encodeFunctionName name))
   where pc :: Pretty a => BackendPass -> (a -> a) -> Prog a Int -> Prog a Int

src/Feldspar/Compiler/Frontend/Interactive/Interface.hs

@@ -134,6 +134,7 @@ defaultProgOpts =
 targetsFromPlatform :: Platform -> [Target]
 targetsFromPlatform pf = tfp $ name pf
    where tfp "c99"       = []
+         tfp "c99i"      = []
          tfp "c99OpenMp" = []
          tfp "c99Wool"   = [Wool]
          tfp "ba"        = [BA]

src/Feldspar/Compiler/Imperative/ArrayOps.hs

@@ -34,22 +34,32 @@ module Feldspar.Compiler.Imperative.ArrayOps (arrayOps) where
 import Feldspar.Compiler.Imperative.Representation
 import Feldspar.Compiler.Imperative.Frontend
         (litI32, deepCopy, fun, call, for, toBlock, mkIf, isShallow, variant, arrayFun, freeArrayE,
-         lowerCopy, mkSequence, elemTyAwL, isAwLType)
+         lowerCopy, mkSequence, elemTyAwL, isAwLType, encodeType)
 import Feldspar.Range (fullRange)
 import Feldspar.Core.Types(Length)
 import Feldspar.Compiler.Backend.C.Options(Options)
 
-import Data.List (nub, isPrefixOf, concatMap)
+import Data.List (nub, isPrefixOf, concatMap, sortBy)
 import Control.Monad.Writer(Writer(..), runWriter, tell, censor)
+import Data.Bifunctor(bimap)
 
 -- | Main interface for adding needed array operations to a module.
 arrayOps :: Options -> Module () -> Module ()
-arrayOps opts (Module ents) = Module $ concatMap mkArrayOps dts ++ ents'
+arrayOps opts (Module ents) = Module $ concatMap mkArrayOps sdts ++ ents'
   where dts = filter (not . either isShallow isShallow) lrts
+        sdts = map (bimap snd snd) $ sortBy compFst $ map (bimap rank rank) dts
         (ents',lrts) = lower opts ents
         mkArrayOps (Left  t) = [mkInitArray opts t, mkFreeArray opts t]
         mkArrayOps (Right t) = [mkCopyArrayPos opts t, mkCopyArray opts t, mkInitCopyArray opts t]
 
+-- | Annotate a type with a measure of the size of the type
+rank :: Type -> (Int, Type)
+rank t = (length $ encodeType t, t)
+
+-- | Compare two pairs only on their first components
+compFst :: Ord a => Either (a,b) (a,b) -> Either (a,c) (a,c) -> Ordering
+compFst x y = compare (bimap fst fst x) (bimap fst fst y)
+
 -- | Copying an array to a given position in the destination
 mkCopyArrayPos :: Options -> Type -> Entity ()
 mkCopyArrayPos opts t = Proc name False [dstVar, dstLVar, srcVar, srcLVar, posVar] (typeof dstVar) (Just body)

src/Feldspar/Compiler/Imperative/DeadFunElim.hs

@@ -0,0 +1,53 @@
+module Feldspar.Compiler.Imperative.DeadFunElim (deadFunElim) where
+
+import Feldspar.Compiler.Imperative.Representation
+import Feldspar.Compiler.Backend.C.Options(Options(..), Platform(..))
+
+import qualified Data.Set as S
+
+type NameSet = S.Set String
+
+deadFunElim :: Options -> Module () -> Module ()
+deadFunElim opts (Module ents) = Module $ snd $ foldr (dfeEnt opts) (S.empty, []) ents
+
+dfeEnt :: Options -> Entity () -> (NameSet, [Entity ()]) -> (NameSet, [Entity ()])
+dfeEnt opts ent@Proc{procName = name, procBody = body} (names, ents)
+  | not $ S.member name names || null ents = (names, ents)
+  | otherwise = (maybeNames blockNames body `S.union` S.delete name names, ent : ents)
+dfeEnt opts ent (names, ents) = (names, ent : ents)
+
+blockNames :: Block () -> NameSet
+blockNames (Block ds p) = S.unions $ progNames p : map declNames ds
+  where declNames d = maybeNames exprNames $ initVal d
+
+progNames :: Program () -> NameSet
+progNames = go
+  where go (Assign lhs rhs)      = goE lhs `S.union` goE rhs
+        go (ProcedureCall p aps) = S.unions $ S.singleton p : map goA aps
+        go (Sequence ps)         = S.unions $ map go ps
+        go (Switch e alts)       = S.unions $ goE e : map (goB . snd) alts
+        go (SeqLoop c cc b)      = goE c `S.union` goB cc `S.union` goB b
+        go (ParLoop _ _ s e i b) = S.unions [goE s, goE e, goE i, goB b]
+        go (BlockProgram b)      = goB b
+        go _                     = S.empty
+
+        goE = exprNames
+        goB = blockNames
+        goA (ValueParameter e)  = goE e
+        goA (FunParameter name) = S.singleton name
+        goA _                   = S.empty
+
+exprNames :: Expression () -> NameSet
+exprNames = go
+  where go (ArrayElem arr ixs) = S.unions $ go arr : map go ixs
+        go (StructField e _)   = go e
+        go (FunctionCall f es) = S.unions $ goF f : map go es
+        go (Cast _ e)          = go e
+        go (AddrOf e)          = go e
+        go (Deref e)           = go e
+        go _                   = S.empty
+
+        goF (Function name _) = S.singleton name
+
+maybeNames :: (a -> NameSet) -> Maybe a -> NameSet
+maybeNames f m = maybe S.empty f m