51e6b26 · rowtype-yoga/purescript-native

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

on golang help sign in

C++: update to 0.10.3 and use Text instead of String

51e6b26Andy Arvanitis10 years ago

pcc/Main.hs+3−3

compare with golang

unifiedsplit

@@ -32,7 +32,7 @@ import qualified Data.ByteString.UTF8 as BU8

32import Data.Char (isSpace)

33import qualified Data.Map as M

34import Data.Maybe (maybe)

35−import Data.Text (Text)

35+import Data.Text (Text, unpack)

36import Data.Version (showVersion)

38import qualified Language.PureScript as P

@@ -109,13 +109,13 @@ briefFormat (JSONResult warnings errors) =

109 (startLine pos)

110 (startColumn pos)

111 (show t)

112− (combine msg lnk)

112+ (combine msg (unpack lnk))

113 renderError t (JSONError _ msg _ lnk _ module' _) =

114 printf

115 "%s: in module %s - %s"

116 (show t)

117 (maybe "?" (printf "\"%s\"") module')

118− (combine msg lnk)

118+ (combine msg (unpack lnk))

119 combine :: String -> String -> String

120 combine msg lnk

121 | null lnk = msg'

pcc/Make.hs+32−30

@@ -15,6 +15,7 @@

15{-# LANGUAGE DataKinds #-}

16{-# LANGUAGE FlexibleContexts #-}

17{-# LANGUAGE GeneralizedNewtypeDeriving #-}

18+{-# LANGUAGE OverloadedStrings #-}

18{-# LANGUAGE PatternGuards #-}

19{-# LANGUAGE PatternGuards #-}

19{-# LANGUAGE TupleSections #-}

20{-# LANGUAGE TupleSections #-}

20{-# LANGUAGE TemplateHaskell #-}

21{-# LANGUAGE TemplateHaskell #-}

@@ -27,33 +28,32 @@ module Make

27 ) where

28 ) where

29import Control.Monad

30import Control.Monad

30−import Control.Monad.Error.Class (MonadError(..))

31import Control.Monad.Reader

33import Data.FileEmbed (embedFile)

34import Data.Maybe (fromMaybe)

35+import Data.Monoid ((<>))

36+import qualified Data.Text as T

37+import qualified Data.Text.Encoding as TE

35import Data.Time.Clock

38import Data.Time.Clock

36import Data.Version (showVersion)

39import Data.Version (showVersion)

37import qualified Data.Map as M

40import qualified Data.Map as M

38−import qualified Data.ByteString.Char8 as B

41+import qualified Data.ByteString.Lazy as B

40import System.Directory (copyFile, doesDirectoryExist, doesFileExist, getModificationTime, createDirectoryIfMissing)

43import System.Directory (copyFile, doesDirectoryExist, doesFileExist, getModificationTime, createDirectoryIfMissing)

41import System.FilePath ((</>), takeDirectory, addExtension, dropExtension)

44import System.FilePath ((</>), takeDirectory, addExtension, dropExtension)

42import System.IO.Error (tryIOError)

45import System.IO.Error (tryIOError)

43−import System.IO.UTF8

45import Language.PureScript.Errors

47import Language.PureScript.Errors

46−import Language.PureScript (Make, runMake)

48+import Language.PureScript (Make, makeIO, readTextFile, runMake)

48import qualified Language.PureScript as P

50import qualified Language.PureScript as P

49import qualified Language.PureScript.CodeGen.Cpp as CPP

51import qualified Language.PureScript.CodeGen.Cpp as CPP

50import qualified Language.PureScript.CoreFn as CF

52import qualified Language.PureScript.CoreFn as CF

51import qualified Paths_purescript as Paths

53import qualified Paths_purescript as Paths

53−makeIO :: (IOError -> P.ErrorMessage) -> IO a -> Make a

55+runModuleName' :: P.ModuleName -> String

54−makeIO f io = do

56+runModuleName' = T.unpack . P.runModuleName

55− e <- liftIO $ tryIOError io

56− either (throwError . P.singleError . f) return e

58buildMakeActions :: FilePath

59 -> M.Map P.ModuleName (Either P.RebuildPolicy FilePath)

@@ -75,7 +75,7 @@ buildMakeActions outputDir filePathMap usePrefix otherOpts =

75 getInputTimestamp mn = do

76 let path = fromMaybe (error "Module has no filename in 'make'") $ M.lookup mn filePathMap

77 let filePath = either (const []) takeDirectory path

78− fileBase = filePath </> (last . words . dotsTo ' ' $ P.runModuleName mn)

78+ fileBase = filePath </> (last . words . dotsTo ' ' $ runModuleName' mn)

79 ffis = addExtension fileBase <$> [sourceExt, headerExt] ++ otherExts

80 e1 <- traverse getTimestamp path

81 ffimax <- foldl1 max <$> mapM getTimestamp ffis

@@ -83,8 +83,8 @@ buildMakeActions outputDir filePathMap usePrefix otherOpts =

84 getOutputTimestamp :: P.ModuleName -> Make (Maybe UTCTime)

85 getOutputTimestamp mn = do

86− let filePath = P.runModuleName mn

86+ let filePath = runModuleName' mn

87− fileBase = outputDir </> filePath </> (last . words . dotsTo ' ' $ P.runModuleName mn)

87+ fileBase = outputDir </> filePath </> (last . words . dotsTo ' ' $ runModuleName' mn)

88 sourceFile = addExtension fileBase sourceExt

89 headerFile = addExtension fileBase headerExt

90 externsFile = outputDir </> filePath </> "externs.json"

@@ -92,36 +92,36 @@ buildMakeActions outputDir filePathMap usePrefix otherOpts =

93 readExterns :: P.ModuleName -> Make (FilePath, P.Externs)

94 readExterns mn = do

95− let path = outputDir </> (P.runModuleName mn) </> "externs.json"

95+ let path = outputDir </> (runModuleName' mn) </> "externs.json"

96 (path, ) <$> readTextFile path

98 codegen :: CF.Module CF.Ann -> P.Environment -> P.Externs -> P.SupplyT Make ()

99 codegen m env exts = do

100 let mn = CF.moduleName m

101− let filePath = P.runModuleName mn

101+ let filePath = runModuleName' mn

102− fileBase = outputDir </> filePath </> (last . words . dotsTo ' ' $ P.runModuleName mn)

102+ fileBase = outputDir </> filePath </> (last . words . dotsTo ' ' $ runModuleName' mn)

103 sourceFile = addExtension fileBase sourceExt

104 headerFile = addExtension fileBase headerExt

105 externsFile = outputDir </> filePath </> "externs.json"

106− prefix = ["Generated by pcc version " ++ showVersion Paths.version | usePrefix]

106+ prefix = ["Generated by pcc version " <> T.pack (showVersion Paths.version) | usePrefix]

107 cpps <- CPP.moduleToCpp otherOpts env m

108 let (hdrs,srcs) = span (/= CPP.CppEndOfHeader) cpps

109 psrcs <- CPP.prettyPrintCpp <$> pure srcs

110 phdrs <- CPP.prettyPrintCpp <$> pure hdrs

111− let src = unlines $ map ("// " ++) prefix ++ [psrcs]

111+ let src = T.unlines $ map ("// " <>) prefix ++ [psrcs]

112− hdr = unlines $ map ("// " ++) prefix ++ [phdrs]

112+ hdr = T.unlines $ map ("// " <>) prefix ++ [phdrs]

113

114 lift $ do

115− writeTextFile sourceFile src

115+ writeTextFile' sourceFile src

116− writeTextFile headerFile hdr

116+ writeTextFile' headerFile hdr

117 writeTextFile externsFile exts

118

119 let supportDir = outputDir </> "PureScript"

120 supportFilesExist <- dirExists supportDir

121 when (not supportFilesExist) $ do

122− writeTextFile (supportDir </> "PureScript.hh") $ B.unpack $(embedFile "pcc/runtime/purescript.hh")

122+ writeTextFile (supportDir </> "PureScript.hh") $ B.fromStrict $(embedFile "pcc/runtime/purescript.hh")

123− writeTextFile (supportDir </> "PureScript.cc") $ B.unpack $(embedFile "pcc/runtime/purescript.cc")

123+ writeTextFile (supportDir </> "PureScript.cc") $ B.fromStrict $(embedFile "pcc/runtime/purescript.cc")

124− writeTextFile (supportDir </> "purescript_memory.hh") $ B.unpack $(embedFile "pcc/runtime/purescript_memory.hh")

124+ writeTextFile (supportDir </> "purescript_memory.hh") $ B.fromStrict $(embedFile "pcc/runtime/purescript_memory.hh")

125

126 let inputPath = dropExtension $ getInputFile mn

127 hfile = addExtension inputPath headerExt

@@ -131,7 +131,7 @@ buildMakeActions outputDir filePathMap usePrefix otherOpts =

131 let dstFile = addExtension (fileBase ++ ffiMangle) headerExt

132 if hfileExists

133 then copyTextFile dstFile hfile

134− else writeTextFile dstFile []

134+ else writeTextFile dstFile ""

135 sfileExists <- textFileExists sfile

136 when (sfileExists) $ do

137 copyTextFile (addExtension (fileBase ++ ffiMangle) sourceExt) sfile

@@ -154,9 +154,6 @@ buildMakeActions outputDir filePathMap usePrefix otherOpts =

154 exists <- doesFileExist path

155 traverse (const $ getModificationTime path) $ guard exists

156

157− readTextFile :: FilePath -> Make String

158− readTextFile path = makeIO (const (ErrorMessage [] $ CannotReadFile path)) $ readUTF8File path

159−

160 copyTextFile :: FilePath -> FilePath -> Make ()

157 copyTextFile :: FilePath -> FilePath -> Make ()

161 copyTextFile to from = makeIO (const (ErrorMessage [] $ CannotWriteFile to)) $ do

158 copyTextFile to from = makeIO (const (ErrorMessage [] $ CannotWriteFile to)) $ do

162 createDirectoryIfMissing True (takeDirectory to)

159 createDirectoryIfMissing True (takeDirectory to)

@@ -168,15 +165,20 @@ buildMakeActions outputDir filePathMap usePrefix otherOpts =

168 _ <- tryIOError $ copyFile (addExtension from ext) (addExtension to ext)

165 _ <- tryIOError $ copyFile (addExtension from ext) (addExtension to ext)

169 return ()

166 return ()

170

167

171− writeTextFile :: FilePath -> String -> Make ()

168+ writeTextFile :: FilePath -> B.ByteString -> Make ()

172 writeTextFile path text = makeIO (const (ErrorMessage [] $ CannotWriteFile path)) $ do

169 writeTextFile path text = makeIO (const (ErrorMessage [] $ CannotWriteFile path)) $ do

173− createDirectoryIfMissing True (takeDirectory path)

170+ mkdirp path

174− _ <- tryIOError $ writeFile path text -- TODO: intended to ignore "file busy", fix properly asap

171+ _ <- tryIOError $ B.writeFile path text -- TODO: intended to ignore "file busy", fix properly asap

175 return ()

172 return ()

173+ where

174+ mkdirp :: FilePath -> IO ()

175+ mkdirp = createDirectoryIfMissing True . takeDirectory

176+

177+ writeTextFile' path = writeTextFile path . B.fromStrict . TE.encodeUtf8

176

178

177 -- | Render a progress message

179 -- | Render a progress message

178 renderProgressMessage :: P.ProgressMessage -> String

180 renderProgressMessage :: P.ProgressMessage -> String

179− renderProgressMessage (P.CompilingModule mn) = "Compiling " ++ P.runModuleName mn

181+ renderProgressMessage (P.CompilingModule mn) = "Compiling " ++ runModuleName' mn

180

182

181 progress :: P.ProgressMessage -> Make ()

183 progress :: P.ProgressMessage -> Make ()

182 progress = liftIO . putStrLn . renderProgressMessage

184 progress = liftIO . putStrLn . renderProgressMessage

src/Language/PureScript/CodeGen/Cpp.hs+46−38

@@ -34,6 +34,9 @@ import Data.Function (on)

34import Data.List

35import qualified Data.Map as M

36import Data.Maybe (catMaybes, fromJust)

37+import Data.Monoid ((<>))

38+import Data.Text (Text, unpack)

39+import qualified Data.Text as Text

38import Control.Monad (forM, replicateM)

41import Control.Monad (forM, replicateM)

39import Control.Monad.Reader (MonadReader, ask)

42import Control.Monad.Reader (MonadReader, ask)

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

95 P.linebreak ++

98 P.linebreak ++

96 ((\i -> CppInclude i i) <$> cppImports') ++

99 ((\i -> CppInclude i i) <$> cppImports') ++

97 (if not (null foreigns)

100 (if not (null foreigns)

98− then [CppInclude [] (runModuleName mn ++ "_ffi")]

101+ then [CppInclude "" (runModuleName mn <> "_ffi")]

99 else []) ++

102 else []) ++

100 P.linebreak ++

103 P.linebreak ++

101 [ CppNamespace (runModuleName mn) $

104 [ CppNamespace (runModuleName mn) $

@@ -135,8 +138,8 @@ moduleToCpp otherOpts env (Module _ mn imps _ foreigns decls) = do

135 -------------------------------------------------------------------------------------------------

138 -------------------------------------------------------------------------------------------------

136 declToCpp _ (_, ident) e@(Abs (_, _, _, Just IsTypeClassConstructor) _ _) =

139 declToCpp _ (_, ident) e@(Abs (_, _, _, Just IsTypeClassConstructor) _ _) =

137 let className = identToCpp ident

140 let className = identToCpp ident

138− (supers, members) = span (C.__superclass_ `isPrefixOf`) (identToCpp <$> (fst $ unAbs e []))

141+ (supers, members) = span (C.__superclass_ `Text.isPrefixOf`) (identToCpp <$> (fst $ unAbs e []))

139− in return $ CppStruct className [CppEnum Nothing Nothing (sort supers ++ members)]

142+ in return $ CppStruct className [CppEnum Nothing Nothing (sort supers <> members)]

140 declToCpp vqs (_, ident) (Abs (_, com, ty, _) arg body) = do

143 declToCpp vqs (_, ident) (Abs (_, com, ty, _) arg body) = do

141 fn <-

144 fn <-

142 if TopLevel `elem` vqs

145 if TopLevel `elem` vqs

@@ -352,9 +355,9 @@ moduleToCpp otherOpts env (Module _ mn imps _ foreigns decls) = do

352 where

355 where

353 cpps' = everywhereOnCpp removeRec <$> cpps

356 cpps' = everywhereOnCpp removeRec <$> cpps

354 allCpps = CppBlock $ otherCpp : cpps'

357 allCpps = CppBlock $ otherCpp : cpps'

355− fns :: [(String, Cpp)]

358+ fns :: [(Text, Cpp)]

356 fns = toelem <$> concatMap (everythingOnCpp (++) recursive) cpps

359 fns = toelem <$> concatMap (everythingOnCpp (++) recursive) cpps

357− filteredFns :: Cpp -> [(String, Cpp)]

360+ filteredFns :: Cpp -> [(Text, Cpp)]

358 filteredFns cpp = filter (\(f, _) -> everythingOnCpp (||) (== CppVar f) cpp) fns

361 filteredFns cpp = filter (\(f, _) -> everythingOnCpp (||) (== CppVar f) cpp) fns

359 recursive :: Cpp -> [Cpp]

362 recursive :: Cpp -> [Cpp]

360 recursive cpp'@(CppFunction _ _ _ qs _)

363 recursive cpp'@(CppFunction _ _ _ qs _)

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

368 removeRec (CppVariableIntroduction _ qs _)

371 removeRec (CppVariableIntroduction _ qs _)

369 | Recursive `elem` qs = CppNoOp

372 | Recursive `elem` qs = CppNoOp

370 removeRec cpp' = cpp'

373 removeRec cpp' = cpp'

371− replaceVar :: [(String, Cpp)] -> Cpp -> Cpp

374+ replaceVar :: [(Text, Cpp)] -> Cpp -> Cpp

372 replaceVar rs = go

375 replaceVar rs = go

373 where

376 where

374 go (CppVar var)

377 go (CppVar var)

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

380 (topdict, Just $ Any [Const])

383 (topdict, Just $ Any [Const])

381 []

384 []

382 (Just $ CppDataLiteral ((\(f, cpp) -> CppComment [LineComment f] cpp) <$> fns))

385 (Just $ CppDataLiteral ((\(f, cpp) -> CppComment [LineComment f] cpp) <$> fns))

383− accessed :: String -> String -> (String, Cpp)

386+ accessed :: Text -> Text -> (Text, Cpp)

384 accessed dictname name =

387 accessed dictname name =

385 ( name

388 ( name

386 , CppApp

389 , CppApp

@@ -391,10 +394,10 @@ moduleToCpp otherOpts env (Module _ mn imps _ foreigns decls) = do

391 where

394 where

392 dict' = CppVar dictname

395 dict' = CppVar dictname

393 dict'' = CppCast (dataType 1) dict'

396 dict'' = CppCast (dataType 1) dict'

394− accessor :: String -> (String, Cpp) -> Cpp

397+ accessor :: Text -> (Text, Cpp) -> Cpp

395 accessor dictname (name, _) =

398 accessor dictname (name, _) =

396 CppVariableIntroduction (name, Just $ Any [Const]) [] (Just . snd $ accessed dictname name)

399 CppVariableIntroduction (name, Just $ Any [Const]) [] (Just . snd $ accessed dictname name)

397− toelem :: Cpp -> (String, Cpp)

400+ toelem :: Cpp -> (Text, Cpp)

398 toelem (CppFunction name args rtyp _ body'@(CppBlock body)) =

401 toelem (CppFunction name args rtyp _ body'@(CppBlock body)) =

399 ( name

402 ( name

400 , withdict . maybeRemCaps $

403 , withdict . maybeRemCaps $

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

416 [(localdict, Just $ Any [Const, Ref])]

419 [(localdict, Just $ Any [Const, Ref])]

417 (Just $ Any [])

420 (Just $ Any [])

418 (returnBlock cpp')

421 (returnBlock cpp')

419− topdict :: String

422+ topdict :: Text

420 topdict = "_$dict$_"

423 topdict = "_$dict$_"

421− localdict :: String

424+ localdict :: Text

422 localdict = "$dict$"

425 localdict = "$dict$"

423 convertRecursiveFns cpps _ = cpps

426 convertRecursiveFns cpps _ = cpps

424

427

@@ -452,10 +455,10 @@ moduleToCpp otherOpts env (Module _ mn imps _ foreigns decls) = do

452 CppMapLiteral Record $

455 CppMapLiteral Record $

453 (\(k, v) -> (CppSymbol k, v)) <$> sortBy (compare `on` fst) (origFields ++ updatedFields)

456 (\(k, v) -> (CppSymbol k, v)) <$> sortBy (compare `on` fst) (origFields ++ updatedFields)

454 where

457 where

455− allKeys :: T.Type -> [String]

458+ allKeys :: T.Type -> [Text]

456 allKeys (T.TypeApp (T.TypeConstructor _) r@(T.RCons {})) = fst <$> (fst $ T.rowToList r)

459 allKeys (T.TypeApp (T.TypeConstructor _) r@(T.RCons {})) = fst <$> (fst $ T.rowToList r)

457 allKeys (T.ForAll _ t _) = allKeys t

460 allKeys (T.ForAll _ t _) = allKeys t

458− allKeys _ = error $ show "Not a recognized row type"

461+ allKeys _ = error "Not a recognized row type"

459 valueToCpp (ObjectUpdate _ _ _) = error $ "Bad Type in object update!"

462 valueToCpp (ObjectUpdate _ _ _) = error $ "Bad Type in object update!"

460 valueToCpp (Abs (_, _, ty, _) arg body) = do

463 valueToCpp (Abs (_, _, ty, _) arg body) = do

461 cpp <- valueToCpp body

464 cpp <- valueToCpp body

@@ -505,9 +508,9 @@ moduleToCpp otherOpts env (Module _ mn imps _ foreigns decls) = do

505 hasRecursion :: [Cpp] -> Bool

508 hasRecursion :: [Cpp] -> Bool

506 hasRecursion cpps' = any (everythingOnCpp (||) hasRecursiveRef) cpps'

509 hasRecursion cpps' = any (everythingOnCpp (||) hasRecursiveRef) cpps'

507 where

510 where

508− valnames :: [String]

511+ valnames :: [Text]

509 valnames = concatMap (everythingOnCpp (++) valname) cpps'

512 valnames = concatMap (everythingOnCpp (++) valname) cpps'

510− valname :: Cpp -> [String]

513+ valname :: Cpp -> [Text]

511 valname (CppFunction name _ _ _ _) = [name]

514 valname (CppFunction name _ _ _ _) = [name]

512 valname (CppVariableIntroduction (name, _) _ _) = [name]

515 valname (CppVariableIntroduction (name, _) _ _) = [name]

513 valname _ = []

516 valname _ = []

@@ -554,21 +557,21 @@ moduleToCpp otherOpts env (Module _ mn imps _ foreigns decls) = do

554 (CppBlock (assignments ++ concat cpps ++ [failedPatternError valNames])))

557 (CppBlock (assignments ++ concat cpps ++ [failedPatternError valNames])))

555 []

558 []

556 where

559 where

557− mkVarDecl :: String -> Maybe Cpp -> Cpp

560+ mkVarDecl :: Text -> Maybe Cpp -> Cpp

558 mkVarDecl name = CppVariableIntroduction (name, Nothing) []

561 mkVarDecl name = CppVariableIntroduction (name, Nothing) []

559− go :: [String] -> [Cpp] -> [Binder Ann] -> m [Cpp]

562+ go :: [Text] -> [Cpp] -> [Binder Ann] -> m [Cpp]

560 go _ done [] = return done

563 go _ done [] = return done

561 go (v:vs) done' (b:bs) = do

564 go (v:vs) done' (b:bs) = do

562 done'' <- go vs done' bs

565 done'' <- go vs done' bs

563 binderToCpp v done'' b

566 binderToCpp v done'' b

564 go _ _ _ = error "Invalid arguments to bindersToCpp"

567 go _ _ _ = error "Invalid arguments to bindersToCpp"

565− failedPatternError :: [String] -> Cpp

568+ failedPatternError :: [Text] -> Cpp

566 failedPatternError _ =

569 failedPatternError _ =

567 CppThrow $ CppApp (CppVar "runtime_error") [CppStringLiteral errorMessage]

570 CppThrow $ CppApp (CppVar "runtime_error") [CppStringLiteral errorMessage]

568− errorMessage :: String

571+ errorMessage :: Text

569 errorMessage =

572 errorMessage =

570− "Failed pattern match" ++

573+ "Failed pattern match" <>

571− maybe "" (((" at " ++ runModuleName mn ++ " ") ++) . displayStartEndPos) maybeSpan ++ ": "

574+ maybe "" (((" at " <> runModuleName mn <> " ") <>) . displayStartEndPos) maybeSpan <> ": "

572 guardsToCpp :: Either [(Guard Ann, Expr Ann)] (Expr Ann) -> m [Cpp]

575 guardsToCpp :: Either [(Guard Ann, Expr Ann)] (Expr Ann) -> m [Cpp]

573 guardsToCpp (Left gs) =

576 guardsToCpp (Left gs) =

574 forM gs $ \(cond, val) -> do

577 forM gs $ \(cond, val) -> do

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

582 -- binder.

585 -- binder.

583 --

586 --

584 -------------------------------------------------------------------------------------------------

587 -------------------------------------------------------------------------------------------------

585− binderToCpp :: String -> [Cpp] -> Binder Ann -> m [Cpp]

588+ binderToCpp :: Text -> [Cpp] -> Binder Ann -> m [Cpp]

586 -------------------------------------------------------------------------------------------------

589 -------------------------------------------------------------------------------------------------

587 binderToCpp _ done (NullBinder {}) = return done

590 binderToCpp _ done (NullBinder {}) = return done

588 binderToCpp varName done (LiteralBinder _ l) = literalToBinderCpp varName done l

591 binderToCpp varName done (LiteralBinder _ l) = literalToBinderCpp varName done l

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

622 (CppCast (dataType $ fieldToIndex field + 1) $ CppVar varName)) :

625 (CppCast (dataType $ fieldToIndex field + 1) $ CppVar varName)) :

623 cpps

626 cpps

624 fieldToIndex :: Ident -> Int

627 fieldToIndex :: Ident -> Int

625− fieldToIndex = (+ 1) . read . dropWhile isLetter . runIdent

628+ fieldToIndex = (+ 1) . read . dropWhile isLetter . unpack . runIdent

626 fieldToIndex' :: Ident -> Cpp

629 fieldToIndex' :: Ident -> Cpp

627 fieldToIndex' = CppNumericLiteral . Left . toInteger . fieldToIndex

630 fieldToIndex' = CppNumericLiteral . Left . toInteger . fieldToIndex

628 ctor' :: Cpp

631 ctor' :: Cpp

@@ -633,14 +636,14 @@ moduleToCpp otherOpts env (Module _ mn imps _ foreigns decls) = do

633 , mn'' /= mn = CppAccessor ctor' (CppVar $ moduleNameToCpp mn'')

636 , mn'' /= mn = CppAccessor ctor' (CppVar $ moduleNameToCpp mn'')

634 | otherwise = ctor'

637 | otherwise = ctor'

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

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

636− error $ "Invalid ConstructorBinder in binderToCpp: " ++ show b

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

637 binderToCpp varName done (NamedBinder _ ident binder) = do

640 binderToCpp varName done (NamedBinder _ ident binder) = do

638 cpp <- binderToCpp varName done binder

641 cpp <- binderToCpp varName done binder

639 return $

642 return $

640 CppVariableIntroduction (identToCpp ident, Just $ Any [Const]) [] (Just $ CppVar varName) :

643 CppVariableIntroduction (identToCpp ident, Just $ Any [Const]) [] (Just $ CppVar varName) :

641 cpp

644 cpp

642 -------------------------------------------------------------------------------------------------

645 -------------------------------------------------------------------------------------------------

643− literalToBinderCpp :: String -> [Cpp] -> Literal (Binder Ann) -> m [Cpp]

646+ literalToBinderCpp :: Text -> [Cpp] -> Literal (Binder Ann) -> m [Cpp]

644 -------------------------------------------------------------------------------------------------

647 -------------------------------------------------------------------------------------------------

645 literalToBinderCpp varName done (NumericLiteral num) =

648 literalToBinderCpp varName done (NumericLiteral num) =

646 return

649 return

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

665 return [CppIfElse (CppUnary Not (CppVar varName)) (CppBlock done) Nothing]

668 return [CppIfElse (CppUnary Not (CppVar varName)) (CppBlock done) Nothing]

666 literalToBinderCpp varName done (ObjectLiteral bs) = go done bs

669 literalToBinderCpp varName done (ObjectLiteral bs) = go done bs

667 where

670 where

668− go :: [Cpp] -> [(String, Binder Ann)] -> m [Cpp]

671+ go :: [Cpp] -> [(Text, Binder Ann)] -> m [Cpp]

669 go done' [] = return done'

672 go done' [] = return done'

670 go done' ((prop, binder):bs') = do

673 go done' ((prop, binder):bs') = do

671 propVar <- freshName

674 propVar <- freshName

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

726 --

729 --

727 -------------------------------------------------------------------------------------------------

730 -------------------------------------------------------------------------------------------------

728 findClass :: Qualified (ProperName 'ClassName)

731 findClass :: Qualified (ProperName 'ClassName)

729− -> Maybe ([String], [T.Constraint], [(String, T.Type)])

732+ -> Maybe ([Text], [T.Constraint], [(Text, T.Type)])

730 -------------------------------------------------------------------------------------------------

733 -------------------------------------------------------------------------------------------------

731 findClass name

734 findClass name

732 | Just tcd <- M.lookup name (E.typeClasses env)

735 | Just tcd <- M.lookup name (E.typeClasses env)

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

756 ]

759 ]

757 ]

760 ]

758 where

761 where

759− modCtor :: Qualified (ProperName a) -> Maybe String

762+ modCtor :: Qualified (ProperName a) -> Maybe Text

760 modCtor (Qualified (Just mn') (ProperName name))

763 modCtor (Qualified (Just mn') (ProperName name))

761 | mn' == mn = Just $ identToCpp (Ident name)

764 | mn' == mn = Just $ identToCpp (Ident name)

762 modCtor _ = Nothing

765 modCtor _ = Nothing

@@ -794,7 +797,7 @@ returnBlock :: Cpp -> Cpp

794returnBlock cpp = CppBlock [CppReturn cpp]

797returnBlock cpp = CppBlock [CppReturn cpp]

795

798

796---------------------------------------------------------------------------------------------------

799---------------------------------------------------------------------------------------------------

797−curriedLambda :: [String] -> Cpp -> Cpp

800+curriedLambda :: [Text] -> Cpp -> Cpp

798---------------------------------------------------------------------------------------------------

801---------------------------------------------------------------------------------------------------

799curriedLambda args ret =

802curriedLambda args ret =

800 foldr

803 foldr

@@ -804,7 +807,7 @@ curriedLambda args ret =

804 args

807 args

805

808

806---------------------------------------------------------------------------------------------------

809---------------------------------------------------------------------------------------------------

807−curriedApp :: [String] -> Expr Ann -> Expr Ann

810+curriedApp :: [Text] -> Expr Ann -> Expr Ann

808---------------------------------------------------------------------------------------------------

811---------------------------------------------------------------------------------------------------

809curriedApp args vals =

812curriedApp args vals =

810 foldl (\val arg -> App nullAnn val (Var nullAnn . Qualified Nothing $ Ident arg)) vals args

813 foldl (\val arg -> App nullAnn val (Var nullAnn . Qualified Nothing $ Ident arg)) vals args

@@ -844,10 +847,13 @@ optIndexers classes = everywhereOnCpp dictIndexerToEnum

844 dictIndexerToEnum cpp = cpp

847 dictIndexerToEnum cpp = cpp

845

848

846---------------------------------------------------------------------------------------------------

849---------------------------------------------------------------------------------------------------

847−curriedName :: String -> String

850+curriedName :: Text -> Text

848---------------------------------------------------------------------------------------------------

851---------------------------------------------------------------------------------------------------

849−curriedName name@('$':_) = name

852+curriedName name

850−curriedName name = '$' : name

853+ | Text.null name = name

854+curriedName name

855+ | Text.head name == '$' = name

856+ | otherwise = '$' `Text.cons` name

851

857

852---------------------------------------------------------------------------------------------------

858---------------------------------------------------------------------------------------------------

853curriedName' :: Cpp -> Cpp

859curriedName' :: Cpp -> Cpp

@@ -881,28 +887,30 @@ primFn = go []

881convertIfPrimFn :: Maybe T.Type -> Cpp -> Cpp

887convertIfPrimFn :: Maybe T.Type -> Cpp -> Cpp

882---------------------------------------------------------------------------------------------------

888---------------------------------------------------------------------------------------------------

883convertIfPrimFn ty@(Just _) (CppNamespace ns fs) = CppNamespace ns (convertIfPrimFn ty <$> fs)

889convertIfPrimFn ty@(Just _) (CppNamespace ns fs) = CppNamespace ns (convertIfPrimFn ty <$> fs)

884−convertIfPrimFn (Just _) cpp@(CppFunction ('$':_) _ _ _ _) = cpp

890+convertIfPrimFn (Just _) cpp@(CppFunction name _ _ _ _)

891+ | not $ Text.null name

892+ , Text.head name == '$' = cpp

885convertIfPrimFn (Just ty) (CppFunction name params _ qs body)

893convertIfPrimFn (Just ty) (CppFunction name params _ qs body)

886 | (tys', Just rty') <- primFn ty =

894 | (tys', Just rty') <- primFn ty =

887 CppFunction name (zipWith (\(p, _) t -> (p, Just t)) params tys') (Just rty') qs body

895 CppFunction name (zipWith (\(p, _) t -> (p, Just t)) params tys') (Just rty') qs body

888convertIfPrimFn _ cpp = cpp

896convertIfPrimFn _ cpp = cpp

889

897

890---------------------------------------------------------------------------------------------------

898---------------------------------------------------------------------------------------------------

891−allSymbols :: [Cpp] -> [String]

899+allSymbols :: [Cpp] -> [Text]

892---------------------------------------------------------------------------------------------------

900---------------------------------------------------------------------------------------------------

893allSymbols cpps = nub $ concatMap (everythingOnCpp (++) symbols) cpps

901allSymbols cpps = nub $ concatMap (everythingOnCpp (++) symbols) cpps

894 where

902 where

895− symbols :: Cpp -> [String]

903+ symbols :: Cpp -> [Text]

896 symbols (CppSymbol s) = [symbolname s]

904 symbols (CppSymbol s) = [symbolname s]

897 symbols _ = []

905 symbols _ = []

898

906

899---------------------------------------------------------------------------------------------------

907---------------------------------------------------------------------------------------------------

900−symbolDefs :: [String] -> Cpp

908+symbolDefs :: [Text] -> Cpp

901---------------------------------------------------------------------------------------------------

909---------------------------------------------------------------------------------------------------

902symbolDefs [] = CppNoOp

910symbolDefs [] = CppNoOp

903symbolDefs syms = CppNamespace "PureScript" [CppNamespace "symbol" (asStruct <$> syms)]

911symbolDefs syms = CppNamespace "PureScript" [CppNamespace "symbol" (asStruct <$> syms)]

904 where

912 where

905− asStruct :: String -> Cpp

913+ asStruct :: Text -> Cpp

906 asStruct s = CppStruct s []

914 asStruct s = CppStruct s []

907

915

908---------------------------------------------------------------------------------------------------

916---------------------------------------------------------------------------------------------------

src/Language/PureScript/CodeGen/Cpp/AST.hs+14−13

@@ -25,6 +25,7 @@ import Control.Applicative (Applicative, (<$>), (<*>))

25import Data.Traversable (traverse)

26#endif

27import Control.Monad.Identity

28+import Data.Text (Text)

28import Language.PureScript.Comments

29import Language.PureScript.Comments

29import Language.PureScript.CodeGen.Cpp.Types

30import Language.PureScript.CodeGen.Cpp.Types

30import Language.PureScript.Traversals

31import Language.PureScript.Traversals

@@ -149,7 +150,7 @@ data Cpp

149 -- |

150 -- |

150 -- A string literal

151 -- A string literal

151 --

152 --

152− | CppStringLiteral String

153+ | CppStringLiteral Text

153 -- |

154 -- |

154 -- A character literal

155 -- A character literal

155 --

156 --

@@ -177,7 +178,7 @@ data Cpp

177 -- |

178 -- |

178 -- An enum definition (optional name, optional type)

179 -- An enum definition (optional name, optional type)

179 --

180 --

180− | CppEnum (Maybe String) (Maybe CppType) [String]

181+ | CppEnum (Maybe Text) (Maybe CppType) [Text]

181 -- |

182 -- |

182 -- An array indexer expression

183 -- An array indexer expression

183 --

184 --

@@ -193,11 +194,11 @@ data Cpp

193 -- |

194 -- |

194 -- A function introduction (name, arguments, return type, qualifiers, body)

195 -- A function introduction (name, arguments, return type, qualifiers, body)

195 --

196 --

196− | CppFunction String [(String, Maybe CppType)] (Maybe CppType) [ValueQual] Cpp

197+ | CppFunction Text [(Text, Maybe CppType)] (Maybe CppType) [ValueQual] Cpp

197 -- |

198 -- |

198 -- A lambda introduction (arguments, return type, body)

199 -- A lambda introduction (arguments, return type, body)

199 --

200 --

200− | CppLambda [CaptureType] [(String, Maybe CppType)] (Maybe CppType) Cpp

201+ | CppLambda [CaptureType] [(Text, Maybe CppType)] (Maybe CppType) Cpp

201 -- |

202 -- |

202 -- Value type cast

203 -- Value type cast

203 --

204 --

@@ -213,11 +214,11 @@ data Cpp

213 -- |

214 -- |

214 -- Variable

215 -- Variable

215 --

216 --

216− | CppVar String

217+ | CppVar Text

217 -- |

218 -- |

218 -- Unique system-wide name/constant

219 -- Unique system-wide name/constant

219 --

220 --

220− | CppSymbol String

221+ | CppSymbol Text

221 -- |

222 -- |

223 -- |

223 -- A block of expressions in braces

224 -- A block of expressions in braces

@@ -226,27 +227,27 @@ data Cpp

226 -- |

227 -- |

227 -- A C++ namespace

228 -- A C++ namespace

228 --

229 --

229− | CppNamespace String [Cpp]

230+ | CppNamespace Text [Cpp]

230 -- |

231 -- |

231 -- An C++ struct declaration (name, members)

232 -- An C++ struct declaration (name, members)

232 --

233 --

233− | CppStruct String [Cpp]

234+ | CppStruct Text [Cpp]

234 -- |

235 -- |

235 -- A C++ #include

236 -- A C++ #include

236 --

237 --

237− | CppInclude String String

238+ | CppInclude Text Text

238 -- |

239 -- |

239 -- A C++ using namespace declaration

240 -- A C++ using namespace declaration

240 --

241 --

241− | CppUseNamespace String

242+ | CppUseNamespace Text

242 -- |

243 -- |

243 -- Type alias, e.g. "using T = U" (new name and template types, original type)

244 -- Type alias, e.g. "using T = U" (new name and template types, original type)

244 --

245 --

245− | CppTypeAlias (String,[(String, Int)]) CppType String

246+ | CppTypeAlias (Text,[(Text, Int)]) CppType Text

246 -- |

247 -- |

247 -- A variable introduction and optional initialization

248 -- A variable introduction and optional initialization

248 --

249 --

249− | CppVariableIntroduction (String, Maybe CppType) [ValueQual] (Maybe Cpp)

250+ | CppVariableIntroduction (Text, Maybe CppType) [ValueQual] (Maybe Cpp)

250 -- |

251 -- |

251 -- A variable assignment

252 -- A variable assignment

252 --

253 --

@@ -286,7 +287,7 @@ data Cpp

286 -- |

287 -- |

287 -- Raw C++11 (generated when parsing fails for an inline foreign import declaration)

288 -- Raw C++11 (generated when parsing fails for an inline foreign import declaration)

288 --

289 --

289− | CppRaw String

290+ | CppRaw Text

290 -- |

291 -- |

291 -- Commented C++11

292 -- Commented C++11

292 --

293 --

src/Language/PureScript/CodeGen/Cpp/Common.hs+26−18

@@ -14,14 +14,16 @@

14-----------------------------------------------------------------------------

16{-# LANGUAGE PatternGuards #-}

17+{-# LANGUAGE OverloadedStrings #-}

18module Language.PureScript.CodeGen.Cpp.Common where

19module Language.PureScript.CodeGen.Cpp.Common where

20−import Prelude.Compat

21+import Prelude.Compat hiding (all, concatMap, last, init)

22import Data.Char

23import Data.Char

23−import Data.List (intercalate)

24+import Data.Text hiding (map)

24−

25+import Data.Monoid ((<>))

26+import qualified Data.Text as T

25import Language.PureScript.Crash

27import Language.PureScript.Crash

26import Language.PureScript.Names

28import Language.PureScript.Names

@@ -34,33 +36,35 @@ import Language.PureScript.Names

34--

36--

35-- * Symbols are wrapped with '_' between a symbol name or their ordinal value.

37-- * Symbols are wrapped with '_' between a symbol name or their ordinal value.

36--

38--

37−identToCpp :: Ident -> String

39+identToCpp :: Ident -> Text

38−identToCpp (Ident name) | nameIsCppReserved name = '_' : name ++ "_"

40+identToCpp (Ident name) | nameIsCppReserved name = "_" <> name <> "_"

39−identToCpp (Ident name@('$' : s)) | all isDigit s = name

41+identToCpp (Ident name)

42+ | Just ('$', s) <- uncons name

43+ , all isDigit s = name

40identToCpp (Ident name) = concatMap identCharToString name

44identToCpp (Ident name) = concatMap identCharToString name

41−identToCpp (GenIdent _ _) = internalError "GenIdent in identToJs"

45+identToCpp (GenIdent _ _) = internalError "GenIdent in identToCpp"

43-- |

47-- |

44-- Test if a string is a valid Cpp identifier without escaping.

48-- Test if a string is a valid Cpp identifier without escaping.

45--

49--

46−identNeedsEscaping :: String -> Bool

50+identNeedsEscaping :: Text -> Bool

47identNeedsEscaping s = s /= identToCpp (Ident s)

51identNeedsEscaping s = s /= identToCpp (Ident s)

49-- |

53-- |

50-- Attempts to find a human-readable name for a symbol, if none has been specified returns the

54-- Attempts to find a human-readable name for a symbol, if none has been specified returns the

51-- ordinal value.

55-- ordinal value.

52--

56--

53−identCharToString :: Char -> String

57+identCharToString :: Char -> Text

54−identCharToString c | isAlphaNum c = [c]

58+identCharToString c | isAlphaNum c = singleton c

55identCharToString '_' = "_"

59identCharToString '_' = "_"

56identCharToString '.' = "_"

60identCharToString '.' = "_"

57identCharToString '\'' = "_prime"

61identCharToString '\'' = "_prime"

58−identCharToString c = "$0" ++ show (ord c)

62+identCharToString c = "$0" <> (pack . show $ ord c)

60-- |

64-- |

61-- Checks whether an identifier name is reserved in C++11.

65-- Checks whether an identifier name is reserved in C++11.

62--

66--

63−nameIsCppReserved :: String -> Bool

67+nameIsCppReserved :: Text -> Bool

64nameIsCppReserved name =

68nameIsCppReserved name =

65 name `elem` [ "alignas"

69 name `elem` [ "alignas"

66 , "alignof"

70 , "alignof"

@@ -172,19 +176,23 @@ nameIsCppReserved name =

172 , "xor"

176 , "xor"

173 , "xor_eq" ] || properNameIsCppReserved name

177 , "xor_eq" ] || properNameIsCppReserved name

174

178

175−normalizedName :: String -> String

179+normalizedName :: Text -> Text

180+normalizedName name

181+ | Just ('_', s) <- uncons name

182+ , last s == '_'

183+ , s' <- init s

176−normalizedName ('_' : s) | last s == '_', s' <- init s, nameIsCppReserved s' = s'

184+ , nameIsCppReserved s' = s'

177normalizedName s = s

185normalizedName s = s

178

186

179−moduleNameToCpp :: ModuleName -> String

187+moduleNameToCpp :: ModuleName -> Text

180moduleNameToCpp (ModuleName pns) =

188moduleNameToCpp (ModuleName pns) =

181− let name = intercalate "_" (runProperName `map` pns)

189+ let name = T.intercalate "_" (runProperName `map` pns)

182− in if properNameIsCppReserved name then '_' : name ++ "_" else name

190+ in if properNameIsCppReserved name then "_" <> name <> "_" else name

183

191

184-- |

192-- |

185-- Checks whether a proper name is reserved in C++11.

193-- Checks whether a proper name is reserved in C++11.

186--

194--

187−properNameIsCppReserved :: String -> Bool

195+properNameIsCppReserved :: Text -> Bool

188properNameIsCppReserved name =

196properNameIsCppReserved name =

189 name `elem` [ "Private"

197 name `elem` [ "Private"

190 , "PureScript" ]

198 , "PureScript" ]

src/Language/PureScript/CodeGen/Cpp/File.hs+10−7

@@ -13,12 +13,15 @@

13--

14-----------------------------------------------------------------------------

15{-# LANGUAGE PatternGuards #-}

16+{-# LANGUAGE OverloadedStrings #-}

17module Language.PureScript.CodeGen.Cpp.File where

18module Language.PureScript.CodeGen.Cpp.File where

19import Prelude.Compat

20import Prelude.Compat

21import Data.Maybe

22import Data.Maybe

23+import Data.Monoid ((<>))

24+import Data.Text (Text)

23import Language.PureScript.CodeGen.Cpp.AST

26import Language.PureScript.CodeGen.Cpp.AST

24import Language.PureScript.CodeGen.Cpp.Types

27import Language.PureScript.CodeGen.Cpp.Types

@@ -160,15 +163,15 @@ maybeRemCaps (CppLambda [CaptureAll] args rtyp body@(CppBlock [CppReturn (CppVar

160maybeRemCaps cpp = cpp

163maybeRemCaps cpp = cpp

161

164

162---------------------------------------------------------------------------------------------------

165---------------------------------------------------------------------------------------------------

163−fileBegin :: ModuleName -> String -> [Cpp]

166+fileBegin :: ModuleName -> Text -> [Cpp]

164fileBegin mn suffix =

167fileBegin mn suffix =

165− [CppRaw ("#ifndef " ++ fileModName mn suffix), CppRaw ("#define " ++ fileModName mn suffix)]

168+ [CppRaw ("#ifndef " <> fileModName mn suffix), CppRaw ("#define " <> fileModName mn suffix)]

166

169

167−fileEnd :: ModuleName -> String -> [Cpp]

170+fileEnd :: ModuleName -> Text -> [Cpp]

168−fileEnd mn suffix = [CppRaw ("#endif // " ++ fileModName mn suffix)]

171+fileEnd mn suffix = [CppRaw ("#endif // " <> fileModName mn suffix)]

169

172

170−fileModName :: ModuleName -> String -> String

173+fileModName :: ModuleName -> Text -> Text

171−fileModName mn suffix = P.dotsTo '_' (runModuleName mn ++ '_' : suffix)

174+fileModName mn suffix = P.dotsTo '_' (runModuleName mn <> "_" <> suffix)

172

175

173isMain :: ModuleName -> Bool

176isMain :: ModuleName -> Bool

174isMain (ModuleName [ProperName "Main"]) = True

177isMain (ModuleName [ProperName "Main"]) = True

@@ -178,7 +181,7 @@ nativeMain :: Cpp

178nativeMain =

181nativeMain =

179 CppFunction

182 CppFunction

180 "main"

183 "main"

181− [([], Just $ Primitive "int"), ([], Just $ Primitive "char *[]")]

184+ [("", Just $ Primitive "int"), ("", Just $ Primitive "char *[]")]

182 (Just $ Primitive "int")

185 (Just $ Primitive "int")

183 []

186 []

184 (CppBlock

187 (CppBlock

src/Language/PureScript/CodeGen/Cpp/Optimizer/Common.hs+11−10

@@ -18,25 +18,26 @@ module Language.PureScript.CodeGen.Cpp.Optimizer.Common where

18import Prelude.Compat

20import Data.Maybe (fromMaybe)

21+import Data.Text (Text, cons)

22import Language.PureScript.CodeGen.Cpp.AST

23import Language.PureScript.CodeGen.Cpp.AST

24applyAll :: [a -> a] -> a -> a

25applyAll :: [a -> a] -> a -> a

25applyAll = foldl1 (.)

26applyAll = foldl1 (.)

27−replaceIdent :: String -> Cpp -> Cpp -> Cpp

28+replaceIdent :: Text -> Cpp -> Cpp -> Cpp

28replaceIdent var1 cpp = everywhereOnCpp replace

29replaceIdent var1 cpp = everywhereOnCpp replace

29 where

30 where

30 replace (CppVar var2) | var1 == var2 = cpp

31 replace (CppVar var2) | var1 == var2 = cpp

31 replace other = other

32 replace other = other

33−replaceIdents :: [(String, Cpp)] -> Cpp -> Cpp

34+replaceIdents :: [(Text, Cpp)] -> Cpp -> Cpp

34replaceIdents vars = everywhereOnCpp replace

35replaceIdents vars = everywhereOnCpp replace

35 where

36 where

36 replace v@(CppVar var) = fromMaybe v $ lookup var vars

37 replace v@(CppVar var) = fromMaybe v $ lookup var vars

37 replace other = other

38 replace other = other

39−isReassigned :: String -> Cpp -> Bool

40+isReassigned :: Text -> Cpp -> Bool

40isReassigned var1 = everythingOnCpp (||) check

41isReassigned var1 = everythingOnCpp (||) check

41 where

42 where

42 check :: Cpp -> Bool

43 check :: Cpp -> Bool

@@ -51,7 +52,7 @@ isRebound cpp d = any (\v -> isReassigned v d || isUpdated v d) (everythingOnCpp

51 variablesOf (CppVar var) = [var]

52 variablesOf (CppVar var) = [var]

52 variablesOf _ = []

53 variablesOf _ = []

54−isUsed :: String -> Cpp -> Bool

55+isUsed :: Text -> Cpp -> Bool

55isUsed var1 = everythingOnCpp (||) check

56isUsed var1 = everythingOnCpp (||) check

56 where

57 where

57 check :: Cpp -> Bool

58 check :: Cpp -> Bool

@@ -59,14 +60,14 @@ isUsed var1 = everythingOnCpp (||) check

59 check (CppAssignment target _) | var1 == targetVariable target = True

60 check (CppAssignment target _) | var1 == targetVariable target = True

60 check _ = False

61 check _ = False

62−targetVariable :: Cpp -> String

63+targetVariable :: Cpp -> Text

63targetVariable (CppVar var) = var

64targetVariable (CppVar var) = var

64targetVariable (CppAccessor _ tgt) = targetVariable tgt

65targetVariable (CppAccessor _ tgt) = targetVariable tgt

65targetVariable (CppIndexer _ tgt) = targetVariable tgt

66targetVariable (CppIndexer _ tgt) = targetVariable tgt

66targetVariable (CppGet _ tgt) = targetVariable tgt

67targetVariable (CppGet _ tgt) = targetVariable tgt

67targetVariable _ = error "Invalid argument to targetVariable"

68targetVariable _ = error "Invalid argument to targetVariable"

69−isUpdated :: String -> Cpp -> Bool

70+isUpdated :: Text -> Cpp -> Bool

70isUpdated var1 = everythingOnCpp (||) check

71isUpdated var1 = everythingOnCpp (||) check

71 where

72 where

72 check :: Cpp -> Bool

73 check :: Cpp -> Bool

@@ -77,16 +78,16 @@ removeFromBlock :: ([Cpp] -> [Cpp]) -> Cpp -> Cpp

77removeFromBlock go (CppBlock sts) = CppBlock (go sts)

78removeFromBlock go (CppBlock sts) = CppBlock (go sts)

78removeFromBlock _ cpp = cpp

79removeFromBlock _ cpp = cpp

80−isFn :: (String, String) -> Cpp -> Bool

81+isFn :: (Text, Text) -> Cpp -> Bool

81isFn (moduleName, fnName) (CppAccessor (CppVar x) (CppVar y)) =

82isFn (moduleName, fnName) (CppAccessor (CppVar x) (CppVar y)) =

82− (x == fnName || x == ('$':fnName)) && y == moduleName

83+ (x == fnName || x == ('$' `cons` fnName)) && y == moduleName

83isFn (moduleName, fnName) (CppIndexer (CppStringLiteral x) (CppVar y)) =

84isFn (moduleName, fnName) (CppIndexer (CppStringLiteral x) (CppVar y)) =

84 x == fnName && y == moduleName

85 x == fnName && y == moduleName

85isFn _ _ = False

86isFn _ _ = False

87−isDict :: (String, String) -> Cpp -> Bool

88+isDict :: (Text, Text) -> Cpp -> Bool

88isDict (moduleName, dictName) (CppAccessor (CppVar x) (CppVar y)) = x == dictName && y == moduleName

89isDict (moduleName, dictName) (CppAccessor (CppVar x) (CppVar y)) = x == dictName && y == moduleName

89isDict _ _ = False

90isDict _ _ = False

91−isDict' :: [(String, String)] -> Cpp -> Bool

92+isDict' :: [(Text, Text)] -> Cpp -> Bool

92isDict' xs cpp = any (`isDict` cpp) xs

93isDict' xs cpp = any (`isDict` cpp) xs

src/Language/PureScript/CodeGen/Cpp/Optimizer/Inliner.hs+51−47

@@ -12,6 +12,9 @@

12-- This module provides basic inlining capabilities

13--

14-----------------------------------------------------------------------------

15+{-# LANGUAGE PatternGuards #-}

16+{-# LANGUAGE OverloadedStrings #-}

17+

15module Language.PureScript.CodeGen.Cpp.Optimizer.Inliner

18module Language.PureScript.CodeGen.Cpp.Optimizer.Inliner

16 ( inlineVariables

19 ( inlineVariables

17 , inlineCommonValues

20 , inlineCommonValues

@@ -25,6 +28,7 @@ module Language.PureScript.CodeGen.Cpp.Optimizer.Inliner

25 ) where

28 ) where

27import Prelude.Compat

30import Prelude.Compat

31+import Data.Text (Text)

29import Control.Monad.Supply.Class (MonadSupply, freshName)

33import Control.Monad.Supply.Class (MonadSupply, freshName)

@@ -127,7 +131,7 @@ inlineCommonValues = everywhereOnCpp convert

127 fnMultiply = (C.dataSemiring, C.mul)

131 fnMultiply = (C.dataSemiring, C.mul)

128 fnSubtract = (C.dataRing, C.sub)

132 fnSubtract = (C.dataRing, C.sub)

129

133

130−inlineOperator :: (String, String) -> (Cpp -> Cpp -> Cpp) -> Cpp -> Cpp

134+inlineOperator :: (Text, Text) -> (Cpp -> Cpp -> Cpp) -> Cpp -> Cpp

131inlineOperator (m, op) f = everywhereOnCpp convert

135inlineOperator (m, op) f = everywhereOnCpp convert

132 where

136 where

133 convert :: Cpp -> Cpp

137 convert :: Cpp -> Cpp

@@ -200,28 +204,28 @@ inlineCommonOperators = applyAll $

200 []

204 []

201 -- [ fn | i <- [0..10], fn <- [ mkFn i, runFn i ] ]

205 -- [ fn | i <- [0..10], fn <- [ mkFn i, runFn i ] ]

202 where

206 where

203− binary :: (String, String) -> (String, String) -> BinaryOperator -> Cpp -> Cpp

207+ binary :: (Text, Text) -> (Text, Text) -> BinaryOperator -> Cpp -> Cpp

204 binary dict fns op = everywhereOnCpp convert

208 binary dict fns op = everywhereOnCpp convert

205 where

209 where

206 convert :: Cpp -> Cpp

210 convert :: Cpp -> Cpp

207 convert (CppApp fn [dict', x, y]) | isDict dict dict' && isFn fns fn = CppBinary op x y

211 convert (CppApp fn [dict', x, y]) | isDict dict dict' && isFn fns fn = CppBinary op x y

208 convert (CppApp (CppApp (CppApp fn [dict']) [x]) [y]) | isDict dict dict' && isFn fns fn = CppBinary op x y

212 convert (CppApp (CppApp (CppApp fn [dict']) [x]) [y]) | isDict dict dict' && isFn fns fn = CppBinary op x y

209 convert other = other

213 convert other = other

210− binary' :: String -> String -> BinaryOperator -> Cpp -> Cpp

214+ binary' :: Text -> Text -> BinaryOperator -> Cpp -> Cpp

211 binary' moduleName opString op = everywhereOnCpp convert

215 binary' moduleName opString op = everywhereOnCpp convert

212 where

216 where

213 convert :: Cpp -> Cpp

217 convert :: Cpp -> Cpp

214 convert (CppApp fn [x, y]) | isFn (moduleName, opString) fn = CppBinary op x y

218 convert (CppApp fn [x, y]) | isFn (moduleName, opString) fn = CppBinary op x y

215 convert (CppApp (CppApp fn [x]) [y]) | isFn (moduleName, opString) fn = CppBinary op x y

219 convert (CppApp (CppApp fn [x]) [y]) | isFn (moduleName, opString) fn = CppBinary op x y

216 convert other = other

220 convert other = other

217− unary :: (String, String) -> (String, String) -> UnaryOperator -> Cpp -> Cpp

221+ unary :: (Text, Text) -> (Text, Text) -> UnaryOperator -> Cpp -> Cpp

218 unary dicts fns op = everywhereOnCpp convert

222 unary dicts fns op = everywhereOnCpp convert

219 where

223 where

220 convert :: Cpp -> Cpp

224 convert :: Cpp -> Cpp

221 convert (CppApp fn [dict', x]) | isDict dicts dict' && isFn fns fn = CppUnary op x

225 convert (CppApp fn [dict', x]) | isDict dicts dict' && isFn fns fn = CppUnary op x

222 convert (CppApp (CppApp fn [dict']) [x]) | isDict dicts dict' && isFn fns fn = CppUnary op x

226 convert (CppApp (CppApp fn [dict']) [x]) | isDict dicts dict' && isFn fns fn = CppUnary op x

223 convert other = other

227 convert other = other

224− unary' :: String -> String -> UnaryOperator -> Cpp -> Cpp

228+ unary' :: Text -> Text -> UnaryOperator -> Cpp -> Cpp

225 unary' moduleName fnName op = everywhereOnCpp convert

229 unary' moduleName fnName op = everywhereOnCpp convert

226 where

230 where

227 convert :: Cpp -> Cpp

231 convert :: Cpp -> Cpp

@@ -242,14 +246,14 @@ inlineCommonOperators = applyAll $

242 -- Just (args, cpp) -> CppLambda [CaptureAll] args Nothing (CppBlock cpp)

246 -- Just (args, cpp) -> CppLambda [CaptureAll] args Nothing (CppBlock cpp)

243 -- Nothing -> orig

247 -- Nothing -> orig

244 -- convert other = other

248 -- convert other = other

245− -- collectArgs :: Int -> [String] -> Cpp -> Maybe ([String], [Cpp])

249+ -- collectArgs :: Int -> [Text] -> Cpp -> Maybe ([Text], [Cpp])

246 -- collectArgs 1 acc (CppLambda _ [oneArg] _ (CppBlock cpp)) | length acc == n - 1 = Just (reverse (oneArg : acc), cpp)

250 -- collectArgs 1 acc (CppLambda _ [oneArg] _ (CppBlock cpp)) | length acc == n - 1 = Just (reverse (oneArg : acc), cpp)

247 -- collectArgs m acc (CppLambda _ [oneArg] _ (CppBlock [CppReturn ret])) = collectArgs (m - 1) (oneArg : acc) ret

251 -- collectArgs m acc (CppLambda _ [oneArg] _ (CppBlock [CppReturn ret])) = collectArgs (m - 1) (oneArg : acc) ret

248 -- collectArgs _ _ _ = Nothing

252 -- collectArgs _ _ _ = Nothing

249 --

253 --

250− -- isNFn :: String -> Int -> Cpp -> Bool

254+ -- isNFn :: Text -> Int -> Cpp -> Bool

251− -- isNFn prefix n (CppVar name) = name == (prefix ++ show n)

255+ -- isNFn prefix n (CppVar name) = name == (prefix <> show n)

252− -- isNFn prefix n (CppAccessor _ name (CppVar dataFunction)) | dataFunction == C.dataFunction = name == (prefix ++ show n)

256+ -- isNFn prefix n (CppAccessor _ name (CppVar dataFunction)) | dataFunction == C.dataFunction = name == (prefix <> show n)

253 -- isNFn _ _ _ = False

257 -- isNFn _ _ _ = False

254 --

258 --

255 -- runFn :: Int -> Cpp -> Cpp

259 -- runFn :: Int -> Cpp -> Cpp

@@ -294,9 +298,9 @@ inlineFnComposition = everywhereOnCppTopDownM convert

294 isFnCompose dict' fn = isDict semigroupoidFn dict' && isFn fnCompose fn

298 isFnCompose dict' fn = isDict semigroupoidFn dict' && isFn fnCompose fn

295 isFnComposeFlipped :: Cpp -> Cpp -> Bool

299 isFnComposeFlipped :: Cpp -> Cpp -> Bool

296 isFnComposeFlipped dict' fn = isDict semigroupoidFn dict' && isFn fnComposeFlipped fn

300 isFnComposeFlipped dict' fn = isDict semigroupoidFn dict' && isFn fnComposeFlipped fn

297− fnCompose :: (String, String)

301+ fnCompose :: (Text, Text)

298 fnCompose = (C.controlSemigroupoid, C.compose)

302 fnCompose = (C.controlSemigroupoid, C.compose)

299− fnComposeFlipped :: (String, String)

303+ fnComposeFlipped :: (Text, Text)

300 fnComposeFlipped = (C.controlSemigroupoid, C.composeFlipped)

304 fnComposeFlipped = (C.controlSemigroupoid, C.composeFlipped)

301

305

302toAutoVars :: Cpp -> Cpp

306toAutoVars :: Cpp -> Cpp

@@ -322,110 +326,110 @@ toAutoVars = everywhereOnCpp convert

322 var t = CppVariableIntroduction (ident, (Just t)) qs (Just value)

326 var t = CppVariableIntroduction (ident, (Just t)) qs (Just value)

323 convert cpp = cpp

327 convert cpp = cpp

324

328

325−semiringNumber :: (String, String)

329+semiringNumber :: (Text, Text)

326semiringNumber = (C.dataSemiring, C.semiringNumber)

330semiringNumber = (C.dataSemiring, C.semiringNumber)

327

331

328−semiringInt :: (String, String)

332+semiringInt :: (Text, Text)

329semiringInt = (C.dataSemiring, C.semiringInt)

333semiringInt = (C.dataSemiring, C.semiringInt)

330

334

331−ringNumber :: (String, String)

335+ringNumber :: (Text, Text)

332ringNumber = (C.dataRing, C.ringNumber)

336ringNumber = (C.dataRing, C.ringNumber)

333

337

334−ringInt :: (String, String)

338+ringInt :: (Text, Text)

335ringInt = (C.dataRing, C.ringInt)

339ringInt = (C.dataRing, C.ringInt)

336

340

337−euclideanRingNumber :: (String, String)

341+euclideanRingNumber :: (Text, Text)

338euclideanRingNumber = (C.dataEuclideanRing, C.euclideanRingNumber)

342euclideanRingNumber = (C.dataEuclideanRing, C.euclideanRingNumber)

339

343

340−euclideanRingInt :: (String, String)

344+euclideanRingInt :: (Text, Text)

341euclideanRingInt = (C.dataEuclideanRing, C.euclideanRingInt)

345euclideanRingInt = (C.dataEuclideanRing, C.euclideanRingInt)

342

346

343−eqNumber :: (String, String)

347+eqNumber :: (Text, Text)

344eqNumber = (C.dataEq, C.eqNumber)

348eqNumber = (C.dataEq, C.eqNumber)

345

349

346−eqInt :: (String, String)

350+eqInt :: (Text, Text)

347eqInt = (C.dataEq, C.eqInt)

351eqInt = (C.dataEq, C.eqInt)

348

352

349−eqString :: (String, String)

353+eqString :: (Text, Text)

350eqString = (C.dataEq, C.eqString)

354eqString = (C.dataEq, C.eqString)

351

355

352−eqChar :: (String, String)

356+eqChar :: (Text, Text)

353eqChar = (C.dataEq, C.eqChar)

357eqChar = (C.dataEq, C.eqChar)

354

358

355−eqBoolean :: (String, String)

359+eqBoolean :: (Text, Text)

356eqBoolean = (C.dataEq, C.eqBoolean)

360eqBoolean = (C.dataEq, C.eqBoolean)

357

361

358−ordBoolean :: (String, String)

362+ordBoolean :: (Text, Text)

359ordBoolean = (C.dataOrd, C.ordBoolean)

363ordBoolean = (C.dataOrd, C.ordBoolean)

360

364

361−ordNumber :: (String, String)

365+ordNumber :: (Text, Text)

362ordNumber = (C.dataOrd, C.ordNumber)

366ordNumber = (C.dataOrd, C.ordNumber)

363

367

364−ordInt :: (String, String)

368+ordInt :: (Text, Text)

365ordInt = (C.dataOrd, C.ordInt)

369ordInt = (C.dataOrd, C.ordInt)

366

370

367−ordString :: (String, String)

371+ordString :: (Text, Text)

368ordString = (C.dataOrd, C.ordString)

372ordString = (C.dataOrd, C.ordString)

369

373

370−ordChar :: (String, String)

374+ordChar :: (Text, Text)

371ordChar = (C.dataOrd, C.ordChar)

375ordChar = (C.dataOrd, C.ordChar)

372

376

373−semigroupString :: (String, String)

377+semigroupString :: (Text, Text)

374semigroupString = (C.dataSemigroup, C.semigroupString)

378semigroupString = (C.dataSemigroup, C.semigroupString)

375

379

376−boundedBoolean :: (String, String)

380+boundedBoolean :: (Text, Text)

377boundedBoolean = (C.dataBounded, C.boundedBoolean)

381boundedBoolean = (C.dataBounded, C.boundedBoolean)

378

382

379−heytingAlgebraBoolean :: (String, String)

383+heytingAlgebraBoolean :: (Text, Text)

380heytingAlgebraBoolean = (C.dataHeytingAlgebra, C.heytingAlgebraBoolean)

384heytingAlgebraBoolean = (C.dataHeytingAlgebra, C.heytingAlgebraBoolean)

381

385

382−semigroupoidFn :: (String, String)

386+semigroupoidFn :: (Text, Text)

383semigroupoidFn = (C.controlSemigroupoid, C.semigroupoidFn)

387semigroupoidFn = (C.controlSemigroupoid, C.semigroupoidFn)

384

388

385−opAdd :: (String, String)

389+opAdd :: (Text, Text)

386opAdd = (C.dataSemiring, C.add)

390opAdd = (C.dataSemiring, C.add)

387

391

388−opMul :: (String, String)

392+opMul :: (Text, Text)

389opMul = (C.dataSemiring, C.mul)

393opMul = (C.dataSemiring, C.mul)

390

394

391−opEq :: (String, String)

395+opEq :: (Text, Text)

392opEq = (C.dataEq, C.eq)

396opEq = (C.dataEq, C.eq)

393

397

394−opNotEq :: (String, String)

398+opNotEq :: (Text, Text)

395opNotEq = (C.dataEq, C.notEq)

399opNotEq = (C.dataEq, C.notEq)

396

400

397−opLessThan :: (String, String)

401+opLessThan :: (Text, Text)

398opLessThan = (C.dataOrd, C.lessThan)

402opLessThan = (C.dataOrd, C.lessThan)

399

403

400−opLessThanOrEq :: (String, String)

404+opLessThanOrEq :: (Text, Text)

401opLessThanOrEq = (C.dataOrd, C.lessThanOrEq)

405opLessThanOrEq = (C.dataOrd, C.lessThanOrEq)

402

406

403−opGreaterThan :: (String, String)

407+opGreaterThan :: (Text, Text)

404opGreaterThan = (C.dataOrd, C.greaterThan)

408opGreaterThan = (C.dataOrd, C.greaterThan)

405

409

406−opGreaterThanOrEq :: (String, String)

410+opGreaterThanOrEq :: (Text, Text)

407opGreaterThanOrEq = (C.dataOrd, C.greaterThanOrEq)

411opGreaterThanOrEq = (C.dataOrd, C.greaterThanOrEq)

408

412

409−opAppend :: (String, String)

413+opAppend :: (Text, Text)

410opAppend = (C.dataSemigroup, C.append)

414opAppend = (C.dataSemigroup, C.append)

411

415

412−opSub :: (String, String)

416+opSub :: (Text, Text)

413opSub = (C.dataRing, C.sub)

417opSub = (C.dataRing, C.sub)

414

418

415−opNegate :: (String, String)

419+opNegate :: (Text, Text)

416opNegate = (C.dataRing, C.negate)

420opNegate = (C.dataRing, C.negate)

417

421

418−opDiv :: (String, String)

422+opDiv :: (Text, Text)

419opDiv = (C.dataEuclideanRing, C.div)

423opDiv = (C.dataEuclideanRing, C.div)

420

424

421−opMod :: (String, String)

425+opMod :: (Text, Text)

422opMod = (C.dataEuclideanRing, C.mod)

426opMod = (C.dataEuclideanRing, C.mod)

423

427

424−opConj :: (String, String)

428+opConj :: (Text, Text)

425opConj = (C.dataHeytingAlgebra, C.conj)

429opConj = (C.dataHeytingAlgebra, C.conj)

426

430

427−opDisj :: (String, String)

431+opDisj :: (Text, Text)

428opDisj = (C.dataHeytingAlgebra, C.disj)

432opDisj = (C.dataHeytingAlgebra, C.disj)

429

433

430−opNot :: (String, String)

434+opNot :: (Text, Text)

431opNot = (C.dataHeytingAlgebra, C.not)

435opNot = (C.dataHeytingAlgebra, C.not)

src/Language/PureScript/CodeGen/Cpp/Optimizer/TCO.hs+14−10

@@ -12,13 +12,17 @@

12-- This module implements tail call elimination.

13--

14-----------------------------------------------------------------------------

15+{-# LANGUAGE PatternGuards #-}

16+{-# LANGUAGE OverloadedStrings #-}

16module Language.PureScript.CodeGen.Cpp.Optimizer.TCO (tco) where

18module Language.PureScript.CodeGen.Cpp.Optimizer.TCO (tco) where

18import Prelude.Compat

20import Prelude.Compat

20import Data.List

22import Data.List

23+import Data.Monoid ((<>))

21import qualified Data.Monoid as Monoid

24import qualified Data.Monoid as Monoid

25+import Data.Text (Text)

23import Language.PureScript.Options

27import Language.PureScript.Options

24import Language.PureScript.CodeGen.Cpp.Types

28import Language.PureScript.CodeGen.Cpp.Types

@@ -34,13 +38,13 @@ tco opts | optionsNoTco opts = id

34tco' :: Cpp -> Cpp

38tco' :: Cpp -> Cpp

35tco' = everywhereOnCpp convert

39tco' = everywhereOnCpp convert

36 where

40 where

37− tcoVar :: String -> String

41+ tcoVar :: Text -> Text

38− tcoVar arg = "__tco_" ++ arg

42+ tcoVar arg = "__tco_" <> arg

40− copyVar :: String -> String

44+ copyVar :: Text -> Text

41− copyVar arg = "__copy_" ++ arg

45+ copyVar arg = "__copy_" <> arg

43− copyVar' :: (String, Maybe CppType) -> (String, Maybe CppType)

47+ copyVar' :: (Text, Maybe CppType) -> (Text, Maybe CppType)

44 copyVar' (arg, t) = (copyVar arg, t)

48 copyVar' (arg, t) = (copyVar arg, t)

46 convert :: Cpp -> Cpp

50 convert :: Cpp -> Cpp

@@ -69,7 +73,7 @@ tco' = everywhereOnCpp convert

70 convert cpp = cpp

74 convert cpp = cpp

72− collectAllFunctionArgs :: [[(String, Maybe CppType)]] -> (Cpp -> Cpp) -> Cpp -> ([[(String, Maybe CppType)]], Cpp, Cpp -> Cpp)

76+ collectAllFunctionArgs :: [[(Text, Maybe CppType)]] -> (Cpp -> Cpp) -> Cpp -> ([[(Text, Maybe CppType)]], Cpp, Cpp -> Cpp)

73 collectAllFunctionArgs allArgs f (CppFunction ident args rty qs (CppBlock (body@(CppReturn _):_))) =

77 collectAllFunctionArgs allArgs f (CppFunction ident args rty qs (CppBlock (body@(CppReturn _):_))) =

74 collectAllFunctionArgs (args : allArgs) (\b -> f (CppFunction ident (map copyVar' args) rty qs (CppBlock [b]))) body

78 collectAllFunctionArgs (args : allArgs) (\b -> f (CppFunction ident (map copyVar' args) rty qs (CppBlock [b]))) body

75 collectAllFunctionArgs allArgs f (CppFunction ident args rty qs body@(CppBlock _)) =

79 collectAllFunctionArgs allArgs f (CppFunction ident args rty qs body@(CppBlock _)) =

@@ -80,7 +84,7 @@ tco' = everywhereOnCpp convert

80 (args : allArgs, body, f . CppReturn . CppLambda cs (map copyVar' args) rty)

84 (args : allArgs, body, f . CppReturn . CppLambda cs (map copyVar' args) rty)

81 collectAllFunctionArgs allArgs f body = (allArgs, body, f)

85 collectAllFunctionArgs allArgs f body = (allArgs, body, f)

83− isTailCall :: String -> Cpp -> Bool

87+ isTailCall :: Text -> Cpp -> Bool

84 isTailCall ident cpp =

88 isTailCall ident cpp =

85 let

89 let

86 numSelfCalls = everythingOnCpp (+) countSelfCalls cpp

90 numSelfCalls = everythingOnCpp (+) countSelfCalls cpp

@@ -109,7 +113,7 @@ tco' = everywhereOnCpp convert

109 countSelfCallsWithFnArgs :: Cpp -> Int

113 countSelfCallsWithFnArgs :: Cpp -> Int

110 countSelfCallsWithFnArgs ret = if isSelfCallWithFnArgs ident ret [] then 1 else 0

114 countSelfCallsWithFnArgs ret = if isSelfCallWithFnArgs ident ret [] then 1 else 0

111

115

112− toLoop :: String -> [String] -> Cpp -> Cpp

116+ toLoop :: Text -> [Text] -> Cpp -> Cpp

113 toLoop ident allArgs cpp = CppBlock $

117 toLoop ident allArgs cpp = CppBlock $

114 map (\arg -> CppVariableIntroduction (arg, Just $ Any []) [] (Just (CppVar (copyVar arg)))) allArgs ++

118 map (\arg -> CppVariableIntroduction (arg, Just $ Any []) [] (Just (CppVar (copyVar arg)))) allArgs ++

115 [ CppWhile (CppBooleanLiteral True) (CppBlock loop) ]

119 [ CppWhile (CppBooleanLiteral True) (CppBlock loop) ]

@@ -134,12 +138,12 @@ tco' = everywhereOnCpp convert

134 collectSelfCallArgs allArgumentValues (CppApp fn args') = collectSelfCallArgs (args' : allArgumentValues) fn

138 collectSelfCallArgs allArgumentValues (CppApp fn args') = collectSelfCallArgs (args' : allArgumentValues) fn

135 collectSelfCallArgs allArgumentValues _ = allArgumentValues

139 collectSelfCallArgs allArgumentValues _ = allArgumentValues

136

140

137− isSelfCall :: String -> Cpp -> Bool

141+ isSelfCall :: Text -> Cpp -> Bool

138 isSelfCall ident (CppApp (CppVar ident') _) = ident == ident'

142 isSelfCall ident (CppApp (CppVar ident') _) = ident == ident'

139 isSelfCall ident (CppApp fn _) = isSelfCall ident fn

143 isSelfCall ident (CppApp fn _) = isSelfCall ident fn

140 isSelfCall _ _ = False

144 isSelfCall _ _ = False

141

145

142− isSelfCallWithFnArgs :: String -> Cpp -> [Cpp] -> Bool

146+ isSelfCallWithFnArgs :: Text -> Cpp -> [Cpp] -> Bool

143 isSelfCallWithFnArgs ident (CppVar ident') args | ident == ident' && any hasFunction args = True

147 isSelfCallWithFnArgs ident (CppVar ident') args | ident == ident' && any hasFunction args = True

144 isSelfCallWithFnArgs ident (CppApp fn args) acc = isSelfCallWithFnArgs ident fn (args ++ acc)

148 isSelfCallWithFnArgs ident (CppApp fn args) acc = isSelfCallWithFnArgs ident fn (args ++ acc)

145 isSelfCallWithFnArgs _ _ _ = False

149 isSelfCallWithFnArgs _ _ _ = False

src/Language/PureScript/CodeGen/Cpp/Optimizer/Uncurry.hs+3−1

@@ -16,6 +16,7 @@

16module Language.PureScript.CodeGen.Cpp.Optimizer.Uncurry where

18import Prelude.Compat

19+import Data.Text (uncons)

20import Language.PureScript.CodeGen.Cpp.AST

21import Language.PureScript.CodeGen.Cpp.AST

@@ -37,7 +38,8 @@ removeCurrying nm = everywhereOnCpp convert

37 unCurried :: Cpp -> Maybe Cpp

38 unCurried :: Cpp -> Maybe Cpp

38 unCurried (CppAccessor var mn)

39 unCurried (CppAccessor var mn)

39 | Just var' <- unCurried var = Just $ CppAccessor var' mn

40 | Just var' <- unCurried var = Just $ CppAccessor var' mn

40− unCurried (CppVar ('$':name)) = Just $ CppVar name

41+ unCurried (CppVar name)

42+ | Just ('$', name') <- uncons name = Just $ CppVar name'

41 unCurried _ = Nothing

43 unCurried _ = Nothing

42 convert cpp = cpp

44 convert cpp = cpp

src/Language/PureScript/CodeGen/Cpp/Types.hs+16−13

@@ -14,12 +14,15 @@

14-----------------------------------------------------------------------------

15{-# LANGUAGE PatternGuards #-}

16{-# LANGUAGE DeriveDataTypeable #-}

17+{-# LANGUAGE OverloadedStrings #-}

18module Language.PureScript.CodeGen.Cpp.Types where

19module Language.PureScript.CodeGen.Cpp.Types where

20import Prelude.Compat

21import Prelude.Compat

22import Data.List

23import Data.List

24+import Data.Monoid ((<>))

25+import Data.Text

24import Language.PureScript.CodeGen.Cpp.Common

27import Language.PureScript.CodeGen.Cpp.Common

25import Language.PureScript.Names

28import Language.PureScript.Names

@@ -27,7 +30,7 @@ import qualified Language.PureScript.Constants as C

28-- import Debug.Trace

31-- import Debug.Trace

30−data CppType = Primitive String | Auto [TypeQual] | Any [TypeQual]

33+data CppType = Primitive Text | Auto [TypeQual] | Any [TypeQual]

31 deriving (Show, Read, Eq)

34 deriving (Show, Read, Eq)

33data TypeQual = Const | Ref

36data TypeQual = Const | Ref

@@ -75,7 +78,7 @@ data CaptureType = CaptureAll

75data MapType = Instance | Record

78data MapType = Instance | Record

76 deriving (Show, Eq)

79 deriving (Show, Eq)

78−runType :: CppType -> String

81+runType :: CppType -> Text

79runType (Primitive t) = t

82runType (Primitive t) = t

80runType (Auto []) = "auto"

83runType (Auto []) = "auto"

81runType (Any []) = "any"

84runType (Any []) = "any"

@@ -86,11 +89,11 @@ runType typ =

86 _ -> rendered Any []

89 _ -> rendered Any []

87 where

90 where

88 rendered t qs

91 rendered t qs

89− | Const `elem` qs = "const " ++ (runType . t $ delete Const qs)

92+ | Const `elem` qs = "const " <> (runType . t $ delete Const qs)

90− | Ref `elem` qs = runType (t $ delete Ref qs) ++ "&"

93+ | Ref `elem` qs = runType (t $ delete Ref qs) <> "&"

91 | otherwise = runType (t qs)

94 | otherwise = runType (t qs)

93−runValueQual :: ValueQual -> String

96+runValueQual :: ValueQual -> Text

94runValueQual Static = "static"

97runValueQual Static = "static"

95runValueQual Inline = "inline"

98runValueQual Inline = "inline"

96runValueQual ConstExpr = "constexpr"

99runValueQual ConstExpr = "constexpr"

@@ -98,16 +101,16 @@ runValueQual Extern = "extern"

98runValueQual Recursive = ""

101runValueQual Recursive = ""

99runValueQual TopLevel = ""

102runValueQual TopLevel = ""

100

103

101−runCaptureType :: CaptureType -> String

104+runCaptureType :: CaptureType -> Text

102runCaptureType CaptureAll = "="

105runCaptureType CaptureAll = "="

103

106

104-- TODO: move or remove this

107-- TODO: move or remove this

105--

108--

106−qualifiedToStr :: ModuleName -> (a -> Ident) -> Qualified a -> String

109+qualifiedToStr :: ModuleName -> (a -> Ident) -> Qualified a -> Text

107qualifiedToStr _ f (Qualified (Just (ModuleName [ProperName mn])) a)

110qualifiedToStr _ f (Qualified (Just (ModuleName [ProperName mn])) a)

108 | mn == C.prim = runIdent $ f a

111 | mn == C.prim = runIdent $ f a

109qualifiedToStr m f (Qualified (Just m') a)

112qualifiedToStr m f (Qualified (Just m') a)

110− | m /= m' = moduleNameToCpp m' ++ "::" ++ identToCpp (f a)

113+ | m /= m' = moduleNameToCpp m' <> "::" <> identToCpp (f a)

111qualifiedToStr _ f (Qualified _ a) = identToCpp (f a)

114qualifiedToStr _ f (Qualified _ a) = identToCpp (f a)

112

115

113boolType :: CppType

116boolType :: CppType

@@ -132,11 +135,11 @@ mapType :: Int -> CppType

132mapType = maptype

135mapType = maptype

133 where

136 where

134 maptype 0 = mapprim "unknown_size"

137 maptype 0 = mapprim "unknown_size"

135− maptype n = mapprim $ show n

138+ maptype n = mapprim . pack $ show n

136− mapprim s = Primitive $ "any::map<" ++ s ++ ">"

139+ mapprim s = Primitive $ "any::map<" <> s <> ">"

137

140

138dataType :: Int -> CppType

141dataType :: Int -> CppType

139−dataType n = Primitive $ "any::data<" ++ show n ++ ">"

142+dataType n = Primitive $ "any::data<" <> pack (show n) <> ">"

140

143

141arrayType :: CppType

144arrayType :: CppType

142arrayType = Primitive "any::array"

145arrayType = Primitive "any::array"

@@ -144,11 +147,11 @@ arrayType = Primitive "any::array"

144thunkMarkerType :: CppType

147thunkMarkerType :: CppType

145thunkMarkerType = Primitive "any::as_thunk"

148thunkMarkerType = Primitive "any::as_thunk"

146

149

147−ctorKey :: String

150+ctorKey :: Text

148ctorKey = "constructor"

151ctorKey = "constructor"

149

152

150constAnyRef :: Maybe CppType

153constAnyRef :: Maybe CppType

151constAnyRef = Just $ Any [Const, Ref]

154constAnyRef = Just $ Any [Const, Ref]

152

155

153−symbolname :: String -> String

156+symbolname :: Text -> Text

154symbolname = identToCpp . Ident

157symbolname = identToCpp . Ident

src/Language/PureScript/CodeGen/Cpp/Unicode.hs+10−6

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

21import Prelude.Compat

22import Data.Char (isAscii, ord)

23+import Data.Text (Text, pack, unpack)

23import Text.Printf (printf)

24import Text.Printf (printf)

25import Language.PureScript.CodeGen.Cpp.AST

26import Language.PureScript.CodeGen.Cpp.AST

@@ -50,11 +51,14 @@ unicodeToUCNs (CppTypeAlias (s1,ss) t s2) =

50unicodeToUCNs cpp = cpp

51unicodeToUCNs cpp = cpp

52---------------------------------------------------------------------------------------------------

53---------------------------------------------------------------------------------------------------

53−toUcns :: String -> String

54+toUcns :: Text -> Text

54---------------------------------------------------------------------------------------------------

55---------------------------------------------------------------------------------------------------

55−toUcns s | any (not . isAscii) s = concatMap toUcn s

56+toUcns = pack . toUcns' . unpack

56 where

57 where

58+ toUcns' :: String -> String

59+ toUcns' s | any (not . isAscii) s = concatMap toUcn s

60+ where

57− toUcn :: Char -> String

61+ toUcn :: Char -> String

58− toUcn c | isAscii c = [c]

62+ toUcn c | isAscii c = [c]

59− toUcn c = printf "\\U%08x" $ ord c

63+ toUcn c = printf "\\U%08x" $ ord c

60−toUcns s = s

64+ toUcns' s = s

src/Language/PureScript/Pretty/Cpp.hs+183−200

@@ -13,6 +13,7 @@

13--

14-----------------------------------------------------------------------------

15{-# LANGUAGE PatternGuards #-}

16+{-# LANGUAGE OverloadedStrings #-}

16{-# LANGUAGE CPP #-}

17{-# LANGUAGE CPP #-}

18module Language.PureScript.Pretty.Cpp

19module Language.PureScript.Pretty.Cpp

@@ -23,165 +24,158 @@ module Language.PureScript.Pretty.Cpp

24import Prelude.Compat

25import Prelude.Compat

26−import Data.Bits

27import Data.Char

28−import Data.List

28+import Data.Maybe (fromMaybe)

29−import Data.Maybe (catMaybes, fromMaybe)

29+import Data.Text (Text)

30+import qualified Data.Text as T

31+import Data.Monoid ((<>))

32+

30#if __GLASGOW_HASKELL__ < 710

33#if __GLASGOW_HASKELL__ < 710

31import Control.Applicative

34import Control.Applicative

32#endif

35#endif

33import Control.Arrow ((<+>))

36import Control.Arrow ((<+>))

34import qualified Control.Arrow as A

37import qualified Control.Arrow as A

35import Control.Monad.State

38import Control.Monad.State

39+import Numeric (showHex)

36import Control.PatternArrows

40import Control.PatternArrows

38import Language.PureScript.CodeGen.Cpp.AST

42import Language.PureScript.CodeGen.Cpp.AST

39import Language.PureScript.CodeGen.Cpp.Types

43import Language.PureScript.CodeGen.Cpp.Types

40import Language.PureScript.Comments

44import Language.PureScript.Comments

41import qualified Language.PureScript.Constants as C

45import qualified Language.PureScript.Constants as C

42−import Numeric

46+import Language.PureScript.Pretty.Common (PrinterState(..), intercalate, parensT)

43−import Text.Printf (printf)

44−

45−-- import Debug.Trace

46−---------------------------------------------------------------------------------------------------

47−-- TODO: Go back to using Pretty.Common? (will require some work)

48−--

49−newtype PrinterState = PrinterState

50− { indent :: Int

51− } deriving (Show, Read, Eq, Ord)

52−

53−-- |

54−-- Pretty print with a new indentation level

55−--

56−withIndent :: StateT PrinterState Maybe String -> StateT PrinterState Maybe String

57−withIndent action = do

58− modify $ \st -> st { indent = indent st + blockIndent }

59− result <- action

60− modify $ \st -> st { indent = indent st - blockIndent }

61− return result

63-- |

48-- |

64-- Get the current indentation level

49-- Get the current indentation level

65--

50--

66−currentIndent :: StateT PrinterState Maybe String

51+currentIndent :: StateT PrinterState Maybe Text

67currentIndent = do

52currentIndent = do

68 current <- get

53 current <- get

69− return $ replicate (indent current) ' '

54+ return $ T.replicate (indent current) " "

71blockIndent :: Int

56blockIndent :: Int

72blockIndent = 2

57blockIndent = 2

74-- |

59-- |

75−-- Wrap a string in parentheses

60+-- Pretty print with a new indentation level

76--

61--

77−parens :: String -> String

62+withIndent :: StateT PrinterState Maybe Text -> StateT PrinterState Maybe Text

78−parens s = '(' : s ++ ")"

63+withIndent action = do

64+ modify $ \st -> st { indent = indent st + blockIndent }

65+ result <- action

66+ modify $ \st -> st { indent = indent st - blockIndent }

67+ return result

69+show' :: Show a => a -> Text

70+show' = T.pack . show

71+

72+---------------------------------------------------------------------------------------------------

73+literals :: Pattern PrinterState Cpp Text

80---------------------------------------------------------------------------------------------------

74---------------------------------------------------------------------------------------------------

81−literals :: Pattern PrinterState Cpp String

82literals = mkPattern' match

75literals = mkPattern' match

83 where

76 where

84− match :: Cpp -> StateT PrinterState Maybe String

77+ match :: Cpp -> StateT PrinterState Maybe Text

85− match CppNoOp = return []

78+ match CppNoOp = return ""

86− match CppEndOfHeader = return []

79+ match CppEndOfHeader = return ""

87− match (CppNumericLiteral (Left n)) = return $ show n

80+ match (CppNumericLiteral (Left n)) = return $ show' n

88− match (CppNumericLiteral n) = return $ either show show n

81+ match (CppNumericLiteral n) = return $ either show' show' n

89 match (CppStringLiteral s)

82 match (CppStringLiteral s)

90− | all isAscii s = return $ string s

83+ | T.all isAscii s = return $ string s

91− match (CppStringLiteral s) = return $ "u8" ++ string s

84+ match (CppStringLiteral s) = return $ "u8" <> string s

92− match (CppCharLiteral c) = return $ show c

85+ match (CppCharLiteral c) = return $ "'" <> T.singleton c <> "'"

93 match (CppBooleanLiteral True) = return "true"

86 match (CppBooleanLiteral True) = return "true"

94 match (CppBooleanLiteral False) = return "false"

87 match (CppBooleanLiteral False) = return "false"

95 match (CppArrayLiteral [x@CppArrayLiteral {}]) = -- Works around what appears to be a recent clang bug

88 match (CppArrayLiteral [x@CppArrayLiteral {}]) = -- Works around what appears to be a recent clang bug

96− fmap concat $ sequence

89+ mconcat <$> sequence

97 [ return $ runType arrayType

90 [ return $ runType arrayType

98 , return "{ { "

91 , return "{ { "

99 , prettyPrintCpp' x

92 , prettyPrintCpp' x

100 , return " } }"

93 , return " } }"

101 ]

94 ]

102− match (CppArrayLiteral xs) = fmap concat $ sequence

95+ match (CppArrayLiteral xs) = mconcat <$> sequence

103 [ return $ runType arrayType

96 [ return $ runType arrayType

104 , return "{ "

97 , return "{ "

105− , fmap (intercalate ", ") $ forM xs prettyPrintCpp'

98+ , fmap (T.intercalate ", ") $ forM xs prettyPrintCpp'

106 , return " }"

99 , return " }"

107 ]

100 ]

108− match (CppDataLiteral xs) = fmap concat $ sequence

101+ match (CppDataLiteral xs) = mconcat <$> sequence

109 [ return $ runType (dataType $ length xs)

102 [ return $ runType (dataType $ length xs)

110 , return "{ "

103 , return "{ "

111− , fmap (intercalate ", ") $ forM xs prettyPrintCpp'

104+ , fmap (T.intercalate ", ") $ forM xs prettyPrintCpp'

112 , return " }"

105 , return " }"

113 ]

106 ]

114− match (CppEnum name ty es) = fmap concat $ sequence

107+ match (CppEnum name ty es) = mconcat <$> sequence

115 [ return "enum"

108 [ return "enum"

116− , return $ maybe "" (" " ++) name

109+ , return $ maybe "" (" " <>) name

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

110+ , return $ maybe "" ((" : " <>) . runType) ty

118 , return " { "

111 , return " { "

119− , return $ intercalate ", " es

112+ , return $ T.intercalate ", " es

120 , return " }"

113 , return " }"

121 ]

114 ]

122− match (CppMapLiteral _ ps) = fmap concat $ sequence

115+ match (CppMapLiteral _ ps) = mconcat <$> sequence

123− [ return $ runType (mapType $ length ps + 1) ++ "{{\n"

116+ [ return $ runType (mapType $ length ps + 1) <> "{{\n"

124 , withIndent $ do

117 , withIndent $ do

125 cpps <-

118 cpps <-

126 forM ps $ \(key, value) -> do

119 forM ps $ \(key, value) -> do

127 value' <- prettyPrintCpp' value

120 value' <- prettyPrintCpp' value

128 key' <- prettyPrintCpp' key

121 key' <- prettyPrintCpp' key

129− return $ "{ " ++ key' ++ ", " ++ value' ++ " }"

122+ return $ "{ " <> key' <> ", " <> value' <> " }"

130 indentString <- currentIndent

123 indentString <- currentIndent

131− return $ intercalate ", \n" $ map (indentString ++) (cpps ++ ["{ nullptr, nullptr }"])

124+ return $ T.intercalate ", \n" $ map (indentString <>) (cpps ++ ["{ nullptr, nullptr }"])

132 , return "\n"

125 , return "\n"

133 , currentIndent

126 , currentIndent

134 , return "}}"

127 , return "}}"

135 ]

128 ]

136− match (CppFunction name args rty qs ret) =

129+ match (CppFunction name args rty qs ret) = mconcat <$> sequence

137− fmap concat $ sequence

138− [ return . concatMap (++ " ") . filter (not . null) $ runValueQual <$> qs

130+ [ return . T.concat . fmap (<> " ") . filter (not . T.null) $ runValueQual <$> qs

139 , return "auto "

131 , return "auto "

140 , return name

132 , return name

141− , return $ parens (intercalate ", " $ argstr <$> args)

133+ , return $ parensT (T.intercalate ", " $ argstr <$> args)

142− , return (maybe "" ((" -> " ++) . runType) rty)

134+ , return (maybe "" ((" -> " <>) . runType) rty)

143 , if ret /= CppNoOp

135 , if ret /= CppNoOp

144 then do

136 then do

145 cpps <- prettyPrintCpp' ret

137 cpps <- prettyPrintCpp' ret

146− return $ ' ' : cpps

138+ return $ ' ' `T.cons` cpps

147 else return ""

139 else return ""

148 ]

140 ]

149− match (CppBlock sts) = concat <$> sequence

141+ match (CppBlock sts) = mconcat <$> sequence

150 [ return "{\n"

142 [ return "{\n"

151 , withIndent $ prettyStatements sts

143 , withIndent $ prettyStatements sts

152 , return $ if null sts then "" else "\n"

144 , return $ if null sts then "" else "\n"

153 , currentIndent

145 , currentIndent

154 , return "}"

146 , return "}"

155 ]

147 ]

156− match (CppNamespace _ []) = return []

148+ match (CppNamespace _ []) = return ""

157− match (CppNamespace [] sts) = fmap concat $ sequence $

149+ match (CppNamespace name sts) | T.null name = mconcat <$> sequence

158 [ return "\n"

150 [ return "\n"

159 , prettyStatements sts

151 , prettyStatements sts

160 , return "#"

152 , return "#"

161 ]

153 ]

162− match (CppNamespace (':':':':name) sts) = fmap concat $ sequence $

154+ match (CppNamespace name sts)

155+ | Just name' <- T.stripPrefix "::" name = mconcat <$> sequence

163 [ return "\n"

156 [ return "\n"

164 , currentIndent

157 , currentIndent

165− , return $ "namespace " ++ (dotsTo '_' name) ++ " {\n"

158+ , return $ "namespace " <> (dotsTo '_' name') <> " {\n"

166 , withIndent $ prettyStatements sts

159 , withIndent $ prettyStatements sts

167 , return "\n"

160 , return "\n"

168 , currentIndent

161 , currentIndent

169 , return "}#"

162 , return "}#"

170 ]

163 ]

171− match (CppNamespace name sts) = fmap concat $ sequence $

164+ match (CppNamespace name sts) = mconcat <$> sequence (

172 [ return "\n"

165 [ return "\n"

173 , currentIndent

166 , currentIndent

174− , return $ "namespace " ++ (dotsTo '_' name) ++ " {\n"

167+ , return $ "namespace " <> (dotsTo '_' name) <> " {\n"

175 , withIndent $ prettyStatements sts'

168 , withIndent $ prettyStatements sts'

176 , return "\n"

169 , return "\n"

177 , currentIndent

170 , currentIndent

178 , return "}#"

171 , return "}#"

179− ] ++

172+ ] <>

180 let (cpp', cpps') = fromNested nested'

173 let (cpp', cpps') = fromNested nested'

181 in map match cpp' ++

174 in map match cpp' ++

182 if null cpps'

175 if null cpps'

183 then []

176 then []

184− else [match (CppNamespace name (filter isUseNamespace sts ++ cpps'))]

177+ else [match (CppNamespace name (filter isUseNamespace sts <> cpps'))]

178+ )

185 where

179 where

186 (sts', nested') = break isNestedNamespace sts

180 (sts', nested') = break isNestedNamespace sts

187 fromNested :: [Cpp] -> ([Cpp], [Cpp])

181 fromNested :: [Cpp] -> ([Cpp], [Cpp])

@@ -201,11 +195,11 @@ literals = mkPattern' match

201 isUseNamespace :: Cpp -> Bool

195 isUseNamespace :: Cpp -> Bool

202 isUseNamespace (CppUseNamespace {}) = True

196 isUseNamespace (CppUseNamespace {}) = True

203 isUseNamespace _ = False

197 isUseNamespace _ = False

204− match (CppStruct (name) []) = return $ "struct " ++ name ++ " {}"

198+ match (CppStruct (name) []) = return $ "struct " <> name <> " {}"

205− match (CppStruct (name) mems) = fmap concat $ sequence $

199+ match (CppStruct (name) mems) = mconcat <$> sequence

206 [ return "\n"

200 [ return "\n"

207 , currentIndent

201 , currentIndent

208− , return $ "struct " ++ name ++ " {\n"

202+ , return $ "struct " <> name <> " {\n"

209 , withIndent $ prettyStatements mems

203 , withIndent $ prettyStatements mems

210 , return "\n"

204 , return "\n"

211 , currentIndent

205 , currentIndent

@@ -213,60 +207,60 @@ literals = mkPattern' match

213 ]

207 ]

214 match (CppInclude path name) =

208 match (CppInclude path name) =

215 let fullpath

209 let fullpath

216− | null path = last . words . dotsTo ' ' $ name

210+ | T.null path = last . T.words . dotsTo ' ' $ name

217− | otherwise = path ++ '/' : (last . words . dotsTo ' ' $ name) in

211+ | otherwise = path <> "/" <> (last . T.words . dotsTo ' ' $ name) in

218− fmap concat $ sequence

212+ mconcat <$> sequence

219− [ return $ "#include \"" ++ fullpath ++ ".hh\""

213+ [ return $ "#include \"" <> fullpath <> ".hh\""

220 ]

214 ]

221− match (CppUseNamespace name) = fmap concat $ sequence

215+ match (CppUseNamespace name) = mconcat <$> sequence

222− [ return $ "using namespace " ++ (dotsTo '_' name)

216+ [ return $ "using namespace " <> (dotsTo '_' name)

223 ]

217 ]

224 match (CppTypeAlias (newName, newTyps) typ spec) =

218 match (CppTypeAlias (newName, newTyps) typ spec) =

225 let typ' = runType typ

219 let typ' = runType typ

226 (tmps, name') = if null newTyps

220 (tmps, name') = if null newTyps

227 then ([], typ')

221 then ([], typ')

228 else ([return (templDecl newTyps), return "\n", currentIndent], typ')

222 else ([return (templDecl newTyps), return "\n", currentIndent], typ')

229− in fmap concat $ sequence $

223+ in mconcat <$> sequence (

230 tmps ++

224 tmps ++

231− [ return $ "using "

225+ [ return "using "

232 , return newName

226 , return newName

233 , return " = "

227 , return " = "

234− , return $ if null spec then name' else spec ++ angles name'

228+ , return $ if T.null spec then name' else spec <> angles name'

235− ]

229+ ])

236 match (CppCast typ val) = return $

230 match (CppCast typ val) = return $

237 case val of

231 case val of

238 CppNumericLiteral {} -> vstr

232 CppNumericLiteral {} -> vstr

239 CppStringLiteral {} -> vstr

233 CppStringLiteral {} -> vstr

240 CppBooleanLiteral {} -> vstr

234 CppBooleanLiteral {} -> vstr

241− _ -> "cast" ++ angles (runType typ) ++ parens val'

235+ _ -> "cast" <> angles (runType typ) <> parensT val'

242 where

236 where

243 vstr = prettyPrintCpp1 val

237 vstr = prettyPrintCpp1 val

244− val' | '(' `elem` vstr || '[' `elem` vstr = parens vstr

238+ val' | "(" `T.isInfixOf` vstr || "[" `T.isInfixOf` vstr = parensT vstr

245 | otherwise = vstr

239 | otherwise = vstr

246 match (CppGet i@(CppSymbol _) val) =

240 match (CppGet i@(CppSymbol _) val) =

247− return $ printf "get(%s, %s)" (prettyPrintCpp1 i) (prettyPrintCpp1 val)

241+ return . prettyPrintCpp1 $ CppApp (CppVar "get") [i, val]

248 match (CppGet i val) =

242 match (CppGet i val) =

249− return $ printf "get<%s>(%s)" (prettyPrintCpp1 i) (prettyPrintCpp1 val)

243+ return . prettyPrintCpp1 $ CppApp (CppVar $ "get" <> angles (prettyPrintCpp1 i)) [val]

250 match (CppVar ident)

244 match (CppVar ident)

251− | ident == C.__unused = match (CppVar $ '$' : ident)

245+ | ident == C.__unused = match (CppVar $ '$' `T.cons` ident)

252 match (CppVar ident) = return ident

246 match (CppVar ident) = return ident

253− match (CppSymbol ident) = return $ "SYMBOL" ++ parens (symbolname ident)

247+ match (CppSymbol ident) = return $ "SYMBOL" <> parensT (symbolname ident)

254 match (CppApp v [CppNoOp]) = return (prettyPrintCpp1 v)

248 match (CppApp v [CppNoOp]) = return (prettyPrintCpp1 v)

255 match (CppVariableIntroduction (ident, typ) qs value)

249 match (CppVariableIntroduction (ident, typ) qs value)

256− | ident == C.__unused = match (CppVariableIntroduction ('$' : ident, typ) qs value)

250+ | ident == C.__unused = match (CppVariableIntroduction ('$' `T.cons` ident, typ) qs value)

257 match (CppVariableIntroduction (ident, typ) qs value) =

251 match (CppVariableIntroduction (ident, typ) qs value) =

258− fmap concat $ sequence

252+ mconcat <$> sequence

259− [ return . concatMap (++ " ") . filter (not . null) $ runValueQual <$> qs

253+ [ return . T.concat . fmap (<> " ") . filter (not . T.null) $ runValueQual <$> qs

260− , return $ runType (fromMaybe (Any [Const]) typ) ++ " "

254+ , return $ runType (fromMaybe (Any [Const]) typ) <> " "

261 , return ident

255 , return ident

262− , maybe (return "") (fmap (" = " ++) . prettyPrintCpp') value

256+ , maybe (return "") (fmap (" = " <>) . prettyPrintCpp') value

263 ]

257 ]

264− match (CppAssignment target value) = fmap concat $ sequence

258+ match (CppAssignment target value) = mconcat <$> sequence

265 [ prettyPrintCpp' target

259 [ prettyPrintCpp' target

266 , return " = "

260 , return " = "

267 , prettyPrintCpp' value

261 , prettyPrintCpp' value

268 ]

262 ]

269− match (CppWhile cond sts) = fmap concat $ sequence

263+ match (CppWhile cond sts) = mconcat <$> sequence

270 [ return "while ("

264 [ return "while ("

271 , prettyPrintCpp' cond

265 , prettyPrintCpp' cond

272 , return ") "

266 , return ") "

@@ -276,24 +270,24 @@ literals = mkPattern' match

276 sts' | CppBlock cpps'@(_:_) <- sts,

270 sts' | CppBlock cpps'@(_:_) <- sts,

277 last cpps' == CppContinue = CppBlock (init cpps')

271 last cpps' == CppContinue = CppBlock (init cpps')

278 | otherwise = sts

272 | otherwise = sts

279− match (CppIfElse cond thens elses) = fmap concat $ sequence

273+ match (CppIfElse cond thens elses) = mconcat <$> sequence

280 [ return "if ("

274 [ return "if ("

281 , prettyPrintCpp' cond

275 , prettyPrintCpp' cond

282 , return ") "

276 , return ") "

283 , prettyPrintCpp' thens

277 , prettyPrintCpp' thens

284− , maybe (return "") (fmap (" else " ++) . prettyPrintCpp') elses

278+ , maybe (return "") (fmap (" else " <>) . prettyPrintCpp') elses

285 ]

279 ]

286− match (CppSwitch cond cases@((case1,_):_:_)) = fmap concat $ sequence

280+ match (CppSwitch cond cases@((case1,_):_:_)) = mconcat <$> sequence

287 [ return "switch "

281 [ return "switch "

288− , return . parens $ prettyPrintCpp1 (cast case1 cond)

282+ , return . parensT $ prettyPrintCpp1 (cast case1 cond)

289 , return " {\n"

283 , return " {\n"

290 , withIndent $ do

284 , withIndent $ do

291 cpps <- forM cases $ \(c, s) -> do

285 cpps <- forM cases $ \(c, s) -> do

292 c' <- prettyPrintCpp' c

286 c' <- prettyPrintCpp' c

293 s' <- prettyPrintCpp' s

287 s' <- prettyPrintCpp' s

294− return $ "case " ++ c' ++ ": " ++ s' ++ ";"

288+ return $ "case " <> c' <> ": " <> s' <> ";"

295 indentString <- currentIndent

289 indentString <- currentIndent

296− return $ intercalate "\n" $ map (indentString ++) cpps

290+ return $ T.intercalate "\n" $ map (indentString <>) cpps

297 , return "\n"

291 , return "\n"

298 , currentIndent

292 , currentIndent

299 , return "}"

293 , return "}"

@@ -304,71 +298,63 @@ literals = mkPattern' match

304 cast CppBooleanLiteral {} cpp' = CppCast boolType cpp'

298 cast CppBooleanLiteral {} cpp' = CppCast boolType cpp'

305 cast CppCharLiteral {} cpp' = CppCast charType cpp'

299 cast CppCharLiteral {} cpp' = CppCast charType cpp'

306 cast _ cpp' = cpp'

300 cast _ cpp' = cpp'

307− match (CppReturn (CppBlock (cpp:cpps))) = fmap concat $ sequence

301+ match (CppReturn (CppBlock (cpp:cpps))) = mconcat <$> sequence

308 [ do s <- prettyPrintCpp' cpp

302 [ do s <- prettyPrintCpp' cpp

309− return $ dropWhile isSpace s

303+ return $ T.dropWhile isSpace s

310 , return $ if null cpps then "" else "\n"

304 , return $ if null cpps then "" else "\n"

311 , prettyStatements cpps

305 , prettyStatements cpps

312 ]

306 ]

313− match (CppReturn value@(CppStringLiteral _)) = fmap concat $ sequence

307+ match (CppReturn value@(CppStringLiteral _)) = mconcat <$> sequence

314 [ return "return "

308 [ return "return "

315 , return . runType $ Any []

309 , return . runType $ Any []

316 , return "("

310 , return "("

317 , prettyPrintCpp' value

311 , prettyPrintCpp' value

318 , return ")"

312 , return ")"

319 ]

313 ]

320− match (CppReturn value) = fmap concat $ sequence

314+ match (CppReturn value) = mconcat <$> sequence

321 [ return "return "

315 [ return "return "

322 , prettyPrintCpp' value

316 , prettyPrintCpp' value

323 ]

317 ]

324− match (CppThrow value) = fmap concat $ sequence

318+ match (CppThrow value) = mconcat <$> sequence

325 [ return "throw "

319 [ return "throw "

326 , prettyPrintCpp' value

320 , prettyPrintCpp' value

327 ]

321 ]

328 match CppContinue = return "continue"

322 match CppContinue = return "continue"

329 match (CppComment [] cpp) = match cpp

323 match (CppComment [] cpp) = match cpp

330− match (CppComment com cpp) = fmap concat $ sequence $

324+ match (CppComment com cpp) = mconcat <$> sequence

331− [ return "\n"

325+ ([ return "\n"

332 , currentIndent

326 , currentIndent

333 , return "/**\n"

327 , return "/**\n"

334− ] ++

328+ ] <>

335− map asLine (concatMap commentLines com) ++

329+ map asLine (concat $ commentLines <$> com) ++

336 [ currentIndent

330 [ currentIndent

337 , return " */\n"

331 , return " */\n"

338 , currentIndent

332 , currentIndent

339 , prettyPrintCpp' cpp

333 , prettyPrintCpp' cpp

340− ]

334+ ])

341 where

335 where

342− commentLines :: Comment -> [String]

336+ commentLines :: Comment -> [Text]

343 commentLines (LineComment s) = [s]

337 commentLines (LineComment s) = [s]

344− commentLines (BlockComment s) = lines s

338+ commentLines (BlockComment s) = T.lines s

345− asLine :: String -> StateT PrinterState Maybe String

339+ asLine :: Text -> StateT PrinterState Maybe Text

346 asLine s = do

340 asLine s = do

347 i <- currentIndent

341 i <- currentIndent

348− return $ i ++ " * " ++ removeComments s ++ "\n"

342+ return $ i <> " * " <> removeComments s <> "\n"

343+

349− removeComments :: String -> String

344+ removeComments :: Text -> Text

350− removeComments ('*':'/':s) = removeComments s

345+ removeComments t =

346+ case T.stripPrefix "*/" t of

351− removeComments (c:s) = c : removeComments s

347+ Just rest -> removeComments rest

352− removeComments [] = []

348+ Nothing -> case T.uncons t of

349+ Just (x, xs) -> x `T.cons` removeComments xs

350+ Nothing -> ""

353 match (CppRaw cpp) = return cpp

351 match (CppRaw cpp) = return cpp

354 match _ = mzero

352 match _ = mzero

355

353

356−string :: String -> String

354+string :: Text -> Text

357−string s = '"' : concatMap encodeChar (decodeSurrogates s) ++ "\""

355+string s = "\"" <> T.concatMap encodeChar s <> "\""

358 where

356 where

359− decodeSurrogates :: String -> String

360− decodeSurrogates [c] = [c]

361− decodeSurrogates s' = catMaybes $ zipWith decodePair s' (tail s' ++ ['\0'])

362− where

363− decodePair :: Char -> Char -> Maybe Char

364− decodePair a b

365− | fromEnum a >= 0xD800 && fromEnum a <= 0xDFFF &&

366− fromEnum b >= 0xD800 && fromEnum b <= 0xDFFF

367− = Just . chr $ 0x10000 + shiftL (fromEnum a .&. 0x03FF) 10 + (fromEnum b .&. 0x03FF)

368− decodePair a _

369− | fromEnum a >= 0xD800 && fromEnum a <= 0xDFFF = Nothing

370− decodePair a _ = Just a

371− encodeChar :: Char -> String

357+ encodeChar :: Char -> Text

372 encodeChar '\b' = "\\b"

358 encodeChar '\b' = "\\b"

373 encodeChar '\t' = "\\t"

359 encodeChar '\t' = "\\t"

374 encodeChar '\n' = "\\n"

360 encodeChar '\n' = "\\n"

@@ -377,73 +363,69 @@ string s = '"' : concatMap encodeChar (decodeSurrogates s) ++ "\""

377 encodeChar '\r' = "\\r"

363 encodeChar '\r' = "\\r"

378 encodeChar '"' = "\\\""

364 encodeChar '"' = "\\\""

379 encodeChar '\\' = "\\\\"

365 encodeChar '\\' = "\\\\"

380− encodeChar c

366+ -- PureScript strings are sequences of UTF-16 code units, so this case should never be hit.

381− | fromEnum c > 0xFFFF = "\\U" ++ leading ++ hex

367+ -- If it is somehow hit, though, output the designated Unicode replacement character U+FFFD.

382− where

383− hex = showHex (fromEnum c) ""

384− leading = replicate (8 - length hex) '0'

385− encodeChar c

368+ encodeChar c | fromEnum c > 0xFFFF = "\\uFFFD"

386− | fromEnum c > 0xFFF = "\\u" ++ showHex (fromEnum c) ""

369+ encodeChar c | fromEnum c > 0xFFF = "\\u" <> showHex' (fromEnum c) ""

387− encodeChar c

388− | fromEnum c > 0xFF = "\\u0" ++ showHex (fromEnum c) ""

370+ encodeChar c | fromEnum c > 0xFF = "\\u0" <> showHex' (fromEnum c) ""

389− encodeChar c

390− | fromEnum c < 0x10 = "\\x0" ++ showHex (fromEnum c) ""

371+ encodeChar c | fromEnum c < 0x10 = "\\x0" <> showHex' (fromEnum c) ""

391− encodeChar c

392− | fromEnum c > 0x7E || fromEnum c < 0x20 = "\\x" ++ showHex (fromEnum c) ""

372+ encodeChar c | fromEnum c > 0x7E || fromEnum c < 0x20 = "\\x" <> showHex' (fromEnum c) ""

393− encodeChar c = [c]

373+ encodeChar c = T.singleton c

394−

374+

375+ showHex' a b = T.pack (showHex a b)

376+

395−accessor :: Pattern PrinterState Cpp (String, Cpp)

377+accessor :: Pattern PrinterState Cpp (Text, Cpp)

396accessor = mkPattern match

378accessor = mkPattern match

397 where

379 where

398 match (CppAccessor prop val) = Just (prettyPrintCpp1 prop, val)

380 match (CppAccessor prop val) = Just (prettyPrintCpp1 prop, val)

399 match _ = Nothing

381 match _ = Nothing

400

382

401−indexer :: Pattern PrinterState Cpp (String, Cpp)

383+indexer :: Pattern PrinterState Cpp (Text, Cpp)

402indexer = mkPattern' match

384indexer = mkPattern' match

403 where

385 where

404 match (CppIndexer (CppNumericLiteral (Left 0)) val) = return ("0UL", val)

386 match (CppIndexer (CppNumericLiteral (Left 0)) val) = return ("0UL", val)

405− match (CppIndexer (CppNumericLiteral (Left index)) val) = return (show index, val)

387+ match (CppIndexer (CppNumericLiteral (Left index)) val) = return (show' index, val)

406 match (CppIndexer index val) = do

388 match (CppIndexer index val) = do

407 index' <- prettyPrintCpp' index

389 index' <- prettyPrintCpp' index

408 return (index', val)

390 return (index', val)

409 match _ = mzero

391 match _ = mzero

410

392

411−lam :: Pattern PrinterState Cpp ((String, [(String, Maybe CppType)], Maybe CppType), Cpp)

393+lam :: Pattern PrinterState Cpp ((Text, [(Text, Maybe CppType)], Maybe CppType), Cpp)

412lam = mkPattern match

394lam = mkPattern match

413 where

395 where

414− match (CppLambda caps args rty ret) = Just ((concatMap runCaptureType caps, args, rty), ret)

396+ match (CppLambda caps args rty ret) = Just ((T.concat $ runCaptureType <$> caps, args, rty), ret)

415 match _ = Nothing

397 match _ = Nothing

416

398

417−app :: Pattern PrinterState Cpp (String, Cpp)

399+app :: Pattern PrinterState Cpp (Text, Cpp)

418app = mkPattern' match

400app = mkPattern' match

419 where

401 where

420 match (CppApp _ [CppNoOp]) = mzero

402 match (CppApp _ [CppNoOp]) = mzero

421 match (CppApp val args) = do

403 match (CppApp val args) = do

422 cpps <- mapM prettyPrintCpp' args

404 cpps <- mapM prettyPrintCpp' args

423− return (intercalate ", " cpps, val)

405+ return (T.intercalate ", " cpps, val)

424 match _ = mzero

406 match _ = mzero

425

407

426−unary' :: UnaryOperator -> (Cpp -> String) -> Operator PrinterState Cpp String

408+unary' :: UnaryOperator -> (Cpp -> Text) -> Operator PrinterState Cpp Text

427−unary' op mkStr = Wrap match (++)

409+unary' op mkStr = Wrap match (<>)

428 where

410 where

429− match :: Pattern PrinterState Cpp (String, Cpp)

411+ match :: Pattern PrinterState Cpp (Text, Cpp)

430 match = mkPattern match'

412 match = mkPattern match'

431 where

413 where

432 match' (CppUnary op' val)

414 match' (CppUnary op' val)

433 | op' == op = Just (mkStr val, val)

415 | op' == op = Just (mkStr val, val)

434 match' _ = Nothing

416 match' _ = Nothing

435

417

436−unary :: UnaryOperator -> String -> Operator PrinterState Cpp String

418+unary :: UnaryOperator -> Text -> Operator PrinterState Cpp Text

437unary op str = unary' op (const str)

419unary op str = unary' op (const str)

438

420

439−negateOperator :: Operator PrinterState Cpp String

421+negateOperator :: Operator PrinterState Cpp Text

440negateOperator = unary' Negate (\v -> if isNegate v then "- " else "-")

422negateOperator = unary' Negate (\v -> if isNegate v then "- " else "-")

441 where

423 where

442 isNegate (CppUnary Negate _) = True

424 isNegate (CppUnary Negate _) = True

443 isNegate _ = False

425 isNegate _ = False

444

426

445−binary :: BinaryOperator -> String -> Operator PrinterState Cpp String

427+binary :: BinaryOperator -> Text -> Operator PrinterState Cpp Text

446−binary op str = AssocL match (\v1 v2 -> v1 ++ str ++ v2)

428+binary op str = AssocL match (\v1 v2 -> v1 <> str <> v2)

447 where

429 where

448 match :: Pattern PrinterState Cpp (Cpp, Cpp)

430 match :: Pattern PrinterState Cpp (Cpp, Cpp)

449 match = mkPattern match'

431 match = mkPattern match'

@@ -454,53 +436,54 @@ binary op str = AssocL match (\v1 v2 -> v1 ++ str ++ v2)

454 | op' == op = Just (v1, v2)

436 | op' == op = Just (v1, v2)

455 match' _ = Nothing

437 match' _ = Nothing

456

438

457−prettyStatements :: [Cpp] -> StateT PrinterState Maybe String

439+prettyStatements :: [Cpp] -> StateT PrinterState Maybe Text

458prettyStatements sts = do

440prettyStatements sts = do

459 cpps <- forM (filter (not . isNoOp) sts) prettyPrintCpp'

441 cpps <- forM (filter (not . isNoOp) sts) prettyPrintCpp'

460 indentString <- currentIndent

442 indentString <- currentIndent

461− return $ intercalate "\n" $ map (addsemi . (indentString ++)) cpps

443+ return $ T.intercalate "\n" $ map (addsemi . (indentString <>)) cpps

462 where

444 where

463− addsemi :: String -> String

445+ addsemi :: Text -> Text

464− addsemi [] = []

446+ addsemi s | T.null s = s

447+ addsemi s

448+ | T.all isSpace s = ""

465 addsemi s

449 addsemi s

466− | all isSpace s = []

450+ | T.head s == '#' = s

467− addsemi s@('#':_) = s

468 addsemi s

451 addsemi s

469− | last s == '#' = init s

452+ | T.last s == '#' = T.init s

470− addsemi s = s ++ ";"

453+ addsemi s = s <> ";"

471

454

472-- |

455-- |

473-- Generate a pretty-printed string representing a C++11 expression

456-- Generate a pretty-printed string representing a C++11 expression

474--

457--

475−prettyPrintCpp1 :: Cpp -> String

458+prettyPrintCpp1 :: Cpp -> Text

476prettyPrintCpp1 = fromMaybe (error "Incomplete pattern") . flip evalStateT (PrinterState 0) . prettyPrintCpp'

459prettyPrintCpp1 = fromMaybe (error "Incomplete pattern") . flip evalStateT (PrinterState 0) . prettyPrintCpp'

477

460

478-- |

461-- |

479-- Generate a pretty-printed string representing a collection of C++11 expressions at the same indentation level

462-- Generate a pretty-printed string representing a collection of C++11 expressions at the same indentation level

480--

463--

481−prettyPrintCpp :: [Cpp] -> String

464+prettyPrintCpp :: [Cpp] -> Text

482prettyPrintCpp = fromMaybe (error "Incomplete pattern") . flip evalStateT (PrinterState 0) . prettyStatements

465prettyPrintCpp = fromMaybe (error "Incomplete pattern") . flip evalStateT (PrinterState 0) . prettyStatements

483

466

484-- |

467-- |

485-- Generate an indented, pretty-printed string representing a C++11 expression

468-- Generate an indented, pretty-printed string representing a C++11 expression

486--

469--

487−prettyPrintCpp' :: Cpp -> StateT PrinterState Maybe String

470+prettyPrintCpp' :: Cpp -> StateT PrinterState Maybe Text

488prettyPrintCpp' = A.runKleisli $ runPattern matchValue

471prettyPrintCpp' = A.runKleisli $ runPattern matchValue

489 where

472 where

490− matchValue :: Pattern PrinterState Cpp String

473+ matchValue :: Pattern PrinterState Cpp Text

491− matchValue = buildPrettyPrinter operators (literals <+> fmap parens matchValue)

474+ matchValue = buildPrettyPrinter operators (literals <+> fmap parensT matchValue)

492− operators :: OperatorTable PrinterState Cpp String

475+ operators :: OperatorTable PrinterState Cpp Text

493 operators =

476 operators =

494− OperatorTable [ [ Wrap accessor $ \prop val -> val ++ "::" ++ prop ]

477+ OperatorTable [ [ Wrap accessor $ \prop val -> val <> "::" <> prop ]

495− , [ Wrap indexer $ \index val -> val ++ "[" ++ index ++ "]" ]

478+ , [ Wrap indexer $ \index val -> val <> "[" <> index <> "]" ]

496− , [ Wrap app $ \args val -> val ++ parens args ]

479+ , [ Wrap app $ \args val -> val <> parensT args ]

497 , [ unary New "new " ]

480 , [ unary New "new " ]

498− , [ Wrap lam $ \(caps, args, rty) ret -> '[' : caps ++ "]"

481+ , [ Wrap lam $ \(caps, args, rty) ret -> '[' `T.cons` caps <> "]"

499− ++ let args' = argstr <$> args in

482+ <> let args' = argstr <$> args in

500− parens (intercalate ", " args')

483+ parensT (T.intercalate ", " args')

501− ++ maybe "" ((" -> " ++) . runType) rty

484+ <> maybe "" ((" -> " <>) . runType) rty

502− ++ " "

485+ <> " "

503− ++ ret ]

486+ <> ret ]

504 , [ unary Not "!"

487 , [ unary Not "!"

505 , unary BitwiseNot "~"

488 , unary BitwiseNot "~"

506 , unary Positive "+"

489 , unary Positive "+"

@@ -526,35 +509,35 @@ prettyPrintCpp' = A.runKleisli $ runPattern matchValue

526 , [ binary Or " || " ]

509 , [ binary Or " || " ]

527 ]

510 ]

528

511

529−dotsTo :: Char -> String -> String

512+dotsTo :: Char -> Text -> Text

530−dotsTo chr' = map (\c -> if c == '.' then chr' else c)

513+dotsTo chr' = T.map (\c -> if c == '.' then chr' else c)

531

514

532−argstr :: (String, Maybe CppType) -> String

515+argstr :: (Text, Maybe CppType) -> Text

533argstr (name, Nothing) = argStr name (Auto [])

516argstr (name, Nothing) = argStr name (Auto [])

534argstr (name, Just typ)

517argstr (name, Just typ)

535− | name == C.__unused = argStr [] typ

518+ | name == C.__unused = argStr "" typ

536argstr (name, Just typ) = argStr name typ

519argstr (name, Just typ) = argStr name typ

537

520

538−argStr :: String -> CppType -> String

521+argStr :: Text -> CppType -> Text

539−argStr name typ =

522+argStr name typ = runType typ <>

540− runType typ ++

541− if null name

523+ if T.null name

542− then []

524+ then ""

543− else " " ++ name

525+ else " " <> name

544

526

545−templDecl :: [(String, Int)] -> String

527+templDecl :: [(Text, Int)] -> Text

546−templDecl ps = "template " ++ angles (intercalate ", " (go <$> ps))

528+templDecl ps = "template " <> angles (intercalate ", " (go <$> ps))

547 where

529 where

548− go :: (String, Int) -> String

530+ go :: (Text, Int) -> Text

549− go (name, 0) = "typename " ++ name

531+ go (name, 0) = "typename " <> name

550− go (name, n) = "typename" ++ parens (intercalate "," $ replicate n "typename") ++ ' ' : name

532+ go (name, n) = "typename" <> parensT (intercalate "," $ replicate n "typename") <> (' ' `T.cons` name)

551

533

552isNestedNamespace :: Cpp -> Bool

534isNestedNamespace :: Cpp -> Bool

553−isNestedNamespace (CppNamespace (':':':':_) _) = True

535+isNestedNamespace (CppNamespace name _)

536+ | "::" `T.isPrefixOf` name = True

554isNestedNamespace _ = False

537isNestedNamespace _ = False

555

538

556−angles :: String -> String

539+angles :: Text -> Text

557−angles s = '<' : s ++ ">"

540+angles s = "<" <> s <> ">"

558

541

559linebreak :: [Cpp]

542linebreak :: [Cpp]

560linebreak = [CppRaw ""]

543linebreak = [CppRaw ""]