ede46c4 · rowtype-yoga/purescript-native

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

C++: PSString support

commitede46c4431990fe7b2174c02cf0641ab9314e4ca authorAndy Arvanitis <andyarvanitis@gmail.com> dateTue 10 Jan 2017, 00:15 (10 years ago) parenta193b03

8 files changed+81−55

compare with golang

unifiedsplit

src/Language/PureScript/CodeGen/Cpp.hs+12−8 src/Language/PureScript/CodeGen/Cpp/AST.hs+4−3 src/Language/PureScript/CodeGen/Cpp/Common.hs+11−3 src/Language/PureScript/CodeGen/Cpp/Optimizer/Common.hs−2 src/Language/PureScript/CodeGen/Cpp/Optimizer/Inliner.hs−1 src/Language/PureScript/CodeGen/Cpp/Optimizer/MagicDo.hs+2−1 src/Language/PureScript/CodeGen/Cpp/Unicode.hs+25−20 src/Language/PureScript/Pretty/Cpp.hs+27−17

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

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

5252import Language.PureScript.CoreFn

5353import Language.PureScript.Names

5454import Language.PureScript.Options

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

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

5657import Language.PureScript.Traversals (sndM)

5758

5859import qualified Language.PureScript.Constants as C

5960import qualified Language.PureScript.Environment as E

61+import Language.PureScript.Label (runLabel)

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

6163import qualified Language.PureScript.Types as T

6264

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

455457 CppMapLiteral Record $

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

457459 where

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

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

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

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

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

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

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

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

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

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

487489 in return . CppMapLiteral Instance $

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

490+ zip

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

492+ args'

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

490494 _ -> applied f args' id

491495 where

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

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

568572 failedPatternError :: [Text] -> Cpp

569573 failedPatternError _ =

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

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

571575 errorMessage :: Text

572576 errorMessage =

573577 "Failed pattern match" <>

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

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

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

670674 where

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

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

672676 go done' [] = return done'

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

674678 propVar <- freshName

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

840844 dictIndexerToEnum :: Cpp -> Cpp

841845 dictIndexerToEnum (CppMapGet (CppSymbol prop) dict)

842846 | Just cls <- lookup dict classes =

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

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

844848 in CppMapGet index dict

845849 dictIndexerToEnum cpp = cpp

846850

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

894898convertIfPrimFn _ cpp = cpp

895899

896900---------------------------------------------------------------------------------------------------

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

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

898902---------------------------------------------------------------------------------------------------

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

900904 where

901− symbols :: Cpp -> [Text]

905+ symbols :: Cpp -> [PSString]

902906 symbols (CppSymbol s) = [s]

903907 symbols _ = []

904908

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

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

2828import Data.Text (Text)

2929import Language.PureScript.Comments

3030import Language.PureScript.CodeGen.Cpp.Types

31+import Language.PureScript.PSString (PSString)

3132import Language.PureScript.Traversals

3233

3334-- |

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

150151 -- |

151152 -- A string literal

152153 --

153− | CppStringLiteral Text

154+ | CppStringLiteral PSString

154155 -- |

155156 -- A character literal

156157 --

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

222223 -- |

223224 -- Unique system-wide name/constant

224225 --

225− | CppSymbol Text

226+ | CppSymbol PSString

226227 -- |

227228 -- Define unique system-wide name/constant

228229 --

229− | CppDefineSymbol Text

230+ | CppDefineSymbol PSString

230231 -- |

231232 -- A block of expressions in braces

232233 --

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

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

1818

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

2020

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

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

2222

2323import Data.Char

24−import Data.Text hiding (foldl1)

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

25+import qualified Data.Text as T

2526import Data.Monoid ((<>))

2627import qualified Language.PureScript.Constants as C

2728import Language.PureScript.Crash

2829import Language.PureScript.Names

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

2931

3032-- |

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

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

5860escaped = escapeDoubleUnderscores . concatMap identCharToText

