2cd12ce · rowtype-yoga/purescript-native

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

C++: use enums for data ctor ids

commit2cd12ce98eefe5ed8772b244c76828b628aa542b authorAndy Arvanitis <andyarvanitis@gmail.com> dateSun 28 Feb 2016, 21:05 (11 years ago) parent26c4601

3 files changed+45−8

compare with golang

unifiedsplit

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

src/Language/PureScript/CodeGen/Cpp.hs+33−8

@@ -29,6 +29,7 @@ module Language.PureScript.CodeGen.Cpp

2929import Data.Char (isLetter)

3030import Data.List

3131import Data.Function (on)

32+import Data.Maybe (catMaybes)

3233import qualified Data.Map as M

3334

3435import Control.Monad (forM, replicateM)

@@ -79,9 +80,14 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do

7980 else []) ++

8081 P.linebreak ++

8182 [ CppNamespace (runModuleName mn) $

82− (CppUseNamespace <$> cppImports') ++

83− P.linebreak ++ toHeader optimized ++ toHeaderFns optimized ] ++

84− P.linebreak ++ fileEnd mn "HH"

83+ (CppUseNamespace <$> cppImports') ++

84+ P.linebreak ++

85+ dataCtors ++

86+ toHeader optimized ++

87+ toHeaderFns optimized

88+ ] ++

89+ P.linebreak ++

90+ fileEnd mn "HH"

8591 let bodyCpps = toBodyDecl optimized ++ toBody optimized

8692 moduleBody =

8793 CppInclude (runModuleName mn) (runModuleName mn) :

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

181187 []

182188 (Just $ CppAny [])

183189 [CppInline]

184− (asReturnBlock (CppDataLiteral [CppStringLiteral (identToCpp ident)]))

190+ (asReturnBlock $

191+ CppDataLiteral [CppAccessor (CppVar $ identToCpp ident) (CppVar "data")])

185192

186193 declToCpp _ ident (Constructor _ _ (ProperName _) fields) =

187194 return . CppNamespace "" $

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

190197 (farg <$> fields')

191198 (Just $ CppAny [])

192199 [CppInline]

193− (asReturnBlock (CppDataLiteral (CppStringLiteral name : (CppVar <$> fields'))))

200+ (asReturnBlock $

201+ CppDataLiteral $

202+ CppAccessor (CppVar name) (CppVar "data") : (CppVar <$> fields'))

194203 ] ++

195204 if length fields > 1

196205 then

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

427436 Var (_, _, _, Just IsNewtype) _ -> return (head args')

428437 Var (_, _, _, Just (IsConstructor _ fields)) ident

429438 | length args == length fields ->

430− return $ CppApp (uncurried' $ qualifiedToCpp id ident) args'

439+ return $ CppApp (uncurried' $ qualifiedToCpp id ident) args'

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

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

433442 return . CppObjectLiteral $

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

587596

588597 binderToCpp varName done (ConstructorBinder (_, _, _, Just (IsConstructor ctorType fields))

589598 _

590− (Qualified _ (ProperName ctor))

599+ (Qualified mn' (ProperName ctor))

591600 bs) = do

592601 cpps <- go (zip fields bs) done

593602 return $

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

600609 (CppIndexer

601610 (CppVar ctorKey)

602611 (CppCast dataType $ CppVar varName))

603− (CppStringLiteral ctor))

612+ ctorCpp)

604613 (CppBlock cpps)

605614 Nothing]

606615 where

@@ -620,6 +629,11 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do

620629 : cpps

621630 fieldToIndex :: Ident -> Cpp

622631 fieldToIndex = CppNumericLiteral . Left . (+1) . read . dropWhile isLetter . runIdent

632+ ctor' :: Cpp

633+ ctor' = CppAccessor (CppVar . identToCpp $ Ident ctor) (CppVar "data")

634+ ctorCpp :: Cpp

635+ ctorCpp | Just mn'' <- mn', mn'' /= mn = CppAccessor ctor' (CppVar $ moduleNameToCpp mn'')

636+ | otherwise = ctor'

623637

624638 binderToCpp _ _ b@(ConstructorBinder{}) =

625639 error $ "Invalid ConstructorBinder in binderToCpp: " ++ show b

@@ -753,6 +767,17 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do

753767 = Just (fst <$> params, constraints, (sortBy (compare `on` normalizedName . fst) fns'))

754768 findClass _ = Nothing

755769

770+ -------------------------------------------------------------------------------------------------

771+ dataCtors :: [Cpp]

772+ -------------------------------------------------------------------------------------------------

773+ dataCtors = [CppNamespace "data"

774+ [CppEnum Nothing (Just intType) . ("_" :) .

775+ catMaybes . map modCtor . M.keys $ E.dataConstructors env]]

776+ where

777+ modCtor :: Qualified (ProperName a) -> Maybe String

778+ modCtor (Qualified (Just mn') (ProperName name)) | mn' == mn = Just name

779+ modCtor _ = Nothing

780+

756781 -------------------------------------------------------------------------------------------------

757782 curriedForeigns :: m [Cpp]

758783 -------------------------------------------------------------------------------------------------

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

@@ -174,6 +174,10 @@ data Cpp

174174 --

175175 | CppDataLiteral [Cpp]

176176 -- |

177+ -- An enum definition (optional name, optional type)

178+ --

179+ | CppEnum (Maybe String) (Maybe CppType) [String]

180+ -- |

177181 -- An array indexer expression

178182 --

179183 | CppIndexer Cpp Cpp

src/Language/PureScript/Pretty/Cpp.hs+8

@@ -77,6 +77,14 @@ literals = mkPattern' match

7777 , fmap (intercalate ", ") $ forM xs prettyPrintCpp'

7878 , return " }"

7979 ]

80+ match (CppEnum name ty es) = fmap concat $ sequence

81+ [ return "enum"

82+ , return $ maybe "" (" " ++) name

83+ , return $ maybe "" ((" : " ++) . runType) ty

84+ , return " { "

85+ , return $ intercalate ", " es

86+ , return " }"

87+ ]

8088 match (CppObjectLiteral ps) = fmap concat $ sequence

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

8290 , withIndent $ do