ede46c4 · rowtype-yoga/purescript-native

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

on golang help sign in

C++: PSString support

ede46c4Andy Arvanitis10 years ago

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

compare with golang

unifiedsplit

@@ -52,11 +52,13 @@ import Language.PureScript.Comments

52import Language.PureScript.CoreFn

53import Language.PureScript.Names

54import Language.PureScript.Options

55+import Language.PureScript.PSString (PSString, mkString)

55import Language.PureScript.Sugar.TypeClasses (superClassDictionaryNames)

56import Language.PureScript.Sugar.TypeClasses (superClassDictionaryNames)

56import Language.PureScript.Traversals (sndM)

57import Language.PureScript.Traversals (sndM)

58import qualified Language.PureScript.Constants as C

59import qualified Language.PureScript.Constants as C

59import qualified Language.PureScript.Environment as E

60import qualified Language.PureScript.Environment as E

61+import Language.PureScript.Label (runLabel)

60import qualified Language.PureScript.Pretty.Cpp as P

62import qualified Language.PureScript.Pretty.Cpp as P

61import qualified Language.PureScript.Types as T

63import qualified Language.PureScript.Types as T

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

455 CppMapLiteral Record $

457 CppMapLiteral Record $

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

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

457 where

459 where

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

460+ allKeys :: T.Type -> [PSString]

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

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

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

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

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

463 allKeys _ = error "Not a recognized row type"

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

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

@@ -485,7 +487,9 @@ moduleToCpp otherOpts env (Module _ mn imps _ foreigns decls) = do

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

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

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

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

487 in return . CppMapLiteral Instance $

489 in return . CppMapLiteral Instance $

490+ zip

488− zip (CppSymbol <$> (sort $ superClassDictionaryNames constraints) ++ (fst <$> fns)) args'

491+ (CppSymbol . mkString <$> (sort $ superClassDictionaryNames constraints) ++ (fst <$> fns))

492+ args'

489 Var _ (Qualified (Just _) _) -> applied f args' curriedName'

493 Var _ (Qualified (Just _) _) -> applied f args' curriedName'

490 _ -> applied f args' id

494 _ -> applied f args' id

491 where

495 where

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

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

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

568 failedPatternError :: [Text] -> Cpp

572 failedPatternError :: [Text] -> Cpp

569 failedPatternError _ =

573 failedPatternError _ =

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

574+ CppThrow $ CppApp (CppVar "runtime_error") [CppStringLiteral $ mkString errorMessage]

571 errorMessage :: Text

575 errorMessage :: Text

572 errorMessage =

576 errorMessage =

573 "Failed pattern match" <>

577 "Failed pattern match" <>

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

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

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

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

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

670 where

674 where

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

675+ go :: [Cpp] -> [(PSString, Binder Ann)] -> m [Cpp]

672 go done' [] = return done'

676 go done' [] = return done'

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

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

674 propVar <- freshName

678 propVar <- freshName

@@ -840,7 +844,7 @@ optIndexers classes = everywhereOnCpp dictIndexerToEnum

840 dictIndexerToEnum :: Cpp -> Cpp

844 dictIndexerToEnum :: Cpp -> Cpp

841 dictIndexerToEnum (CppMapGet (CppSymbol prop) dict)

845 dictIndexerToEnum (CppMapGet (CppSymbol prop) dict)

842 | Just cls <- lookup dict classes =

846 | Just cls <- lookup dict classes =

843− let index = CppAccessor (CppVar $ safeName prop) cls

847+ let index = CppAccessor (CppVar . safeName $ P.utf16Text prop) cls

844 in CppMapGet index dict

848 in CppMapGet index dict

845 dictIndexerToEnum cpp = cpp

849 dictIndexerToEnum cpp = cpp

846

850

@@ -894,11 +898,11 @@ convertIfPrimFn (Just ty) (CppFunction name params _ qs body)

894convertIfPrimFn _ cpp = cpp

