git.iko.soy/patch
on ef4da28 help sign in
patch/src/Reflex/Optimizer.hs
51 lines 1.7 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 = return $ makeInlinable : p
35install options@(_:_) p = do
36 warnMsg $ "Reflex.Optimizer: ignoring " <> fromString (show $ length options) <> " command-line options"
37 install [] p
39makeInlinable :: CoreToDo
40makeInlinable = CoreDoPluginPass "MakeInlinable" $ \modGuts -> do
41 let f v = setIdInfo v $ let i = idInfo v in
42 setInlinePragInfo i $ let p = inlinePragInfo i in
43 if isDefaultInlinePragma p
44 then defaultInlinePragma { inl_inline = Inlinable }
45 else p
46 newBinds = flip map (mg_binds modGuts) $ \case
47 NonRec b e -> NonRec (f b) e
48 Rec bes -> Rec $ map (first f) bes
49 return $ modGuts { mg_binds = newBinds }
51#endif