f0e52a5 · rowtype-yoga/purescript-native

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

C++: make instance thunks fns instead of const vars

commitf0e52a537a56d5062959834383f56648b6cf5609 authorAndy Arvanitis <andyarvanitis@gmail.com> dateMon 15 Aug 2016, 20:53 (10 years ago) parent4599a30

6 files changed+32−18

compare with golang

unifiedsplit

src/Language/PureScript/CodeGen/Cpp.hs+3−3 src/Language/PureScript/CodeGen/Cpp/AST.hs+4−4 src/Language/PureScript/CodeGen/Cpp/File.hs+14−6 src/Language/PureScript/CodeGen/Cpp/Optimizer/MagicDo.hs+4−4 src/Language/PureScript/CodeGen/Cpp/Types.hs+6 src/Language/PureScript/Pretty/Cpp.hs+1−1

src/Language/PureScript/CodeGen/Cpp.hs+3−3

@@ -419,7 +419,7 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do

419419 CppArrayLiteral <$> mapM valueToCpp xs

420420

421421 valueToCpp (Literal _ (ObjectLiteral ps)) =

422− CppObjectLiteral <$> sortBy (compare `on` fst) <$> mapM (sndM valueToCpp) ps

422+ CppObjectLiteral CppRecord <$> sortBy (compare `on` fst) <$> mapM (sndM valueToCpp) ps

423423

424424 valueToCpp (Accessor _ prop val) =

425425 CppIndexer <$> pure (CppStringLiteral prop) <*> valueToCpp val

@@ -430,7 +430,7 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do

430430 updatedFields <- mapM (sndM valueToCpp) ps

431431 let origKeys = (allKeys ty) \\ (fst <$> updatedFields)

