0fb72ce · rowtype-yoga/purescript-native

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

on golang help sign in

Use const refs for static value returns

0fb72ceAndy Arvanitis8 years ago

src/CodeGen/Cpp.hs+12−3

compare with golang

unifiedsplit

@@ -16,7 +16,7 @@ import Control.Monad.Supply.Class

16import Data.List ((\\), delete, intersect)

17import qualified Data.Foldable as F

18import qualified Data.Map as M

19−import Data.Maybe (fromMaybe, isNothing)

19+import Data.Maybe (fromMaybe, isNothing, mapMaybe)

20import Data.Monoid ((<>))

21import Data.String (fromString)

22import Data.Text (Text)

@@ -59,14 +59,23 @@ moduleToCpp (Module _ coms mn _ imps exports foreigns decls) _ =

59 let decls' = renameModules mnLookup decls

60 cppDecls <- mapM (bindToCpp ModuleDecl) decls'

61 optimized <- traverse (traverse optimize) cppDecls

62− let interface = interfaceSource modName exports foreigns

62+ let optimized' = concat optimized

63+ exports' = mapMaybe (export $ identToCpp <$> exports) optimized'

63 foreigns' = identToCpp <$> foreigns

64 foreigns' = identToCpp <$> foreigns

65+ interface = interfaceSource modName exports' foreigns

64 implHeader = implHeaderSource modName cppImports interfaceImport

66 implHeader = implHeaderSource modName cppImports interfaceImport

65 implFooter = implFooterSource modName foreigns

67 implFooter = implFooterSource modName foreigns

66− return $ (interface, foreigns', concat optimized, implHeader, implFooter)

68+ return $ (interface, foreigns', optimized', implHeader, implFooter)

67 where

69 where

68 modName = moduleNameToCpp mn

70 modName = moduleNameToCpp mn

72+ export :: [Text] -> AST -> Maybe (Text, Bool)

73+ export names (AST.Function _ (Just name) [] (AST.Block _ [AST.Return _ ret]))

74+ | name `elem` names && isLiteral ret = Just (name, True)

75+ export names (AST.Function _ (Just name) [] _)

76+ | name `elem` names = Just (name, False)

77+ export _ _ = Nothing

78+

70 -- | Extracts all declaration names from a binding group.

79 -- | Extracts all declaration names from a binding group.

71 getNames :: Bind Ann -> [Ident]

80 getNames :: Bind Ann -> [Ident]

72 getNames (NonRec _ ident _) = [ident]

81 getNames (NonRec _ ident _) = [ident]

src/CodeGen/Cpp/Printer.hs+41−37

@@ -6,6 +6,7 @@ module CodeGen.Cpp.Printer

6 , interfaceSource

7 , implHeaderSource

8 , implFooterSource

9+ , isLiteral

9 ) where

10 ) where

11import Prelude.Compat

12import Prelude.Compat

@@ -15,7 +16,7 @@ import Control.Monad (forM, mzero)

15import Control.Monad.State (StateT, evalStateT)

16import Control.Monad.State (StateT, evalStateT)

16import Control.PatternArrows

17import Control.PatternArrows

17import Data.Char (isAscii)

18import Data.Char (isAscii)

18−import Data.List ((\\))

19+import Data.List (filter)

19import qualified Control.Arrow as A

20import qualified Control.Arrow as A

21import Data.Maybe (fromMaybe)

22import Data.Maybe (fromMaybe)

@@ -125,46 +126,36 @@ literals = mkPattern' match'

125 , intercalate (emit ", ") <$> forM args prettyPrintCpp'

126 , intercalate (emit ", ") <$> forM args prettyPrintCpp'

126 , return $ emit ")"

127 , return $ emit ")"

127 ]

128 ]

128− match (Function _ (Just name) [] ret@(Block _ [Return _ (Function {})])) = mconcat <$> sequence

129+ match (Function _ (Just name) [] (Block _ [Return _ ret]))

130+ | isLiteral ret = mconcat <$> sequence

129 [ return $ emit "auto "

131 [ return $ emit "auto "

130 , return $ emit name

132 , return $ emit name

131− , return $ emit "() -> boxed "

133+ , return $ emit "() -> const boxed& "

132− , prettyPrintCpp' ret

133− ]

134− match (Function _ (Just name) [] (Block _ [Return _ ret])) = mconcat <$> sequence

135− [ return $ emit "auto "

136− , return $ emit name

137− , return $ emit "() -> boxed "

138 , return $ emit "{\n"

134 , return $ emit "{\n"

139 , withIndent $ do

135 , withIndent $ do

140 indentString <- currentIndent

136 indentString <- currentIndent

141− return $ indentString <> emit dispatchOnceBegin

137+ return $ indentString <> emit staticValueBegin

142 , withIndent $ do

138 , withIndent $ do

139+ case ret of

140+ Function _ Nothing args body -> mconcat <$> sequence

141+ [ return $ emit "[]("

142+ , return $ emit $ intercalate ", " (renderArg <$> args)

143+ , return $ emit ") -> boxed "

144+ , prettyPrintCpp' body

145+ ]

146+ _ -> do

143− prettyPrintCpp' ret

147+ prettyPrintCpp' ret

144 , return $ emit ";\n"

148 , return $ emit ";\n"

145 , withIndent $ do

149 , withIndent $ do

146 indentString <- currentIndent

150 indentString <- currentIndent

147− return $ indentString <> emit dispatchOnceEnd

151+ return $ indentString <> emit staticValueEnd

148 , return $ emit "\n}"

152 , return $ emit "\n}"

149 ]

153 ]

