832ebf0 · rowtype-yoga/purescript-native

git.iko.soy/rowtype-yoga/purescript-native

C++: clean up MagicDo

commit832ebf09bdfc3e8ed9da44940bd21f146fe99b68 authorAndy Arvanitis <andyarvanitis@gmail.com> dateSat 12 Nov 2016, 21:40 (10 years ago) parent7651841

2 files changed+5−16

compare with golang

unifiedsplit

src/Language/PureScript/CodeGen/Cpp/Optimizer.hs+2−5 src/Language/PureScript/CodeGen/Cpp/Optimizer/MagicDo.hs+3−11

src/Language/PureScript/CodeGen/Cpp/Optimizer.hs+2−5

@@ -40,9 +40,6 @@ module Language.PureScript.CodeGen.Cpp.Optimizer (

4040

4141import Prelude.Compat

4242

43−#if __GLASGOW_HASKELL__ < 710

44−import Control.Applicative (Applicative)

45−#endif

4643import Control.Monad (liftM)

4744import Control.Monad.Reader (MonadReader, ask, asks)

4845import Control.Monad.Supply.Class (MonadSupply)

@@ -62,12 +59,12 @@ import Language.PureScript.CodeGen.Cpp.Optimizer.Unused

6259-- |

6360-- Apply a series of optimizer passes to simplified C++11 code

6461--

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

6663optimize nm cpp = do

6764 noOpt <- asks optionsNoOptimizations

6865 if noOpt then return cpp else optimize' nm cpp

6966

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

7168optimize' nm cpp = do

7269 opts <- ask

7370 untilFixedPoint (liftM toAutoVars . inlineFnComposition . applyAll

src/Language/PureScript/CodeGen/Cpp/Optimizer/MagicDo.hs+3−11

@@ -54,19 +54,11 @@ magicDo' = everywhereOnCpp undo . everywhereOnCppTopDown convert

5454 -- Desugar monomorphic calls to >>= and return for the Eff monad

5555 convert :: Cpp -> Cpp

5656 -- Desugar pure & return

57− convert (CppApp (CppApp pure' [dict, val]) []) | isPure (CppApp pure' [dict]) = val

5857 convert (CppApp (CppApp pure' [val]) []) | isPure pure' = val

5958 -- 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 )

6259 convert (CppApp (CppApp bind [m]) [CppLambda _ [] rty (CppBlock cpp)]) | isBind bind =

6360 CppFunction fnName [] rty [] $ CppBlock (CppApp m [] : map applyReturns cpp )

6461 -- 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 []))

7062 convert (CppApp (CppApp bind [m]) [CppLambda _ [arg] rty (CppBlock cpp)]) | isBind bind =

7163 CppFunction fnName [] rty [] $ CppBlock (app' : map applyReturns cpp)

7264 where

@@ -74,12 +66,12 @@ magicDo' = everywhereOnCpp undo . everywhereOnCppTopDown convert

7466 | otherwise = CppVariableIntroduction arg [] (Just (CppApp m []))

7567 -- Desugar untilE

7668 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"])) []

7870 -- Desugar whileE

7971 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"])) []

8173 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"])) []

8375 convert other = other

8476 -- Check if an expression represents a monomorphic call to >>= for the Eff monad

8577 isBind (CppApp fn [dict]) | isDict (C.eff, C.bindEffDictionary) dict && isBindPoly fn = True