f0e52a5 · rowtype-yoga/purescript-native

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

compare with golang

unifiedsplit

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

419 CppArrayLiteral <$> mapM valueToCpp xs

420

421 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

423

424 valueToCpp (Accessor _ prop val) =

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

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

430 updatedFields <- mapM (sndM valueToCpp) ps

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

432 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

434 where

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

436 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

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

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

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

468− return . CppObjectLiteral $

468+ return . CppObjectLiteral CppInstance $

469 zip

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

471 args'

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

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

185 -- |

186 -- An object literal

187 --

188− | CppObjectLiteral [(String, Cpp)]

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

189 -- |

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

191 --

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

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

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

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

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

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

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

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

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

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

330 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

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

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

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

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

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

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

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

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

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

361 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

52 Nothing

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

54 Just $ CppFunction name [] rty [] CppNoOp

55+

55 -- Generate thunks for top-level values

56 -- Generate thunks for top-level values

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

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

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

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

58 go cpp@(CppStruct {}) =

63 go cpp@(CppStruct {}) =

59 Just cpp

64 Just cpp

60 go (CppComment comms cpp')

65 go (CppComment comms cpp')

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

115 Nothing

120 Nothing

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

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

117 Just $ CppFunction name [] rty [] body

122 Just $ CppFunction name [] rty [] body

118− -- Generate thunks for top-level values

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

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

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

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)

121 where

129 where

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

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

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

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

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

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

125 addCaptures :: Cpp -> Cpp

133 addCaptures :: Cpp -> Cpp

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

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

127 where

135 where

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

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

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

137 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

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

75 -- Desugar untilE

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

78 -- Desugar whileE

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

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

83 convert other = other

84 -- 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

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

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

129 -- agg(ressive) parameter.

130 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)]])

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

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

134 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

70data CppCaptureType = CppCaptureAll

71 deriving (Show, Read, Eq)

72

73+-- |

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

75+--

76+data CppObjectType = CppInstance | CppRecord

77+ deriving (Show, Eq)

78+

73runType :: CppType -> String

79runType :: CppType -> String

74runType (CppPrimitive t) = t

80runType (CppPrimitive t) = t

75runType CppAuto = "auto"

81runType CppAuto = "auto"

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

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

117 , return $ intercalate ", " es

118 , return " }"

119 ]

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

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

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

122 , withIndent $ do

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