git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
C++: multiple changes to improve symbol/name mangling and handling"
commit3f816d02b89cb78fcdff588cea1c86e4a687ebbb authorAndy Arvanitis <andyarvanitis@gmail.com> dateSun 18 Dec 2016, 16:15 (10 years ago) parent51e6b26
18 files changed+275−165
compare with golang
unifiedsplit
pcc/TestMain.hs+2 pcc/runtime/purescript.cc+9−1 pcc/runtime/purescript.hh+93−48 pcc/support/psc-package.json+1−1 src/Language/PureScript/CodeGen/Cpp.hs+25−37 src/Language/PureScript/CodeGen/Cpp/AST.hs+15−5 src/Language/PureScript/CodeGen/Cpp/Common.hs+79−29 src/Language/PureScript/CodeGen/Cpp/File.hs+2−2 src/Language/PureScript/CodeGen/Cpp/Optimizer/Common.hs+2−2 src/Language/PureScript/CodeGen/Cpp/Optimizer/Inliner.hs+3−3 src/Language/PureScript/CodeGen/Cpp/Optimizer/MagicDo.hs+2−1 src/Language/PureScript/CodeGen/Cpp/Optimizer/TCO.hs+2−2 src/Language/PureScript/CodeGen/Cpp/Optimizer/Uncurry.hs+1−1 src/Language/PureScript/CodeGen/Cpp/Optimizer/Unused.hs+2−2 src/Language/PureScript/CodeGen/Cpp/Types.hs+11−5 src/Language/PureScript/Parser/Lexer.hs+3−3 src/Language/PureScript/Pretty/Cpp.hs+18−22 stack.yaml+5−1
pcc/TestMain.hs+2
@@ -133,6 +133,8 @@ skipped :: [String]
133133skipped =
134134 [ "NumberLiterals.purs" -- unreliable float comparison, test manually
135135 , "FunWithFunDeps.purs" -- requires FFI
136+ , "SolvingIsSymbol.purs"
137+ , "StringEscapes.purs"
136138 ]
137139
138140logpath :: FilePath
pcc/runtime/purescript.cc+9−1
@@ -87,7 +87,7 @@ auto any::unthunkVariant(const any& a) -> const any& {
8787}
8888
8989auto any::operator[](const symbol_t key) const -> const any& {
90− return get(key, cast<map<unknown_size>>(*this));
90+ return PureScript::map::get(key, cast<map<unknown_size>>(*this));
9191}
9292
9393auto any::operator[](const size_t rhs) const -> const any& {
@@ -100,6 +100,14 @@ auto any::operator[](const any& rhs) const -> const any& {
100100 return xs[cast<int>(rhs)];
101101}
102102
103+auto any::size() const -> size_t {
104+ return cast<array>(*this).size();
105+}
106+
107+auto any::empty() const -> bool {
108+ return cast<array>(*this).empty();
109+}
110+
103111auto any::contains(const symbol_t key) const -> bool {
104112 // TODO: assumes at least one element -- safe assumption?
105113 const auto& m = cast<map<unknown_size>>(*this);
pcc/runtime/purescript.hh+93−48
@@ -46,17 +46,27 @@ namespace PureScript {
4646using cstring = const char *;
4747using std::nullptr_t;
4848
49−struct symbol_generator_anchor {};
50−using symbol_t = const symbol_generator_anchor *;
49+namespace Private {
50+ struct symbol_generator_anchor_t {};
5151
52−template <typename T>
53−struct symbol_generator {
54− constexpr static symbol_generator_anchor anchor = symbol_generator_anchor{};
55−};
56−template <typename T>
57−constexpr symbol_generator_anchor symbol_generator<T>::anchor;
52+ template <typename T>
53+ struct symbol_generator {
54+ constexpr static symbol_generator_anchor_t anchor = symbol_generator_anchor_t{};
55+ };
56+ template <typename T>
57+ constexpr symbol_generator_anchor_t symbol_generator<T>::anchor;
58+}
59+
60+using symbol_t = const Private::symbol_generator_anchor_t *;
5861
59−#define SYMBOL(S) &symbol_generator<symbol::S>::anchor
62+#define define_symbol(S) namespace PureScript { \
63+ namespace Private { \
64+ namespace Symbol { \
65+ struct S_ ## S {}; \
66+ } \
67+ } \
68+ }
69+#define symbol(S) (&Private::symbol_generator<::PureScript::Private::Symbol::S_ ## S>::anchor)
6070
6171// Workaround for missing C++11 version in gcc
6272class runtime_error : public std::runtime_error {
@@ -65,7 +75,6 @@ public:
6575};
6676
6777constexpr bool undefined = false;
68−constexpr size_t constructor = 0;
6978
7079// Not a real limit, just used for simpler accessors
7180static constexpr size_t unknown_size = 64;
@@ -123,10 +132,10 @@ class any {
123132 };
124133
125134 template <typename T>
126− class _closure : public closure {
135+ class closure_ : public closure {
127136 const T lambda;
128137 public:
129− _closure(const T& l) noexcept : lambda(l) {}
138+ closure_(const T& l) noexcept : lambda(l) {}
130139 auto operator()(const any& arg) const -> any override {
131140 return lambda(arg);
132141 }
@@ -139,10 +148,10 @@ class any {
139148 };
140149
141150 template <typename T>
142− class _eff_closure : public eff_closure {
151+ class eff_closure_ : public eff_closure {
143152 const T lambda;
144153 public:
145− _eff_closure(const T& l) noexcept : lambda(l) {}
154+ eff_closure_(const T& l) noexcept : lambda(l) {}
146155 auto operator()() const -> any override {
147156 return lambda();
148157 }
@@ -206,7 +215,7 @@ class any {
206215 template <typename T, typename = typename std::enable_if<!std::is_same<any,T>::value &&
207216 !std::is_convertible<T,fn>::value>::type>
208217 any(const T& val, typename std::enable_if<std::is_assignable<std::function<any(const any&)>,T>::value>::type* = 0)
209− : tag(tag_t::Closure), l(make_managed<_closure<T>>(val)) {}
218+ : tag(tag_t::Closure), l(make_managed<closure_<T>>(val)) {}
210219
211220 template <typename T>
212221 any(const T& val, typename std::enable_if<std::is_convertible<T,eff_fn>::value>::type* = 0) noexcept
@@ -216,7 +225,7 @@ class any {
216225 typename = typename std::enable_if<!std::is_same<any,T>::value &&
217226 !std::is_convertible<T,eff_fn>::value>::type>
218227 any(const T& val, typename std::enable_if<std::is_assignable<std::function<any()>,T>::value>::type* = 0)
219− : tag(tag_t::EffClosure), k(make_managed<_eff_closure<T>>(val)) {}
228+ : tag(tag_t::EffClosure), k(make_managed<eff_closure_<T>>(val)) {}
220229
221230 template <typename T>
222231 any(const T& val, typename std::enable_if<std::is_convertible<T,thunk>::value>::type* = 0) noexcept
@@ -340,6 +349,8 @@ class any {
340349 auto operator[](const size_t) const -> const any&;
341350 auto operator[](const any&) const -> const any&;
342351
352+ auto size() const -> size_t;
353+ auto empty() const -> bool;
343354 auto contains(const symbol_t) const -> bool;
344355
345356 auto extractPointer(IF_DEBUG(const tag_t)) const -> void*;
@@ -411,23 +422,31 @@ class any {
411422
412423}; // class any
413424
414−template <typename T, typename U=void>
415−struct tag_helper {};
425+namespace Private {
426+ template <typename T, typename U=void>
427+ struct tag_helper_t {};
416428
417−template <size_t N>
418−struct tag_helper<any::map<N>> {
419− static constexpr any::tag_t tag = any::tag_t::Map;
420−};
429+ template <size_t N>
430+ struct tag_helper_t<any::map<N>> {
431+ static constexpr any::tag_t tag = any::tag_t::Map;
432+ };
421433
422−template <size_t N>
423−struct tag_helper<any::data<N>> {
424− static constexpr any::tag_t tag = any::tag_t::Data;
425−};
434+ template <size_t N>
435+ struct tag_helper_t<any::data<N>> {
436+ static constexpr any::tag_t tag = any::tag_t::Data;
437+ };
426438
439+ template <typename T>
440+ struct tag_helper_t<T> {
441+ static constexpr any::tag_t tag = any::tag_t::Pointer;
442+ };
443+}
444+
445+// Pass-through
427446template <typename T>
428−struct tag_helper<T> {
429− static constexpr any::tag_t tag = any::tag_t::Pointer;
430−};
447+constexpr auto cast(const T& a) -> const T& {
448+ return a;
449+}
431450
432451template <typename T>
433452inline auto cast(const any& a) ->
@@ -445,7 +464,7 @@ inline auto cast(const any& a) ->
445464template <typename T, typename = typename std::enable_if<std::is_class<T>::value>::type>
446465inline auto cast(const any& a) ->
447466 typename std::enable_if<!std::is_same<T, any::array>::value, T&>::type {
448− return *static_cast<T*>(a.extractPointer(IF_DEBUG(tag_helper<T>::tag)));
467+ return *static_cast<T*>(a.extractPointer(IF_DEBUG(Private::tag_helper_t<T>::tag)));
449468}
450469
451470template <typename T>
@@ -454,27 +473,53 @@ inline auto cast(const any& a) ->
454473 return a.rawPointer();
455474}
456475
457−template <size_t N>
458−inline auto get(const any& a) -> const any& {
459− return cast<any::map<N+1>>(a)[N].second;
460−}
476+namespace map {
477+ template <size_t N, typename T>
478+ inline auto get(const T& a) ->
479+ typename std::enable_if<!std::is_same<any, T>::value, const any&>::type {
480+ return a[N].second;
481+ }
461482
462−template <size_t N>
463−inline auto get(const symbol_t key, const any::map<N>& a) -> const any& {
464− static_assert(N > 0, "map size must be greater than zero"); // TODO: not safe
465− typename std::remove_reference<decltype(a)>::type::size_type i = 0;
466− do {
467− if (a[i].first == key) {
468− return a[i].second;
469− }
470− } while (a[++i].first != nullptr);
471− assert(false && "map key not found");
472− static const any invalid_key(nullptr);
473− return invalid_key;
483+ template <size_t N>
484+ inline auto get(const any& a) -> const any& {
485+ return cast<any::map<N+1>>(a)[N].second;
486+ }
487+
488+ template <size_t N>
489+ inline auto get(const symbol_t key, const any::map<N>& a) -> const any& {
490+ static_assert(N > 0, "map size must be greater than zero");
491+ typename std::remove_reference<decltype(a)>::type::size_type i = 0;
492+ do {
493+ if (a[i].first == key) {
494+ return a[i].second;
495+ }
496+ } while (a[++i].first != nullptr);
497+ assert(false && "map key not found");
498+ static const any invalid_key(nullptr);
499+ return invalid_key;
500+ }
501+
502+ inline auto get(const symbol_t key, const any& a) -> const any& {
503+ return get(key, cast<any::map<unknown_size>>(a));
504+ }
474505}
475506
476−inline auto get(const symbol_t key, const any& a) -> const any& {
477− return get(key, cast<any::map<unknown_size>>(a));
507+namespace data {
508+ template <size_t N, typename T>
509+ inline auto get(const T& a) ->
510+ typename std::enable_if<!std::is_same<any, T>::value, const any&>::type {
511+ return a[N];
512+ }
513+
514+ template <size_t N>
515+ inline auto get(const any& a) -> const any& {
516+ return cast<any::data<N+1>>(a)[N];
517+ }
518+
519+ template <typename T>
520+ inline auto ctor(const T& a) -> const any& {
521+ return get<0>(a);
522+ }
478523}
479524
480525} // namespace PureScript
pcc/support/psc-package.json+1−1
@@ -1,6 +1,6 @@
11{
22 "name": "Main",
3− "set": "psc-0.10.2",
3+ "set": "psc-0.10.3",
44 "source": "https://github.com/pure11/package-sets.git",
55 "depends": [
66 "console",
src/Language/PureScript/CodeGen/Cpp.hs+25−37
@@ -110,7 +110,7 @@ moduleToCpp otherOpts env (Module _ mn imps _ foreigns decls) = do
110110 symbols = allSymbols bodyCpps
111111 moduleBody =
112112 CppInclude (runModuleName mn) (runModuleName mn) :
113− symbolDefs symbols :
113+ (CppDefineSymbol <$> symbols) ++
114114 (if null bodyCpps
115115 then []
116116 else [ CppNamespace (runModuleName mn) $
@@ -235,7 +235,7 @@ moduleToCpp otherOpts env (Module _ mn imps _ foreigns decls) = do
235235 isAccessor Accessor {} = True
236236 isAccessor _ = False
237237 isGet :: Cpp -> Bool
238− isGet (CppGet (CppSymbol _) (CppVar _)) = True
238+ isGet (CppMapGet (CppSymbol _) (CppVar _)) = True
239239 isGet _ = False
240240 classes =
241241 zip
@@ -249,7 +249,7 @@ moduleToCpp otherOpts env (Module _ mn imps _ foreigns decls) = do
249249 []
250250 (Just $ Any [])
251251 [Inline]
252− (returnBlock $ CppDataLiteral [CppAccessor (CppVar $ identToCpp ident) (CppVar "data")])
252+ (returnBlock $ CppDataLiteral [CppAccessor (CppVar $ identToCpp ident) (CppVar ctorNS)])
253253 declToCpp _ (_, ident) (Constructor _ _ (ProperName _) fields) =
254254 return . CppNamespace "" $
255255 [ CppFunction
@@ -258,7 +258,7 @@ moduleToCpp otherOpts env (Module _ mn imps _ foreigns decls) = do
258258 (Just $ Any [])
259259 [Inline]
260260 (returnBlock $
261− CppDataLiteral $ CppAccessor (CppVar name) (CppVar "data") : (CppVar <$> fields'))
261+ CppDataLiteral $ CppAccessor (CppVar name) (CppVar ctorNS) : (CppVar <$> fields'))
262262 ] ++
263263 if length fields > 0
264264 then [ CppFunction
@@ -387,13 +387,12 @@ moduleToCpp otherOpts env (Module _ mn imps _ foreigns decls) = do
387387 accessed dictname name =
388388 ( name
389389 , CppApp
390− (CppIndexer
390+ (CppDataGet
391391 (CppNumericLiteral . Left . fromIntegral . fromJust $ findIndex ((== name) . fst) fns)
392− dict'')
392+ dict')
393393 [dict'])
394394 where
395395 dict' = CppVar dictname
396− dict'' = CppCast (dataType 1) dict'
397396 accessor :: Text -> (Text, Cpp) -> Cpp
398397 accessor dictname (name, _) =
399398 CppVariableIntroduction (name, Just $ Any [Const]) [] (Just . snd $ accessed dictname name)
@@ -444,13 +443,13 @@ moduleToCpp otherOpts env (Module _ mn imps _ foreigns decls) = do
444443 valueToCpp (Literal _ (ObjectLiteral ps)) =
445444 CppMapLiteral Record <$>
446445 mapM (sndM valueToCpp) ((\(k, v) -> (CppSymbol k, v)) <$> sortBy (compare `on` fst) ps)
447− valueToCpp (Accessor _ prop val) = CppGet <$> pure (CppSymbol prop) <*> valueToCpp val
446+ valueToCpp (Accessor _ prop val) = CppMapGet <$> pure (CppSymbol prop) <*> valueToCpp val
448447 -- TODO: use a more efficient way of copying/updating the map?
449448 valueToCpp (ObjectUpdate (_, _, Just ty, _) obj ps) = do
450449 obj' <- valueToCpp obj
451450 updatedFields <- mapM (sndM valueToCpp) ps
452451 let origKeys = (allKeys ty) \\ (fst <$> updatedFields)
453− origFields = (\key -> (key, CppGet (CppSymbol key) obj')) <$> origKeys
452+ origFields = (\key -> (key, CppMapGet (CppSymbol key) obj')) <$> origKeys
454453 return $
455454 CppMapLiteral Record $
456455 (\(k, v) -> (CppSymbol k, v)) <$> sortBy (compare `on` fst) (origFields ++ updatedFields)
@@ -603,7 +602,7 @@ moduleToCpp otherOpts env (Module _ mn imps _ foreigns decls) = do
603602 [ CppIfElse
604603 (CppBinary
605604 EqualTo
606− (CppIndexer (CppVar ctorKey) (CppCast (dataType 1) $ CppVar varName))
605+ (CppApp (CppVar getCtor) [CppVar varName])
607606 ctorCpp)
608607 (CppBlock cpps)
609608 Nothing
@@ -620,16 +619,16 @@ moduleToCpp otherOpts env (Module _ mn imps _ foreigns decls) = do
620619 (argVar, Nothing)
621620 []
622621 (Just $
623− CppIndexer
622+ CppDataGet
624623 (fieldToIndex' field)
625− (CppCast (dataType $ fieldToIndex field + 1) $ CppVar varName)) :
624+ (CppVar varName)) :
626625 cpps
627626 fieldToIndex :: Ident -> Int
628627 fieldToIndex = (+ 1) . read . dropWhile isLetter . unpack . runIdent
629628 fieldToIndex' :: Ident -> Cpp
630629 fieldToIndex' = CppNumericLiteral . Left . toInteger . fieldToIndex
631630 ctor' :: Cpp
632− ctor' = CppAccessor (CppVar . identToCpp $ Ident ctor) (CppVar "data")
631+ ctor' = CppAccessor (CppVar $ safeName ctor) (CppVar ctorNS)
633632 ctorCpp :: Cpp
634633 ctorCpp
635634 | Just mn'' <- mn'
@@ -678,18 +677,16 @@ moduleToCpp otherOpts env (Module _ mn imps _ foreigns decls) = do
678677 CppVariableIntroduction
679678 (propVar, Nothing)
680679 []
681− (Just $ CppGet (CppSymbol prop) (CppVar varName)) :
680+ (Just $ CppMapGet (CppSymbol prop) (CppVar varName)) :
682681 cpp
683682 literalToBinderCpp varName done (ArrayLiteral bs) = do
684683 cpp <- go done 0 bs
685684 let cond =
686685 case length bs of
687− 0 -> CppBinary Dot (CppCast arrayType $ CppVar varName) (CppApp (CppVar "empty") [])
688− n ->
689− let var = CppCast arrayType $ CppVar varName
690− in CppBinary
686+ 0 -> CppBinary Dot (CppVar varName) (CppApp (CppVar "empty") [])
687+ n -> CppBinary
691688 EqualTo
692− (CppBinary Dot var (CppApp (CppVar "size") []))
689+ (CppBinary Dot (CppVar varName) (CppApp (CppVar "size") []))
693690 (CppNumericLiteral (Left (fromIntegral n)))
694691 return [CppIfElse cond (CppBlock cpp) Nothing]
695692 where
@@ -753,7 +750,7 @@ moduleToCpp otherOpts env (Module _ mn imps _ foreigns decls) = do
753750 -------------------------------------------------------------------------------------------------
754751 dataCtors =
755752 [ CppNamespace
756− "data"
753+ ctorNS
757754 [ CppEnum Nothing (Just intType) . ("_" :) . catMaybes . map modCtor . M.keys $
758755 E.dataConstructors env
759756 ]
@@ -761,7 +758,7 @@ moduleToCpp otherOpts env (Module _ mn imps _ foreigns decls) = do
761758 where
762759 modCtor :: Qualified (ProperName a) -> Maybe Text
763760 modCtor (Qualified (Just mn') (ProperName name))
764− | mn' == mn = Just $ identToCpp (Ident name)
761+ | mn' == mn = Just (safeName name)
765762 modCtor _ = Nothing
766763 -------------------------------------------------------------------------------------------------
767764 curriedForeigns :: m [Cpp]
@@ -840,10 +837,10 @@ optIndexers :: [(Cpp, Cpp)] -> Cpp -> Cpp
840837optIndexers classes = everywhereOnCpp dictIndexerToEnum
841838 where
842839 dictIndexerToEnum :: Cpp -> Cpp
843− dictIndexerToEnum (CppGet (CppSymbol prop) dict)
840+ dictIndexerToEnum (CppMapGet (CppSymbol prop) dict)
844841 | Just cls <- lookup dict classes =
845− let index = CppAccessor (CppVar . identToCpp $ Ident prop) cls
846− in CppGet index dict
842+ let index = CppAccessor (CppVar $ safeName prop) cls
843+ in CppMapGet index dict
847844 dictIndexerToEnum cpp = cpp
848845
849846---------------------------------------------------------------------------------------------------
@@ -852,8 +849,8 @@ curriedName :: Text -> Text
852849curriedName name
853850 | Text.null name = name
854851curriedName name
855− | Text.head name == '$' = name
856− | otherwise = '$' `Text.cons` name
852+ | Text.head name == '*' = name
853+ | otherwise = '*' `Text.cons` name
857854
858855---------------------------------------------------------------------------------------------------
859856curriedName' :: Cpp -> Cpp
@@ -889,7 +886,7 @@ convertIfPrimFn :: Maybe T.Type -> Cpp -> Cpp
889886convertIfPrimFn ty@(Just _) (CppNamespace ns fs) = CppNamespace ns (convertIfPrimFn ty <$> fs)
890887convertIfPrimFn (Just _) cpp@(CppFunction name _ _ _ _)
891888 | not $ Text.null name
892− , Text.head name == '$' = cpp
889+ , Text.head name == '*' = cpp
893890convertIfPrimFn (Just ty) (CppFunction name params _ qs body)
894891 | (tys', Just rty') <- primFn ty =
895892 CppFunction name (zipWith (\(p, _) t -> (p, Just t)) params tys') (Just rty') qs body
@@ -901,18 +898,9 @@ allSymbols :: [Cpp] -> [Text]
901898allSymbols cpps = nub $ concatMap (everythingOnCpp (++) symbols) cpps
902899 where
903900 symbols :: Cpp -> [Text]
904− symbols (CppSymbol s) = [symbolname s]
901+ symbols (CppSymbol s) = [s]
905902 symbols _ = []
906903
907−---------------------------------------------------------------------------------------------------
908−symbolDefs :: [Text] -> Cpp
909−---------------------------------------------------------------------------------------------------
910−symbolDefs [] = CppNoOp
911−symbolDefs syms = CppNamespace "PureScript" [CppNamespace "symbol" (asStruct <$> syms)]
912− where
913− asStruct :: Text -> Cpp
914− asStruct s = CppStruct s []
915−
916904---------------------------------------------------------------------------------------------------
917905filterInlineFuncs :: Cpp -> Cpp
918906---------------------------------------------------------------------------------------------------
src/Language/PureScript/CodeGen/Cpp/AST.hs+15−5
@@ -204,9 +204,13 @@ data Cpp
204204 --
205205 | CppCast CppType Cpp
206206 -- |
207− -- Call to getter from templated type
207+ -- Call to getter from templated map type
208208 --
209− | CppGet Cpp Cpp
209+ | CppMapGet Cpp Cpp
210+ -- |
211+ -- Call to getter from templated data type
212+ --
213+ | CppDataGet Cpp Cpp
210214 -- |
211215 -- Function application
212216 --
@@ -220,6 +224,9 @@ data Cpp
220224 --
221225 | CppSymbol Text
222226 -- |
227+ -- Define unique system-wide name/constant
228+ --
229+ | CppDefineSymbol Text
223230 -- |
224231 -- A block of expressions in braces
225232 --
@@ -312,7 +319,8 @@ everywhereOnCpp f = go
312319 go (CppFunction name args rty qs j) = f (CppFunction name args rty qs (go j))
313320 go (CppLambda cps args rty j) = f (CppLambda cps args rty (go j))
314321 go (CppCast t cpp) = f (CppCast t (go cpp))
315− go (CppGet j1 j2) = f (CppGet (go j1) (go j2))
322+ go (CppMapGet j1 j2) = f (CppMapGet (go j1) (go j2))
323+ go (CppDataGet j1 j2) = f (CppDataGet (go j1) (go j2))
316324 go (CppApp j cpp) = f (CppApp (go j) (map go cpp))
317325 go (CppBlock cpp) = f (CppBlock (map go cpp))
318326 go (CppNamespace name cpp) = f (CppNamespace name (map go cpp))
@@ -344,7 +352,8 @@ everywhereOnCppTopDownM f = f >=> go
344352 go (CppFunction name args rty qs j) = CppFunction name args rty qs <$> f' j
345353 go (CppLambda cps args rty j) = CppLambda cps args rty <$> f' j
346354 go (CppCast t cpp) = CppCast t <$> f' cpp
347− go (CppGet j1 j2) = CppGet <$> f' j1 <*> f' j2
355+ go (CppMapGet j1 j2) = CppMapGet <$> f' j1 <*> f' j2
356+ go (CppDataGet j1 j2) = CppDataGet <$> f' j1 <*> f' j2
348357 go (CppApp j cpp) = CppApp <$> f' j <*> traverse f' cpp
349358 go (CppBlock cpp) = CppBlock <$> traverse f' cpp
350359 go (CppNamespace name cpp) = CppNamespace name <$> traverse f' cpp
@@ -372,7 +381,8 @@ everythingOnCpp (<>) f = go
372381 go j@(CppFunction _ _ _ _ j1) = f j <> go j1
373382 go j@(CppLambda _ _ _ j1) = f j <> go j1
374383 go j@(CppCast _ cpp) = f j <> go cpp
375− go j@(CppGet j1 j2) = f j <> go j1 <> go j2
384+ go j@(CppMapGet j1 j2) = f j <> go j1 <> go j2
385+ go j@(CppDataGet j1 j2) = f j <> go j1 <> go j2
376386 go j@(CppApp j1 cpp) = foldl (<>) (f j <> go j1) (map go cpp)
377387 go j@(CppBlock cpp) = foldl (<>) (f j) (map go cpp)
378388 go j@(CppNamespace _ cpp) = foldl (<>) (f j) (map go cpp)
src/Language/PureScript/CodeGen/Cpp/Common.hs+79−29
@@ -18,12 +18,11 @@
1818
1919module Language.PureScript.CodeGen.Cpp.Common where
2020
21−import Prelude.Compat hiding (all, concatMap, last, init)
21+import Prelude.Compat hiding (all, concatMap, last, init, null)
2222
2323import Data.Char
2424import Data.Text hiding (map)
2525import Data.Monoid ((<>))
26−import qualified Data.Text as T
2726import Language.PureScript.Crash
2827import Language.PureScript.Names
2928
@@ -32,34 +31,72 @@ import Language.PureScript.Names
3231--
3332-- * Alphanumeric characters are kept unmodified.
3433--
35−-- * Reserved C++11 identifiers are wrapped with '_'
34+-- * Reserved C++11 identifiers are suffixed with a '$'
3635--
37−-- * Symbols are wrapped with '_' between a symbol name or their ordinal value.
36+-- * Symbols are prefixed with "$0" plus their ordinal value.
3837--
3938identToCpp :: Ident -> Text
40−identToCpp (Ident name) | nameIsCppReserved name = "_" <> name <> "_"
41−identToCpp (Ident name)
39+identToCpp (Ident name) = safeName name
40+identToCpp (GenIdent _ _) = internalError "GenIdent in identToCpp"
41+
42+safeName :: Text -> Text
43+safeName name
44+ | nameIsCppReserved name = name <> "$"
45+safeName name
4246 | Just ('$', s) <- uncons name
4347 , all isDigit s = name
44−identToCpp (Ident name) = concatMap identCharToString name
45−identToCpp (GenIdent _ _) = internalError "GenIdent in identToCpp"
48+safeName name
49+ | "_" `isPrefixOf` name = "$" <> escaped name
50+safeName name = escaped name
51+
52+escaped :: Text -> Text
53+escaped = escapeDoubleUnderscores . concatMap identCharToText
54+
55+-- |
56+-- C++ actually reserves all identifiers containing double
57+-- underscores.
58+--
59+escapeDoubleUnderscores :: Text -> Text
60+escapeDoubleUnderscores = replace "__" "_$_"
61+
62+unescapeDoubleUnderscores :: Text -> Text
63+unescapeDoubleUnderscores = replace "_$_" "__"
4664
4765-- |
4866-- Test if a string is a valid Cpp identifier without escaping.
4967--
5068identNeedsEscaping :: Text -> Bool
51−identNeedsEscaping s = s /= identToCpp (Ident s)
69+identNeedsEscaping s = s /= safeName s
5270
5371-- |
5472-- Attempts to find a human-readable name for a symbol, if none has been specified returns the
5573-- ordinal value.
5674--
57−identCharToString :: Char -> Text
58−identCharToString c | isAlphaNum c = singleton c
59−identCharToString '_' = "_"
60−identCharToString '.' = "_"
61−identCharToString '\'' = "_prime"
62−identCharToString c = "$0" <> (pack . show $ ord c)
75+identCharToText :: Char -> Text
76+identCharToText c | isAlphaNum c = singleton c
77+identCharToText '_' = "_"
78+identCharToText '.' = "$dot"
79+identCharToText '$' = "$dollar"
80+identCharToText '~' = "$tilde"
81+identCharToText '=' = "$eq"
82+identCharToText '<' = "$less"
83+identCharToText '>' = "$greater"
84+identCharToText '!' = "$bang"
85+identCharToText '#' = "$hash"
86+identCharToText '%' = "$percent"
87+identCharToText '^' = "$up"
88+identCharToText '&' = "$amp"
89+identCharToText '|' = "$bar"
90+identCharToText '*' = "$times"
91+identCharToText '/' = "$div"
92+identCharToText '+' = "$plus"
93+identCharToText '-' = "$minus"
94+identCharToText ':' = "$colon"
95+identCharToText '\\' = "$bslash"
96+identCharToText '?' = "$qmark"
97+identCharToText '@' = "$at"
98+identCharToText '\'' = "$prime"
99+identCharToText c = "$0" <> (pack . show $ ord c)
63100
64101-- |
65102-- Checks whether an identifier name is reserved in C++11.
@@ -73,6 +110,9 @@ nameIsCppReserved name =
73110 , "any"
74111 , "asm"
75112 , "assert"
113+ , "atomic_cancel"
114+ , "atomic_commit"
115+ , "atomic_noexcept"
76116 , "auto"
77117 , "bitand"
78118 , "bitor"
@@ -92,9 +132,12 @@ nameIsCppReserved name =
92132 , "constexpr"
93133 , "const_cast"
94134 , "continue"
95− , "constructor"
135+ , "concept"
136+ , "cstring"
137+ , "ctor"
96138 , "decltype"
97139 , "default"
140+ , "define_symbol"
98141 , "delete"
99142 , "do"
100143 , "double"
@@ -109,7 +152,6 @@ nameIsCppReserved name =
109152 , "float"
110153 , "for"
111154 , "friend"
112− , "get"
113155 , "goto"
114156 , "if"
115157 , "import"
@@ -117,6 +159,9 @@ nameIsCppReserved name =
117159 , "int"
118160 , "list"
119161 , "long"
162+ , "make_managed"
163+ , "make_managed_and_finalized"
164+ , "managed"
120165 , "mutable"
121166 , "namespace"
122167 , "new"
@@ -132,17 +177,14 @@ nameIsCppReserved name =
132177 , "or"
133178 , "or_eq"
134179 , "override"
135− , "param"
136180 , "private"
137181 , "protected"
138182 , "public"
139− , "PureScript"
140183 , "register"
141184 , "reinterpret_cast"
142185 , "requires"
143186 , "return"
144187 , "runtime_error"
145− , "shared_list"
146188 , "short"
147189 , "signed"
148190 , "sizeof"
@@ -154,7 +196,10 @@ nameIsCppReserved name =
154196 , "struct"
155197 , "switch"
156198 , "symbol"
199+ , "symbol_t"
200+ , "synchronized"
157201 , "template"
202+ , "the_value"
158203 , "this"
159204 , "thread_local"
160205 , "throw"
@@ -164,6 +209,7 @@ nameIsCppReserved name =
164209 , "typeid"
165210 , "typename"
166211 , "typeof"
212+ , "undefined"
167213 , "union"
168214 , "unknown_size"
169215 , "unsigned"
@@ -177,17 +223,20 @@ nameIsCppReserved name =
177223 , "xor_eq" ] || properNameIsCppReserved name
178224
179225normalizedName :: Text -> Text
180−normalizedName name
181− | Just ('_', s) <- uncons name
182− , last s == '_'
183− , s' <- init s
184− , nameIsCppReserved s' = s'
185−normalizedName s = s
226+normalizedName = unescapeDoubleUnderscores . normalizedName'
227+ where
228+ normalizedName' name
229+ | null name = ""
230+ normalizedName' name
231+ | last name == '$' = init name
232+ normalizedName' name
233+ | Just ('$', s) <- uncons name = s
234+ normalizedName' s = s
186235
187236moduleNameToCpp :: ModuleName -> Text
188237moduleNameToCpp (ModuleName pns) =
189− let name = T.intercalate "_" (runProperName `map` pns)
190− in if properNameIsCppReserved name then "_" <> name <> "_" else name
238+ let name = intercalate "_" (runProperName `map` pns)
239+ in if properNameIsCppReserved name then name <> "$" else name
191240
192241-- |
193242-- Checks whether a proper name is reserved in C++11.
@@ -195,4 +244,5 @@ moduleNameToCpp (ModuleName pns) =
195244properNameIsCppReserved :: Text -> Bool
196245properNameIsCppReserved name =
197246 name `elem` [ "Private"
198− , "PureScript" ]
247+ , "PureScript"
248+ ]
src/Language/PureScript/CodeGen/Cpp/File.hs+2−2
@@ -124,8 +124,8 @@ toBody = catMaybes . map go
124124 Just $ CppFunction name [("", Just thunkMarkerType)] (Just $ Any [Const, Ref]) [] block
125125 _ -> Just $ CppVariableIntroduction (name, Just $ Any [Const]) [] (Just lambda)
126126 where
127− val = CppVariableIntroduction ("$value$", Just $ Any [Const]) [Static] (Just $ addCaptures cpp)
128− block = CppBlock [val, CppReturn (CppVar "$value$")]
127+ val = CppVariableIntroduction ("the_value", Just $ Any [Const]) [Static] (Just $ addCaptures cpp)
128+ block = CppBlock [val, CppReturn (CppVar "the_value")]
129129 lambda = CppLambda [] [("", Just $ thunkMarkerType)] (Just $ Any [Const, Ref]) block
130130 addCaptures :: Cpp -> Cpp
131131 addCaptures (CppMapLiteral t objs) = CppMapLiteral t (objlam <$> objs)
src/Language/PureScript/CodeGen/Cpp/Optimizer/Common.hs+2−2
@@ -64,7 +64,7 @@ targetVariable :: Cpp -> Text
6464targetVariable (CppVar var) = var
6565targetVariable (CppAccessor _ tgt) = targetVariable tgt
6666targetVariable (CppIndexer _ tgt) = targetVariable tgt
67−targetVariable (CppGet _ tgt) = targetVariable tgt
67+targetVariable (CppMapGet _ tgt) = targetVariable tgt
6868targetVariable _ = error "Invalid argument to targetVariable"
6969
7070isUpdated :: Text -> Cpp -> Bool
@@ -80,7 +80,7 @@ removeFromBlock _ cpp = cpp
8080
8181isFn :: (Text, Text) -> Cpp -> Bool
8282isFn (moduleName, fnName) (CppAccessor (CppVar x) (CppVar y)) =
83− (x == fnName || x == ('$' `cons` fnName)) && y == moduleName
83+ (x == fnName || x == ('*' `cons` fnName)) && y == moduleName
8484isFn (moduleName, fnName) (CppIndexer (CppStringLiteral x) (CppVar y)) =
8585 x == fnName && y == moduleName
8686isFn _ _ = False
src/Language/PureScript/CodeGen/Cpp/Optimizer/Inliner.hs+3−3
@@ -36,7 +36,6 @@ import Language.PureScript.CodeGen.Cpp.AST
3636import Language.PureScript.CodeGen.Cpp.Common
3737import Language.PureScript.CodeGen.Cpp.Optimizer.Common
3838import Language.PureScript.CodeGen.Cpp.Types
39−import Language.PureScript.Names
4039import qualified Language.PureScript.Constants as C
4140
4241-- TODO: Potential bug:
@@ -50,7 +49,8 @@ shouldInline (CppStringLiteral _) = True
5049shouldInline (CppBooleanLiteral _) = True
5150shouldInline (CppAccessor _ val) = shouldInline val
5251shouldInline (CppIndexer index val) = shouldInline index && shouldInline val
53−shouldInline (CppGet index val) = shouldInline index && shouldInline val
52+shouldInline (CppMapGet index val) = shouldInline index && shouldInline val
53+shouldInline (CppDataGet index val) = shouldInline index && shouldInline val
5454shouldInline (CppCast _ val) = shouldInline val
5555shouldInline _ = False
5656
@@ -138,7 +138,7 @@ inlineOperator (m, op) f = everywhereOnCpp convert
138138 convert (CppApp op' [x, y]) | isOp op' = f x y
139139 convert (CppApp (CppApp op' [x]) [y]) | isOp op' = f x y
140140 convert other = other
141− isOp (CppAccessor (CppVar longForm) (CppVar m')) = m == m' && longForm == identToCpp (Ident op)
141+ isOp (CppAccessor (CppVar longForm) (CppVar m')) = m == m' && longForm == safeName op
142142 isOp (CppIndexer (CppStringLiteral op') (CppVar m')) = m == m' && op == op'
143143 isOp _ = False
144144
src/Language/PureScript/CodeGen/Cpp/Optimizer/MagicDo.hs+2−1
@@ -21,6 +21,7 @@ import Data.List (nub)
2121import Data.Maybe (fromJust, isJust)
2222
2323import Language.PureScript.CodeGen.Cpp.AST
24+import Language.PureScript.CodeGen.Cpp.Common
2425import Language.PureScript.CodeGen.Cpp.Optimizer.Common
2526import Language.PureScript.CodeGen.Cpp.Types
2627import Language.PureScript.Options
@@ -62,7 +63,7 @@ magicDo' = everywhereOnCpp undo . everywhereOnCppTopDown convert
6263 convert (CppApp (CppApp bind [m]) [CppLambda _ [arg] rty (CppBlock cpp)]) | isBind bind =
6364 CppFunction fnName [] rty [] $ CppBlock (app' : map applyReturns cpp)
6465 where
65− app' | fst arg == C.__unused = CppApp m []
66+ app' | arg' <- fst arg, arg' == C.__unused || arg' == (safeName C.__unused) = CppApp m []
6667 | otherwise = CppVariableIntroduction arg [] (Just (CppApp m []))
6768 -- Desugar untilE
6869 convert (CppApp (CppApp f [arg]) []) | isEffFunc C.untilE f =
src/Language/PureScript/CodeGen/Cpp/Optimizer/TCO.hs+2−2
@@ -39,10 +39,10 @@ tco' :: Cpp -> Cpp
3939tco' = everywhereOnCpp convert
4040 where
4141 tcoVar :: Text -> Text
42− tcoVar arg = "__tco_" <> arg
42+ tcoVar arg = "tco$" <> arg
4343
4444 copyVar :: Text -> Text
45− copyVar arg = "__copy_" <> arg
45+ copyVar arg = "copy$" <> arg
4646
4747 copyVar' :: (Text, Maybe CppType) -> (Text, Maybe CppType)
4848 copyVar' (arg, t) = (copyVar arg, t)
src/Language/PureScript/CodeGen/Cpp/Optimizer/Uncurry.hs+1−1
@@ -39,7 +39,7 @@ removeCurrying nm = everywhereOnCpp convert
3939 unCurried (CppAccessor var mn)
4040 | Just var' <- unCurried var = Just $ CppAccessor var' mn
4141 unCurried (CppVar name)
42− | Just ('$', name') <- uncons name = Just $ CppVar name'
42+ | Just ('*', name') <- uncons name = Just $ CppVar name'
4343 unCurried _ = Nothing
4444 convert cpp = cpp
4545
src/Language/PureScript/CodeGen/Cpp/Optimizer/Unused.hs+2−2
@@ -16,8 +16,8 @@
1616module Language.PureScript.CodeGen.Cpp.Optimizer.Unused where
1717
1818import Prelude.Compat
19−
2019import Language.PureScript.CodeGen.Cpp.AST
20+import Language.PureScript.CodeGen.Cpp.Common
2121import Language.PureScript.CodeGen.Cpp.Optimizer.Common
2222
2323import qualified Language.PureScript.Constants as C
@@ -43,5 +43,5 @@ removeUnusedArg :: Cpp -> Cpp
4343removeUnusedArg = everywhereOnCpp convert
4444 where
4545 convert (CppFunction name [(arg,atyp)] rtyp qs body)
46− | arg == C.__unused = CppFunction name [("",atyp)] rtyp qs body
46+ | arg == C.__unused || arg == (safeName C.__unused) = CppFunction name [("",atyp)] rtyp qs body
4747 convert cpp = cpp
src/Language/PureScript/CodeGen/Cpp/Types.hs+11−5
@@ -147,11 +147,17 @@ arrayType = Primitive "any::array"
147147thunkMarkerType :: CppType
148148thunkMarkerType = Primitive "any::as_thunk"
149149
150−ctorKey :: Text
151−ctorKey = "constructor"
150+mapNS :: Text
151+mapNS = "map"
152+
153+dataNS :: Text
154+dataNS = "data"
155+
156+ctorNS :: Text
157+ctorNS = "ctor"
158+
159+getCtor :: Text
160+getCtor = dataNS <> "::ctor"
152161
153162constAnyRef :: Maybe CppType
154163constAnyRef = Just $ Any [Const, Ref]
155−
156−symbolname :: Text -> Text
157−symbolname = identToCpp . Ident
src/Language/PureScript/Parser/Lexer.hs+3−3
@@ -247,7 +247,7 @@ parseToken = P.choice
247247
248248 symbolChar :: Lexer u Char
249249 symbolChar = P.satisfy isSymbolChar
250−
250+{-
251251 surrogates :: Char -> (Char, Char)
252252 surrogates c = (high, low)
253253 where
@@ -259,7 +259,7 @@ parseToken = P.choice
259259 expandAstralCodePointToUTF16Surrogates c | fromEnum c > 0xFFFF = [high, low]
260260 where (high, low) = surrogates c
261261 expandAstralCodePointToUTF16Surrogates c = [c]
262−
262+-}
263263 parseCharLiteral :: Lexer u Char
264264 parseCharLiteral = P.try $ do {
265265 c <- PT.charLiteral tokenParser;
@@ -269,7 +269,7 @@ parseToken = P.choice
269269 }
270270
271271 parseStringLiteral :: Lexer u Text
272− parseStringLiteral = blockString <|> T.pack <$> concatMap expandAstralCodePointToUTF16Surrogates <$> PT.stringLiteral tokenParser
272+ parseStringLiteral = blockString <|> T.pack <$> {- concatMap expandAstralCodePointToUTF16Surrogates <$> -} PT.stringLiteral tokenParser
273273 where
274274 delimiter = P.try (P.string "\"\"\"")
275275 blockString = delimiter *> (T.pack <$> P.manyTill P.anyChar delimiter)
src/Language/PureScript/Pretty/Cpp.hs+18−22
@@ -36,12 +36,12 @@ import Control.Applicative
3636import Control.Arrow ((<+>))
3737import qualified Control.Arrow as A
3838import Control.Monad.State
39−import Numeric (showHex)
4039import Control.PatternArrows
4140
4241import Language.PureScript.CodeGen.Cpp.AST
4342import Language.PureScript.CodeGen.Cpp.Types
4443import Language.PureScript.Comments
44+import Language.PureScript.CodeGen.Cpp.Common
4545import qualified Language.PureScript.Constants as C
4646import Language.PureScript.Pretty.Common (PrinterState(..), intercalate, parensT)
4747
@@ -129,7 +129,7 @@ literals = mkPattern' match
129129 match (CppFunction name args rty qs ret) = mconcat <$> sequence
130130 [ return . T.concat . fmap (<> " ") . filter (not . T.null) $ runValueQual <$> qs
131131 , return "auto "
132− , return name
132+ , return $ renderName name
133133 , return $ parensT (T.intercalate ", " $ argstr <$> args)
134134 , return (maybe "" ((" -> " <>) . runType) rty)
135135 , if ret /= CppNoOp
@@ -237,17 +237,16 @@ literals = mkPattern' match
237237 vstr = prettyPrintCpp1 val
238238 val' | "(" `T.isInfixOf` vstr || "[" `T.isInfixOf` vstr = parensT vstr
239239 | otherwise = vstr
240− match (CppGet i@(CppSymbol _) val) =
241− return . prettyPrintCpp1 $ CppApp (CppVar "get") [i, val]
242− match (CppGet i val) =
243− return . prettyPrintCpp1 $ CppApp (CppVar $ "get" <> angles (prettyPrintCpp1 i)) [val]
244− match (CppVar ident)
245− | ident == C.__unused = match (CppVar $ '$' `T.cons` ident)
246− match (CppVar ident) = return ident
247− match (CppSymbol ident) = return $ "SYMBOL" <> parensT (symbolname ident)
240+ match (CppMapGet i@(CppSymbol _) val) =
241+ return . prettyPrintCpp1 $ CppApp (CppVar $ mapNS <> "::get") [i, val]
242+ match (CppMapGet i val) =
243+ return . prettyPrintCpp1 $ CppApp (CppVar $ mapNS <> "::get" <> angles (prettyPrintCpp1 i)) [val]
244+ match (CppDataGet i val) =
245+ return . prettyPrintCpp1 $ CppApp (CppVar $ dataNS <> "::get" <> angles (prettyPrintCpp1 i)) [val]
246+ match (CppVar ident) = return $ renderName ident
247+ match (CppSymbol ident) = return $ "symbol" <> parensT (safeName ident)
248+ match (CppDefineSymbol ident) = return $ "define_symbol" <> parensT (safeName ident)
248249 match (CppApp v [CppNoOp]) = return (prettyPrintCpp1 v)
249− match (CppVariableIntroduction (ident, typ) qs value)
250− | ident == C.__unused = match (CppVariableIntroduction ('$' `T.cons` ident, typ) qs value)
251250 match (CppVariableIntroduction (ident, typ) qs value) =
252251 mconcat <$> sequence
253252 [ return . T.concat . fmap (<> " ") . filter (not . T.null) $ runValueQual <$> qs
@@ -355,6 +354,7 @@ string :: Text -> Text
355354string s = "\"" <> T.concatMap encodeChar s <> "\""
356355 where
357356 encodeChar :: Char -> Text
357+ encodeChar '\0' = "\\0"
358358 encodeChar '\b' = "\\b"
359359 encodeChar '\t' = "\\t"
360360 encodeChar '\n' = "\\n"
@@ -363,17 +363,8 @@ string s = "\"" <> T.concatMap encodeChar s <> "\""
363363 encodeChar '\r' = "\\r"
364364 encodeChar '"' = "\\\""
365365 encodeChar '\\' = "\\\\"
366− -- PureScript strings are sequences of UTF-16 code units, so this case should never be hit.
367− -- If it is somehow hit, though, output the designated Unicode replacement character U+FFFD.
368− encodeChar c | fromEnum c > 0xFFFF = "\\uFFFD"
369− encodeChar c | fromEnum c > 0xFFF = "\\u" <> showHex' (fromEnum c) ""
370− encodeChar c | fromEnum c > 0xFF = "\\u0" <> showHex' (fromEnum c) ""
371− encodeChar c | fromEnum c < 0x10 = "\\x0" <> showHex' (fromEnum c) ""
372− encodeChar c | fromEnum c > 0x7E || fromEnum c < 0x20 = "\\x" <> showHex' (fromEnum c) ""
373366 encodeChar c = T.singleton c
374367
375− showHex' a b = T.pack (showHex a b)
376−
377368accessor :: Pattern PrinterState Cpp (Text, Cpp)
378369accessor = mkPattern match
379370 where
@@ -515,7 +506,7 @@ dotsTo chr' = T.map (\c -> if c == '.' then chr' else c)
515506argstr :: (Text, Maybe CppType) -> Text
516507argstr (name, Nothing) = argStr name (Auto [])
517508argstr (name, Just typ)
518− | name == C.__unused = argStr "" typ
509+ | name == C.__unused || name == (safeName C.__unused) = argStr "" typ
519510argstr (name, Just typ) = argStr name typ
520511
521512argStr :: Text -> CppType -> Text
@@ -546,3 +537,8 @@ isNoOp :: Cpp -> Bool
546537isNoOp CppNoOp = True
547538isNoOp (CppComment [] CppNoOp) = True
548539isNoOp _ = False
540+
541+renderName :: Text -> Text
542+renderName name
543+ | Just ('*', name') <- T.uncons name = '$' `T.cons` name'
544+ | otherwise = name
stack.yaml+5−1
@@ -1,3 +1,7 @@
1−resolver: lts-7.8
1+resolver: lts-7.9
22packages:
33- '.'
4+extra-deps:
5+- pipes-http-1.0.2
6+- wai-websockets-3.0.0.9
7+- websockets-0.9.6.2