898convertIfPrimFn _ cpp = cpp

895

899

896---------------------------------------------------------------------------------------------------

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

897−allSymbols :: [Cpp] -> [Text]

901+allSymbols :: [Cpp] -> [PSString]

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

902---------------------------------------------------------------------------------------------------

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

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

900 where

904 where

901− symbols :: Cpp -> [Text]

905+ symbols :: Cpp -> [PSString]

902 symbols (CppSymbol s) = [s]

906 symbols (CppSymbol s) = [s]

903 symbols _ = []

907 symbols _ = []

904

908

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

@@ -28,6 +28,7 @@ import Control.Monad.Identity

28import Data.Text (Text)

29import Language.PureScript.Comments

30import Language.PureScript.CodeGen.Cpp.Types

31+import Language.PureScript.PSString (PSString)

31import Language.PureScript.Traversals

32import Language.PureScript.Traversals

33-- |

34-- |

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

150 -- |

151 -- |

151 -- A string literal

152 -- A string literal

152 --

153 --

153− | CppStringLiteral Text

154+ | CppStringLiteral PSString

154 -- |

155 -- |

155 -- A character literal

156 -- A character literal

156 --

157 --

@@ -222,11 +223,11 @@ data Cpp

222 -- |

223 -- |

223 -- Unique system-wide name/constant

224 -- Unique system-wide name/constant

224 --

225 --

225− | CppSymbol Text

226+ | CppSymbol PSString

226 -- |

227 -- |

227 -- Define unique system-wide name/constant

228 -- Define unique system-wide name/constant

228 --

229 --

229− | CppDefineSymbol Text

230+ | CppDefineSymbol PSString

230 -- |

231 -- |

231 -- A block of expressions in braces

232 -- A block of expressions in braces

232 --

233 --

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

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

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

21−import Prelude.Compat hiding (all, any, concatMap, last, init, map, null)

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

23import Data.Char

24−import Data.Text hiding (foldl1)

24+import Data.Text hiding (foldl1, map)

25+import qualified Data.Text as T

25import Data.Monoid ((<>))

26import Data.Monoid ((<>))

26import qualified Language.PureScript.Constants as C

27import qualified Language.PureScript.Constants as C

27import Language.PureScript.Crash

28import Language.PureScript.Crash

28import Language.PureScript.Names

29import Language.PureScript.Names

30+import Language.PureScript.PSString (PSString, decodeStringEither)

30-- |

32-- |

31-- Convert an Ident into a valid C++11 identifier:

33-- Convert an Ident into a valid C++11 identifier:

@@ -58,7 +60,13 @@ escaped :: Text -> Text

58escaped = escapeDoubleUnderscores . concatMap identCharToText

60escaped = escapeDoubleUnderscores . concatMap identCharToText

60dotsTo :: Char -> Text -> Text

62dotsTo :: Char -> Text -> Text

61−dotsTo chr' = map (\c -> if c == '.' then chr' else c)

63+dotsTo chr' = T.map (\c -> if c == '.' then chr' else c)

64+

65+codePoints :: PSString -> String

66+codePoints = map (either (chr . fromIntegral) id) . decodeStringEither

67+

68+safeSymbol :: PSString -> Text

69+safeSymbol = T.concat . map identCharToText . codePoints

63-- |

71-- |

64-- C++ actually reserves all identifiers containing double

72-- C++ actually reserves all identifiers containing double

src/Language/PureScript/CodeGen/Cpp/Optimizer/Common.hs−2

@@ -81,8 +81,6 @@ removeFromBlock _ cpp = cpp

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

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

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

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

85− x == fnName && y == moduleName

86isFn _ _ = False

84isFn _ _ = False

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

86isDict :: (Text, Text) -> Cpp -> Bool

src/Language/PureScript/CodeGen/Cpp/Optimizer/Inliner.hs−1

