git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
C++: multiple changes to improve symbol/name mangling and handling"
3f816d0Andy Arvanitis
pcc/TestMain.hs+2
compare with golang
unifiedsplit
@@ -133,6 +133,8 @@ skipped :: [String]
133skipped =
133skipped =
134 [ "NumberLiterals.purs" -- unreliable float comparison, test manually
134 [ "NumberLiterals.purs" -- unreliable float comparison, test manually
135 , "FunWithFunDeps.purs" -- requires FFI
135 , "FunWithFunDeps.purs" -- requires FFI
136+ , "SolvingIsSymbol.purs"
137+ , "StringEscapes.purs"
136 ]
138 ]
137
139
138logpath :: FilePath
140logpath :: FilePath
pcc/runtime/purescript.cc+9−1
@@ -87,7 +87,7 @@ auto any::unthunkVariant(const any& a) -> const any& {
87}
87}
88
88
89auto any::operator[](const symbol_t key) const -> const any& {
89auto 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));
91}
91}
92
92
93auto any::operator[](const size_t rhs) const -> const any& {
93auto any::operator[](const size_t rhs) const -> const any& {
@@ -100,6 +100,14 @@ auto any::operator[](const any& rhs) const -> const any& {
100 return xs[cast<int>(rhs)];
100 return xs[cast<int>(rhs)];
101}
101}
102
102
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+
103auto any::contains(const symbol_t key) const -> bool {
111auto any::contains(const symbol_t key) const -> bool {
104 // TODO: assumes at least one element -- safe assumption?
112 // TODO: assumes at least one element -- safe assumption?
105 const auto& m = cast<map<unknown_size>>(*this);
113 const auto& m = cast<map<unknown_size>>(*this);
pcc/runtime/purescript.hh+93−48
@@ -46,17 +46,27 @@ namespace PureScript {
46using cstring = const char *;
46using cstring = const char *;
47using std::nullptr_t;
47using std::nullptr_t;
48
48
49−struct symbol_generator_anchor {};
49+namespace Private {
50−using symbol_t = const symbol_generator_anchor *;
50+ struct symbol_generator_anchor_t {};
51
51
52−template <typename T>
52+ template <typename T>
53−struct symbol_generator {
53+ struct symbol_generator {
54− constexpr static symbol_generator_anchor anchor = symbol_generator_anchor{};
54+ constexpr static symbol_generator_anchor_t anchor = symbol_generator_anchor_t{};
55−};
55+ };
56−template <typename T>
56+ template <typename T>
57−constexpr symbol_generator_anchor symbol_generator<T>::anchor;
57+ constexpr symbol_generator_anchor_t symbol_generator<T>::anchor;
58+}
59+
60+using symbol_t = const Private::symbol_generator_anchor_t *;
58
61
62+#define define_symbol(S) namespace PureScript { \
63+ namespace Private { \
64+ namespace Symbol { \
65+ struct S_ ## S {}; \
66+ } \
67+ } \
68+ }
59−#define SYMBOL(S) &symbol_generator<symbol::S>::anchor
69+#define symbol(S) (&Private::symbol_generator<::PureScript::Private::Symbol::S_ ## S>::anchor)
60
70
61// Workaround for missing C++11 version in gcc
71// Workaround for missing C++11 version in gcc
62class runtime_error : public std::runtime_error {
72class runtime_error : public std::runtime_error {
@@ -65,7 +75,6 @@ public:
65};
75};
66
76
67constexpr bool undefined = false;
77constexpr bool undefined = false;
68−constexpr size_t constructor = 0;
69
78
70// Not a real limit, just used for simpler accessors
79// Not a real limit, just used for simpler accessors
71static constexpr size_t unknown_size = 64;
80static constexpr size_t unknown_size = 64;
@@ -123,10 +132,10 @@ class any {
123 };
132 };
124
133
125 template <typename T>
134 template <typename T>
126− class _closure : public closure {
135+ class closure_ : public closure {
127 const T lambda;
136 const T lambda;
128 public:
137 public:
129− _closure(const T& l) noexcept : lambda(l) {}
138+ closure_(const T& l) noexcept : lambda(l) {}
130 auto operator()(const any& arg) const -> any override {
139 auto operator()(const any& arg) const -> any override {
131 return lambda(arg);
140 return lambda(arg);
132 }
141 }
@@ -139,10 +148,10 @@ class any {
139 };
148 };
140
149
141 template <typename T>
150 template <typename T>
142− class _eff_closure : public eff_closure {
151+ class eff_closure_ : public eff_closure {
143 const T lambda;
152 const T lambda;
144 public:
153 public:
145− _eff_closure(const T& l) noexcept : lambda(l) {}
154+ eff_closure_(const T& l) noexcept : lambda(l) {}
146 auto operator()() const -> any override {
155 auto operator()() const -> any override {
147 return lambda();
156 return lambda();
148 }
157 }
@@ -206,7 +215,7 @@ class any {
206 template <typename T, typename = typename std::enable_if<!std::is_same<any,T>::value &&
215 template <typename T, typename = typename std::enable_if<!std::is_same<any,T>::value &&
207 !std::is_convertible<T,fn>::value>::type>
216 !std::is_convertible<T,fn>::value>::type>
208 any(const T& val, typename std::enable_if<std::is_assignable<std::function<any(const any&)>,T>::value>::type* = 0)
217 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)) {}
210
219
211 template <typename T>
220 template <typename T>
212 any(const T& val, typename std::enable_if<std::is_convertible<T,eff_fn>::value>::type* = 0) noexcept
221 any(const T& val, typename std::enable_if<std::is_convertible<T,eff_fn>::value>::type* = 0) noexcept
@@ -216,7 +225,7 @@ class any {
216 typename = typename std::enable_if<!std::is_same<any,T>::value &&
225 typename = typename std::enable_if<!std::is_same<any,T>::value &&
217 !std::is_convertible<T,eff_fn>::value>::type>
226 !std::is_convertible<T,eff_fn>::value>::type>
218 any(const T& val, typename std::enable_if<std::is_assignable<std::function<any()>,T>::value>::type* = 0)
227 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)) {}
220
229
221 template <typename T>
230 template <typename T>
222 any(const T& val, typename std::enable_if<std::is_convertible<T,thunk>::value>::type* = 0) noexcept
231 any(const T& val, typename std::enable_if<std::is_convertible<T,thunk>::value>::type* = 0) noexcept
@@ -340,6 +349,8 @@ class any {
340 auto operator[](const size_t) const -> const any&;
349 auto operator[](const size_t) const -> const any&;
341 auto operator[](const any&) const -> const any&;
350 auto operator[](const any&) const -> const any&;
342
351
352+ auto size() const -> size_t;
353+ auto empty() const -> bool;
343 auto contains(const symbol_t) const -> bool;
354 auto contains(const symbol_t) const -> bool;
344
355
345 auto extractPointer(IF_DEBUG(const tag_t)) const -> void*;
356 auto extractPointer(IF_DEBUG(const tag_t)) const -> void*;
@@ -411,23 +422,31 @@ class any {
411
422
412}; // class any
423}; // class any
413
424
425+namespace Private {
414−template <typename T, typename U=void>
426+ template <typename T, typename U=void>
415−struct tag_helper {};
427+ struct tag_helper_t {};
416
428
417−template <size_t N>
429+ template <size_t N>
418−struct tag_helper<any::map<N>> {
430+ struct tag_helper_t<any::map<N>> {
419− static constexpr any::tag_t tag = any::tag_t::Map;
431+ static constexpr any::tag_t tag = any::tag_t::Map;
420−};
432+ };
421
433
422−template <size_t N>
434+ template <size_t N>
423−struct tag_helper<any::data<N>> {
435+ struct tag_helper_t<any::data<N>> {
424− static constexpr any::tag_t tag = any::tag_t::Data;
436+ static constexpr any::tag_t tag = any::tag_t::Data;
425−};
437+ };
426
438
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
427template <typename T>
446template <typename T>
428−struct tag_helper<T> {
447+constexpr auto cast(const T& a) -> const T& {
429− static constexpr any::tag_t tag = any::tag_t::Pointer;
448+ return a;
430−};
449+}
431
450
432template <typename T>
451template <typename T>
433inline auto cast(const any& a) ->
452inline auto cast(const any& a) ->
@@ -445,7 +464,7 @@ inline auto cast(const any& a) ->
445template <typename T, typename = typename std::enable_if<std::is_class<T>::value>::type>
464template <typename T, typename = typename std::enable_if<std::is_class<T>::value>::type>
446inline auto cast(const any& a) ->
465inline auto cast(const any& a) ->
447 typename std::enable_if<!std::is_same<T, any::array>::value, T&>::type {
466 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)));
449}
468}
450
469
451template <typename T>
470template <typename T>
@@ -454,27 +473,53 @@ inline auto cast(const any& a) ->
454 return a.rawPointer();
473 return a.rawPointer();
455}
474}
456
475
476+namespace map {
457−template <size_t N>
477+ template <size_t N, typename T>
458−inline auto get(const any& a) -> const any& {
478+ inline auto get(const T& a) ->
479+ typename std::enable_if<!std::is_same<any, T>::value, const any&>::type {
459− return cast<any::map<N+1>>(a)[N].second;
480+ return a[N].second;
460−}
481+ }
461
482
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+
462−template <size_t N>
488+ template <size_t N>
463−inline auto get(const symbol_t key, const any::map<N>& a) -> const any& {
489+ 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
490+ static_assert(N > 0, "map size must be greater than zero");
465− typename std::remove_reference<decltype(a)>::type::size_type i = 0;
491+ typename std::remove_reference<decltype(a)>::type::size_type i = 0;
466− do {
492+ do {
467− if (a[i].first == key) {
493+ if (a[i].first == key) {
468− return a[i].second;
494+ return a[i].second;
469− }
495+ }
470− } while (a[++i].first != nullptr);
496+ } while (a[++i].first != nullptr);
471− assert(false && "map key not found");
497+ assert(false && "map key not found");
472− static const any invalid_key(nullptr);
498+ static const any invalid_key(nullptr);
473− return invalid_key;
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+ }
474}
505}
475
506
507+namespace data {
508+ template <size_t N, typename T>
476−inline auto get(const symbol_t key, const any& a) -> const any& {
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& {
477− return get(key, cast<any::map<unknown_size>>(a));
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+ }
478}
523}
479
524
480} // namespace PureScript
525} // namespace PureScript
pcc/support/psc-package.json+1−1
@@ -1,6 +1,6 @@
1{
1{
2 "name": "Main",
2 "name": "Main",
3− "set": "psc-0.10.2",
3+ "set": "psc-0.10.3",
4 "source": "https://github.com/pure11/package-sets.git",
4 "source": "https://github.com/pure11/package-sets.git",
5 "depends": [
5 "depends": [
6 "console",
6 "console",
src/Language/PureScript/CodeGen/Cpp.hs+25−37
@@ -110,7 +110,7 @@ moduleToCpp otherOpts env (Module _ mn imps _ foreigns decls) = do
110 symbols = allSymbols bodyCpps
110 symbols = allSymbols bodyCpps
111 moduleBody =
111 moduleBody =
112 CppInclude (runModuleName mn) (runModuleName mn) :
112 CppInclude (runModuleName mn) (runModuleName mn) :
113− symbolDefs symbols :
113+ (CppDefineSymbol <$> symbols) ++
114 (if null bodyCpps
114 (if null bodyCpps
115 then []
115 then []
116 else [ CppNamespace (runModuleName mn) $
116 else [ CppNamespace (runModuleName mn) $
@@ -235,7 +235,7 @@ moduleToCpp otherOpts env (Module _ mn imps _ foreigns decls) = do
235 isAccessor Accessor {} = True
235 isAccessor Accessor {} = True
236 isAccessor _ = False
236 isAccessor _ = False
237 isGet :: Cpp -> Bool
237 isGet :: Cpp -> Bool
238− isGet (CppGet (CppSymbol _) (CppVar _)) = True
238+ isGet (CppMapGet (CppSymbol _) (CppVar _)) = True
239 isGet _ = False
239 isGet _ = False
240 classes =
240 classes =
241 zip
241 zip
@@ -249,7 +249,7 @@ moduleToCpp otherOpts env (Module _ mn imps _ foreigns decls) = do
249 []
249 []
250 (Just $ Any [])
250 (Just $ Any [])
251 [Inline]
251 [Inline]
252− (returnBlock $ CppDataLiteral [CppAccessor (CppVar $ identToCpp ident) (CppVar "data")])
252+ (returnBlock $ CppDataLiteral [CppAccessor (CppVar $ identToCpp ident) (CppVar ctorNS)])
253 declToCpp _ (_, ident) (Constructor _ _ (ProperName _) fields) =
253 declToCpp _ (_, ident) (Constructor _ _ (ProperName _) fields) =
254 return . CppNamespace "" $
254 return . CppNamespace "" $
255 [ CppFunction
255 [ CppFunction
@@ -258,7 +258,7 @@ moduleToCpp otherOpts env (Module _ mn imps _ foreigns decls) = do
258 (Just $ Any [])
258 (Just $ Any [])
259 [Inline]
259 [Inline]
260 (returnBlock $
260 (returnBlock $
261− CppDataLiteral $ CppAccessor (CppVar name) (CppVar "data") : (CppVar <$> fields'))
261+ CppDataLiteral $ CppAccessor (CppVar name) (CppVar ctorNS) : (CppVar <$> fields'))
262 ] ++
262 ] ++
263 if length fields > 0
263 if length fields > 0
264 then [ CppFunction
264 then [ CppFunction
@@ -387,13 +387,12 @@ moduleToCpp otherOpts env (Module _ mn imps _ foreigns decls) = do
387 accessed dictname name =
387 accessed dictname name =
388 ( name
388 ( name
389 , CppApp
389 , CppApp
390− (CppIndexer
390+ (CppDataGet
391 (CppNumericLiteral . Left . fromIntegral . fromJust $ findIndex ((== name) . fst) fns)
391 (CppNumericLiteral . Left . fromIntegral . fromJust $ findIndex ((== name) . fst) fns)
392− dict'')
392+ dict')
393 [dict'])
393 [dict'])
394 where
394 where
395 dict' = CppVar dictname
395 dict' = CppVar dictname
396− dict'' = CppCast (dataType 1) dict'
397 accessor :: Text -> (Text, Cpp) -> Cpp
396 accessor :: Text -> (Text, Cpp) -> Cpp
398 accessor dictname (name, _) =
397 accessor dictname (name, _) =
399 CppVariableIntroduction (name, Just $ Any [Const]) [] (Just . snd $ accessed dictname name)
398 CppVariableIntroduction (name, Just $ Any [Const]) [] (Just . snd $ accessed dictname name)
@@ -444,13 +443,13 @@ moduleToCpp otherOpts env (Module _ mn imps _ foreigns decls) = do
444 valueToCpp (Literal _ (ObjectLiteral ps)) =
443 valueToCpp (Literal _ (ObjectLiteral ps)) =
445 CppMapLiteral Record <$>
444 CppMapLiteral Record <$>
446 mapM (sndM valueToCpp) ((\(k, v) -> (CppSymbol k, v)) <$> sortBy (compare `on` fst) ps)
445 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
448 -- TODO: use a more efficient way of copying/updating the map?
447 -- TODO: use a more efficient way of copying/updating the map?
449 valueToCpp (ObjectUpdate (_, _, Just ty, _) obj ps) = do
448 valueToCpp (ObjectUpdate (_, _, Just ty, _) obj ps) = do
450 obj' <- valueToCpp obj
449 obj' <- valueToCpp obj
451 updatedFields <- mapM (sndM valueToCpp) ps
450 updatedFields <- mapM (sndM valueToCpp) ps
452 let origKeys = (allKeys ty) \\ (fst <$> updatedFields)
451 let origKeys = (allKeys ty) \\ (fst <$> updatedFields)
453− origFields = (\key -> (key, CppGet (CppSymbol key) obj')) <$> origKeys
452+ origFields = (\key -> (key, CppMapGet (CppSymbol key) obj')) <$> origKeys
454 return $
453 return $
455 CppMapLiteral Record $
454 CppMapLiteral Record $
456 (\(k, v) -> (CppSymbol k, v)) <$> sortBy (compare `on` fst) (origFields ++ updatedFields)
455 (\(k, v) -> (CppSymbol k, v)) <$> sortBy (compare `on` fst) (origFields ++ updatedFields)
@@ -603,7 +602,7 @@ moduleToCpp otherOpts env (Module _ mn imps _ foreigns decls) = do
603 [ CppIfElse
602 [ CppIfElse
604 (CppBinary
603 (CppBinary
605 EqualTo
604 EqualTo
606− (CppIndexer (CppVar ctorKey) (CppCast (dataType 1) $ CppVar varName))
605+ (CppApp (CppVar getCtor) [CppVar varName])
607 ctorCpp)
606 ctorCpp)
608 (CppBlock cpps)
607 (CppBlock cpps)
609 Nothing
608 Nothing
@@ -620,16 +619,16 @@ moduleToCpp otherOpts env (Module _ mn imps _ foreigns decls) = do
620 (argVar, Nothing)
619 (argVar, Nothing)
621 []
620 []
622 (Just $
621 (Just $
623− CppIndexer
622+ CppDataGet
624 (fieldToIndex' field)
623 (fieldToIndex' field)
625− (CppCast (dataType $ fieldToIndex field + 1) $ CppVar varName)) :
624+ (CppVar varName)) :
626 cpps
625 cpps
627 fieldToIndex :: Ident -> Int
626 fieldToIndex :: Ident -> Int
628 fieldToIndex = (+ 1) . read . dropWhile isLetter . unpack . runIdent
627 fieldToIndex = (+ 1) . read . dropWhile isLetter . unpack . runIdent
629 fieldToIndex' :: Ident -> Cpp
628 fieldToIndex' :: Ident -> Cpp
630 fieldToIndex' = CppNumericLiteral . Left . toInteger . fieldToIndex
629 fieldToIndex' = CppNumericLiteral . Left . toInteger . fieldToIndex
631 ctor' :: Cpp
630 ctor' :: Cpp
632− ctor' = CppAccessor (CppVar . identToCpp $ Ident ctor) (CppVar "data")
631+ ctor' = CppAccessor (CppVar $ safeName ctor) (CppVar ctorNS)
633 ctorCpp :: Cpp
632 ctorCpp :: Cpp
634 ctorCpp
633 ctorCpp
635 | Just mn'' <- mn'
634 | Just mn'' <- mn'
@@ -678,18 +677,16 @@ moduleToCpp otherOpts env (Module _ mn imps _ foreigns decls) = do
678 CppVariableIntroduction
677 CppVariableIntroduction
679 (propVar, Nothing)
678 (propVar, Nothing)
680 []
679 []
681− (Just $ CppGet (CppSymbol prop) (CppVar varName)) :
680+ (Just $ CppMapGet (CppSymbol prop) (CppVar varName)) :
682 cpp
681 cpp
683 literalToBinderCpp varName done (ArrayLiteral bs) = do
682 literalToBinderCpp varName done (ArrayLiteral bs) = do
684 cpp <- go done 0 bs
683 cpp <- go done 0 bs
685 let cond =
684 let cond =
686 case length bs of
685 case length bs of
687− 0 -> CppBinary Dot (CppCast arrayType $ CppVar varName) (CppApp (CppVar "empty") [])
686+ 0 -> CppBinary Dot (CppVar varName) (CppApp (CppVar "empty") [])
688− n ->
689− let var = CppCast arrayType $ CppVar varName
690− in CppBinary
687+ n -> CppBinary
691 EqualTo
688 EqualTo
692− (CppBinary Dot var (CppApp (CppVar "size") []))
689+ (CppBinary Dot (CppVar varName) (CppApp (CppVar "size") []))
693 (CppNumericLiteral (Left (fromIntegral n)))
690 (CppNumericLiteral (Left (fromIntegral n)))
694 return [CppIfElse cond (CppBlock cpp) Nothing]
691 return [CppIfElse cond (CppBlock cpp) Nothing]
695 where
692 where
@@ -753,7 +750,7 @@ moduleToCpp otherOpts env (Module _ mn imps _ foreigns decls) = do
753 -------------------------------------------------------------------------------------------------
750 -------------------------------------------------------------------------------------------------
754 dataCtors =
751 dataCtors =
755 [ CppNamespace
752 [ CppNamespace
756− "data"
753+ ctorNS
757 [ CppEnum Nothing (Just intType) . ("_" :) . catMaybes . map modCtor . M.keys $
754 [ CppEnum Nothing (Just intType) . ("_" :) . catMaybes . map modCtor . M.keys $
758 E.dataConstructors env
755 E.dataConstructors env
759 ]
756 ]
@@ -761,7 +758,7 @@ moduleToCpp otherOpts env (Module _ mn imps _ foreigns decls) = do
761 where
758 where
762 modCtor :: Qualified (ProperName a) -> Maybe Text
759 modCtor :: Qualified (ProperName a) -> Maybe Text
763 modCtor (Qualified (Just mn') (ProperName name))
760 modCtor (Qualified (Just mn') (ProperName name))
764− | mn' == mn = Just $ identToCpp (Ident name)
761+ | mn' == mn = Just (safeName name)
765 modCtor _ = Nothing
762 modCtor _ = Nothing
766 -------------------------------------------------------------------------------------------------
763 -------------------------------------------------------------------------------------------------
767 curriedForeigns :: m [Cpp]
764 curriedForeigns :: m [Cpp]
@@ -840,10 +837,10 @@ optIndexers :: [(Cpp, Cpp)] -> Cpp -> Cpp
840optIndexers classes = everywhereOnCpp dictIndexerToEnum
837optIndexers classes = everywhereOnCpp dictIndexerToEnum
841 where
838 where
842 dictIndexerToEnum :: Cpp -> Cpp
839 dictIndexerToEnum :: Cpp -> Cpp
843− dictIndexerToEnum (CppGet (CppSymbol prop) dict)
840+ dictIndexerToEnum (CppMapGet (CppSymbol prop) dict)
844 | Just cls <- lookup dict classes =
841 | Just cls <- lookup dict classes =
845− let index = CppAccessor (CppVar . identToCpp $ Ident prop) cls
842+ let index = CppAccessor (CppVar $ safeName prop) cls
846− in CppGet index dict
843+ in CppMapGet index dict
847 dictIndexerToEnum cpp = cpp
844 dictIndexerToEnum cpp = cpp
848
845
849---------------------------------------------------------------------------------------------------
846---------------------------------------------------------------------------------------------------
@@ -852,8 +849,8 @@ curriedName :: Text -> Text
852curriedName name
849curriedName name
853 | Text.null name = name
850 | Text.null name = name
854curriedName name
851curriedName name
855− | Text.head name == '$' = name
852+ | Text.head name == '*' = name
856− | otherwise = '$' `Text.cons` name
853+ | otherwise = '*' `Text.cons` name
857
854
858---------------------------------------------------------------------------------------------------
855---------------------------------------------------------------------------------------------------
859curriedName' :: Cpp -> Cpp
856curriedName' :: Cpp -> Cpp
@@ -889,7 +886,7 @@ convertIfPrimFn :: Maybe T.Type -> Cpp -> Cpp
889convertIfPrimFn ty@(Just _) (CppNamespace ns fs) = CppNamespace ns (convertIfPrimFn ty <$> fs)
886convertIfPrimFn ty@(Just _) (CppNamespace ns fs) = CppNamespace ns (convertIfPrimFn ty <$> fs)
890convertIfPrimFn (Just _) cpp@(CppFunction name _ _ _ _)
887convertIfPrimFn (Just _) cpp@(CppFunction name _ _ _ _)
891 | not $ Text.null name
888 | not $ Text.null name
892− , Text.head name == '$' = cpp
889+ , Text.head name == '*' = cpp
893convertIfPrimFn (Just ty) (CppFunction name params _ qs body)
890convertIfPrimFn (Just ty) (CppFunction name params _ qs body)
894 | (tys', Just rty') <- primFn ty =
891 | (tys', Just rty') <- primFn ty =
895 CppFunction name (zipWith (\(p, _) t -> (p, Just t)) params tys') (Just rty') qs body
892 CppFunction name (zipWith (\(p, _) t -> (p, Just t)) params tys') (Just rty') qs body
@@ -901,18 +898,9 @@ allSymbols :: [Cpp] -> [Text]
901allSymbols cpps = nub $ concatMap (everythingOnCpp (++) symbols) cpps
898allSymbols cpps = nub $ concatMap (everythingOnCpp (++) symbols) cpps
902 where
899 where
903 symbols :: Cpp -> [Text]
900 symbols :: Cpp -> [Text]
904− symbols (CppSymbol s) = [symbolname s]
901+ symbols (CppSymbol s) = [s]
905 symbols _ = []
902 symbols _ = []
906
903
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−
916---------------------------------------------------------------------------------------------------
904---------------------------------------------------------------------------------------------------
917filterInlineFuncs :: Cpp -> Cpp
905filterInlineFuncs :: Cpp -> Cpp
918---------------------------------------------------------------------------------------------------
906---------------------------------------------------------------------------------------------------
src/Language/PureScript/CodeGen/Cpp/AST.hs+15−5
@@ -204,9 +204,13 @@ data Cpp
204 --
204 --
205 | CppCast CppType Cpp
205 | CppCast CppType Cpp
206 -- |
206 -- |
207− -- Call to getter from templated type
207+ -- Call to getter from templated map type
208 --
208 --
209+ | CppMapGet Cpp Cpp
210+ -- |
211+ -- Call to getter from templated data type
212+ --
209− | CppGet Cpp Cpp
213+ | CppDataGet Cpp Cpp
210 -- |
214 -- |
211 -- Function application
215 -- Function application
212 --
216 --
@@ -220,6 +224,9 @@ data Cpp
220 --
224 --
221 | CppSymbol Text
225 | CppSymbol Text
222 -- |
226 -- |
227+ -- Define unique system-wide name/constant
228+ --
229+ | CppDefineSymbol Text
223 -- |
230 -- |
224 -- A block of expressions in braces
231 -- A block of expressions in braces
225 --
232 --
@@ -312,7 +319,8 @@ everywhereOnCpp f = go
312 go (CppFunction name args rty qs j) = f (CppFunction name args rty qs (go j))
319 go (CppFunction name args rty qs j) = f (CppFunction name args rty qs (go j))
313 go (CppLambda cps args rty j) = f (CppLambda cps args rty (go j))
320 go (CppLambda cps args rty j) = f (CppLambda cps args rty (go j))
314 go (CppCast t cpp) = f (CppCast t (go cpp))
321 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))
316 go (CppApp j cpp) = f (CppApp (go j) (map go cpp))
324 go (CppApp j cpp) = f (CppApp (go j) (map go cpp))
317 go (CppBlock cpp) = f (CppBlock (map go cpp))
325 go (CppBlock cpp) = f (CppBlock (map go cpp))
318 go (CppNamespace name cpp) = f (CppNamespace name (map go cpp))
326 go (CppNamespace name cpp) = f (CppNamespace name (map go cpp))
@@ -344,7 +352,8 @@ everywhereOnCppTopDownM f = f >=> go
344 go (CppFunction name args rty qs j) = CppFunction name args rty qs <$> f' j
352 go (CppFunction name args rty qs j) = CppFunction name args rty qs <$> f' j
345 go (CppLambda cps args rty j) = CppLambda cps args rty <$> f' j
353 go (CppLambda cps args rty j) = CppLambda cps args rty <$> f' j
346 go (CppCast t cpp) = CppCast t <$> f' cpp
354 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
348 go (CppApp j cpp) = CppApp <$> f' j <*> traverse f' cpp
357 go (CppApp j cpp) = CppApp <$> f' j <*> traverse f' cpp
349 go (CppBlock cpp) = CppBlock <$> traverse f' cpp
358 go (CppBlock cpp) = CppBlock <$> traverse f' cpp
350 go (CppNamespace name cpp) = CppNamespace name <$> traverse f' cpp
359 go (CppNamespace name cpp) = CppNamespace name <$> traverse f' cpp
@@ -372,7 +381,8 @@ everythingOnCpp (<>) f = go
372 go j@(CppFunction _ _ _ _ j1) = f j <> go j1
381 go j@(CppFunction _ _ _ _ j1) = f j <> go j1
373 go j@(CppLambda _ _ _ j1) = f j <> go j1
382 go j@(CppLambda _ _ _ j1) = f j <> go j1
374 go j@(CppCast _ cpp) = f j <> go cpp
383 go j@(CppCast _ cpp) = f j <> go cpp
384+ go j@(CppMapGet j1 j2) = f j <> go j1 <> go j2
375− go j@(CppGet j1 j2) = f j <> go j1 <> go j2
385+ go j@(CppDataGet j1 j2) = f j <> go j1 <> go j2
376 go j@(CppApp j1 cpp) = foldl (<>) (f j <> go j1) (map go cpp)
386 go j@(CppApp j1 cpp) = foldl (<>) (f j <> go j1) (map go cpp)
377 go j@(CppBlock cpp) = foldl (<>) (f j) (map go cpp)
387 go j@(CppBlock cpp) = foldl (<>) (f j) (map go cpp)
378 go j@(CppNamespace _ cpp) = foldl (<>) (f j) (map go cpp)
388 go j@(CppNamespace _ cpp) = foldl (<>) (f j) (map go cpp)
src/Language/PureScript/CodeGen/Cpp/Common.hs+79−29
@@ -18,12 +18,11 @@
18
18
19module Language.PureScript.CodeGen.Cpp.Common where
19module Language.PureScript.CodeGen.Cpp.Common where
20
20
21−import Prelude.Compat hiding (all, concatMap, last, init)
21+import Prelude.Compat hiding (all, concatMap, last, init, null)
22
22
23import Data.Char
23import Data.Char
24import Data.Text hiding (map)
24import Data.Text hiding (map)
25import Data.Monoid ((<>))
25import Data.Monoid ((<>))
26−import qualified Data.Text as T
27import Language.PureScript.Crash
26import Language.PureScript.Crash
28import Language.PureScript.Names
27import Language.PureScript.Names
29
28
@@ -32,34 +31,72 @@ import Language.PureScript.Names
32--
31--
33-- * Alphanumeric characters are kept unmodified.
32-- * Alphanumeric characters are kept unmodified.
34--
33--
35−-- * Reserved C++11 identifiers are wrapped with '_'
34+-- * Reserved C++11 identifiers are suffixed with a '$'
36--
35--
37−-- * Symbols are wrapped with '_' between a symbol name or their ordinal value.
36+-- * Symbols are prefixed with "$0" plus their ordinal value.
38--
37--
39identToCpp :: Ident -> Text
38identToCpp :: Ident -> Text
39+identToCpp (Ident name) = safeName name
40+identToCpp (GenIdent _ _) = internalError "GenIdent in identToCpp"
41+
42+safeName :: Text -> Text
43+safeName name
40−identToCpp (Ident name) | nameIsCppReserved name = "_" <> name <> "_"
44+ | nameIsCppReserved name = name <> "$"
41−identToCpp (Ident name)
45+safeName name
42 | Just ('$', s) <- uncons name
46 | Just ('$', s) <- uncons name
43 , all isDigit s = name
47 , all isDigit s = name
44−identToCpp (Ident name) = concatMap identCharToString name
48+safeName name
45−identToCpp (GenIdent _ _) = internalError "GenIdent in identToCpp"
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 "_$_" "__"
46
64
47-- |
65-- |
48-- Test if a string is a valid Cpp identifier without escaping.
66-- Test if a string is a valid Cpp identifier without escaping.
49--
67--
50identNeedsEscaping :: Text -> Bool
68identNeedsEscaping :: Text -> Bool
51−identNeedsEscaping s = s /= identToCpp (Ident s)
69+identNeedsEscaping s = s /= safeName s
52
70
53-- |
71-- |
54-- Attempts to find a human-readable name for a symbol, if none has been specified returns the
72-- Attempts to find a human-readable name for a symbol, if none has been specified returns the
55-- ordinal value.
73-- ordinal value.
56--
74--
57−identCharToString :: Char -> Text
75+identCharToText :: Char -> Text
58−identCharToString c | isAlphaNum c = singleton c
76+identCharToText c | isAlphaNum c = singleton c
59−identCharToString '_' = "_"
77+identCharToText '_' = "_"
60−identCharToString '.' = "_"
78+identCharToText '.' = "$dot"
61−identCharToString '\'' = "_prime"
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"
62−identCharToString c = "$0" <> (pack . show $ ord c)
99+identCharToText c = "$0" <> (pack . show $ ord c)
63
100
64-- |
101-- |
65-- Checks whether an identifier name is reserved in C++11.
102-- Checks whether an identifier name is reserved in C++11.
@@ -73,6 +110,9 @@ nameIsCppReserved name =
73 , "any"
110 , "any"
74 , "asm"
111 , "asm"
75 , "assert"
112 , "assert"
113+ , "atomic_cancel"
114+ , "atomic_commit"
115+ , "atomic_noexcept"
76 , "auto"
116 , "auto"
77 , "bitand"
117 , "bitand"
78 , "bitor"
118 , "bitor"
@@ -92,9 +132,12 @@ nameIsCppReserved name =
92 , "constexpr"
132 , "constexpr"
93 , "const_cast"
133 , "const_cast"
94 , "continue"
134 , "continue"
95− , "constructor"
135+ , "concept"
136+ , "cstring"
137+ , "ctor"
96 , "decltype"
138 , "decltype"
97 , "default"
139 , "default"
140+ , "define_symbol"
98 , "delete"
141 , "delete"
99 , "do"
142 , "do"
100 , "double"
143 , "double"
@@ -109,7 +152,6 @@ nameIsCppReserved name =
109 , "float"
152 , "float"
110 , "for"
153 , "for"
111 , "friend"
154 , "friend"
112− , "get"
113 , "goto"
155 , "goto"
114 , "if"
156 , "if"
115 , "import"
157 , "import"
@@ -117,6 +159,9 @@ nameIsCppReserved name =
117 , "int"
159 , "int"
118 , "list"
160 , "list"
119 , "long"
161 , "long"
162+ , "make_managed"
163+ , "make_managed_and_finalized"
164+ , "managed"
120 , "mutable"
165 , "mutable"
121 , "namespace"
166 , "namespace"
122 , "new"
167 , "new"
@@ -132,17 +177,14 @@ nameIsCppReserved name =
132 , "or"
177 , "or"
133 , "or_eq"
178 , "or_eq"
134 , "override"
179 , "override"
135− , "param"
136 , "private"
180 , "private"
137 , "protected"
181 , "protected"
138 , "public"
182 , "public"
139− , "PureScript"
140 , "register"
183 , "register"
141 , "reinterpret_cast"
184 , "reinterpret_cast"
142 , "requires"
185 , "requires"
143 , "return"
186 , "return"
144 , "runtime_error"
187 , "runtime_error"
145− , "shared_list"
146 , "short"
188 , "short"
147 , "signed"
189 , "signed"
148 , "sizeof"
190 , "sizeof"
@@ -154,7 +196,10 @@ nameIsCppReserved name =
154 , "struct"
196 , "struct"
155 , "switch"
197 , "switch"
156 , "symbol"
198 , "symbol"
199+ , "symbol_t"
200+ , "synchronized"
157 , "template"
201 , "template"
202+ , "the_value"
158 , "this"
203 , "this"
159 , "thread_local"
204 , "thread_local"
160 , "throw"
205 , "throw"
@@ -164,6 +209,7 @@ nameIsCppReserved name =
164 , "typeid"
209 , "typeid"
165 , "typename"
210 , "typename"
166 , "typeof"
211 , "typeof"
212+ , "undefined"
167 , "union"
213 , "union"
168 , "unknown_size"
214 , "unknown_size"
169 , "unsigned"
215 , "unsigned"
@@ -177,17 +223,20 @@ nameIsCppReserved name =
177 , "xor_eq" ] || properNameIsCppReserved name
223 , "xor_eq" ] || properNameIsCppReserved name
178
224
179normalizedName :: Text -> Text
225normalizedName :: Text -> Text
180−normalizedName name
226+normalizedName = unescapeDoubleUnderscores . normalizedName'
227+ where
228+ normalizedName' name
229+ | null name = ""
230+ normalizedName' name
231+ | last name == '$' = init name
232+ normalizedName' name
181− | Just ('_', s) <- uncons name
233+ | Just ('$', s) <- uncons name = s
182− , last s == '_'
234+ normalizedName' s = s
183− , s' <- init s
184− , nameIsCppReserved s' = s'
185−normalizedName s = s
186
235
187moduleNameToCpp :: ModuleName -> Text
236moduleNameToCpp :: ModuleName -> Text
188moduleNameToCpp (ModuleName pns) =
237moduleNameToCpp (ModuleName pns) =
189− let name = T.intercalate "_" (runProperName `map` pns)
238+ let name = intercalate "_" (runProperName `map` pns)
190− in if properNameIsCppReserved name then "_" <> name <> "_" else name
239+ in if properNameIsCppReserved name then name <> "$" else name
191
240
192-- |
241-- |
193-- Checks whether a proper name is reserved in C++11.
242-- Checks whether a proper name is reserved in C++11.
@@ -195,4 +244,5 @@ moduleNameToCpp (ModuleName pns) =
195properNameIsCppReserved :: Text -> Bool
244properNameIsCppReserved :: Text -> Bool
196properNameIsCppReserved name =
245properNameIsCppReserved name =
197 name `elem` [ "Private"
246 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
124 Just $ CppFunction name [("", Just thunkMarkerType)] (Just $ Any [Const, Ref]) [] block
124 Just $ CppFunction name [("", Just thunkMarkerType)] (Just $ Any [Const, Ref]) [] block
125 _ -> Just $ CppVariableIntroduction (name, Just $ Any [Const]) [] (Just lambda)
125 _ -> Just $ CppVariableIntroduction (name, Just $ Any [Const]) [] (Just lambda)
126 where
126 where
127− val = CppVariableIntroduction ("$value$", Just $ Any [Const]) [Static] (Just $ addCaptures cpp)
127+ val = CppVariableIntroduction ("the_value", Just $ Any [Const]) [Static] (Just $ addCaptures cpp)
128− block = CppBlock [val, CppReturn (CppVar "$value$")]
128+ block = CppBlock [val, CppReturn (CppVar "the_value")]
129 lambda = CppLambda [] [("", Just $ thunkMarkerType)] (Just $ Any [Const, Ref]) block
129 lambda = CppLambda [] [("", Just $ thunkMarkerType)] (Just $ Any [Const, Ref]) block
130 addCaptures :: Cpp -> Cpp
130 addCaptures :: Cpp -> Cpp
131 addCaptures (CppMapLiteral t objs) = CppMapLiteral t (objlam <$> objs)
131 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
64targetVariable (CppVar var) = var
64targetVariable (CppVar var) = var
65targetVariable (CppAccessor _ tgt) = targetVariable tgt
65targetVariable (CppAccessor _ tgt) = targetVariable tgt
66targetVariable (CppIndexer _ tgt) = targetVariable tgt
66targetVariable (CppIndexer _ tgt) = targetVariable tgt
67−targetVariable (CppGet _ tgt) = targetVariable tgt
67+targetVariable (CppMapGet _ tgt) = targetVariable tgt
68targetVariable _ = error "Invalid argument to targetVariable"
68targetVariable _ = error "Invalid argument to targetVariable"
69
69
70isUpdated :: Text -> Cpp -> Bool
70isUpdated :: Text -> Cpp -> Bool
@@ -80,7 +80,7 @@ removeFromBlock _ cpp = cpp
80
80
81isFn :: (Text, Text) -> Cpp -> Bool
81isFn :: (Text, Text) -> Cpp -> Bool
82isFn (moduleName, fnName) (CppAccessor (CppVar x) (CppVar y)) =
82isFn (moduleName, fnName) (CppAccessor (CppVar x) (CppVar y)) =
83− (x == fnName || x == ('$' `cons` fnName)) && y == moduleName
83+ (x == fnName || x == ('*' `cons` fnName)) && y == moduleName
84isFn (moduleName, fnName) (CppIndexer (CppStringLiteral x) (CppVar y)) =
84isFn (moduleName, fnName) (CppIndexer (CppStringLiteral x) (CppVar y)) =
85 x == fnName && y == moduleName
85 x == fnName && y == moduleName
86isFn _ _ = False
86isFn _ _ = False
src/Language/PureScript/CodeGen/Cpp/Optimizer/Inliner.hs+3−3
@@ -36,7 +36,6 @@ import Language.PureScript.CodeGen.Cpp.AST
36import Language.PureScript.CodeGen.Cpp.Common
36import Language.PureScript.CodeGen.Cpp.Common
37import Language.PureScript.CodeGen.Cpp.Optimizer.Common
37import Language.PureScript.CodeGen.Cpp.Optimizer.Common
38import Language.PureScript.CodeGen.Cpp.Types
38import Language.PureScript.CodeGen.Cpp.Types
39−import Language.PureScript.Names
40import qualified Language.PureScript.Constants as C
39import qualified Language.PureScript.Constants as C
41
40
42-- TODO: Potential bug:
41-- TODO: Potential bug:
@@ -50,7 +49,8 @@ shouldInline (CppStringLiteral _) = True
50shouldInline (CppBooleanLiteral _) = True
49shouldInline (CppBooleanLiteral _) = True
51shouldInline (CppAccessor _ val) = shouldInline val
50shouldInline (CppAccessor _ val) = shouldInline val
52shouldInline (CppIndexer index val) = shouldInline index && shouldInline val
51shouldInline (CppIndexer index val) = shouldInline index && shouldInline val
52+shouldInline (CppMapGet index val) = shouldInline index && shouldInline val
53−shouldInline (CppGet index val) = shouldInline index && shouldInline val
53+shouldInline (CppDataGet index val) = shouldInline index && shouldInline val
54shouldInline (CppCast _ val) = shouldInline val
54shouldInline (CppCast _ val) = shouldInline val
55shouldInline _ = False
55shouldInline _ = False
56
56
@@ -138,7 +138,7 @@ inlineOperator (m, op) f = everywhereOnCpp convert
138 convert (CppApp op' [x, y]) | isOp op' = f x y
138 convert (CppApp op' [x, y]) | isOp op' = f x y
139 convert (CppApp (CppApp op' [x]) [y]) | isOp op' = f x y
139 convert (CppApp (CppApp op' [x]) [y]) | isOp op' = f x y
140 convert other = other
140 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
142 isOp (CppIndexer (CppStringLiteral op') (CppVar m')) = m == m' && op == op'
142 isOp (CppIndexer (CppStringLiteral op') (CppVar m')) = m == m' && op == op'
143 isOp _ = False
143 isOp _ = False
144
144
src/Language/PureScript/CodeGen/Cpp/Optimizer/MagicDo.hs+2−1
@@ -21,6 +21,7 @@ import Data.List (nub)
21import Data.Maybe (fromJust, isJust)
21import Data.Maybe (fromJust, isJust)
22
22
23import Language.PureScript.CodeGen.Cpp.AST
23import Language.PureScript.CodeGen.Cpp.AST
24+import Language.PureScript.CodeGen.Cpp.Common
24import Language.PureScript.CodeGen.Cpp.Optimizer.Common
25import Language.PureScript.CodeGen.Cpp.Optimizer.Common
25import Language.PureScript.CodeGen.Cpp.Types
26import Language.PureScript.CodeGen.Cpp.Types
26import Language.PureScript.Options
27import Language.PureScript.Options
@@ -62,7 +63,7 @@ magicDo' = everywhereOnCpp undo . everywhereOnCppTopDown convert
62 convert (CppApp (CppApp bind [m]) [CppLambda _ [arg] rty (CppBlock cpp)]) | isBind bind =
63 convert (CppApp (CppApp bind [m]) [CppLambda _ [arg] rty (CppBlock cpp)]) | isBind bind =
63 CppFunction fnName [] rty [] $ CppBlock (app' : map applyReturns cpp)
64 CppFunction fnName [] rty [] $ CppBlock (app' : map applyReturns cpp)
64 where
65 where
65− app' | fst arg == C.__unused = CppApp m []
66+ app' | arg' <- fst arg, arg' == C.__unused || arg' == (safeName C.__unused) = CppApp m []
66 | otherwise = CppVariableIntroduction arg [] (Just (CppApp m []))
67 | otherwise = CppVariableIntroduction arg [] (Just (CppApp m []))
67 -- Desugar untilE
68 -- Desugar untilE
68 convert (CppApp (CppApp f [arg]) []) | isEffFunc C.untilE f =
69 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
39tco' = everywhereOnCpp convert
39tco' = everywhereOnCpp convert
40 where
40 where
41 tcoVar :: Text -> Text
41 tcoVar :: Text -> Text
42− tcoVar arg = "__tco_" <> arg
42+ tcoVar arg = "tco$" <> arg
43
43
44 copyVar :: Text -> Text
44 copyVar :: Text -> Text
45− copyVar arg = "__copy_" <> arg
45+ copyVar arg = "copy$" <> arg
46
46
47 copyVar' :: (Text, Maybe CppType) -> (Text, Maybe CppType)
47 copyVar' :: (Text, Maybe CppType) -> (Text, Maybe CppType)
48 copyVar' (arg, t) = (copyVar arg, t)
48 copyVar' (arg, t) = (copyVar arg, t)
src/Language/PureScript/CodeGen/Cpp/Optimizer/Uncurry.hs+1−1
@@ -39,7 +39,7 @@ removeCurrying nm = everywhereOnCpp convert
39 unCurried (CppAccessor var mn)
39 unCurried (CppAccessor var mn)
40 | Just var' <- unCurried var = Just $ CppAccessor var' mn
40 | Just var' <- unCurried var = Just $ CppAccessor var' mn
41 unCurried (CppVar name)
41 unCurried (CppVar name)
42− | Just ('$', name') <- uncons name = Just $ CppVar name'
42+ | Just ('*', name') <- uncons name = Just $ CppVar name'
43 unCurried _ = Nothing
43 unCurried _ = Nothing
44 convert cpp = cpp
44 convert cpp = cpp
45
45
src/Language/PureScript/CodeGen/Cpp/Optimizer/Unused.hs+2−2
@@ -16,8 +16,8 @@
16module Language.PureScript.CodeGen.Cpp.Optimizer.Unused where
16module Language.PureScript.CodeGen.Cpp.Optimizer.Unused where
17
17
18import Prelude.Compat
18import Prelude.Compat
19−
20import Language.PureScript.CodeGen.Cpp.AST
19import Language.PureScript.CodeGen.Cpp.AST
20+import Language.PureScript.CodeGen.Cpp.Common
21import Language.PureScript.CodeGen.Cpp.Optimizer.Common
21import Language.PureScript.CodeGen.Cpp.Optimizer.Common
22
22
23import qualified Language.PureScript.Constants as C
23import qualified Language.PureScript.Constants as C
@@ -43,5 +43,5 @@ removeUnusedArg :: Cpp -> Cpp
43removeUnusedArg = everywhereOnCpp convert
43removeUnusedArg = everywhereOnCpp convert
44 where
44 where
45 convert (CppFunction name [(arg,atyp)] rtyp qs body)
45 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
47 convert cpp = cpp
47 convert cpp = cpp
src/Language/PureScript/CodeGen/Cpp/Types.hs+11−5
@@ -147,11 +147,17 @@ arrayType = Primitive "any::array"
147thunkMarkerType :: CppType
147thunkMarkerType :: CppType
148thunkMarkerType = Primitive "any::as_thunk"
148thunkMarkerType = Primitive "any::as_thunk"
149
149
150−ctorKey :: Text
150+mapNS :: Text
151−ctorKey = "constructor"
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"
152
161
153constAnyRef :: Maybe CppType
162constAnyRef :: Maybe CppType
154constAnyRef = Just $ Any [Const, Ref]
163constAnyRef = 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
247
247
248 symbolChar :: Lexer u Char
248 symbolChar :: Lexer u Char
249 symbolChar = P.satisfy isSymbolChar
249 symbolChar = P.satisfy isSymbolChar
250−
250+{-
251 surrogates :: Char -> (Char, Char)
251 surrogates :: Char -> (Char, Char)
252 surrogates c = (high, low)
252 surrogates c = (high, low)
253 where
253 where
@@ -259,7 +259,7 @@ parseToken = P.choice
259 expandAstralCodePointToUTF16Surrogates c | fromEnum c > 0xFFFF = [high, low]
259 expandAstralCodePointToUTF16Surrogates c | fromEnum c > 0xFFFF = [high, low]
260 where (high, low) = surrogates c
260 where (high, low) = surrogates c
261 expandAstralCodePointToUTF16Surrogates c = [c]
261 expandAstralCodePointToUTF16Surrogates c = [c]
262−
262+-}
263 parseCharLiteral :: Lexer u Char
263 parseCharLiteral :: Lexer u Char
264 parseCharLiteral = P.try $ do {
264 parseCharLiteral = P.try $ do {
265 c <- PT.charLiteral tokenParser;
265 c <- PT.charLiteral tokenParser;
@@ -269,7 +269,7 @@ parseToken = P.choice
269 }
269 }
270
270
271 parseStringLiteral :: Lexer u Text
271 parseStringLiteral :: Lexer u Text
272− parseStringLiteral = blockString <|> T.pack <$> concatMap expandAstralCodePointToUTF16Surrogates <$> PT.stringLiteral tokenParser
272+ parseStringLiteral = blockString <|> T.pack <$> {- concatMap expandAstralCodePointToUTF16Surrogates <$> -} PT.stringLiteral tokenParser
273 where
273 where
274 delimiter = P.try (P.string "\"\"\"")
274 delimiter = P.try (P.string "\"\"\"")
275 blockString = delimiter *> (T.pack <$> P.manyTill P.anyChar delimiter)
275 blockString = delimiter *> (T.pack <$> P.manyTill P.anyChar delimiter)
src/Language/PureScript/Pretty/Cpp.hs+18−22
@@ -36,12 +36,12 @@ import Control.Applicative
36import Control.Arrow ((<+>))
36import Control.Arrow ((<+>))
37import qualified Control.Arrow as A
37import qualified Control.Arrow as A
38import Control.Monad.State
38import Control.Monad.State
39−import Numeric (showHex)
40import Control.PatternArrows
39import Control.PatternArrows
41
40
42import Language.PureScript.CodeGen.Cpp.AST
41import Language.PureScript.CodeGen.Cpp.AST
43import Language.PureScript.CodeGen.Cpp.Types
42import Language.PureScript.CodeGen.Cpp.Types
44import Language.PureScript.Comments
43import Language.PureScript.Comments
44+import Language.PureScript.CodeGen.Cpp.Common
45import qualified Language.PureScript.Constants as C
45import qualified Language.PureScript.Constants as C
46import Language.PureScript.Pretty.Common (PrinterState(..), intercalate, parensT)
46import Language.PureScript.Pretty.Common (PrinterState(..), intercalate, parensT)
47
47
@@ -129,7 +129,7 @@ literals = mkPattern' match
129 match (CppFunction name args rty qs ret) = mconcat <$> sequence
129 match (CppFunction name args rty qs ret) = mconcat <$> sequence
130 [ return . T.concat . fmap (<> " ") . filter (not . T.null) $ runValueQual <$> qs
130 [ return . T.concat . fmap (<> " ") . filter (not . T.null) $ runValueQual <$> qs
131 , return "auto "
131 , return "auto "
132− , return name
132+ , return $ renderName name
133 , return $ parensT (T.intercalate ", " $ argstr <$> args)
133 , return $ parensT (T.intercalate ", " $ argstr <$> args)
134 , return (maybe "" ((" -> " <>) . runType) rty)
134 , return (maybe "" ((" -> " <>) . runType) rty)
135 , if ret /= CppNoOp
135 , if ret /= CppNoOp
@@ -237,17 +237,16 @@ literals = mkPattern' match
237 vstr = prettyPrintCpp1 val
237 vstr = prettyPrintCpp1 val
238 val' | "(" `T.isInfixOf` vstr || "[" `T.isInfixOf` vstr = parensT vstr
238 val' | "(" `T.isInfixOf` vstr || "[" `T.isInfixOf` vstr = parensT vstr
239 | otherwise = vstr
239 | otherwise = vstr
240− match (CppGet i@(CppSymbol _) val) =
240+ match (CppMapGet i@(CppSymbol _) val) =
241− return . prettyPrintCpp1 $ CppApp (CppVar "get") [i, val]
241+ return . prettyPrintCpp1 $ CppApp (CppVar $ mapNS <> "::get") [i, val]
242− match (CppGet i val) =
242+ match (CppMapGet i val) =
243− return . prettyPrintCpp1 $ CppApp (CppVar $ "get" <> angles (prettyPrintCpp1 i)) [val]
243+ return . prettyPrintCpp1 $ CppApp (CppVar $ mapNS <> "::get" <> angles (prettyPrintCpp1 i)) [val]
244− match (CppVar ident)
244+ match (CppDataGet i val) =
245− | ident == C.__unused = match (CppVar $ '$' `T.cons` ident)
245+ return . prettyPrintCpp1 $ CppApp (CppVar $ dataNS <> "::get" <> angles (prettyPrintCpp1 i)) [val]
246− match (CppVar ident) = return ident
246+ match (CppVar ident) = return $ renderName ident
247− match (CppSymbol ident) = return $ "SYMBOL" <> parensT (symbolname ident)
247+ match (CppSymbol ident) = return $ "symbol" <> parensT (safeName ident)
248+ match (CppDefineSymbol ident) = return $ "define_symbol" <> parensT (safeName ident)
248 match (CppApp v [CppNoOp]) = return (prettyPrintCpp1 v)
249 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)
251 match (CppVariableIntroduction (ident, typ) qs value) =
250 match (CppVariableIntroduction (ident, typ) qs value) =
252 mconcat <$> sequence
251 mconcat <$> sequence
253 [ return . T.concat . fmap (<> " ") . filter (not . T.null) $ runValueQual <$> qs
252 [ return . T.concat . fmap (<> " ") . filter (not . T.null) $ runValueQual <$> qs
@@ -355,6 +354,7 @@ string :: Text -> Text
355string s = "\"" <> T.concatMap encodeChar s <> "\""
354string s = "\"" <> T.concatMap encodeChar s <> "\""
356 where
355 where
357 encodeChar :: Char -> Text
356 encodeChar :: Char -> Text
357+ encodeChar '\0' = "\\0"
358 encodeChar '\b' = "\\b"
358 encodeChar '\b' = "\\b"
359 encodeChar '\t' = "\\t"
359 encodeChar '\t' = "\\t"
360 encodeChar '\n' = "\\n"
360 encodeChar '\n' = "\\n"
@@ -363,17 +363,8 @@ string s = "\"" <> T.concatMap encodeChar s <> "\""
363 encodeChar '\r' = "\\r"
363 encodeChar '\r' = "\\r"
364 encodeChar '"' = "\\\""
364 encodeChar '"' = "\\\""
365 encodeChar '\\' = "\\\\"
365 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) ""
373 encodeChar c = T.singleton c
366 encodeChar c = T.singleton c
374
367
375− showHex' a b = T.pack (showHex a b)
376−
377accessor :: Pattern PrinterState Cpp (Text, Cpp)
368accessor :: Pattern PrinterState Cpp (Text, Cpp)
378accessor = mkPattern match
369accessor = mkPattern match
379 where
370 where
@@ -515,7 +506,7 @@ dotsTo chr' = T.map (\c -> if c == '.' then chr' else c)
515argstr :: (Text, Maybe CppType) -> Text
506argstr :: (Text, Maybe CppType) -> Text
516argstr (name, Nothing) = argStr name (Auto [])
507argstr (name, Nothing) = argStr name (Auto [])
517argstr (name, Just typ)
508argstr (name, Just typ)
518− | name == C.__unused = argStr "" typ
509+ | name == C.__unused || name == (safeName C.__unused) = argStr "" typ
519argstr (name, Just typ) = argStr name typ
510argstr (name, Just typ) = argStr name typ
520
511
521argStr :: Text -> CppType -> Text
512argStr :: Text -> CppType -> Text
@@ -546,3 +537,8 @@ isNoOp :: Cpp -> Bool
546isNoOp CppNoOp = True
537isNoOp CppNoOp = True
547isNoOp (CppComment [] CppNoOp) = True
538isNoOp (CppComment [] CppNoOp) = True
548isNoOp _ = False
539isNoOp _ = 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
2packages:
2packages:
3- '.'
3- '.'
4+extra-deps:
5+- pipes-http-1.0.2
6+- wai-websockets-3.0.0.9
7+- websockets-0.9.6.2