@@ -6,6 +6,7 @@ module CodeGen.Cpp.Printer
66 , interfaceSource
77 , implHeaderSource
88 , implFooterSource
9+ , isLiteral
910 ) where
1011
1112import Prelude.Compat
@@ -15,7 +16,7 @@ import Control.Monad (forM, mzero)
1516import Control.Monad.State (StateT, evalStateT)
1617import Control.PatternArrows
1718import Data.Char (isAscii)
18−import Data.List ((\\))
19+import Data.List (filter)
1920import qualified Control.Arrow as A
2021
2122import Data.Maybe (fromMaybe)
@@ -125,46 +126,36 @@ literals = mkPattern' match'
125126 , intercalate (emit ", ") <$> forM args prettyPrintCpp'
126127 , return $ emit ")"
127128 ]
128− match (Function _ (Just name) [] ret@(Block _ [Return _ (Function {})])) = mconcat <$> sequence
129+ match (Function _ (Just name) [] (Block _ [Return _ ret]))
130+ | isLiteral ret = mconcat <$> sequence
129131 [ return $ emit "auto "
130132 , return $ emit name
131− , return $ emit "() -> 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 "
133+ , return $ emit "() -> const boxed& "
138134 , return $ emit "{\n"
139135 , withIndent $ do
140136 indentString <- currentIndent
141− return $ indentString <> emit dispatchOnceBegin
137+ return $ indentString <> emit staticValueBegin
142138 , withIndent $ do
143− prettyPrintCpp' ret
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
147+ prettyPrintCpp' ret
144148 , return $ emit ";\n"
145149 , withIndent $ do
146150 indentString <- currentIndent
147− return $ indentString <> emit dispatchOnceEnd
151+ return $ indentString <> emit staticValueEnd
148152 , return $ emit "\n}"
149153 ]
150− -- match (Function _ (Just name) [] ret) = mconcat <$> sequence
151− match (Function _ (Just name) [] (Block ss sts)) | Return _ ret <- last sts = mconcat <$> sequence
154+ match (Function _ (Just name) [] ret) = mconcat <$> sequence
152155 [ return $ emit "auto "
153156 , return $ emit name
154− , return $ emit "() -> boxed {\n"
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
163− , return $ emit ";\n"
164− , withIndent $ do
165− indentString <- currentIndent
166− return $ indentString <> emit dispatchOnceEnd
167− , return $ emit "\n}"
157+ , return $ emit "() -> boxed "
158+ , prettyPrintCpp' ret
168159 ]
169160 match (Function _ name args ret) = mconcat <$> sequence
170161 [ return $ emit $ if name == (Just tcoLoop) then "[&]" else "[=]"
@@ -327,6 +318,15 @@ binary op str = AssocL match (\v1 v2 -> v1 <> emit (" " <> str <> " ") <> v2)
327318 match' (Binary _ op' v1 v2) | op' == op = Just (v1, v2)
328319 match' _ = Nothing
329320
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+
330330prettyStatements :: (Emit gen) => [AST] -> StateT PrinterState Maybe gen
331331prettyStatements sts = do
332332 cpps <- forM sts prettyPrintCpp'
@@ -428,8 +428,10 @@ renderOp op
428428 | op == C.div = Just " / "
429429 | otherwise = Nothing
430430
431−interfaceSource :: Text -> [Ident] -> [Ident] -> Text
431+interfaceSource :: Text -> [(Text,Bool)] -> [Ident] -> Text
432432interfaceSource mn exports foreigns =
433+ let foreigns' = identToCpp <$> foreigns
434+ exports' = filter ((`notElem` foreigns') . fst) exports in
433435 "// Generated by pscpp compiler\n\n" <>
434436 "#ifndef " <> mn <> "_H\n" <>
435437 "#define " <> mn <> "_H\n\n" <>
@@ -437,16 +439,18 @@ interfaceSource mn exports foreigns =
437439 "\n" <>
438440 "namespace " <> mn <> " {\n\n" <>
439441 "using namespace purescript;\n\n" <>
440− (T.concat $ (\export -> "auto " <> identToCpp export <> "() -> boxed;\n") <$> (exports \\ foreigns)) <>
442+ (T.concat $ (\(export, static) ->
443+ let rty = if static then "const boxed&" else "boxed" in
444+ "auto " <> export <> "() -> " <> rty <> ";\n") <$> exports') <>
441445 "\n" <>
442446 (if null foreigns then "" else ("// Foreign values\n\nauto " <> foreignDict <> "() -> " <> dictType <> "&;\n\n")) <>
443447 (T.concat $ (\foreign' -> "inline auto " <>
444448 identToCpp foreign' <>
445− "() -> " <> varDecl <> " { " <>
446− dispatchOnceBegin <>
449+ "() -> const boxed& { " <>
450+ staticValueBegin <>
447451 foreignDict <> "().at(" <>
448452 (stringLiteral . mkString $ runIdent foreign') <> "); " <>
449− dispatchOnceEnd <>
453+ staticValueEnd <>
450454 " };\n") <$> foreigns) <>
451455 "\n" <>
452456 "} // end namespace " <> mn <>
@@ -489,8 +493,8 @@ renderArg arg
489493foreignDict :: Text
490494foreignDict = "foreign"
491495
492−dispatchOnceBegin :: Text
493−dispatchOnceBegin = "static const boxed $value$ = "
496+staticValueBegin :: Text
497+staticValueBegin = "static const boxed _ = "
494498
495−dispatchOnceEnd :: Text
496−dispatchOnceEnd = "return $value$;"
499+staticValueEnd :: Text
500+staticValueEnd = "return _;"