150− -- match (Function _ (Just name) [] ret) = mconcat <$> sequence

154+ match (Function _ (Just name) [] ret) = mconcat <$> sequence

151− match (Function _ (Just name) [] (Block ss sts)) | Return _ ret <- last sts = mconcat <$> sequence

152 [ return $ emit "auto "

155 [ return $ emit "auto "

153 , return $ emit name

156 , return $ emit name

154− , return $ emit "() -> boxed {\n"

157+ , return $ emit "() -> boxed "

155− , withIndent $ do

156− prettyStatements $ init sts

157− , return $ emit "\n"

158− , withIndent $ do

159− indentString <- currentIndent

160− return $ indentString <> emit dispatchOnceBegin

161− , withIndent $ do

162− prettyPrintCpp' ret

158+ , prettyPrintCpp' ret

163− , return $ emit ";\n"

164− , withIndent $ do

165− indentString <- currentIndent

166− return $ indentString <> emit dispatchOnceEnd

167− , return $ emit "\n}"

168 ]

159 ]

169 match (Function _ name args ret) = mconcat <$> sequence

160 match (Function _ name args ret) = mconcat <$> sequence

170 [ return $ emit $ if name == (Just tcoLoop) then "[&]" else "[=]"

161 [ return $ emit $ if name == (Just tcoLoop) then "[&]" else "[=]"

@@ -327,6 +318,15 @@ binary op str = AssocL match (\v1 v2 -> v1 <> emit (" " <> str <> " ") <> v2)

327 match' (Binary _ op' v1 v2) | op' == op = Just (v1, v2)

318 match' (Binary _ op' v1 v2) | op' == op = Just (v1, v2)

328 match' _ = Nothing

319 match' _ = Nothing

329

320

321+isLiteral :: AST -> Bool

322+isLiteral Function{} = True

323+isLiteral NumericLiteral{} = True

324+isLiteral StringLiteral{} = True

325+isLiteral BooleanLiteral{} = True

326+isLiteral ObjectLiteral{} = True

327+isLiteral ArrayLiteral{} = True

328+isLiteral _ = False

329+

330prettyStatements :: (Emit gen) => [AST] -> StateT PrinterState Maybe gen

331prettyStatements sts = do

332 cpps <- forM sts prettyPrintCpp'

@@ -428,8 +428,10 @@ renderOp op

428 | op == C.div = Just " / "

429 | otherwise = Nothing

430

431−interfaceSource :: Text -> [Ident] -> [Ident] -> Text

431+interfaceSource :: Text -> [(Text,Bool)] -> [Ident] -> Text

432interfaceSource mn exports foreigns =

433+ let foreigns' = identToCpp <$> foreigns

434+ exports' = filter ((`notElem` foreigns') . fst) exports in

433 "// Generated by pscpp compiler\n\n" <>

435 "// Generated by pscpp compiler\n\n" <>

434 "#ifndef " <> mn <> "_H\n" <>

436 "#ifndef " <> mn <> "_H\n" <>

435 "#define " <> mn <> "_H\n\n" <>

437 "#define " <> mn <> "_H\n\n" <>

@@ -437,16 +439,18 @@ interfaceSource mn exports foreigns =

437 "\n" <>

439 "\n" <>

438 "namespace " <> mn <> " {\n\n" <>

440 "namespace " <> mn <> " {\n\n" <>

439 "using namespace purescript;\n\n" <>

441 "using namespace purescript;\n\n" <>

442+ (T.concat $ (\(export, static) ->

443+ let rty = if static then "const boxed&" else "boxed" in

440− (T.concat $ (\export -> "auto " <> identToCpp export <> "() -> boxed;\n") <$> (exports \\ foreigns)) <>

444+ "auto " <> export <> "() -> " <> rty <> ";\n") <$> exports') <>

441 "\n" <>

445 "\n" <>

442 (if null foreigns then "" else ("// Foreign values\n\nauto " <> foreignDict <> "() -> " <> dictType <> "&;\n\n")) <>

446 (if null foreigns then "" else ("// Foreign values\n\nauto " <> foreignDict <> "() -> " <> dictType <> "&;\n\n")) <>

443 (T.concat $ (\foreign' -> "inline auto " <>

447 (T.concat $ (\foreign' -> "inline auto " <>

444 identToCpp foreign' <>

448 identToCpp foreign' <>

445− "() -> " <> varDecl <> " { " <>

449+ "() -> const boxed& { " <>

446− dispatchOnceBegin <>

450+ staticValueBegin <>

447 foreignDict <> "().at(" <>

451 foreignDict <> "().at(" <>

448 (stringLiteral . mkString $ runIdent foreign') <> "); " <>

452 (stringLiteral . mkString $ runIdent foreign') <> "); " <>

449− dispatchOnceEnd <>

453+ staticValueEnd <>

450 " };\n") <$> foreigns) <>

454 " };\n") <$> foreigns) <>

451 "\n" <>

455 "\n" <>

452 "} // end namespace " <> mn <>

456 "} // end namespace " <> mn <>

@@ -489,8 +493,8 @@ renderArg arg

489foreignDict :: Text

493foreignDict :: Text

490foreignDict = "foreign"

494foreignDict = "foreign"

491

495

492−dispatchOnceBegin :: Text

496+staticValueBegin :: Text

493−dispatchOnceBegin = "static const boxed $value$ = "

497+staticValueBegin = "static const boxed _ = "

494

498

495−dispatchOnceEnd :: Text

499+staticValueEnd :: Text

496−dispatchOnceEnd = "return $value$;"

500+staticValueEnd = "return _;"