git.iko.soy/reflex
on dn-minor-code-fixes help sign in
reflex/src/Reflex/Optimizer.hs
61 lines 1.9 kB history raw
1-- | This module provides a GHC plugin designed to improve code that uses
2-- Reflex. Currently, it just adds an INLINABLE pragma to any top-level
3-- definition that doesn't have an explicit inlining pragma. In the future,
4-- additional optimizations are likely to be added.
5{-# LANGUAGE CPP #-}
6{-# LANGUAGE LambdaCase #-}
7{-# LANGUAGE OverloadedStrings #-}
8module Reflex.Optimizer
9 ( plugin
10 ) where
12#ifdef ghcjs_HOST_OS
13import Plugins
14#else
15import Control.Arrow
16import CoreMonad
17import Data.String
18import GhcPlugins
20#if MIN_VERSION_base(4,9,0)
21import Prelude hiding ((<>))
22#endif
24#endif
26#ifdef ghcjs_HOST_OS
28-- | The GHCJS build of Reflex.Optimizer just throws an error; instead, the version built with GHC should be used.
29plugin :: Plugin
30plugin = error "The GHCJS build of Reflex.Optimizer cannot be used. Instead, build with GHC and use the result with GHCJS."
32#else
34-- | The GHC plugin itself. See "GhcPlugins" for more details.
35plugin :: Plugin
36plugin = defaultPlugin { installCoreToDos = install }
38install :: [CommandLineOption] -> [CoreToDo] -> CoreM [CoreToDo]
39install [] p = do
40 liftIO $ putStrLn $ showSDocUnsafe $ ppr p
41 let f = \case
42 simpl@(CoreDoSimplify _ _) -> [CoreDoSpecialising, simpl]
43 x -> [x]
44 return $ makeInlinable : concatMap f p
45install options@(_:_) p = do
46 warnMsg $ "Reflex.Optimizer: ignoring " <> fromString (show $ length options) <> " command-line options"
47 install [] p
49makeInlinable :: CoreToDo
50makeInlinable = CoreDoPluginPass "MakeInlinable" $ \modGuts -> do
51 let f v = setIdInfo v $ let i = idInfo v in
52 setInlinePragInfo i $ let p = inlinePragInfo i in
53 if isDefaultInlinePragma p
54 then defaultInlinePragma { inl_inline = Inlinable }
55 else p
56 newBinds = flip map (mg_binds modGuts) $ \case
57 NonRec b e -> NonRec (f b) e
58 Rec bes -> Rec $ map (first f) bes
59 return $ modGuts { mg_binds = newBinds }
61#endif