@@ -139,7 +139,6 @@ inlineOperator (m, op) f = everywhereOnCpp convert

139 convert (CppApp (CppApp op' [x]) [y]) | isOp op' = f x y

140 convert other = other

141 isOp (CppAccessor (CppVar longForm) (CppVar m')) = m == m' && longForm == safeName op

142− isOp (CppIndexer (CppStringLiteral op') (CppVar m')) = m == m' && op == op'

143 isOp _ = False

142 isOp _ = False

144

143

145inlineCommonOperators :: Cpp -> Cpp

144inlineCommonOperators :: Cpp -> Cpp

src/Language/PureScript/CodeGen/Cpp/Optimizer/MagicDo.hs+2−1

@@ -26,6 +26,7 @@ import Language.PureScript.CodeGen.Cpp.Optimizer.Common

26import Language.PureScript.CodeGen.Cpp.Types

27import Language.PureScript.Options

28import qualified Language.PureScript.Constants as C

29+import Language.PureScript.PSString (mkString)

30magicDo :: Options -> Cpp -> Cpp

31magicDo :: Options -> Cpp -> Cpp

31magicDo opts | optionsNoMagicDo opts = id

32magicDo opts | optionsNoMagicDo opts = id

@@ -121,7 +122,7 @@ inlineST = everywhereOnCpp convertBlock

121 -- or in a more aggressive way, turning wrappers into local variables depending on the

122 -- or in a more aggressive way, turning wrappers into local variables depending on the

122 -- agg(ressive) parameter.

123 -- agg(ressive) parameter.

123 convert agg (CppApp f [arg]) | isSTFunc C.newSTRef f =

124 convert agg (CppApp f [arg]) | isSTFunc C.newSTRef f =

124− CppLambda [CaptureAll] [] Nothing (CppBlock [CppReturn $ if agg then arg else CppMapLiteral Record [(CppSymbol C.stRefValue, arg)]])

125+ CppLambda [CaptureAll] [] Nothing (CppBlock [CppReturn $ if agg then arg else CppMapLiteral Record [(CppSymbol $ mkString C.stRefValue, arg)]])

125 convert agg (CppApp (CppApp f [ref]) []) | isSTFunc C.readSTRef f =

126 convert agg (CppApp (CppApp f [ref]) []) | isSTFunc C.readSTRef f =

126 if agg then ref else CppAccessor (CppVar C.stRefValue) ref

127 if agg then ref else CppAccessor (CppVar C.stRefValue) ref

127 convert agg (CppApp (CppApp (CppApp f [ref]) [arg]) []) | isSTFunc C.writeSTRef f =

128 convert agg (CppApp (CppApp (CppApp f [ref]) [arg]) []) | isSTFunc C.writeSTRef f =

src/Language/PureScript/CodeGen/Cpp/Unicode.hs+25−20

@@ -24,41 +24,46 @@ import Data.Text (Text, pack, unpack)

24import Text.Printf (printf)

26import Language.PureScript.CodeGen.Cpp.AST

27+import Language.PureScript.CodeGen.Cpp.Common

28+import Language.PureScript.PSString (PSString, mkString)

28---------------------------------------------------------------------------------------------------

30---------------------------------------------------------------------------------------------------

29unicodeToUCNs :: Cpp -> Cpp

31unicodeToUCNs :: Cpp -> Cpp

30---------------------------------------------------------------------------------------------------

32---------------------------------------------------------------------------------------------------

31unicodeToUCNs (CppVar s) =

33unicodeToUCNs (CppVar s) =

32− CppVar (toUcns s)

34+ CppVar (toUCNs s)

33unicodeToUCNs (CppSymbol s) =

35unicodeToUCNs (CppSymbol s) =

34− CppSymbol (toUcns s)

36+ CppSymbol (toUCNs' s)

35unicodeToUCNs (CppFunction s ss rty qs cpp) =

37unicodeToUCNs (CppFunction s ss rty qs cpp) =

36− CppFunction (toUcns s) ((\(a,t) -> (toUcns a, t)) <$> ss) rty qs cpp

38+ CppFunction (toUCNs s) ((\(a,t) -> (toUCNs a, t)) <$> ss) rty qs cpp

37unicodeToUCNs (CppLambda cps ss rty cpp) =

39unicodeToUCNs (CppLambda cps ss rty cpp) =

38− CppLambda cps ((\(a,t) -> (toUcns a, t)) <$> ss) rty cpp

40+ CppLambda cps ((\(a,t) -> (toUCNs a, t)) <$> ss) rty cpp

39unicodeToUCNs (CppVariableIntroduction (ss,t) qs cpp) =

41unicodeToUCNs (CppVariableIntroduction (ss,t) qs cpp) =

40− CppVariableIntroduction (toUcns ss, t) qs cpp

42+ CppVariableIntroduction (toUCNs ss, t) qs cpp

41unicodeToUCNs (CppEnum s t ss) =

43unicodeToUCNs (CppEnum s t ss) =

42− CppEnum (toUcns <$> s) t (toUcns <$> ss)

44+ CppEnum (toUCNs <$> s) t (toUCNs <$> ss)

43unicodeToUCNs (CppStruct s cpps) =

45unicodeToUCNs (CppStruct s cpps) =

44− CppStruct (toUcns s) cpps

46+ CppStruct (toUCNs s) cpps

45unicodeToUCNs (CppNamespace s cpps) =

47unicodeToUCNs (CppNamespace s cpps) =

46− CppNamespace (toUcns s) cpps

48+ CppNamespace (toUCNs s) cpps

47unicodeToUCNs (CppUseNamespace s) =

49unicodeToUCNs (CppUseNamespace s) =

48− CppUseNamespace (toUcns s)

50+ CppUseNamespace (toUCNs s)

49unicodeToUCNs (CppTypeAlias (s1,ss) t s2) =

51unicodeToUCNs (CppTypeAlias (s1,ss) t s2) =

50− CppTypeAlias (toUcns s1, (\(a,n) -> (toUcns a, n)) <$> ss) t (toUcns s2)

52+ CppTypeAlias (toUCNs s1, (\(a,n) -> (toUCNs a, n)) <$> ss) t (toUCNs s2)

51unicodeToUCNs cpp = cpp

53unicodeToUCNs cpp = cpp

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

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

54−toUcns :: Text -> Text

56+toUCNs :: Text -> Text

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

57---------------------------------------------------------------------------------------------------

56−toUcns = pack . toUcns' . unpack

58+toUCNs = pack . concatMap toUCN . unpack

57− where

59+

58− toUcns' :: String -> String

60+---------------------------------------------------------------------------------------------------

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

61+toUCNs' :: PSString -> PSString

60− where

62+---------------------------------------------------------------------------------------------------

63+toUCNs' = mkString . pack . concatMap toUCN . codePoints

64+

65+---------------------------------------------------------------------------------------------------

61− toUcn :: Char -> String

66+toUCN :: Char -> String

67+---------------------------------------------------------------------------------------------------

62− toUcn c | isAscii c = [c]

68+toUCN c | isAscii c = [c]

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

69+toUCN c = printf "\\U%08x" $ ord c

64− toUcns' s = s

src/Language/PureScript/Pretty/Cpp.hs+27−17

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

20 ( dotsTo

21 , linebreak

22 , prettyPrintCpp

23+ , utf16Text

23 ) where

24 ) where

25import Prelude.Compat

26import Prelude.Compat

@@ -44,6 +45,7 @@ import Language.PureScript.Comments

44import Language.PureScript.CodeGen.Cpp.Common

45import Language.PureScript.CodeGen.Cpp.Common

45import qualified Language.PureScript.Constants as C

46import qualified Language.PureScript.Constants as C

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

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

48+import Language.PureScript.PSString (PSString, decodeString, decodeStringEither)

48-- |

50-- |

49-- Get the current indentation level

51-- Get the current indentation level

@@ -80,9 +82,12 @@ literals = mkPattern' match

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

82 match (CppNumericLiteral (Left n)) = return $ show' n

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

83 match (CppNumericLiteral n) = return $ either show' show' n

82 match (CppStringLiteral s)

84 match (CppStringLiteral s)

85+ | Just s' <- decodeString s

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

86+ , T.all isAscii s' = return $ string s'

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

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

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

88+ match (CppCharLiteral c)

89+ | isAscii c = return $ "'" <> encodeChar c <> "'"

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

86 match (CppBooleanLiteral True) = return "true"

91 match (CppBooleanLiteral True) = return "true"

87 match (CppBooleanLiteral False) = return "false"

92 match (CppBooleanLiteral False) = return "false"

88 match (CppArrayLiteral []) = return $ runType arrayType <> "{}"

93 match (CppArrayLiteral []) = return $ runType arrayType <> "{}"

@@ -263,8 +268,8 @@ literals = mkPattern' match

263 | Empty <- op = "empty"

268 | Empty <- op = "empty"

264 | otherwise = error $ "Incorrect match on unary " <> show op

269 | otherwise = error $ "Incorrect match on unary " <> show op

265 match (CppVar ident) = return $ renderName ident

270 match (CppVar ident) = return $ renderName ident

266− match (CppSymbol ident) = return $ "symbol" <> parensT (safeName ident)

271+ match (CppSymbol ident) = return $ "symbol" <> parensT (safeSymbol ident)

267− match (CppDefineSymbol ident) = return $ "define_symbol" <> parensT (safeName ident)

272+ match (CppDefineSymbol ident) = return $ "define_symbol" <> parensT (safeSymbol ident)

268 match (CppApp v [CppNoOp]) = return (prettyPrintCpp1 v)

273 match (CppApp v [CppNoOp]) = return (prettyPrintCpp1 v)

269 match (CppVariableIntroduction (ident, typ) qs value) =

274 match (CppVariableIntroduction (ident, typ) qs value) =

270 mconcat <$> sequence

275 mconcat <$> sequence

@@ -392,18 +397,23 @@ literals = mkPattern' match

392

397

393string :: Text -> Text

398string :: Text -> Text

394string s = "\"" <> T.concatMap encodeChar s <> "\""

399string s = "\"" <> T.concatMap encodeChar s <> "\""

395− where

400+

396− encodeChar :: Char -> Text

401+encodeChar :: Char -> Text

397− encodeChar '\0' = "\\0"

402+encodeChar '\0' = "\\0"

398− encodeChar '\b' = "\\b"

403+encodeChar '\b' = "\\b"

399− encodeChar '\t' = "\\t"

404+encodeChar '\t' = "\\t"

400− encodeChar '\n' = "\\n"

405+encodeChar '\n' = "\\n"

401− encodeChar '\v' = "\\v"

406+encodeChar '\v' = "\\v"

402− encodeChar '\f' = "\\f"

407+encodeChar '\f' = "\\f"

403− encodeChar '\r' = "\\r"

408+encodeChar '\r' = "\\r"

404− encodeChar '"' = "\\\""

409+encodeChar '"' = "\\\""

405− encodeChar '\\' = "\\\\"

410+encodeChar '\\' = "\\\\"

406− encodeChar c = T.singleton c

411+encodeChar c = T.singleton c

412+

413+-- Note: Any lone surrogates will be replaced with U+FFFD

414+--

415+utf16Text :: PSString -> Text

416+utf16Text = T.pack . map (either (chr . fromIntegral) id) . decodeStringEither

407

417

408accessor :: Pattern PrinterState Cpp (Text, Cpp)

418accessor :: Pattern PrinterState Cpp (Text, Cpp)

409accessor = mkPattern match

419accessor = mkPattern match