git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
C++: reduce false positive on recursive lets
94e5a1eAndy Arvanitis
src/Language/PureScript/CodeGen/Cpp.hs+1−1
compare with golang
unifiedsplit
@@ -92,7 +92,7 @@ moduleToCpp otherOpts env (Module _ mn imps _ foreigns decls) = do
92 E.dataConstructors env
92 E.dataConstructors env
93 cpps' <- traverse (optimize $ namesmap ++ datamap) cpps
93 cpps' <- traverse (optimize $ namesmap ++ datamap) cpps
94 foreignWrappers <- curriedForeigns
94 foreignWrappers <- curriedForeigns
95− let optimized = (otherTransforms otherOpts . convertRecursiveRefs <$> cpps') ++ foreignWrappers
95+ let optimized = (otherTransforms otherOpts . convertRecursiveLets <$> cpps') ++ foreignWrappers
96 let moduleHeader =
96 let moduleHeader =
97 fileBegin mn "HH" ++
97 fileBegin mn "HH" ++
98 P.linebreak ++
98 P.linebreak ++
src/Language/PureScript/CodeGen/Cpp/Recursion.hs+81−93
@@ -13,127 +13,115 @@
13{-# LANGUAGE PatternGuards #-}
13{-# LANGUAGE PatternGuards #-}
14
14
15module Language.PureScript.CodeGen.Cpp.Recursion
15module Language.PureScript.CodeGen.Cpp.Recursion
16− ( convertRecursiveRefs
16+ ( convertRecursiveLets
17 ) where
17 ) where
18
18
19import Prelude.Compat
19import Prelude.Compat
20import Data.List
20import Data.List
21import Data.Maybe (fromJust)
21import Data.Maybe (fromJust)
22+import Data.Monoid ((<>))
22import Data.Text (Text)
23import Data.Text (Text)
23
24
24import Language.PureScript.CodeGen.Cpp.AST as AST
25import Language.PureScript.CodeGen.Cpp.AST as AST
25import Language.PureScript.CodeGen.Cpp.File
26import Language.PureScript.CodeGen.Cpp.File
26import Language.PureScript.CodeGen.Cpp.Types
27import Language.PureScript.CodeGen.Cpp.Types
27import Language.PureScript.Comments (Comment(..))
28import Language.PureScript.Comments (Comment(..))
29+import qualified Language.PureScript.Pretty.Cpp as P
28
30
29-------------------------------------------------------------------------------------------------
31-------------------------------------------------------------------------------------------------
30−convertRecursiveRefs :: Cpp -> Cpp
32+convertRecursiveLets :: Cpp -> Cpp
31-------------------------------------------------------------------------------------------------
33-------------------------------------------------------------------------------------------------
32−convertRecursiveRefs = everywhereOnCpp go
34+convertRecursiveLets = everywhereOnCpp go
33 where
35 where
34 go :: Cpp -> Cpp
36 go :: Cpp -> Cpp
35 go (CppFunction name args rty qs (CppBlock cpps)) =
37 go (CppFunction name args rty qs (CppBlock cpps)) =
36− CppFunction name args rty qs (CppBlock (convertRecursive cpps))
38+ CppFunction name args rty qs (CppBlock (convertIfRecursive cpps))
37 go (CppLambda cs args rty (CppBlock cpps)) =
39 go (CppLambda cs args rty (CppBlock cpps)) =
38− CppLambda cs args rty (CppBlock (convertRecursive cpps))
40+ CppLambda cs args rty (CppBlock (convertIfRecursive cpps))
39 go cpp = cpp
41 go cpp = cpp
40− convertRecursive :: [Cpp] -> [Cpp]
42+ convertIfRecursive :: [Cpp] -> [Cpp]
41− convertRecursive cpps
43+ convertIfRecursive cpps
42− | hasRecursion cpps
44+ | names@(_:_) <- recNames cpps = convertRecursive names cpps
43− = convertRecursiveRefs' cpps
44 where
45 where
45− hasRecursion :: [Cpp] -> Bool
46+ recNames :: [Cpp] -> [Text]
46− hasRecursion cpps' = any (everythingOnCpp (||) hasRecursiveRef) cpps'
47+ recNames cpps' = nub $ concatMap (everythingOnCpp (++) recRefs) cpps'
47 where
48 where
48− valnames :: [Text]
49+ recRefs :: Cpp -> [Text]
50+ recRefs (CppVariableIntroduction _ qs (Just cpp))
51+ | Recursive `elem` qs = everythingOnCpp (++) recRef cpp
52+ recRefs _ = []
53+ --
54+ recRef :: Cpp -> [Text]
55+ recRef (CppVar name') | name' `elem` possiblyRecNames = [name']
56+ recRef _ = []
57+ --
58+ possiblyRecNames :: [Text]
49− valnames = concatMap (everythingOnCpp (++) valname) cpps'
59+ possiblyRecNames = concatMap (everythingOnCpp (++) possiblyRecName) cpps'
50− valname :: Cpp -> [Text]
60+ where
51− valname (CppFunction name' _ _ _ _) = [name']
61+ possiblyRecName :: Cpp -> [Text]
52− valname (CppVariableIntroduction (name', _) _ _) = [name']
62+ possiblyRecName (CppVariableIntroduction (name', _) qs (Just _))
53− valname _ = []
63+ | Recursive `elem` qs = [name']
54− hasRecursiveRef :: Cpp -> Bool
64+ possiblyRecName _ = []
55− hasRecursiveRef (CppFunction _ _ _ _ body) = everythingOnCpp (||) ref body
65+ convertIfRecursive cpp = cpp
56− hasRecursiveRef (CppVariableIntroduction _ _ (Just value)) = everythingOnCpp (||) ref value
57− hasRecursiveRef _ = False
58− ref :: Cpp -> Bool
59− ref (CppVar name')
60− | name' `elem` valnames = True
61− ref _ = False
62− convertRecursive cpp = cpp
63
66
64-------------------------------------------------------------------------------------------------
67-------------------------------------------------------------------------------------------------
65−convertRecursiveRefs' :: [Cpp] -> [Cpp]
68+convertRecursive :: [Text] -> [Cpp] -> [Cpp]
66-------------------------------------------------------------------------------------------------
69-------------------------------------------------------------------------------------------------
67−convertRecursiveRefs' cpps
70+convertRecursive names cpps
68− | not $ null fns = dict : (accessor topdict <$> filteredFns allCpps) ++ cpps'
71+ | not $ null lets
72+ = defines ++
73+ [letTable] ++
74+ (everywhereOnCpp remRecLet <$> cpps) ++
75+ undefines
69 where
76 where
70− cpps' = everywhereOnCpp removeRec <$> cpps
77+ tableName :: Text
71− allCpps = CppBlock cpps'
78+ tableName = "let"
72− fns :: [(Text, Cpp)]
79+ --
73− fns = toelem <$> concatMap (everythingOnCpp (++) recursive) cpps
80+ letTable :: Cpp
74− filteredFns :: Cpp -> [(Text, Cpp)]
81+ letTable =
75− filteredFns cpp = filter (\(f, _) -> everythingOnCpp (||) (== CppVar f) cpp) fns
76− recursive :: Cpp -> [Cpp]
77− recursive cpp'@(CppFunction _ _ _ qs _)
78− | Recursive `elem` qs = [cpp']
79− recursive cpp'@(CppVariableIntroduction _ qs _)
80− | Recursive `elem` qs = [cpp']
81− recursive _ = []
82− removeRec :: Cpp -> Cpp
83− removeRec (CppFunction _ _ _ qs _)
84− | Recursive `elem` qs = CppNoOp
85− removeRec (CppVariableIntroduction _ qs _)
86− | Recursive `elem` qs = CppNoOp
87− removeRec cpp' = cpp'
88− replaceVar :: [(Text, Cpp)] -> Cpp -> Cpp
89− replaceVar rs = go
90− where
91− go (CppVar var)
92− | Just var' <- lookup var rs = var'
93− go cpp' = cpp'
94− dict :: Cpp
95− dict =
96 CppVariableIntroduction
82 CppVariableIntroduction
97− (topdict, Just $ Any [Const])
83+ (tableName, Just $ Any [Const])
98 []
84 []
99− (Just $ CppDataLiteral ((\(f, cpp) -> CppComment [LineComment f] cpp) <$> fns))
85+ (Just $ CppDataLiteral ((\(f, cpp) -> CppComment [LineComment f] cpp) <$> lets))
100− accessed :: Text -> Text -> (Text, Cpp)
86+ --
101− accessed dictname name =
87+ lets :: [(Text, Cpp)]
88+ lets = tableItem <$> concatMap (everythingOnCpp (++) recLet) cpps
89+ --
90+ recLet :: Cpp -> [Cpp]
91+ recLet cpp@(CppVariableIntroduction (name, _) _ (Just _))
92+ | name `elem` names = [cpp]
93+ recLet _ = []
94+ --
95+ remRecLet :: Cpp -> Cpp
96+ remRecLet (CppVariableIntroduction (name, _) _ (Just _))
97+ | name `elem` names = CppNoOp
98+ remRecLet cpp = cpp
99+ --
100+ tableItem :: Cpp -> (Text, Cpp)
101+ tableItem (CppVariableIntroduction (name, _) _ (Just body)) =
102+ (name, maybeRemCaps . addItemArg $ CppBlock [CppReturn body])
103+ where
104+ addItemArg :: Cpp -> Cpp
105+ addItemArg cpp = CppLambda [CaptureAll] [(tableName, constAnyRef)] (Just $ Any []) (CppBlock [CppReturn cpp])
106+ tableItem _ = error "not a variable introduction"
107+ --
108+ tableAccessor :: Text -> (Text, Cpp)
109+ tableAccessor name =
102 ( name
110 ( name
103 , CppApp
111 , CppApp
104 (CppDataGet
112 (CppDataGet
105− (CppNumericLiteral . Left . fromIntegral . fromJust $ findIndex ((== name) . fst) fns)
113+ (CppNumericLiteral . Left . fromIntegral . fromJust $ findIndex ((== name) . fst) lets)
106− dict')
114+ (CppVar tableName))
107− [dict'])
115+ [CppVar tableName])
116+ --
117+ defines :: [Cpp]
118+ defines = def . tableAccessor . fst <$> lets
108 where
119 where
109− dict' = CppVar dictname
120+ def (name, cpp) = CppRaw $ "#define " <> name <> " " <> P.prettyPrintCpp1 cpp <> "#"
110− accessor :: Text -> (Text, Cpp) -> Cpp
121+ --
111− accessor dictname (name, _) =
122+ undefines :: [Cpp]
112− CppVariableIntroduction (name, Just $ Any [Const]) [] (Just . snd $ accessed dictname name)
123+ undefines = undef . tableAccessor . fst <$> lets
113− toelem :: Cpp -> (Text, Cpp)
124+ where
114− toelem (CppFunction name args rtyp _ body'@(CppBlock body)) =
125+ undef (name, _) = CppRaw $ "#undef " <> name <> "#"
115− ( name
126+ --
116− , withdict . maybeRemCaps $
127+convertRecursive _ cpps = cpps
117− CppLambda
118− [CaptureAll]
119− args
120− rtyp
121− (CppBlock $ (accessor localdict <$> filteredFns body') ++ body))
122− toelem (CppVariableIntroduction (name, _) _ (Just body')) =
123− let replacements = accessed localdict . fst <$> filteredFns body'
124− replaced = everywhereOnCpp (replaceVar replacements) body'
125− in (name, withdict . maybeRemCaps $ CppBlock [CppReturn replaced])
126− toelem _ = error "not a function"
127− withdict :: Cpp -> Cpp
128− withdict cpp' =
129− maybeRemCaps $
130− CppLambda
131− [CaptureAll]
132− [(localdict, Just $ Any [Const, Ref])]
133− (Just $ Any [])
134− (CppBlock [CppReturn cpp'])
135− topdict :: Text
136− topdict = "_$dict$_"
137− localdict :: Text
138− localdict = "$dict$"
139−convertRecursiveRefs' cpps = cpps
src/Language/PureScript/Pretty/Cpp.hs+1
@@ -20,6 +20,7 @@ module Language.PureScript.Pretty.Cpp
20 ( dotsTo
20 ( dotsTo
21 , linebreak
21 , linebreak
22 , prettyPrintCpp
22 , prettyPrintCpp
23+ , prettyPrintCpp1
23 , utf16Text
24 , utf16Text
24 ) where
25 ) where
25
26