git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
C++: cleanup - get rid of some 'Cpp' prefixes
353e3e2Andy Arvanitis
src/Language/PureScript/CodeGen/Cpp.hs+56−56
compare with golang
unifiedsplit
@@ -70,7 +70,7 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do
70 delete (ModuleName [ProperName C.prim]) . (\\ [mn]) $
70 delete (ModuleName [ProperName C.prim]) . (\\ [mn]) $
71 (snd <$> imps)
71 (snd <$> imps)
72 let cppImports' = "PureScript" : cppImports
72 let cppImports' = "PureScript" : cppImports
73− cppDecls <- concat <$> mapM (bindToCpp [CppTopLevel]) decls
73+ cppDecls <- concat <$> mapM (bindToCpp [TopLevel]) decls
74 let cpps = filterInlineFuncs <$> cppDecls
74 let cpps = filterInlineFuncs <$> cppDecls
75 namesmap = M.toList .
75 namesmap = M.toList .
76 M.mapKeysMonotonic (qualifiedToCpp id) . M.map (\(t, _, _) -> arity t) $
76 M.mapKeysMonotonic (qualifiedToCpp id) . M.map (\(t, _, _) -> arity t) $
@@ -119,16 +119,16 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do
119 -- Generate code in the simplified C++1x intermediate representation for a declaration
119 -- Generate code in the simplified C++1x intermediate representation for a declaration
120 --
120 --
121 -------------------------------------------------------------------------------------------------
121 -------------------------------------------------------------------------------------------------
122− bindToCpp :: [CppValueQual] -> Bind Ann -> m [Cpp]
122+ bindToCpp :: [ValueQual] -> Bind Ann -> m [Cpp]
123 -------------------------------------------------------------------------------------------------
123 -------------------------------------------------------------------------------------------------
124 bindToCpp qs (NonRec ann ident val) = return <$> declToCpp qs (ann, ident) val
124 bindToCpp qs (NonRec ann ident val) = return <$> declToCpp qs (ann, ident) val
125− bindToCpp qs (Rec vals) = forM vals (uncurry $ declToCpp (CppRecursive:qs))
125+ bindToCpp qs (Rec vals) = forM vals (uncurry $ declToCpp (Recursive:qs))
126
126
127 -- |
127 -- |
128 -- Desugar a declaration into a variable introduction or named function
128 -- Desugar a declaration into a variable introduction or named function
129 -- declaration.
129 -- declaration.
130 -------------------------------------------------------------------------------------------------
130 -------------------------------------------------------------------------------------------------
131− declToCpp :: [CppValueQual] -> (Ann, Ident) -> Expr Ann -> m Cpp
131+ declToCpp :: [ValueQual] -> (Ann, Ident) -> Expr Ann -> m Cpp
132 -------------------------------------------------------------------------------------------------
132 -------------------------------------------------------------------------------------------------
133 declToCpp _ (_, ident) e@(Abs (_, _, _, Just IsTypeClassConstructor) _ _) =
133 declToCpp _ (_, ident) e@(Abs (_, _, _, Just IsTypeClassConstructor) _ _) =
134 let className = identToCpp ident
134 let className = identToCpp ident
@@ -136,7 +136,7 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do
136 in return $ CppStruct className [CppEnum Nothing Nothing (sort supers ++ members)]
136 in return $ CppStruct className [CppEnum Nothing Nothing (sort supers ++ members)]
137
137
138 declToCpp vqs (_, ident) (Abs (_, com, ty, _) arg body) = do
138 declToCpp vqs (_, ident) (Abs (_, com, ty, _) arg body) = do
139− fn <- if CppTopLevel `elem` vqs
139+ fn <- if TopLevel `elem` vqs
140 then do
140 then do
141 argNames <- replicateM (arity' - length args' - 1) freshName
141 argNames <- replicateM (arity' - length args' - 1) freshName
142 let args'' = zip argNames (repeat aty)
142 let args'' = zip argNames (repeat aty)
@@ -154,13 +154,13 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do
154 name
154 name
155 (arg' : args' ++ args'')
155 (arg' : args' ++ args'')
156 rty
156 rty
157− (vqs ++ if isAccessor (snd abs') then [CppInline] else [])
157+ (vqs ++ if isAccessor (snd abs') then [Inline] else [])
158 (convertNestedLambdas $ convertDictIndexers block)
158 (convertNestedLambdas $ convertDictIndexers block)
159 , CppFunction
159 , CppFunction
160 (curriedName name)
160 (curriedName name)
161 [arg']
161 [arg']
162 rty
162 rty
163− (if arity' == 1 then [CppInline] else [])
163+ (if arity' == 1 then [Inline] else [])
164 (asReturnBlock $
164 (asReturnBlock $
165 curriedLambda
165 curriedLambda
166 (fst <$> args' ++ args'')
166 (fst <$> args' ++ args'')
@@ -173,7 +173,7 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do
173 name
173 name
174 [arg']
174 [arg']
175 rty
175 rty
176− (vqs ++ if isIndexer block then [CppInline] else [])
176+ (vqs ++ if isIndexer block then [Inline] else [])
177 (convertNestedLambdas . asReturnBlock $ convertDictIndexers block)
177 (convertNestedLambdas . asReturnBlock $ convertDictIndexers block)
178 return (CppComment com $ convertIfPrimFn ty' fn)
178 return (CppComment com $ convertIfPrimFn ty' fn)
179 where
179 where
@@ -182,8 +182,8 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do
182 | otherwise = Nothing
182 | otherwise = Nothing
183 arity' = maybe 0 arity ty'
183 arity' = maybe 0 arity ty'
184 name = identToCpp ident
184 name = identToCpp ident
185− aty = Just $ CppAny [CppConst, CppRef]
185+ aty = Just $ Any [Const, Ref]
186− rty = Just $ CppAny []
186+ rty = Just $ Any []
187 arg' = (identToCpp arg, aty)
187 arg' = (identToCpp arg, aty)
188 args' = (\i -> (identToCpp i, aty)) <$> fst abs'
188 args' = (\i -> (identToCpp i, aty)) <$> fst abs'
189 abs' = unAbs body []
189 abs' = unAbs body []
@@ -203,8 +203,8 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do
203 CppFunction
203 CppFunction
204 (identToCpp ident)
204 (identToCpp ident)
205 []
205 []
206− (Just $ CppAny [])
206+ (Just $ Any [])
207− [CppInline]
207+ [Inline]
208 (asReturnBlock $
208 (asReturnBlock $
209 CppDataLiteral [CppAccessor (CppVar $ identToCpp ident) (CppVar "data")])
209 CppDataLiteral [CppAccessor (CppVar $ identToCpp ident) (CppVar "data")])
210
210
@@ -213,8 +213,8 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do
213 [ CppFunction
213 [ CppFunction
214 name
214 name
215 (farg <$> fields')
215 (farg <$> fields')
216− (Just $ CppAny [])
216+ (Just $ Any [])
217− [CppInline]
217+ [Inline]
218 (asReturnBlock $
218 (asReturnBlock $
219 CppDataLiteral $
219 CppDataLiteral $
220 CppAccessor (CppVar name) (CppVar "data") : (CppVar <$> fields'))
220 CppAccessor (CppVar name) (CppVar "data") : (CppVar <$> fields'))
@@ -224,8 +224,8 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do
224 [ CppFunction
224 [ CppFunction
225 (curriedName name)
225 (curriedName name)
226 (farg <$> f)
226 (farg <$> f)
227− (Just $ CppAny [])
227+ (Just $ Any [])
228− (if length fields == 1 then [CppInline] else [])
228+ (if length fields == 1 then [Inline] else [])
229 (CppBlock (fieldLambdas fs))
229 (CppBlock (fieldLambdas fs))
230 ]
230 ]
231 else
231 else
@@ -235,19 +235,19 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do
235 fields' = identToCpp <$> fields
235 fields' = identToCpp <$> fields
236 (f, fs) | (f' : fs') <- fields' = ([f'], fs')
236 (f, fs) | (f' : fs') <- fields' = ([f'], fs')
237 | otherwise = ([], [])
237 | otherwise = ([], [])
238− farg = \x -> (x, Just $ CppAny [CppConst, CppRef])
238+ farg = \x -> (x, Just $ Any [Const, Ref])
239 fieldLambdas flds
239 fieldLambdas flds
240 | (f' : fs') <- flds = [ CppReturn . maybeRemCaps $
240 | (f' : fs') <- flds = [ CppReturn . maybeRemCaps $
241 CppLambda
241 CppLambda
242− [CppCaptureAll]
242+ [CaptureAll]
243 (farg <$> [f'])
243 (farg <$> [f'])
244− (Just $ CppAny [])
244+ (Just $ Any [])
245 (CppBlock $ fieldLambdas fs') ]
245 (CppBlock $ fieldLambdas fs') ]
246 | otherwise = [CppReturn $ CppApp (CppVar name) (CppVar <$> fields')]
246 | otherwise = [CppReturn $ CppApp (CppVar name) (CppVar <$> fields')]
247
247
248 declToCpp qs (_, ident) e
248 declToCpp qs (_, ident) e
249 | Just ty <- exprType e,
249 | Just ty <- exprType e,
250− CppTopLevel `elem` qs,
250+ TopLevel `elem` qs,
251 arity' <- arity ty,
251 arity' <- arity ty,
252 arity' > 0 = do
252 arity' > 0 = do
253 argNames <- replicateM arity' freshName
253 argNames <- replicateM arity' freshName
@@ -257,7 +257,7 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do
257 (App nullAnn e (Var nullAnn . Qualified Nothing . Ident $ head argNames))
257 (App nullAnn e (Var nullAnn . Qualified Nothing . Ident $ head argNames))
258 let fn' = CppFunction
258 let fn' = CppFunction
259 (curriedName name)
259 (curriedName name)
260− [(head argNames, Just $ CppAny [CppConst, CppRef])]
260+ [(head argNames, Just $ Any [Const, Ref])]
261 rty
261 rty
262 []
262 []
263 (asReturnBlock $
263 (asReturnBlock $
@@ -277,14 +277,14 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do
277 else []
277 else []
278 where
278 where
279 name = identToCpp ident
279 name = identToCpp ident
280− aty = Just $ CppAny [CppConst, CppRef]
280+ aty = Just $ Any [Const, Ref]
281− rty = Just $ CppAny []
281+ rty = Just $ Any []
282
282
283 declToCpp qs (_, ident) val = do
283 declToCpp qs (_, ident) val = do
284 val' <- valueToCpp val
284 val' <- valueToCpp val
285 return $
285 return $
286 CppVariableIntroduction
286 CppVariableIntroduction
287− (identToCpp ident, Just $ CppAny [CppConst])
287+ (identToCpp ident, Just $ Any [Const])
288 qs
288 qs
289 (Just val')
289 (Just val')
290
290
@@ -302,12 +302,12 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do
302 -------------------------------------------------------------------------------------------------
302 -------------------------------------------------------------------------------------------------
303 fnToLambda (CppFunction name args _ qs body) =
303 fnToLambda (CppFunction name args _ qs body) =
304 CppVariableIntroduction
304 CppVariableIntroduction
305− (name, Just $ CppAny [CppConst])
305+ (name, Just $ Any [Const])
306− (filter (==CppStatic) qs)
306+ (filter (==Static) qs)
307− (Just $ CppLambda cs args (Just $ CppAny []) body)
307+ (Just $ CppLambda cs args (Just $ Any []) body)
308 where
308 where
309− cs | (not . null) (qs `intersect` [CppInline, CppStatic]) = []
309+ cs | (not . null) (qs `intersect` [Inline, Static]) = []
310− | otherwise = [CppCaptureAll]
310+ | otherwise = [CaptureAll]
311 fnToLambda (CppComment com cpp) = CppComment com (fnToLambda cpp)
311 fnToLambda (CppComment com cpp) = CppComment com (fnToLambda cpp)
312 fnToLambda _ = error "Not a function!"
312 fnToLambda _ = error "Not a function!"
313
313
@@ -318,7 +318,7 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do
318 where
318 where
319 go :: Cpp -> Cpp
319 go :: Cpp -> Cpp
320 go f@(CppFunction {}) = maybeRemCaps $ fnToLambda f
320 go f@(CppFunction {}) = maybeRemCaps $ fnToLambda f
321− go (CppLambda _ args rtyp body) = maybeRemCaps $ CppLambda [CppCaptureAll] args rtyp body
321+ go (CppLambda _ args rtyp body) = maybeRemCaps $ CppLambda [CaptureAll] args rtyp body
322 go cpp = cpp
322 go cpp = cpp
323
323
324 -------------------------------------------------------------------------------------------------
324 -------------------------------------------------------------------------------------------------
@@ -337,13 +337,13 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do
337 filteredFns cpp = filter (\(f,_) -> everythingOnCpp (||) (== CppVar f) cpp) fns
337 filteredFns cpp = filter (\(f,_) -> everythingOnCpp (||) (== CppVar f) cpp) fns
338
338
339 recursive :: Cpp -> [Cpp]
339 recursive :: Cpp -> [Cpp]
340− recursive cpp'@(CppFunction _ _ _ qs _) | CppRecursive `elem` qs = [cpp']
340+ recursive cpp'@(CppFunction _ _ _ qs _) | Recursive `elem` qs = [cpp']
341− recursive cpp'@(CppVariableIntroduction _ qs _) | CppRecursive `elem` qs = [cpp']
341+ recursive cpp'@(CppVariableIntroduction _ qs _) | Recursive `elem` qs = [cpp']
342 recursive _ = []
342 recursive _ = []
343
343
344 removeRec :: Cpp -> Cpp
344 removeRec :: Cpp -> Cpp
345− removeRec (CppFunction _ _ _ qs _) | CppRecursive `elem` qs = CppNoOp
345+ removeRec (CppFunction _ _ _ qs _) | Recursive `elem` qs = CppNoOp
346− removeRec (CppVariableIntroduction _ qs _) | CppRecursive `elem` qs = CppNoOp
346+ removeRec (CppVariableIntroduction _ qs _) | Recursive `elem` qs = CppNoOp
347 removeRec cpp' = cpp'
347 removeRec cpp' = cpp'
348
348
349 replaceVar :: [(String, Cpp)] -> Cpp -> Cpp
349 replaceVar :: [(String, Cpp)] -> Cpp -> Cpp
@@ -354,7 +354,7 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do
354
354
355 dict :: Cpp
355 dict :: Cpp
356 dict = CppVariableIntroduction
356 dict = CppVariableIntroduction
357− (topdict, Just $ CppAny [CppConst])
357+ (topdict, Just $ Any [Const])
358 []
358 []
359 (Just $ CppDataLiteral ((\(f,cpp) -> CppComment [LineComment f] cpp) <$> fns))
359 (Just $ CppDataLiteral ((\(f,cpp) -> CppComment [LineComment f] cpp) <$> fns))
360
360
@@ -375,14 +375,14 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do
375 accessor :: String -> (String, Cpp) -> Cpp
375 accessor :: String -> (String, Cpp) -> Cpp
376 accessor dictname (name, _) =
376 accessor dictname (name, _) =
377 CppVariableIntroduction
377 CppVariableIntroduction
378− (name, Just $ CppAny [CppConst])
378+ (name, Just $ Any [Const])
379 []
379 []
380 (Just . snd $ accessed dictname name)
380 (Just . snd $ accessed dictname name)
381
381
382 toelem :: Cpp -> (String, Cpp)
382 toelem :: Cpp -> (String, Cpp)
383 toelem (CppFunction name args rtyp _ body'@(CppBlock body)) =
383 toelem (CppFunction name args rtyp _ body'@(CppBlock body)) =
384 (name, withdict . maybeRemCaps $ CppLambda
384 (name, withdict . maybeRemCaps $ CppLambda
385− [CppCaptureAll]
385+ [CaptureAll]
386 args
386 args
387 rtyp
387 rtyp
388 (CppBlock $ (accessor localdict <$> filteredFns body') ++ body))
388 (CppBlock $ (accessor localdict <$> filteredFns body') ++ body))
@@ -396,9 +396,9 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do
396
396
397 withdict :: Cpp -> Cpp
397 withdict :: Cpp -> Cpp
398 withdict cpp' = maybeRemCaps $ CppLambda
398 withdict cpp' = maybeRemCaps $ CppLambda
399− [CppCaptureAll]
399+ [CaptureAll]
400− [(localdict, Just $ CppAny [CppConst, CppRef])]
400+ [(localdict, Just $ Any [Const, Ref])]
401− (Just $ CppAny [])
401+ (Just $ Any [])
402 (asReturnBlock cpp')
402 (asReturnBlock cpp')
403 topdict :: String
403 topdict :: String
404 topdict = "_$dict$_"
404 topdict = "_$dict$_"
@@ -442,7 +442,7 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do
442 CppArrayLiteral <$> mapM valueToCpp xs
442 CppArrayLiteral <$> mapM valueToCpp xs
443
443
444 valueToCpp (Literal _ (ObjectLiteral ps)) =
444 valueToCpp (Literal _ (ObjectLiteral ps)) =
445− CppMapLiteral CppRecord <$>
445+ CppMapLiteral Record <$>
446 mapM (sndM valueToCpp) ((\(k,v) -> (CppSymbol k, v)) <$> sortBy (compare `on` fst) ps)
446 mapM (sndM valueToCpp) ((\(k,v) -> (CppSymbol k, v)) <$> sortBy (compare `on` fst) ps)
447
447
448 valueToCpp (Accessor _ prop val) =
448 valueToCpp (Accessor _ prop val) =
@@ -454,7 +454,7 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do
454 updatedFields <- mapM (sndM valueToCpp) ps
454 updatedFields <- mapM (sndM valueToCpp) ps
455 let origKeys = (allKeys ty) \\ (fst <$> updatedFields)
455 let origKeys = (allKeys ty) \\ (fst <$> updatedFields)
456 origFields = (\key -> (key, CppIndexer (CppSymbol key) obj')) <$> origKeys
456 origFields = (\key -> (key, CppIndexer (CppSymbol key) obj')) <$> origKeys
457− return $ CppMapLiteral CppRecord $
457+ return $ CppMapLiteral Record $
458 (\(k,v) -> (CppSymbol k, v)) <$> sortBy (compare `on` fst) (origFields ++ updatedFields)
458 (\(k,v) -> (CppSymbol k, v)) <$> sortBy (compare `on` fst) (origFields ++ updatedFields)
459 where
459 where
460 allKeys :: T.Type -> [String]
460 allKeys :: T.Type -> [String]
@@ -470,8 +470,8 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do
470 return $
470 return $
471 CppLambda
471 CppLambda
472 []
472 []
473− [(identToCpp arg, Just $ CppAny [CppConst, CppRef])]
473+ [(identToCpp arg, Just $ Any [Const, Ref])]
474− (Just $ CppAny [])
474+ (Just $ Any [])
475 (asReturnBlock $ convertDictIndexers cpp')
475 (asReturnBlock $ convertDictIndexers cpp')
476 where
476 where
477 arg' = identToCpp arg
477 arg' = identToCpp arg
@@ -487,7 +487,7 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do
487 Var (_, _, _, Just IsNewtype) _ -> return (head args')
487 Var (_, _, _, Just IsNewtype) _ -> return (head args')
488 Var (_, _, _, Just IsTypeClassConstructor) (Qualified mn' (Ident classname)) ->
488 Var (_, _, _, Just IsTypeClassConstructor) (Qualified mn' (Ident classname)) ->
489 let Just (_, constraints, fns) = findClass (Qualified mn' (ProperName classname)) in
489 let Just (_, constraints, fns) = findClass (Qualified mn' (ProperName classname)) in
490− return . CppMapLiteral CppInstance $
490+ return . CppMapLiteral Instance $
491 zip
491 zip
492 (CppSymbol <$> (sort $ superClassDictionaryNames constraints) ++ (fst <$> fns))
492 (CppSymbol <$> (sort $ superClassDictionaryNames constraints) ++ (fst <$> fns))
493 args'
493 args'
@@ -563,7 +563,7 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do
563 (CppLambda
563 (CppLambda
564 []
564 []
565 []
565 []
566− (Just $ CppAny [])
566+ (Just $ Any [])
567 (CppBlock (assignments ++ concat cpps ++ [failedPatternError valNames])))
567 (CppBlock (assignments ++ concat cpps ++ [failedPatternError valNames])))
568 []
568 []
569 where
569 where
@@ -607,7 +607,7 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do
607 binderToCpp varName done (VarBinder _ ident) =
607 binderToCpp varName done (VarBinder _ ident) =
608 return $
608 return $
609 CppVariableIntroduction
609 CppVariableIntroduction
610− (identToCpp ident, Just $ CppAny [CppConst])
610+ (identToCpp ident, Just $ Any [Const])
611 []
611 []
612 (Just $ CppVar varName)
612 (Just $ CppVar varName)
613 : done
613 : done
@@ -665,7 +665,7 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do
665 cpp <- binderToCpp varName done binder
665 cpp <- binderToCpp varName done binder
666 return $
666 return $
667 CppVariableIntroduction
667 CppVariableIntroduction
668− (identToCpp ident, Just $ CppAny [CppConst])
668+ (identToCpp ident, Just $ Any [Const])
669 []
669 []
670 (Just $ CppVar varName)
670 (Just $ CppVar varName)
671 : cpp
671 : cpp
@@ -811,9 +811,9 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do
811 return $
811 return $
812 [ CppFunction
812 [ CppFunction
813 (curriedName name)
813 (curriedName name)
814− [(head argNames, Just $ CppAny [CppConst, CppRef])]
814+ [(head argNames, Just $ Any [Const, Ref])]
815− (Just $ CppAny [])
815+ (Just $ Any [])
816− (if arity' == 1 then [CppInline] else [])
816+ (if arity' == 1 then [Inline] else [])
817 (asReturnBlock $
817 (asReturnBlock $
818 curriedLambda
818 curriedLambda
819 (tail argNames)
819 (tail argNames)
@@ -836,9 +836,9 @@ asReturnBlock cpp = CppBlock [CppReturn cpp]
836curriedLambda :: [String] -> Cpp -> Cpp
836curriedLambda :: [String] -> Cpp -> Cpp
837---------------------------------------------------------------------------------------------------
837---------------------------------------------------------------------------------------------------
838curriedLambda args ret = foldr (\arg ret' -> CppLambda
838curriedLambda args ret = foldr (\arg ret' -> CppLambda
839− [CppCaptureAll]
839+ [CaptureAll]
840− [(arg, Just $ CppAny [CppConst, CppRef])]
840+ [(arg, Just $ Any [Const, Ref])]
841− (Just $ CppAny [])
841+ (Just $ Any [])
842 (asReturnBlock ret')
842 (asReturnBlock ret')
843 ) ret args
843 ) ret args
844
844
@@ -947,8 +947,8 @@ filterInlineFuncs = everywhereOnCpp convert
947 convert :: Cpp -> Cpp
947 convert :: Cpp -> Cpp
948 convert (CppBlock []) = CppBlock []
948 convert (CppBlock []) = CppBlock []
949 convert (CppFunction n ps r qs cpp)
949 convert (CppFunction n ps r qs cpp)
950− | CppInline `elem` qs,
950+ | Inline `elem` qs,
951− everythingOnCpp (||) shouldRemove cpp = CppFunction n ps r (delete CppInline qs) cpp
951+ everythingOnCpp (||) shouldRemove cpp = CppFunction n ps r (delete Inline qs) cpp
952 where
952 where
953 shouldRemove :: Cpp -> Bool
953 shouldRemove :: Cpp -> Bool
954 shouldRemove CppSymbol{} = True
954 shouldRemove CppSymbol{} = True
src/Language/PureScript/CodeGen/Cpp/AST.hs+4−4
@@ -185,7 +185,7 @@ data Cpp
185 -- |
185 -- |
186 -- An object literal
186 -- An object literal
187 --
187 --
188− | CppMapLiteral CppMapType [(Cpp, Cpp)]
188+ | CppMapLiteral MapType [(Cpp, Cpp)]
189 -- |
189 -- |
190 -- An general property accessor expression (property, expr)
190 -- An general property accessor expression (property, expr)
191 --
191 --
@@ -193,11 +193,11 @@ data Cpp
193 -- |
193 -- |
194 -- A function introduction (name, arguments, return type, qualifiers, body)
194 -- A function introduction (name, arguments, return type, qualifiers, body)
195 --
195 --
196− | CppFunction String [(String, Maybe CppType)] (Maybe CppType) [CppValueQual] Cpp
196+ | CppFunction String [(String, Maybe CppType)] (Maybe CppType) [ValueQual] Cpp
197 -- |
197 -- |
198 -- A lambda introduction (arguments, return type, body)
198 -- A lambda introduction (arguments, return type, body)
199 --
199 --
200− | CppLambda [CppCaptureType] [(String, Maybe CppType)] (Maybe CppType) Cpp
200+ | CppLambda [CaptureType] [(String, Maybe CppType)] (Maybe CppType) Cpp
201 -- |
201 -- |
202 -- Value type cast
202 -- Value type cast
203 --
203 --
@@ -242,7 +242,7 @@ data Cpp
242 -- |
242 -- |
243 -- A variable introduction and optional initialization
243 -- A variable introduction and optional initialization
244 --
244 --
245− | CppVariableIntroduction (String, Maybe CppType) [CppValueQual] (Maybe Cpp)
245+ | CppVariableIntroduction (String, Maybe CppType) [ValueQual] (Maybe Cpp)
246 -- |
246 -- |
247 -- A variable assignment
247 -- A variable assignment
248 --
248 --
src/Language/PureScript/CodeGen/Cpp/File.hs+23−23
@@ -38,8 +38,8 @@ toHeader = catMaybes . map go
38 | otherwise = Nothing
38 | otherwise = Nothing
39 go cpp@(CppUseNamespace{}) = Just cpp
39 go cpp@(CppUseNamespace{}) = Just cpp
40 go (CppFunction _ _ _ qs _)
40 go (CppFunction _ _ _ qs _)
41− | CppInline `elem` qs = Nothing
41+ | Inline `elem` qs = Nothing
42− go (CppFunction _ [(_, atyp)] _ _ (CppBlock [CppReturn (CppApp _ [_])])) | atyp == Just (CppAuto [])
42+ go (CppFunction _ [(_, atyp)] _ _ (CppBlock [CppReturn (CppApp _ [_])])) | atyp == Just (Auto [])
43 = Nothing
43 = Nothing
44 go (CppFunction name args rtyp qs _) =
44 go (CppFunction name args rtyp qs _) =
45 let args' = (\(_,t) -> ("", t)) <$> args in
45 let args' = (\(_,t) -> ("", t)) <$> args in
@@ -58,10 +58,10 @@ toHeader = catMaybes . map go
58 -- Generate thunks for top-level values
58 -- Generate thunks for top-level values
59 go (CppVariableIntroduction (name, _) _ (Just cpp)) =
59 go (CppVariableIntroduction (name, _) _ (Just cpp)) =
60 case cpp of
60 case cpp of
61− CppMapLiteral CppInstance _ ->
61+ CppMapLiteral Instance _ ->
62− Just $ CppFunction name [("", Just thunkMarkerType)] (Just $ CppAny [CppConst, CppRef]) [] CppNoOp
62+ Just $ CppFunction name [("", Just thunkMarkerType)] (Just $ Any [Const, Ref]) [] CppNoOp
63 _ ->
63 _ ->
64− Just $ CppVariableIntroduction (name, Just $ CppAny [CppConst]) [CppExtern] Nothing
64+ Just $ CppVariableIntroduction (name, Just $ Any [Const]) [Extern] Nothing
65 go cpp@(CppStruct {}) =
65 go cpp@(CppStruct {}) =
66 Just cpp
66 Just cpp
67 go (CppComment comms cpp')
67 go (CppComment comms cpp')
@@ -79,9 +79,9 @@ toHeaderFns = catMaybes . map go
79 | cpps'@(_:_) <- toHeaderFns cpps = Just (CppNamespace name cpps')
79 | cpps'@(_:_) <- toHeaderFns cpps = Just (CppNamespace name cpps')
80 | otherwise = Nothing
80 | otherwise = Nothing
81 go cpp@(CppFunction _ _ _ qs _)
81 go cpp@(CppFunction _ _ _ qs _)
82− | CppInline `elem` qs = Just cpp
82+ | Inline `elem` qs = Just cpp
83 go (CppFunction name [(_, atyp)] _ _ (CppBlock [CppReturn (CppApp cpp [_])]))
83 go (CppFunction name [(_, atyp)] _ _ (CppBlock [CppReturn (CppApp cpp [_])]))
84− | Just CppAuto {} <- atyp
84+ | Just Auto {} <- atyp
85 = Just (CppVariableIntroduction (name, Nothing) [] (Just cpp))
85 = Just (CppVariableIntroduction (name, Nothing) [] (Just cpp))
86 go cpp@(CppVariableIntroduction _ _ (Just CppNumericLiteral {})) =
86 go cpp@(CppVariableIntroduction _ _ (Just CppNumericLiteral {})) =
87 Just cpp
87 Just cpp
@@ -114,7 +114,7 @@ toBody = catMaybes . map go
114 | otherwise = Nothing
114 | otherwise = Nothing
115 go cpp@(CppUseNamespace{}) = Just cpp
115 go cpp@(CppUseNamespace{}) = Just cpp
116 go (CppFunction _ _ _ qs _)
116 go (CppFunction _ _ _ qs _)
117− | CppInline `elem` qs = Nothing
117+ | Inline `elem` qs = Nothing
118 go cpp@(CppFunction {}) = Just cpp
118 go cpp@(CppFunction {}) = Just cpp
119 go (CppVariableIntroduction _ _ (Just CppNumericLiteral {})) =
119 go (CppVariableIntroduction _ _ (Just CppNumericLiteral {})) =
120 Nothing
120 Nothing
@@ -130,14 +130,14 @@ toBody = catMaybes . map go
130 -- Generate thunks for top-level values
130 -- Generate thunks for top-level values
131 go (CppVariableIntroduction (name, _) _ (Just cpp)) =
131 go (CppVariableIntroduction (name, _) _ (Just cpp)) =
132 case cpp of
132 case cpp of
133− CppMapLiteral CppInstance _ ->
133+ CppMapLiteral Instance _ ->
134− Just $ CppFunction name [("", Just thunkMarkerType)] (Just $ CppAny [CppConst, CppRef]) [] block
134+ Just $ CppFunction name [("", Just thunkMarkerType)] (Just $ Any [Const, Ref]) [] block
135 _ ->
135 _ ->
136− Just $ CppVariableIntroduction (name, Just $ CppAny [CppConst]) [] (Just lambda)
136+ Just $ CppVariableIntroduction (name, Just $ Any [Const]) [] (Just lambda)
137 where
137 where
138− val = CppVariableIntroduction ("$value$", Just $ CppAny [CppConst]) [CppStatic] (Just $ addCaptures cpp)
138+ val = CppVariableIntroduction ("$value$", Just $ Any [Const]) [Static] (Just $ addCaptures cpp)
139 block = CppBlock [val, CppReturn (CppVar "$value$")]
139 block = CppBlock [val, CppReturn (CppVar "$value$")]
140− lambda = CppLambda [] [("", Just $ thunkMarkerType)] (Just $ CppAny [CppConst, CppRef]) block
140+ lambda = CppLambda [] [("", Just $ thunkMarkerType)] (Just $ Any [Const, Ref]) block
141 addCaptures :: Cpp -> Cpp
141 addCaptures :: Cpp -> Cpp
142 addCaptures (CppMapLiteral t objs) = CppMapLiteral t (objlam <$> objs)
142 addCaptures (CppMapLiteral t objs) = CppMapLiteral t (objlam <$> objs)
143 where
143 where
@@ -148,7 +148,7 @@ toBody = catMaybes . map go
148 addCaptures cpps' = everywhereOnCpp addCapture cpps'
148 addCaptures cpps' = everywhereOnCpp addCapture cpps'
149 where
149 where
150 addCapture :: Cpp -> Cpp
150 addCapture :: Cpp -> Cpp
151− addCapture (CppLambda _ args rty body) = maybeRemCaps $ CppLambda [CppCaptureAll] args rty body
151+ addCapture (CppLambda _ args rty body) = maybeRemCaps $ CppLambda [CaptureAll] args rty body
152 addCapture cpp' = cpp'
152 addCapture cpp' = cpp'
153 go (CppComment comms cpp') | Just commented <- go cpp' = Just (CppComment comms commented)
153 go (CppComment comms cpp') | Just commented <- go cpp' = Just (CppComment comms commented)
154 go _ = Nothing
154 go _ = Nothing
@@ -156,17 +156,17 @@ toBody = catMaybes . map go
156-------------------------------------------------------------------------------------------------
156-------------------------------------------------------------------------------------------------
157maybeRemCaps :: Cpp -> Cpp
157maybeRemCaps :: Cpp -> Cpp
158-------------------------------------------------------------------------------------------------
158-------------------------------------------------------------------------------------------------
159−maybeRemCaps (CppLambda [CppCaptureAll] args rtyp body@(CppBlock [CppReturn CppNumericLiteral{}]))
159+maybeRemCaps (CppLambda [CaptureAll] args rtyp body@(CppBlock [CppReturn CppNumericLiteral{}]))
160 = CppLambda [] args rtyp body
160 = CppLambda [] args rtyp body
161−maybeRemCaps (CppLambda [CppCaptureAll] args rtyp body@(CppBlock [CppReturn CppStringLiteral{}]))
161+maybeRemCaps (CppLambda [CaptureAll] args rtyp body@(CppBlock [CppReturn CppStringLiteral{}]))
162 = CppLambda [] args rtyp body
162 = CppLambda [] args rtyp body
163−maybeRemCaps (CppLambda [CppCaptureAll] args rtyp body@(CppBlock [CppReturn CppCharLiteral{}]))
163+maybeRemCaps (CppLambda [CaptureAll] args rtyp body@(CppBlock [CppReturn CppCharLiteral{}]))
164 = CppLambda [] args rtyp body
164 = CppLambda [] args rtyp body
165−maybeRemCaps (CppLambda [CppCaptureAll] args rtyp body@(CppBlock [CppReturn CppBooleanLiteral{}]))
165+maybeRemCaps (CppLambda [CaptureAll] args rtyp body@(CppBlock [CppReturn CppBooleanLiteral{}]))
166 = CppLambda [] args rtyp body
166 = CppLambda [] args rtyp body
167−maybeRemCaps (CppLambda [CppCaptureAll] args rtyp body@(CppBlock [CppReturn CppAccessor{}]))
167+maybeRemCaps (CppLambda [CaptureAll] args rtyp body@(CppBlock [CppReturn CppAccessor{}]))
168 = CppLambda [] args rtyp body
168 = CppLambda [] args rtyp body
169−maybeRemCaps (CppLambda [CppCaptureAll] args rtyp body@(CppBlock [CppReturn (CppVar "unit")])) -- TODO: not really safe
169+maybeRemCaps (CppLambda [CaptureAll] args rtyp body@(CppBlock [CppReturn (CppVar "unit")])) -- TODO: not really safe
170 = CppLambda [] args rtyp body
170 = CppLambda [] args rtyp body
171maybeRemCaps cpp = cpp
171maybeRemCaps cpp = cpp
172
172
@@ -188,10 +188,10 @@ isMain _ = False
188
188
189nativeMain :: Cpp
189nativeMain :: Cpp
190nativeMain = CppFunction "main"
190nativeMain = CppFunction "main"
191− [ ([], Just $ CppPrimitive "int")
191+ [ ([], Just $ Primitive "int")
192− , ([], Just $ CppPrimitive "char *[]")
192+ , ([], Just $ Primitive "char *[]")
193 ]
193 ]
194− (Just $ CppPrimitive "int")
194+ (Just $ Primitive "int")
195 []
195 []
196 (CppBlock [ CppUseNamespace "Main"
196 (CppBlock [ CppUseNamespace "Main"
197 , CppApp (CppVar "INITIALIZE_GC") []
197 , CppApp (CppVar "INITIALIZE_GC") []
src/Language/PureScript/CodeGen/Cpp/Optimizer/Inliner.hs+11−11
@@ -231,14 +231,14 @@ inlineCommonOperators = applyAll $
231 -- where
231 -- where
232 -- convert :: Cpp -> Cpp
232 -- convert :: Cpp -> Cpp
233 -- convert (CppApp mkFnN [CppLambda _ [_] _ (CppBlock cpp)]) | isNFn C.mkFn 0 mkFnN =
233 -- convert (CppApp mkFnN [CppLambda _ [_] _ (CppBlock cpp)]) | isNFn C.mkFn 0 mkFnN =
234− -- CppLambda [CppCaptureAll] [] Nothing (CppBlock cpp)
234+ -- CppLambda [CaptureAll] [] Nothing (CppBlock cpp)
235 -- convert other = other
235 -- convert other = other
236 -- mkFn n = everywhereOnCpp convert
236 -- mkFn n = everywhereOnCpp convert
237 -- where
237 -- where
238 -- convert :: Cpp -> Cpp
238 -- convert :: Cpp -> Cpp
239 -- convert orig@(CppApp mkFnN [fn]) | isNFn C.mkFn n mkFnN =
239 -- convert orig@(CppApp mkFnN [fn]) | isNFn C.mkFn n mkFnN =
240 -- case collectArgs n [] fn of
240 -- case collectArgs n [] fn of
241− -- Just (args, cpp) -> CppLambda [CppCaptureAll] args Nothing (CppBlock cpp)
241+ -- Just (args, cpp) -> CppLambda [CaptureAll] args Nothing (CppBlock cpp)
242 -- Nothing -> orig
242 -- Nothing -> orig
243 -- convert other = other
243 -- convert other = other
244 -- collectArgs :: Int -> [String] -> Cpp -> Maybe ([String], [Cpp])
244 -- collectArgs :: Int -> [String] -> Cpp -> Maybe ([String], [Cpp])
@@ -277,17 +277,17 @@ inlineFnComposition = everywhereOnCppTopDownM convert
277 convert (CppApp fn [dict', x, y])
277 convert (CppApp fn [dict', x, y])
278 | isFnCompose dict' fn = do
278 | isFnCompose dict' fn = do
279 arg <- freshName
279 arg <- freshName
280− return $ CppLambda [CppCaptureAll] [(arg, constAnyRef)] Nothing (CppBlock [CppReturn $ CppApp x [CppApp y [CppVar arg]]])
280+ return $ CppLambda [CaptureAll] [(arg, constAnyRef)] Nothing (CppBlock [CppReturn $ CppApp x [CppApp y [CppVar arg]]])
281 | isFnComposeFlipped dict' fn = do
281 | isFnComposeFlipped dict' fn = do
282 arg <- freshName
282 arg <- freshName
283− return $ CppLambda [CppCaptureAll] [(arg, constAnyRef)] Nothing (CppBlock [CppReturn $ CppApp y [CppApp x [CppVar arg]]])
283+ return $ CppLambda [CaptureAll] [(arg, constAnyRef)] Nothing (CppBlock [CppReturn $ CppApp y [CppApp x [CppVar arg]]])
284 convert (CppApp (CppApp (CppApp fn [dict']) [x]) [y])
284 convert (CppApp (CppApp (CppApp fn [dict']) [x]) [y])
285 | isFnCompose dict' fn = do
285 | isFnCompose dict' fn = do
286 arg <- freshName
286 arg <- freshName
287− return $ CppLambda [CppCaptureAll] [(arg, constAnyRef)] Nothing (CppBlock [CppReturn $ CppApp x [CppApp y [CppVar arg]]])
287+ return $ CppLambda [CaptureAll] [(arg, constAnyRef)] Nothing (CppBlock [CppReturn $ CppApp x [CppApp y [CppVar arg]]])
288 | isFnComposeFlipped dict' fn = do
288 | isFnComposeFlipped dict' fn = do
289 arg <- freshName
289 arg <- freshName
290− return $ CppLambda [CppCaptureAll] [(arg, constAnyRef)] Nothing (CppBlock [CppReturn $ CppApp y [CppApp x [CppVar arg]]])
290+ return $ CppLambda [CaptureAll] [(arg, constAnyRef)] Nothing (CppBlock [CppReturn $ CppApp y [CppApp x [CppVar arg]]])
291 convert other = return other
291 convert other = return other
292 isFnCompose :: Cpp -> Cpp -> Bool
292 isFnCompose :: Cpp -> Cpp -> Bool
293 isFnCompose dict' fn = isDict semigroupoidFn dict' && isFn fnCompose fn
293 isFnCompose dict' fn = isDict semigroupoidFn dict' && isFn fnCompose fn
@@ -302,9 +302,9 @@ toAutoVars :: Cpp -> Cpp
302toAutoVars = everywhereOnCpp convert
302toAutoVars = everywhereOnCpp convert
303 where
303 where
304 convert :: Cpp -> Cpp
304 convert :: Cpp -> Cpp
305− convert cpp@(CppVariableIntroduction (ident, (Just (CppAny tqs))) qs (Just value))
305+ convert cpp@(CppVariableIntroduction (ident, (Just (Any tqs))) qs (Just value))
306− | CppStatic `notElem` qs,
306+ | Static `notElem` qs,
307− CppRef `notElem` tqs =
307+ Ref `notElem` tqs =
308 case value of
308 case value of
309 CppNumericLiteral {} -> var auto'
309 CppNumericLiteral {} -> var auto'
310 CppBooleanLiteral {} -> var auto'
310 CppBooleanLiteral {} -> var auto'
@@ -315,8 +315,8 @@ toAutoVars = everywhereOnCpp convert
315 CppAccessor (CppVar {}) _ -> var autoref'
315 CppAccessor (CppVar {}) _ -> var autoref'
316 _ -> cpp
316 _ -> cpp
317 where
317 where
318− auto' = CppAuto tqs
318+ auto' = Auto tqs
319− autoref' | CppConst `elem` tqs = CppAuto (CppRef : tqs)
319+ autoref' | Const `elem` tqs = Auto (Ref : tqs)
320 | otherwise = auto'
320 | otherwise = auto'
321 var t = CppVariableIntroduction (ident, (Just t)) qs (Just value)
321 var t = CppVariableIntroduction (ident, (Just t)) qs (Just value)
322 convert cpp = cpp
322 convert cpp = cpp
src/Language/PureScript/CodeGen/Cpp/Optimizer/MagicDo.hs+5−5
@@ -74,12 +74,12 @@ magicDo' = everywhereOnCpp undo . everywhereOnCppTopDown convert
74 | otherwise = CppVariableIntroduction arg [] (Just (CppApp m []))
74 | otherwise = CppVariableIntroduction arg [] (Just (CppApp m []))
75 -- Desugar untilE
75 -- Desugar untilE
76 convert (CppApp (CppApp f [arg]) []) | isEffFunc C.untilE f =
76 convert (CppApp (CppApp f [arg]) []) | isEffFunc C.untilE f =
77− CppApp (CppLambda [CppCaptureAll] [] Nothing (CppBlock [ CppWhile (CppUnary Not (CppApp arg [])) (CppBlock []), CppReturn $ CppMapLiteral CppRecord []])) []
77+ CppApp (CppLambda [CaptureAll] [] Nothing (CppBlock [ CppWhile (CppUnary Not (CppApp arg [])) (CppBlock []), CppReturn $ CppMapLiteral Record []])) []
78 -- Desugar whileE
78 -- Desugar whileE
79 convert (CppApp (CppApp f [arg1, arg2]) []) | isEffFunc C.whileE f =
79 convert (CppApp (CppApp f [arg1, arg2]) []) | isEffFunc C.whileE f =
80− CppApp (CppLambda [CppCaptureAll] [] Nothing (CppBlock [ CppWhile (CppApp arg1 []) (CppBlock [ CppApp arg2 [] ]), CppReturn $ CppMapLiteral CppRecord []])) []
80+ CppApp (CppLambda [CaptureAll] [] Nothing (CppBlock [ CppWhile (CppApp arg1 []) (CppBlock [ CppApp arg2 [] ]), CppReturn $ CppMapLiteral Record []])) []
81 convert (CppApp (CppApp (CppApp f [arg1]) [arg2]) []) | isEffFunc C.whileE f =
81 convert (CppApp (CppApp (CppApp f [arg1]) [arg2]) []) | isEffFunc C.whileE f =
82− CppApp (CppLambda [CppCaptureAll] [] Nothing (CppBlock [ CppWhile (CppApp arg1 []) (CppBlock [ CppApp arg2 [] ]), CppReturn $ CppMapLiteral CppRecord []])) []
82+ CppApp (CppLambda [CaptureAll] [] Nothing (CppBlock [ CppWhile (CppApp arg1 []) (CppBlock [ CppApp arg2 [] ]), CppReturn $ CppMapLiteral Record []])) []
83 convert other = other
83 convert other = other
84 -- Check if an expression represents a monomorphic call to >>= for the Eff monad
84 -- Check if an expression represents a monomorphic call to >>= for the Eff monad
85 isBind (CppApp fn [dict]) | isDict (C.eff, C.bindEffDictionary) dict && isBindPoly fn = True
85 isBind (CppApp fn [dict]) | isDict (C.eff, C.bindEffDictionary) dict && isBindPoly fn = True
@@ -98,7 +98,7 @@ magicDo' = everywhereOnCpp undo . everywhereOnCppTopDown convert
98 -- Remove __do function applications which remain after desugaring
98 -- Remove __do function applications which remain after desugaring
99 undo :: Cpp -> Cpp
99 undo :: Cpp -> Cpp
100 undo (CppReturn (CppApp (CppFunction ident [] _ _ body) [])) | ident == fnName = body
100 undo (CppReturn (CppApp (CppFunction ident [] _ _ body) [])) | ident == fnName = body
101− undo (CppFunction ident [] rty _ body) | ident == fnName = CppLambda [CppCaptureAll] [] rty body
101+ undo (CppFunction ident [] rty _ body) | ident == fnName = CppLambda [CaptureAll] [] rty body
102 undo other = other
102 undo other = other
103
103
104 applyReturns :: Cpp -> Cpp
104 applyReturns :: Cpp -> Cpp
@@ -128,7 +128,7 @@ inlineST = everywhereOnCpp convertBlock
128 -- or in a more aggressive way, turning wrappers into local variables depending on the
128 -- or in a more aggressive way, turning wrappers into local variables depending on the
129 -- agg(ressive) parameter.
129 -- agg(ressive) parameter.
130 convert agg (CppApp f [arg]) | isSTFunc C.newSTRef f =
130 convert agg (CppApp f [arg]) | isSTFunc C.newSTRef f =
131− CppLambda [CppCaptureAll] [] Nothing (CppBlock [CppReturn $ if agg then arg else CppMapLiteral CppRecord [(CppSymbol C.stRefValue, arg)]])
131+ CppLambda [CaptureAll] [] Nothing (CppBlock [CppReturn $ if agg then arg else CppMapLiteral Record [(CppSymbol C.stRefValue, arg)]])
132 convert agg (CppApp (CppApp f [ref]) []) | isSTFunc C.readSTRef f =
132 convert agg (CppApp (CppApp f [ref]) []) | isSTFunc C.readSTRef f =
133 if agg then ref else CppAccessor (CppVar C.stRefValue) ref
133 if agg then ref else CppAccessor (CppVar C.stRefValue) ref
134 convert agg (CppApp (CppApp (CppApp f [ref]) [arg]) []) | isSTFunc C.writeSTRef f =
134 convert agg (CppApp (CppApp (CppApp f [ref]) [arg]) []) | isSTFunc C.writeSTRef f =
src/Language/PureScript/CodeGen/Cpp/Optimizer/TCO.hs+4−4
@@ -18,7 +18,7 @@ module Language.PureScript.CodeGen.Cpp.Optimizer.TCO (tco) where
18import Prelude.Compat
18import Prelude.Compat
19
19
20import Data.List
20import Data.List
21−import Data.Monoid
21+import qualified Data.Monoid as Monoid
22
22
23import Language.PureScript.Options
23import Language.PureScript.Options
24import Language.PureScript.CodeGen.Cpp.Types
24import Language.PureScript.CodeGen.Cpp.Types
@@ -111,7 +111,7 @@ tco' = everywhereOnCpp convert
111
111
112 toLoop :: String -> [String] -> Cpp -> Cpp
112 toLoop :: String -> [String] -> Cpp -> Cpp
113 toLoop ident allArgs cpp = CppBlock $
113 toLoop ident allArgs cpp = CppBlock $
114− map (\arg -> CppVariableIntroduction (arg, Just $ CppAny []) [] (Just (CppVar (copyVar arg)))) allArgs ++
114+ map (\arg -> CppVariableIntroduction (arg, Just $ Any []) [] (Just (CppVar (copyVar arg)))) allArgs ++
115 [ CppWhile (CppBooleanLiteral True) (CppBlock loop) ]
115 [ CppWhile (CppBooleanLiteral True) (CppBlock loop) ]
116 where
116 where
117 loop :: [Cpp]
117 loop :: [Cpp]
@@ -125,7 +125,7 @@ tco' = everywhereOnCpp convert
125 allArgumentValues = concat $ collectSelfCallArgs [] ret
125 allArgumentValues = concat $ collectSelfCallArgs [] ret
126 in
126 in
127 CppBlock $ zipWith (\val arg ->
127 CppBlock $ zipWith (\val arg ->
128− CppVariableIntroduction (tcoVar arg, Just $ CppAny [CppConst]) [] (Just val)) allArgumentValues allArgs
128+ CppVariableIntroduction (tcoVar arg, Just $ Any [Const]) [] (Just val)) allArgumentValues allArgs
129 ++ map (\arg ->
129 ++ map (\arg ->
130 CppAssignment (CppVar arg) (CppVar (tcoVar arg))) allArgs
130 CppAssignment (CppVar arg) (CppVar (tcoVar arg))) allArgs
131 ++ [ CppContinue ]
131 ++ [ CppContinue ]
@@ -145,7 +145,7 @@ tco' = everywhereOnCpp convert
145 isSelfCallWithFnArgs _ _ _ = False
145 isSelfCallWithFnArgs _ _ _ = False
146
146
147 hasFunction :: Cpp -> Bool
147 hasFunction :: Cpp -> Bool
148− hasFunction = getAny . everythingOnCpp mappend (Any . isFunction)
148+ hasFunction = Monoid.getAny . everythingOnCpp mappend (Monoid.Any . isFunction)
149 where
149 where
150 isFunction (CppFunction {}) = True
150 isFunction (CppFunction {}) = True
151 isFunction _ = False
151 isFunction _ = False
src/Language/PureScript/CodeGen/Cpp/Types.hs+39−39
@@ -28,79 +28,79 @@ import qualified Language.PureScript.Constants as C
28
28
29-- import Debug.Trace
29-- import Debug.Trace
30
30
31−data CppType = CppPrimitive String | CppAuto [CppTypeQual] | CppAny [CppTypeQual]
31+data CppType = Primitive String | Auto [TypeQual] | Any [TypeQual]
32 deriving (Show, Read, Eq)
32 deriving (Show, Read, Eq)
33
33
34−data CppTypeQual = CppConst | CppRef
34+data TypeQual = Const | Ref
35 deriving (Show, Read, Eq)
35 deriving (Show, Read, Eq)
36
36
37-- |
37-- |
38-- Value C++11 qualifiers
38-- Value C++11 qualifiers
39--
39--
40−data CppValueQual
40+data ValueQual
41 -- |
41 -- |
42 -- C++ static qualifier
42 -- C++ static qualifier
43 --
43 --
44− = CppStatic
44+ = Static
45 -- |
45 -- |
46 -- Inline function
46 -- Inline function
47 --
47 --
48− | CppInline
48+ | Inline
49 -- |
49 -- |
50 -- C++11+ constant expression "constexpr"
50 -- C++11+ constant expression "constexpr"
51 --
51 --
52− | CppConstExpr
52+ | ConstExpr
53 -- |
53 -- |
54 -- Extern value
54 -- Extern value
55 --
55 --
56− | CppExtern
56+ | Extern
57 -- |
57 -- |
58 -- Function or lambda is involved in recursion
58 -- Function or lambda is involved in recursion
59 --
59 --
60− | CppRecursive
60+ | Recursive
61 -- |
61 -- |
62 -- Function or lambda is involved in recursion
62 -- Function or lambda is involved in recursion
63 --
63 --
64− | CppTopLevel
64+ | TopLevel
65 deriving (Show, Read, Eq)
65 deriving (Show, Read, Eq)
66
66
67-- |
67-- |
68-- C++ lambda capture list
68-- C++ lambda capture list
69--
69--
70−data CppCaptureType = CppCaptureAll
70+data CaptureType = CaptureAll
71 deriving (Show, Read, Eq)
71 deriving (Show, Read, Eq)
72
72
73-- |
73-- |
74-- C++ object/map literal type
74-- C++ object/map literal type
75--
75--
76−data CppMapType = CppInstance | CppRecord
76+data MapType = Instance | Record
77 deriving (Show, Eq)
77 deriving (Show, Eq)
78
78
79runType :: CppType -> String
79runType :: CppType -> String
80−runType (CppPrimitive t) = t
80+runType (Primitive t) = t
81−runType (CppAuto []) = "auto"
81+runType (Auto []) = "auto"
82−runType (CppAny []) = "any"
82+runType (Any []) = "any"
83runType typ =
83runType typ =
84 case typ of
84 case typ of
85− CppAuto qs -> rendered CppAuto qs
85+ Auto qs -> rendered Auto qs
86− CppAny qs -> rendered CppAny qs
86+ Any qs -> rendered Any qs
87− _ -> rendered CppAny []
87+ _ -> rendered Any []
88 where
88 where
89 rendered t qs
89 rendered t qs
90− | CppConst `elem` qs = "const " ++ (runType . t $ delete CppConst qs)
90+ | Const `elem` qs = "const " ++ (runType . t $ delete Const qs)
91− | CppRef `elem` qs = runType (t $ delete CppRef qs) ++ "&"
91+ | Ref `elem` qs = runType (t $ delete Ref qs) ++ "&"
92 | otherwise = runType (t qs)
92 | otherwise = runType (t qs)
93
93
94−runValueQual :: CppValueQual -> String
94+runValueQual :: ValueQual -> String
95−runValueQual CppStatic = "static"
95+runValueQual Static = "static"
96−runValueQual CppInline = "inline"
96+runValueQual Inline = "inline"
97−runValueQual CppConstExpr = "constexpr"
97+runValueQual ConstExpr = "constexpr"
98−runValueQual CppExtern = "extern"
98+runValueQual Extern = "extern"
99−runValueQual CppRecursive = ""
99+runValueQual Recursive = ""
100−runValueQual CppTopLevel = ""
100+runValueQual TopLevel = ""
101
101
102−runCaptureType :: CppCaptureType -> String
102+runCaptureType :: CaptureType -> String
103−runCaptureType CppCaptureAll = "="
103+runCaptureType CaptureAll = "="
104
104
105-- TODO: move or remove this
105-- TODO: move or remove this
106--
106--
@@ -110,44 +110,44 @@ qualifiedToStr m f (Qualified (Just m') a) | m /= m' = moduleNameToCpp m' ++ "::
110qualifiedToStr _ f (Qualified _ a) = identToCpp (f a)
110qualifiedToStr _ f (Qualified _ a) = identToCpp (f a)
111
111
112boolType :: CppType
112boolType :: CppType
113−boolType = CppPrimitive "bool"
113+boolType = Primitive "bool"
114
114
115intType :: CppType
115intType :: CppType
116−intType = CppPrimitive "int"
116+intType = Primitive "int"
117
117
118doubleType :: CppType
118doubleType :: CppType
119−doubleType = CppPrimitive "double"
119+doubleType = Primitive "double"
120
120
121stringType :: CppType
121stringType :: CppType
122−stringType = CppPrimitive "string"
122+stringType = Primitive "string"
123
123
124charType :: CppType
124charType :: CppType
125−charType = CppPrimitive "char"
125+charType = Primitive "char"
126
126
127voidType :: CppType
127voidType :: CppType
128−voidType = CppPrimitive "void"
128+voidType = Primitive "void"
129
129
130mapType :: Int -> CppType
130mapType :: Int -> CppType
131mapType = maptype
131mapType = maptype
132 where
132 where
133 maptype 0 = mapprim "unknown_size"
133 maptype 0 = mapprim "unknown_size"
134 maptype n = mapprim $ show n
134 maptype n = mapprim $ show n
135− mapprim s = CppPrimitive $ "any::map<" ++ s ++ ">"
135+ mapprim s = Primitive $ "any::map<" ++ s ++ ">"
136
136
137dataType :: Int -> CppType
137dataType :: Int -> CppType
138−dataType n = CppPrimitive $ "any::data<" ++ show n ++ ">"
138+dataType n = Primitive $ "any::data<" ++ show n ++ ">"
139
139
140arrayType :: CppType
140arrayType :: CppType
141−arrayType = CppPrimitive "any::array"
141+arrayType = Primitive "any::array"
142
142
143thunkMarkerType :: CppType
143thunkMarkerType :: CppType
144−thunkMarkerType = CppPrimitive "any::as_thunk"
144+thunkMarkerType = Primitive "any::as_thunk"
145
145
146ctorKey :: String
146ctorKey :: String
147ctorKey = "constructor"
147ctorKey = "constructor"
148
148
149constAnyRef :: Maybe CppType
149constAnyRef :: Maybe CppType
150−constAnyRef = Just $ CppAny [CppConst, CppRef]
150+constAnyRef = Just $ Any [Const, Ref]
151
151
152symbolname :: String -> String
152symbolname :: String -> String
153symbolname = identToCpp . Ident
153symbolname = identToCpp . Ident
src/Language/PureScript/Pretty/Cpp.hs+3−3
@@ -247,7 +247,7 @@ literals = mkPattern' match
247 match (CppVariableIntroduction (ident, typ) qs value) =
247 match (CppVariableIntroduction (ident, typ) qs value) =
248 fmap concat $ sequence
248 fmap concat $ sequence
249 [ return . concatMap (++ " ") . filter (not . null) $ runValueQual <$> qs
249 [ return . concatMap (++ " ") . filter (not . null) $ runValueQual <$> qs
250− , return $ runType (fromMaybe (CppAny [CppConst]) typ) ++ " "
250+ , return $ runType (fromMaybe (Any [Const]) typ) ++ " "
251 , return ident
251 , return ident
252 , maybe (return "") (fmap (" = " ++) . prettyPrintCpp') value
252 , maybe (return "") (fmap (" = " ++) . prettyPrintCpp') value
253 ]
253 ]
@@ -302,7 +302,7 @@ literals = mkPattern' match
302 ]
302 ]
303 match (CppReturn value@(CppStringLiteral _)) = fmap concat $ sequence
303 match (CppReturn value@(CppStringLiteral _)) = fmap concat $ sequence
304 [ return "return "
304 [ return "return "
305− , return . runType $ CppAny []
305+ , return . runType $ Any []
306 , return "("
306 , return "("
307 , prettyPrintCpp' value
307 , prettyPrintCpp' value
308 , return ")"
308 , return ")"
@@ -515,7 +515,7 @@ dotsTo :: Char -> String -> String
515dotsTo chr' = map (\c -> if c == '.' then chr' else c)
515dotsTo chr' = map (\c -> if c == '.' then chr' else c)
516
516
517argstr :: (String, Maybe CppType) -> String
517argstr :: (String, Maybe CppType) -> String
518−argstr (name, Nothing) = argStr name (CppAuto [])
518+argstr (name, Nothing) = argStr name (Auto [])
519argstr (name, Just typ) | name == C.__unused = argStr [] typ
519argstr (name, Just typ) | name == C.__unused = argStr [] typ
520argstr (name, Just typ) = argStr name typ
520argstr (name, Just typ) = argStr name typ
521
521