432432 origFields = (\key -> (key, CppIndexer (CppStringLiteral key) obj')) <$> origKeys

433− return $ CppObjectLiteral . sortBy (compare `on` fst) $ origFields ++ updatedFields

433+ return $ CppObjectLiteral CppRecord . sortBy (compare `on` fst) $ origFields ++ updatedFields

434434 where

435435 allKeys :: T.Type -> [String]

436436 allKeys (T.TypeApp (T.TypeConstructor _) r@(T.RCons {})) = fst <$> (fst $ T.rowToList r)

@@ -465,7 +465,7 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do

465465 return $ CppApp (uncurried' $ qualifiedToCpp id ident) args'

466466 Var (_, _, _, Just IsTypeClassConstructor) (Qualified mn' (Ident classname)) ->

467467 let Just (_, constraints, fns) = findClass (Qualified mn' (ProperName classname)) in

468− return . CppObjectLiteral $

468+ return . CppObjectLiteral CppInstance $

469469 zip

470470 ((sort $ superClassDictionaryNames constraints) ++ (fst <$> fns))

471471 args'

src/Language/PureScript/CodeGen/Cpp/AST.hs+4−4

@@ -185,7 +185,7 @@ data Cpp

185185 -- |

186186 -- An object literal

187187 --

188− | CppObjectLiteral [(String, Cpp)]

188+ | CppObjectLiteral CppObjectType [(String, Cpp)]

189189 -- |

190190 -- An general property accessor expression (property, expr)

191191 --

@@ -297,7 +297,7 @@ everywhereOnCpp f = go

297297 go (CppArrayLiteral cpp) = f (CppArrayLiteral (map go cpp))

298298 go (CppDataLiteral cpp) = f (CppDataLiteral (map go cpp))

299299 go (CppIndexer j1 j2) = f (CppIndexer (go j1) (go j2))

300− go (CppObjectLiteral cpp) = f (CppObjectLiteral (map (fmap go) cpp))

300+ go (CppObjectLiteral t cpp) = f (CppObjectLiteral t (map (fmap go) cpp))

301301 go (CppAccessor prop j) = f (CppAccessor (go prop) (go j))

302302 go (CppFunction name args rty qs j) = f (CppFunction name args rty qs (go j))

303303 go (CppLambda cps args rty j) = f (CppLambda cps args rty (go j))

@@ -328,7 +328,7 @@ everywhereOnCppTopDownM f = f >=> go

328328 go (CppArrayLiteral cpp) = CppArrayLiteral <$> traverse f' cpp

329329 go (CppDataLiteral cpp) = CppDataLiteral <$> traverse f' cpp

330330 go (CppIndexer j1 j2) = CppIndexer <$> f' j1 <*> f' j2

331− go (CppObjectLiteral cpp) = CppObjectLiteral <$> traverse (sndM f') cpp

331+ go (CppObjectLiteral t cpp) = CppObjectLiteral t <$> traverse (sndM f') cpp

332332 go (CppAccessor prop j) = CppAccessor prop <$> f' j

333333 go (CppFunction name args rty qs j) = CppFunction name args rty qs <$> f' j

334334 go (CppLambda cps args rty j) = CppLambda cps args rty <$> f' j

@@ -355,7 +355,7 @@ everythingOnCpp (<>) f = go

355355 go j@(CppArrayLiteral cpp) = foldl (<>) (f j) (map go cpp)

356356 go j@(CppDataLiteral cpp) = foldl (<>) (f j) (map go cpp)

357357 go j@(CppIndexer j1 j2) = f j <> go j1 <> go j2

358− go j@(CppObjectLiteral cpp) = foldl (<>) (f j) (map (go . snd) cpp)

358+ go j@(CppObjectLiteral _ cpp) = foldl (<>) (f j) (map (go . snd) cpp)

359359 go j@(CppAccessor j1 j2) = f j <> go j1 <> go j2

360360 go j@(CppFunction _ _ _ _ j1) = f j <> go j1

361361 go j@(CppLambda _ _ _ j1) = f j <> go j1

src/Language/PureScript/CodeGen/Cpp/File.hs+14−6

@@ -52,9 +52,14 @@ toHeader = catMaybes . map go

5252 Nothing

5353 go (CppVariableIntroduction (name, _) _ (Just (CppLambda _ [] rty _))) =

5454 Just $ CppFunction name [] rty [] CppNoOp

55+

5556 -- Generate thunks for top-level values

56− go (CppVariableIntroduction (name, _) _ (Just _)) =

57− Just $ CppVariableIntroduction (name, Just $ CppAny [CppConst]) [CppExtern] Nothing

57+ go (CppVariableIntroduction (name, vty) _ (Just cpp)) =

58+ case cpp of

59+ CppObjectLiteral CppInstance vals ->

60+ Just $ CppFunction name [("", Just thunkMarkerType)] (Just $ CppAny [CppConst, CppRef]) [] CppNoOp

61+ _ ->

62+ Just $ CppVariableIntroduction (name, vty) [CppExtern] Nothing

5863 go cpp@(CppStruct {}) =

5964 Just cpp

6065 go (CppComment comms cpp')

@@ -115,15 +120,18 @@ toBody = catMaybes . map go

115120 Nothing

116121 go (CppVariableIntroduction (name, _) _ (Just (CppLambda _ [] rty body))) =

117122 Just $ CppFunction name [] rty [] body

118− -- Generate thunks for top-level values

119− go (CppVariableIntroduction (name, _) _ (Just cpp)) =

120− Just $ CppVariableIntroduction (name, Just $ CppAny [CppConst]) [] (Just lambda)

123+ go (CppVariableIntroduction (name, vty) _ (Just cpp)) =

124+ case cpp of

125+ CppObjectLiteral CppInstance vals ->

126+ Just $ CppFunction name [("", Just thunkMarkerType)] (Just $ CppAny [CppConst, CppRef]) [] block

127+ _ ->

128+ Just $ CppVariableIntroduction (name, vty) [] (Just lambda)

121129 where

122130 val = CppVariableIntroduction ("$value$", Just $ CppAny [CppConst]) [CppStatic] (Just $ addCaptures cpp)

123131 block = CppBlock [val, CppReturn (CppVar "$value$")]

124132 lambda = CppLambda [] [("", Just $ thunkMarkerType)] (Just $ CppAny [CppConst, CppRef]) block

125133 addCaptures :: Cpp -> Cpp

126− addCaptures (CppObjectLiteral objs) = CppObjectLiteral (objlam <$> objs)

134+ addCaptures (CppObjectLiteral t objs) = CppObjectLiteral t (objlam <$> objs)

127135 where

128136 objlam :: (String, Cpp) -> (String, Cpp)

129137 objlam (name', (CppLambda _ args rty body)) = (name' , CppLambda [] args rty $ addCaptures body)

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

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

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

7575 -- Desugar untilE

7676 convert (CppApp (CppApp f [arg]) []) | isEffFunc C.untilE f =

77− CppApp (CppLambda [CppCaptureAll] [] Nothing (CppBlock [ CppWhile (CppUnary Not (CppApp arg [])) (CppBlock []), CppReturn $ CppObjectLiteral []])) []

77+ CppApp (CppLambda [CppCaptureAll] [] Nothing (CppBlock [ CppWhile (CppUnary Not (CppApp arg [])) (CppBlock []), CppReturn $ CppObjectLiteral CppRecord []])) []

7878 -- Desugar whileE

7979 convert (CppApp (CppApp f [arg1, arg2]) []) | isEffFunc C.whileE f =

80− CppApp (CppLambda [CppCaptureAll] [] Nothing (CppBlock [ CppWhile (CppApp arg1 []) (CppBlock [ CppApp arg2 [] ]), CppReturn $ CppObjectLiteral []])) []

80+ CppApp (CppLambda [CppCaptureAll] [] Nothing (CppBlock [ CppWhile (CppApp arg1 []) (CppBlock [ CppApp arg2 [] ]), CppReturn $ CppObjectLiteral CppRecord []])) []

8181 convert (CppApp (CppApp (CppApp f [arg1]) [arg2]) []) | isEffFunc C.whileE f =

82− CppApp (CppLambda [CppCaptureAll] [] Nothing (CppBlock [ CppWhile (CppApp arg1 []) (CppBlock [ CppApp arg2 [] ]), CppReturn $ CppObjectLiteral []])) []

82+ CppApp (CppLambda [CppCaptureAll] [] Nothing (CppBlock [ CppWhile (CppApp arg1 []) (CppBlock [ CppApp arg2 [] ]), CppReturn $ CppObjectLiteral CppRecord []])) []

8383 convert other = other

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

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

@@ -128,7 +128,7 @@ inlineST = everywhereOnCpp convertBlock

128128 -- or in a more aggressive way, turning wrappers into local variables depending on the

129129 -- agg(ressive) parameter.

130130 convert agg (CppApp f [arg]) | isSTFunc C.newSTRef f =

131− CppLambda [CppCaptureAll] [] Nothing (CppBlock [CppReturn $ if agg then arg else CppObjectLiteral [(C.stRefValue, arg)]])

131+ CppLambda [CppCaptureAll] [] Nothing (CppBlock [CppReturn $ if agg then arg else CppObjectLiteral CppRecord [(C.stRefValue, arg)]])

132132 convert agg (CppApp (CppApp f [ref]) []) | isSTFunc C.readSTRef f =

133133 if agg then ref else CppAccessor (CppVar C.stRefValue) ref

134134 convert agg (CppApp (CppApp (CppApp f [ref]) [arg]) []) | isSTFunc C.writeSTRef f =

src/Language/PureScript/CodeGen/Cpp/Types.hs+6

@@ -70,6 +70,12 @@ data CppValueQual

7070data CppCaptureType = CppCaptureAll

7171 deriving (Show, Read, Eq)

7272

73+-- |

74+-- C++ object/map literal type

75+--

76+data CppObjectType = CppInstance | CppRecord

77+ deriving (Show, Eq)

78+

7379runType :: CppType -> String

7480runType (CppPrimitive t) = t

7581runType CppAuto = "auto"

src/Language/PureScript/Pretty/Cpp.hs+1−1

@@ -117,7 +117,7 @@ literals = mkPattern' match

117117 , return $ intercalate ", " es

118118 , return " }"

119119 ]

120− match (CppObjectLiteral ps) = fmap concat $ sequence

120+ match (CppObjectLiteral _ ps) = fmap concat $ sequence

121121 [ return $ runType mapType ++ "{\n"

122122 , withIndent $ do

123123 cpps <- forM ps $ \(key, value) -> do