2cd12ce · rowtype-yoga/purescript-native

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

on golang help sign in

C++: use enums for data ctor ids

2cd12ceAndy Arvanitis11 years ago

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

compare with golang

unifiedsplit

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

29import Data.Char (isLetter)

30import Data.List

31import Data.Function (on)

32+import Data.Maybe (catMaybes)

32import qualified Data.Map as M

33import qualified Data.Map as M

34import Control.Monad (forM, replicateM)

35import Control.Monad (forM, replicateM)

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

79 else []) ++

80 else []) ++

80 P.linebreak ++

81 P.linebreak ++

81 [ CppNamespace (runModuleName mn) $

82 [ CppNamespace (runModuleName mn) $

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

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

84+ P.linebreak ++

85+ dataCtors ++

86+ toHeader optimized ++

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

87+ toHeaderFns optimized

88+ ] ++

89+ P.linebreak ++

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

90+ fileEnd mn "HH"

85 let bodyCpps = toBodyDecl optimized ++ toBody optimized

91 let bodyCpps = toBodyDecl optimized ++ toBody optimized

86 moduleBody =

92 moduleBody =

87 CppInclude (runModuleName mn) (runModuleName mn) :

93 CppInclude (runModuleName mn) (runModuleName mn) :

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

181 []

187 []

182 (Just $ CppAny [])

188 (Just $ CppAny [])

183 [CppInline]

189 [CppInline]

190+ (asReturnBlock $

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

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

185

192

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

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

187 return . CppNamespace "" $

194 return . CppNamespace "" $

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

190 (farg <$> fields')

197 (farg <$> fields')

191 (Just $ CppAny [])

198 (Just $ CppAny [])

192 [CppInline]

199 [CppInline]

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

200+ (asReturnBlock $

201+ CppDataLiteral $

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

194 ] ++

203 ] ++

195 if length fields > 1

204 if length fields > 1

196 then

205 then

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

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

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

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

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

429 | length args == length fields ->

438 | length args == length fields ->

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

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

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

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

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

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

433 return . CppObjectLiteral $

442 return . CppObjectLiteral $

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

587

596

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

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

589 _

598 _

590− (Qualified _ (ProperName ctor))

599+ (Qualified mn' (ProperName ctor))

591 bs) = do

600 bs) = do

592 cpps <- go (zip fields bs) done

601 cpps <- go (zip fields bs) done

593 return $

602 return $

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

600 (CppIndexer

609 (CppIndexer

601 (CppVar ctorKey)

610 (CppVar ctorKey)

602 (CppCast dataType $ CppVar varName))

611 (CppCast dataType $ CppVar varName))

603− (CppStringLiteral ctor))

612+ ctorCpp)

604 (CppBlock cpps)

613 (CppBlock cpps)

605 Nothing]

614 Nothing]

606 where

615 where

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

620 : cpps

629 : cpps

621 fieldToIndex :: Ident -> Cpp

630 fieldToIndex :: Ident -> Cpp

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

631 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'

623

637

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

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

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

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

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

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

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

754 findClass _ = Nothing

768 findClass _ = Nothing

755

769

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+

756 -------------------------------------------------------------------------------------------------

781 -------------------------------------------------------------------------------------------------

757 curriedForeigns :: m [Cpp]

782 curriedForeigns :: m [Cpp]

758 -------------------------------------------------------------------------------------------------

783 -------------------------------------------------------------------------------------------------

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

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

174 --

175 | CppDataLiteral [Cpp]

176 -- |

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

178+ --

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

180+ -- |

177 -- An array indexer expression

181 -- An array indexer expression

178 --

182 --

179 | CppIndexer Cpp Cpp

183 | CppIndexer Cpp Cpp

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

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

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

78 , return " }"

79 ]

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+ ]

80 match (CppObjectLiteral ps) = fmap concat $ sequence

88 match (CppObjectLiteral ps) = fmap concat $ sequence

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

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

82 , withIndent $ do

90 , withIndent $ do