git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
C++: clean up MagicDo
832ebf0Andy Arvanitis
src/Language/PureScript/CodeGen/Cpp/Optimizer.hs+2−5
compare with golang
unifiedsplit
@@ -40,9 +40,6 @@ module Language.PureScript.CodeGen.Cpp.Optimizer (
40
40
41import Prelude.Compat
41import Prelude.Compat
42
42
43−#if __GLASGOW_HASKELL__ < 710
44−import Control.Applicative (Applicative)
45−#endif
46import Control.Monad (liftM)
43import Control.Monad (liftM)
47import Control.Monad.Reader (MonadReader, ask, asks)
44import Control.Monad.Reader (MonadReader, ask, asks)
48import Control.Monad.Supply.Class (MonadSupply)
45import Control.Monad.Supply.Class (MonadSupply)
@@ -62,12 +59,12 @@ import Language.PureScript.CodeGen.Cpp.Optimizer.Unused
62-- |
59-- |
63-- Apply a series of optimizer passes to simplified C++11 code
60-- Apply a series of optimizer passes to simplified C++11 code
64--
61--
65−optimize :: (Monad m, MonadReader Options m, Applicative m, MonadSupply m) => NamesMap -> Cpp -> m Cpp
62+optimize :: (MonadReader Options m, MonadSupply m) => NamesMap -> Cpp -> m Cpp
66optimize nm cpp = do
63optimize nm cpp = do
67 noOpt <- asks optionsNoOptimizations
64 noOpt <- asks optionsNoOptimizations
68 if noOpt then return cpp else optimize' nm cpp
65 if noOpt then return cpp else optimize' nm cpp
69
66
70−optimize' :: (Monad m, MonadReader Options m, Applicative m, MonadSupply m) => NamesMap -> Cpp -> m Cpp
67+optimize' :: (MonadReader Options m, MonadSupply m) => NamesMap -> Cpp -> m Cpp
71optimize' nm cpp = do
68optimize' nm cpp = do
72 opts <- ask
69 opts <- ask
73 untilFixedPoint (liftM toAutoVars . inlineFnComposition . applyAll
70 untilFixedPoint (liftM toAutoVars . inlineFnComposition . applyAll
src/Language/PureScript/CodeGen/Cpp/Optimizer/MagicDo.hs+3−11
@@ -54,19 +54,11 @@ magicDo' = everywhereOnCpp undo . everywhereOnCppTopDown convert
54 -- Desugar monomorphic calls to >>= and return for the Eff monad
54 -- Desugar monomorphic calls to >>= and return for the Eff monad
55 convert :: Cpp -> Cpp
55 convert :: Cpp -> Cpp
56 -- Desugar pure & return
56 -- Desugar pure & return
57− convert (CppApp (CppApp pure' [dict, val]) []) | isPure (CppApp pure' [dict]) = val
58 convert (CppApp (CppApp pure' [val]) []) | isPure pure' = val
57 convert (CppApp (CppApp pure' [val]) []) | isPure pure' = val
59 -- Desugar >>
58 -- Desugar >>
60− convert (CppApp bind [dict, m, CppLambda _ [] rty (CppBlock cpp)]) | isBind (CppApp bind [dict]) =
61− CppFunction fnName [] rty [] $ CppBlock (CppApp m [] : map applyReturns cpp )
62 convert (CppApp (CppApp bind [m]) [CppLambda _ [] rty (CppBlock cpp)]) | isBind bind =
59 convert (CppApp (CppApp bind [m]) [CppLambda _ [] rty (CppBlock cpp)]) | isBind bind =
63 CppFunction fnName [] rty [] $ CppBlock (CppApp m [] : map applyReturns cpp )
60 CppFunction fnName [] rty [] $ CppBlock (CppApp m [] : map applyReturns cpp )
64 -- Desugar >>=
61 -- Desugar >>=
65− convert (CppApp bind [dict, m, CppLambda _ [arg] rty (CppBlock cpp)]) | isBind (CppApp bind [dict]) =
66− CppFunction fnName [] rty [] $ CppBlock (app' : map applyReturns cpp)
67− where
68− app' | fst arg == C.__unused = CppApp m []
69− | otherwise = CppVariableIntroduction arg [] (Just (CppApp m []))
70 convert (CppApp (CppApp bind [m]) [CppLambda _ [arg] rty (CppBlock cpp)]) | isBind bind =
62 convert (CppApp (CppApp bind [m]) [CppLambda _ [arg] rty (CppBlock cpp)]) | isBind bind =
71 CppFunction fnName [] rty [] $ CppBlock (app' : map applyReturns cpp)
63 CppFunction fnName [] rty [] $ CppBlock (app' : map applyReturns cpp)
72 where
64 where
@@ -74,12 +66,12 @@ magicDo' = everywhereOnCpp undo . everywhereOnCppTopDown convert
74 | otherwise = CppVariableIntroduction arg [] (Just (CppApp m []))
66 | otherwise = CppVariableIntroduction arg [] (Just (CppApp m []))
75 -- Desugar untilE
67 -- Desugar untilE
76 convert (CppApp (CppApp f [arg]) []) | isEffFunc C.untilE f =
68 convert (CppApp (CppApp f [arg]) []) | isEffFunc C.untilE f =
77− CppApp (CppLambda [CaptureAll] [] Nothing (CppBlock [ CppWhile (CppUnary Not (CppApp arg [])) (CppBlock []), CppReturn $ CppMapLiteral Record []])) []
69+ CppApp (CppLambda [CaptureAll] [] Nothing (CppBlock [ CppWhile (CppUnary Not (CppApp arg [])) (CppBlock []), CppReturn $ CppVar "nullptr"])) []
78 -- Desugar whileE
70 -- Desugar whileE
79 convert (CppApp (CppApp f [arg1, arg2]) []) | isEffFunc C.whileE f =
71 convert (CppApp (CppApp f [arg1, arg2]) []) | isEffFunc C.whileE f =
80− CppApp (CppLambda [CaptureAll] [] Nothing (CppBlock [ CppWhile (CppApp arg1 []) (CppBlock [ CppApp arg2 [] ]), CppReturn $ CppMapLiteral Record []])) []
72+ CppApp (CppLambda [CaptureAll] [] Nothing (CppBlock [ CppWhile (CppApp arg1 []) (CppBlock [ CppApp arg2 [] ]), CppReturn $ CppVar "nullptr"])) []
81 convert (CppApp (CppApp (CppApp f [arg1]) [arg2]) []) | isEffFunc C.whileE f =
73 convert (CppApp (CppApp (CppApp f [arg1]) [arg2]) []) | isEffFunc C.whileE f =
82− CppApp (CppLambda [CaptureAll] [] Nothing (CppBlock [ CppWhile (CppApp arg1 []) (CppBlock [ CppApp arg2 [] ]), CppReturn $ CppMapLiteral Record []])) []
74+ CppApp (CppLambda [CaptureAll] [] Nothing (CppBlock [ CppWhile (CppApp arg1 []) (CppBlock [ CppApp arg2 [] ]), CppReturn $ CppVar "nullptr"])) []
83 convert other = other
75 convert other = other
84 -- Check if an expression represents a monomorphic call to >>= for the Eff monad
76 -- Check if an expression represents a monomorphic call to >>= for the Eff monad
85 isBind (CppApp fn [dict]) | isDict (C.eff, C.bindEffDictionary) dict && isBindPoly fn = True
77 isBind (CppApp fn [dict]) | isDict (C.eff, C.bindEffDictionary) dict && isBindPoly fn = True