5961

6062dotsTo :: 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

6270

6371-- |

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

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

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

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

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

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

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

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

8684isFn _ _ = False

8785

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

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

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

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

140140 convert other = other

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

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

143142 isOp _ = False

144143

145144inlineCommonOperators :: Cpp -> Cpp

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

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

2626import Language.PureScript.CodeGen.Cpp.Types

2727import Language.PureScript.Options

2828import qualified Language.PureScript.Constants as C

29+import Language.PureScript.PSString (mkString)

2930

3031magicDo :: Options -> Cpp -> Cpp

3132magicDo opts | optionsNoMagicDo opts = id

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

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

122123 -- agg(ressive) parameter.

123124 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)]])

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

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

127128 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)

2424import Text.Printf (printf)

2525

2626import Language.PureScript.CodeGen.Cpp.AST

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

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

2729

2830---------------------------------------------------------------------------------------------------

2931unicodeToUCNs :: Cpp -> Cpp

3032---------------------------------------------------------------------------------------------------

3133unicodeToUCNs (CppVar s) =

32− CppVar (toUcns s)

34+ CppVar (toUCNs s)

3335unicodeToUCNs (CppSymbol s) =

34− CppSymbol (toUcns s)

36+ CppSymbol (toUCNs' s)

3537unicodeToUCNs (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

3739unicodeToUCNs (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

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

40− CppVariableIntroduction (toUcns ss, t) qs cpp

42+ CppVariableIntroduction (toUCNs ss, t) qs cpp

4143unicodeToUCNs (CppEnum s t ss) =

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

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

4345unicodeToUCNs (CppStruct s cpps) =

44− CppStruct (toUcns s) cpps

46+ CppStruct (toUCNs s) cpps

4547unicodeToUCNs (CppNamespace s cpps) =

46− CppNamespace (toUcns s) cpps

48+ CppNamespace (toUCNs s) cpps

4749unicodeToUCNs (CppUseNamespace s) =

48− CppUseNamespace (toUcns s)

50+ CppUseNamespace (toUCNs s)

4951unicodeToUCNs (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)

5153unicodeToUCNs cpp = cpp

5254

5355---------------------------------------------------------------------------------------------------

54−toUcns :: Text -> Text

56+toUCNs :: Text -> Text

5557---------------------------------------------------------------------------------------------------

56−toUcns = pack . toUcns' . unpack

57− where

58− toUcns' :: String -> String

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

60− where

61− toUcn :: Char -> String

62− toUcn c | isAscii c = [c]

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

64− toUcns' s = s

58+toUCNs = pack . concatMap toUCN . unpack

59+

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

61+toUCNs' :: PSString -> PSString

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

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

64+

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

66+toUCN :: Char -> String

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

68+toUCN c | isAscii c = [c]

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

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

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

2020 ( dotsTo

2121 , linebreak

2222 , prettyPrintCpp

23+ , utf16Text

2324 ) where

2425

2526import Prelude.Compat

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

4445import Language.PureScript.CodeGen.Cpp.Common

4546import qualified Language.PureScript.Constants as C

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

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

4749

4850-- |

4951-- Get the current indentation level

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

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

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

8284 match (CppStringLiteral s)

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

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

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

85+ | Just s' <- decodeString s

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

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

88+ match (CppCharLiteral c)

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

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

8691 match (CppBooleanLiteral True) = return "true"

8792 match (CppBooleanLiteral False) = return "false"

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

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

263268 | Empty <- op = "empty"

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

265270 match (CppVar ident) = return $ renderName ident

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

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

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

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

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

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

270275 mconcat <$> sequence

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

392397

393398string :: Text -> Text

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

395− where

396− encodeChar :: Char -> Text

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

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

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

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

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

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

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

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

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

406− encodeChar c = T.singleton c

400+

401+encodeChar :: Char -> Text

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

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

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

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

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

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

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

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

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

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

407417

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

409419accessor = mkPattern match