git.iko.soy/patch
on bd3f014 help sign in
patch/src/Reflex/Optimizer.hs
56 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
19#endif
21#ifdef ghcjs_HOST_OS
23-- | The GHCJS build of Reflex.Optimizer just throws an error; instead, the version built with GHC should be used.
24plugin :: Plugin
25plugin = error "The GHCJS build of Reflex.Optimizer cannot be used. Instead, build with GHC and use the result with GHCJS."
27#else
29-- | The GHC plugin itself. See "GhcPlugins" for more details.
30plugin :: Plugin
31plugin = defaultPlugin { installCoreToDos = install }
33install :: [CommandLineOption] -> [CoreToDo] -> CoreM [CoreToDo]
34install [] p = do
35 liftIO $ putStrLn $ showSDocUnsafe $ ppr p
36 let f = \case
37 simpl@(CoreDoSimplify _ _) -> [CoreDoSpecialising, simpl]
38 x -> [x]
39 return $ makeInlinable : concatMap f p
40install options@(_:_) p = do
41 warnMsg $ "Reflex.Optimizer: ignoring " <> fromString (show $ length options) <> " command-line options"
42 install [] p
44makeInlinable :: CoreToDo
45makeInlinable = CoreDoPluginPass "MakeInlinable" $ \modGuts -> do
46 let f v = setIdInfo v $ let i = idInfo v in
47 setInlinePragInfo i $ let p = inlinePragInfo i in
48 if isDefaultInlinePragma p
49 then defaultInlinePragma { inl_inline = Inlinable }
50 else p
51 newBinds = flip map (mg_binds modGuts) $ \case
52 NonRec b e -> NonRec (f b) e
53 Rec bes -> Rec $ map (first f) bes
54 return $ modGuts { mg_binds = newBinds }
56#endif