353e3e2 · rowtype-yoga/purescript-native

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

C++: cleanup - get rid of some 'Cpp' prefixes

commit353e3e2e7f5cc79ca9a777280a046a4b0b84a467 authorAndy Arvanitis <andyarvanitis@gmail.com> dateMon 31 Oct 2016, 21:58 (10 years ago) parent5973897

8 files changed+145−145

compare with golang

unifiedsplit

src/Language/PureScript/CodeGen/Cpp.hs+56−56 src/Language/PureScript/CodeGen/Cpp/AST.hs+4−4 src/Language/PureScript/CodeGen/Cpp/File.hs+23−23 src/Language/PureScript/CodeGen/Cpp/Optimizer/Inliner.hs+11−11 src/Language/PureScript/CodeGen/Cpp/Optimizer/MagicDo.hs+5−5 src/Language/PureScript/CodeGen/Cpp/Optimizer/TCO.hs+4−4 src/Language/PureScript/CodeGen/Cpp/Types.hs+39−39 src/Language/PureScript/Pretty/Cpp.hs+3−3

src/Language/PureScript/CodeGen/Cpp.hs+56−56

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

7070 delete (ModuleName [ProperName C.prim]) . (\\ [mn]) $

7171 (snd <$> imps)

7272 let cppImports' = "PureScript" : cppImports

73− cppDecls <- concat <$> mapM (bindToCpp [CppTopLevel]) decls

73+ cppDecls <- concat <$> mapM (bindToCpp [TopLevel]) decls

7474 let cpps = filterInlineFuncs <$> cppDecls

7575 namesmap = M.toList .

7676 M.mapKeysMonotonic (qualifiedToCpp id) . M.map (\(t, _, _) -> arity t) $

@@ -119,16 +119,16 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do

119119 -- Generate code in the simplified C++1x intermediate representation for a declaration

120120 --

121121 -------------------------------------------------------------------------------------------------

122− bindToCpp :: [CppValueQual] -> Bind Ann -> m [Cpp]

122+ bindToCpp :: [ValueQual] -> Bind Ann -> m [Cpp]

123123 -------------------------------------------------------------------------------------------------

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

126126

127127 -- |

128128 -- Desugar a declaration into a variable introduction or named function

129129 -- declaration.

130130 -------------------------------------------------------------------------------------------------

131− declToCpp :: [CppValueQual] -> (Ann, Ident) -> Expr Ann -> m Cpp

131+ declToCpp :: [ValueQual] -> (Ann, Ident) -> Expr Ann -> m Cpp

132132 -------------------------------------------------------------------------------------------------

133133 declToCpp _ (_, ident) e@(Abs (_, _, _, Just IsTypeClassConstructor) _ _) =

134134 let className = identToCpp ident

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

136136 in return $ CppStruct className [CppEnum Nothing Nothing (sort supers ++ members)]

137137

138138 declToCpp vqs (_, ident) (Abs (_, com, ty, _) arg body) = do

139− fn <- if CppTopLevel `elem` vqs

139+ fn <- if TopLevel `elem` vqs

140140 then do

141141 argNames <- replicateM (arity' - length args' - 1) freshName

142142 let args'' = zip argNames (repeat aty)

@@ -154,13 +154,13 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do

154154 name

155155 (arg' : args' ++ args'')

156156 rty

157− (vqs ++ if isAccessor (snd abs') then [CppInline] else [])

157+ (vqs ++ if isAccessor (snd abs') then [Inline] else [])

158158 (convertNestedLambdas $ convertDictIndexers block)

159159 , CppFunction

160160 (curriedName name)

161161 [arg']

162162 rty

163− (if arity' == 1 then [CppInline] else [])

163+ (if arity' == 1 then [Inline] else [])

164164 (asReturnBlock $

165165 curriedLambda

166166 (fst <$> args' ++ args'')

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

173173 name

174174 [arg']

175175 rty

176− (vqs ++ if isIndexer block then [CppInline] else [])

176+ (vqs ++ if isIndexer block then [Inline] else [])

177177 (convertNestedLambdas . asReturnBlock $ convertDictIndexers block)

178178 return (CppComment com $ convertIfPrimFn ty' fn)

179179 where

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

182182 | otherwise = Nothing

183183 arity' = maybe 0 arity ty'

184184 name = identToCpp ident

185− aty = Just $ CppAny [CppConst, CppRef]

186− rty = Just $ CppAny []

185+ aty = Just $ Any [Const, Ref]

186+ rty = Just $ Any []

187187 arg' = (identToCpp arg, aty)

188188 args' = (\i -> (identToCpp i, aty)) <$> fst abs'

189189 abs' = unAbs body []

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

203203 CppFunction

204204 (identToCpp ident)

205205 []

206− (Just $ CppAny [])

207− [CppInline]

206+ (Just $ Any [])

207+ [Inline]

208208 (asReturnBlock $

209209 CppDataLiteral [CppAccessor (CppVar $ identToCpp ident) (CppVar "data")])

210210

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

213213 [ CppFunction

214214 name

215215 (farg <$> fields')

216− (Just $ CppAny [])

217− [CppInline]

216+ (Just $ Any [])

217+ [Inline]

218218 (asReturnBlock $

219219 CppDataLiteral $

220220 CppAccessor (CppVar name) (CppVar "data") : (CppVar <$> fields'))

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

224224 [ CppFunction

225225 (curriedName name)

226226 (farg <$> f)

227− (Just $ CppAny [])

228− (if length fields == 1 then [CppInline] else [])

227+ (Just $ Any [])

228+ (if length fields == 1 then [Inline] else [])

229229 (CppBlock (fieldLambdas fs))

230230 ]

231231 else

@@ -235,19 +235,19 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do

235235 fields' = identToCpp <$> fields

236236 (f, fs) | (f' : fs') <- fields' = ([f'], fs')

237237 | otherwise = ([], [])

238− farg = \x -> (x, Just $ CppAny [CppConst, CppRef])

238+ farg = \x -> (x, Just $ Any [Const, Ref])

239239 fieldLambdas flds

240240 | (f' : fs') <- flds = [ CppReturn . maybeRemCaps $

241241 CppLambda

242− [CppCaptureAll]

242+ [CaptureAll]

243243 (farg <$> [f'])

244− (Just $ CppAny [])

244+ (Just $ Any [])

245245 (CppBlock $ fieldLambdas fs') ]

246246 | otherwise = [CppReturn $ CppApp (CppVar name) (CppVar <$> fields')]

247247

248248 declToCpp qs (_, ident) e

249249 | Just ty <- exprType e,

250− CppTopLevel `elem` qs,

250+ TopLevel `elem` qs,

251251 arity' <- arity ty,

252252 arity' > 0 = do

253253 argNames <- replicateM arity' freshName

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

257257 (App nullAnn e (Var nullAnn . Qualified Nothing . Ident $ head argNames))

258258 let fn' = CppFunction

259259 (curriedName name)

260− [(head argNames, Just $ CppAny [CppConst, CppRef])]

260+ [(head argNames, Just $ Any [Const, Ref])]

261261 rty

262262 []

263263 (asReturnBlock $

@@ -277,14 +277,14 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do

277277 else []

278278 where

279279 name = identToCpp ident

280− aty = Just $ CppAny [CppConst, CppRef]

281− rty = Just $ CppAny []

280+ aty = Just $ Any [Const, Ref]

281+ rty = Just $ Any []

282282

283283 declToCpp qs (_, ident) val = do

284284 val' <- valueToCpp val

285285 return $

286286 CppVariableIntroduction

287− (identToCpp ident, Just $ CppAny [CppConst])

287+ (identToCpp ident, Just $ Any [Const])

288288 qs

289289 (Just val')

290290

@@ -302,12 +302,12 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do

302302 -------------------------------------------------------------------------------------------------

303303 fnToLambda (CppFunction name args _ qs body) =

304304 CppVariableIntroduction

305− (name, Just $ CppAny [CppConst])

306− (filter (==CppStatic) qs)

307− (Just $ CppLambda cs args (Just $ CppAny []) body)

305+ (name, Just $ Any [Const])

306+ (filter (==Static) qs)

307+ (Just $ CppLambda cs args (Just $ Any []) body)

308308 where

309− cs | (not . null) (qs `intersect` [CppInline, CppStatic]) = []

310− | otherwise = [CppCaptureAll]

309+ cs | (not . null) (qs `intersect` [Inline, Static]) = []

310+ | otherwise = [CaptureAll]

311311 fnToLambda (CppComment com cpp) = CppComment com (fnToLambda cpp)

312312 fnToLambda _ = error "Not a function!"

313313

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

318318 where

319319 go :: Cpp -> Cpp

320320 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

322322 go cpp = cpp

323323

324324 -------------------------------------------------------------------------------------------------

@@ -337,13 +337,13 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do

337337 filteredFns cpp = filter (\(f,_) -> everythingOnCpp (||) (== CppVar f) cpp) fns

338338

339339 recursive :: Cpp -> [Cpp]

340− recursive cpp'@(CppFunction _ _ _ qs _) | CppRecursive `elem` qs = [cpp']

341− recursive cpp'@(CppVariableIntroduction _ qs _) | CppRecursive `elem` qs = [cpp']

340+ recursive cpp'@(CppFunction _ _ _ qs _) | Recursive `elem` qs = [cpp']

341+ recursive cpp'@(CppVariableIntroduction _ qs _) | Recursive `elem` qs = [cpp']

342342 recursive _ = []

343343

344344 removeRec :: Cpp -> Cpp

345− removeRec (CppFunction _ _ _ qs _) | CppRecursive `elem` qs = CppNoOp

346− removeRec (CppVariableIntroduction _ qs _) | CppRecursive `elem` qs = CppNoOp

345+ removeRec (CppFunction _ _ _ qs _) | Recursive `elem` qs = CppNoOp

346+ removeRec (CppVariableIntroduction _ qs _) | Recursive `elem` qs = CppNoOp

347347 removeRec cpp' = cpp'

348348

349349 replaceVar :: [(String, Cpp)] -> Cpp -> Cpp

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

354354

355355 dict :: Cpp

356356 dict = CppVariableIntroduction

357− (topdict, Just $ CppAny [CppConst])

357+ (topdict, Just $ Any [Const])

358358 []

359359 (Just $ CppDataLiteral ((\(f,cpp) -> CppComment [LineComment f] cpp) <$> fns))

360360

@@ -375,14 +375,14 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do

375375 accessor :: String -> (String, Cpp) -> Cpp

376376 accessor dictname (name, _) =

377377 CppVariableIntroduction

378− (name, Just $ CppAny [CppConst])

378+ (name, Just $ Any [Const])

379379 []

380380 (Just . snd $ accessed dictname name)

381381

382382 toelem :: Cpp -> (String, Cpp)

383383 toelem (CppFunction name args rtyp _ body'@(CppBlock body)) =

384384 (name, withdict . maybeRemCaps $ CppLambda

385− [CppCaptureAll]

385+ [CaptureAll]

386386 args

387387 rtyp

388388 (CppBlock $ (accessor localdict <$> filteredFns body') ++ body))

@@ -396,9 +396,9 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do

396396

397397 withdict :: Cpp -> Cpp

398398 withdict cpp' = maybeRemCaps $ CppLambda

399− [CppCaptureAll]

400− [(localdict, Just $ CppAny [CppConst, CppRef])]

401− (Just $ CppAny [])

399+ [CaptureAll]

400+ [(localdict, Just $ Any [Const, Ref])]

401+ (Just $ Any [])

402402 (asReturnBlock cpp')

403403 topdict :: String

404404 topdict = "_$dict$_"

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

442442 CppArrayLiteral <$> mapM valueToCpp xs

443443

444444 valueToCpp (Literal _ (ObjectLiteral ps)) =

445− CppMapLiteral CppRecord <$>

445+ CppMapLiteral Record <$>

446446 mapM (sndM valueToCpp) ((\(k,v) -> (CppSymbol k, v)) <$> sortBy (compare `on` fst) ps)

447447

448448 valueToCpp (Accessor _ prop val) =

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

454454 updatedFields <- mapM (sndM valueToCpp) ps

455455 let origKeys = (allKeys ty) \\ (fst <$> updatedFields)

456456 origFields = (\key -> (key, CppIndexer (CppSymbol key) obj')) <$> origKeys

457− return $ CppMapLiteral CppRecord $

457+ return $ CppMapLiteral Record $

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

459459 where

460460 allKeys :: T.Type -> [String]

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

470470 return $

471471 CppLambda

472472 []

473− [(identToCpp arg, Just $ CppAny [CppConst, CppRef])]

474− (Just $ CppAny [])

473+ [(identToCpp arg, Just $ Any [Const, Ref])]

474+ (Just $ Any [])

475475 (asReturnBlock $ convertDictIndexers cpp')

476476 where

477477 arg' = identToCpp arg

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

487487 Var (_, _, _, Just IsNewtype) _ -> return (head args')

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

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

490− return . CppMapLiteral CppInstance $

490+ return . CppMapLiteral Instance $

491491 zip

492492 (CppSymbol <$> (sort $ superClassDictionaryNames constraints) ++ (fst <$> fns))

493493 args'

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

563563 (CppLambda

564564 []

565565 []

566− (Just $ CppAny [])

566+ (Just $ Any [])

567567 (CppBlock (assignments ++ concat cpps ++ [failedPatternError valNames])))

568568 []

569569 where

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

607607 binderToCpp varName done (VarBinder _ ident) =

608608 return $

609609 CppVariableIntroduction

610− (identToCpp ident, Just $ CppAny [CppConst])

610+ (identToCpp ident, Just $ Any [Const])

611611 []

612612 (Just $ CppVar varName)

613613 : done

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

665665 cpp <- binderToCpp varName done binder

666666 return $

667667 CppVariableIntroduction

668− (identToCpp ident, Just $ CppAny [CppConst])

668+ (identToCpp ident, Just $ Any [Const])

669669 []

670670 (Just $ CppVar varName)

671671 : cpp

@@ -811,9 +811,9 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do

811811 return $

812812 [ CppFunction

813813 (curriedName name)

814− [(head argNames, Just $ CppAny [CppConst, CppRef])]

815− (Just $ CppAny [])

816− (if arity' == 1 then [CppInline] else [])

814+ [(head argNames, Just $ Any [Const, Ref])]

815+ (Just $ Any [])

816+ (if arity' == 1 then [Inline] else [])

817817 (asReturnBlock $

818818 curriedLambda

819819 (tail argNames)

@@ -836,9 +836,9 @@ asReturnBlock cpp = CppBlock [CppReturn cpp]

836836curriedLambda :: [String] -> Cpp -> Cpp

837837---------------------------------------------------------------------------------------------------

838838curriedLambda args ret = foldr (\arg ret' -> CppLambda

839− [CppCaptureAll]

840− [(arg, Just $ CppAny [CppConst, CppRef])]

841− (Just $ CppAny [])

839+ [CaptureAll]

840+ [(arg, Just $ Any [Const, Ref])]

841+ (Just $ Any [])

842842 (asReturnBlock ret')

843843 ) ret args

844844

@@ -947,8 +947,8 @@ filterInlineFuncs = everywhereOnCpp convert

947947 convert :: Cpp -> Cpp

948948 convert (CppBlock []) = CppBlock []

949949 convert (CppFunction n ps r qs cpp)

950− | CppInline `elem` qs,

951− everythingOnCpp (||) shouldRemove cpp = CppFunction n ps r (delete CppInline qs) cpp

950+ | Inline `elem` qs,

951+ everythingOnCpp (||) shouldRemove cpp = CppFunction n ps r (delete Inline qs) cpp

952952 where

953953 shouldRemove :: Cpp -> Bool

954954 shouldRemove CppSymbol{} = True

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

@@ -185,7 +185,7 @@ data Cpp

185185 -- |

186186 -- An object literal

187187 --

188− | CppMapLiteral CppMapType [(Cpp, Cpp)]

188+ | CppMapLiteral MapType [(Cpp, Cpp)]

189189 -- |

190190 -- An general property accessor expression (property, expr)

191191 --

@@ -193,11 +193,11 @@ data Cpp

193193 -- |

194194 -- A function introduction (name, arguments, return type, qualifiers, body)

195195 --

196− | CppFunction String [(String, Maybe CppType)] (Maybe CppType) [CppValueQual] Cpp

196+ | CppFunction String [(String, Maybe CppType)] (Maybe CppType) [ValueQual] Cpp

197197 -- |

198198 -- A lambda introduction (arguments, return type, body)

199199 --

200− | CppLambda [CppCaptureType] [(String, Maybe CppType)] (Maybe CppType) Cpp

200+ | CppLambda [CaptureType] [(String, Maybe CppType)] (Maybe CppType) Cpp

201201 -- |

202202 -- Value type cast

203203 --

@@ -242,7 +242,7 @@ data Cpp

242242 -- |

243243 -- A variable introduction and optional initialization

244244 --

245− | CppVariableIntroduction (String, Maybe CppType) [CppValueQual] (Maybe Cpp)

245+ | CppVariableIntroduction (String, Maybe CppType) [ValueQual] (Maybe Cpp)

246246 -- |

247247 -- A variable assignment

248248 --

src/Language/PureScript/CodeGen/Cpp/File.hs+23−23

@@ -38,8 +38,8 @@ toHeader = catMaybes . map go

3838 | otherwise = Nothing

3939 go cpp@(CppUseNamespace{}) = Just cpp

4040 go (CppFunction _ _ _ qs _)

41− | CppInline `elem` qs = Nothing

42− go (CppFunction _ [(_, atyp)] _ _ (CppBlock [CppReturn (CppApp _ [_])])) | atyp == Just (CppAuto [])

41+ | Inline `elem` qs = Nothing

42+ go (CppFunction _ [(_, atyp)] _ _ (CppBlock [CppReturn (CppApp _ [_])])) | atyp == Just (Auto [])

4343 = Nothing

4444 go (CppFunction name args rtyp qs _) =

4545 let args' = (\(_,t) -> ("", t)) <$> args in

@@ -58,10 +58,10 @@ toHeader = catMaybes . map go

5858 -- Generate thunks for top-level values

5959 go (CppVariableIntroduction (name, _) _ (Just cpp)) =

6060 case cpp of

61− CppMapLiteral CppInstance _ ->

62− Just $ CppFunction name [("", Just thunkMarkerType)] (Just $ CppAny [CppConst, CppRef]) [] CppNoOp

61+ CppMapLiteral Instance _ ->

62+ Just $ CppFunction name [("", Just thunkMarkerType)] (Just $ Any [Const, Ref]) [] CppNoOp

6363 _ ->

64− Just $ CppVariableIntroduction (name, Just $ CppAny [CppConst]) [CppExtern] Nothing

64+ Just $ CppVariableIntroduction (name, Just $ Any [Const]) [Extern] Nothing

6565 go cpp@(CppStruct {}) =

6666 Just cpp

6767 go (CppComment comms cpp')

@@ -79,9 +79,9 @@ toHeaderFns = catMaybes . map go

7979 | cpps'@(_:_) <- toHeaderFns cpps = Just (CppNamespace name cpps')

8080 | otherwise = Nothing

8181 go cpp@(CppFunction _ _ _ qs _)

82− | CppInline `elem` qs = Just cpp

82+ | Inline `elem` qs = Just cpp

8383 go (CppFunction name [(_, atyp)] _ _ (CppBlock [CppReturn (CppApp cpp [_])]))

84− | Just CppAuto {} <- atyp

84+ | Just Auto {} <- atyp

8585 = Just (CppVariableIntroduction (name, Nothing) [] (Just cpp))

8686 go cpp@(CppVariableIntroduction _ _ (Just CppNumericLiteral {})) =

8787 Just cpp

@@ -114,7 +114,7 @@ toBody = catMaybes . map go

114114 | otherwise = Nothing

115115 go cpp@(CppUseNamespace{}) = Just cpp

116116 go (CppFunction _ _ _ qs _)

117− | CppInline `elem` qs = Nothing

117+ | Inline `elem` qs = Nothing

118118 go cpp@(CppFunction {}) = Just cpp

119119 go (CppVariableIntroduction _ _ (Just CppNumericLiteral {})) =

120120 Nothing

@@ -130,14 +130,14 @@ toBody = catMaybes . map go

130130 -- Generate thunks for top-level values

131131 go (CppVariableIntroduction (name, _) _ (Just cpp)) =

132132 case cpp of

133− CppMapLiteral CppInstance _ ->

134− Just $ CppFunction name [("", Just thunkMarkerType)] (Just $ CppAny [CppConst, CppRef]) [] block

133+ CppMapLiteral Instance _ ->

134+ Just $ CppFunction name [("", Just thunkMarkerType)] (Just $ Any [Const, Ref]) [] block

135135 _ ->

136− Just $ CppVariableIntroduction (name, Just $ CppAny [CppConst]) [] (Just lambda)

136+ Just $ CppVariableIntroduction (name, Just $ Any [Const]) [] (Just lambda)

137137 where

138− val = CppVariableIntroduction ("$value$", Just $ CppAny [CppConst]) [CppStatic] (Just $ addCaptures cpp)

138+ val = CppVariableIntroduction ("$value$", Just $ Any [Const]) [Static] (Just $ addCaptures cpp)

139139 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

141141 addCaptures :: Cpp -> Cpp

142142 addCaptures (CppMapLiteral t objs) = CppMapLiteral t (objlam <$> objs)

143143 where

@@ -148,7 +148,7 @@ toBody = catMaybes . map go

148148 addCaptures cpps' = everywhereOnCpp addCapture cpps'

149149 where

150150 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

152152 addCapture cpp' = cpp'

153153 go (CppComment comms cpp') | Just commented <- go cpp' = Just (CppComment comms commented)

154154 go _ = Nothing

@@ -156,17 +156,17 @@ toBody = catMaybes . map go

156156-------------------------------------------------------------------------------------------------

157157maybeRemCaps :: Cpp -> Cpp

158158-------------------------------------------------------------------------------------------------

159−maybeRemCaps (CppLambda [CppCaptureAll] args rtyp body@(CppBlock [CppReturn CppNumericLiteral{}]))

159+maybeRemCaps (CppLambda [CaptureAll] args rtyp body@(CppBlock [CppReturn CppNumericLiteral{}]))

160160 = CppLambda [] args rtyp body

161−maybeRemCaps (CppLambda [CppCaptureAll] args rtyp body@(CppBlock [CppReturn CppStringLiteral{}]))

161+maybeRemCaps (CppLambda [CaptureAll] args rtyp body@(CppBlock [CppReturn CppStringLiteral{}]))

162162 = CppLambda [] args rtyp body

163−maybeRemCaps (CppLambda [CppCaptureAll] args rtyp body@(CppBlock [CppReturn CppCharLiteral{}]))

163+maybeRemCaps (CppLambda [CaptureAll] args rtyp body@(CppBlock [CppReturn CppCharLiteral{}]))

164164 = CppLambda [] args rtyp body

165−maybeRemCaps (CppLambda [CppCaptureAll] args rtyp body@(CppBlock [CppReturn CppBooleanLiteral{}]))

165+maybeRemCaps (CppLambda [CaptureAll] args rtyp body@(CppBlock [CppReturn CppBooleanLiteral{}]))

166166 = CppLambda [] args rtyp body

167−maybeRemCaps (CppLambda [CppCaptureAll] args rtyp body@(CppBlock [CppReturn CppAccessor{}]))

167+maybeRemCaps (CppLambda [CaptureAll] args rtyp body@(CppBlock [CppReturn CppAccessor{}]))

168168 = 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

170170 = CppLambda [] args rtyp body

171171maybeRemCaps cpp = cpp

172172

@@ -188,10 +188,10 @@ isMain _ = False

188188

189189nativeMain :: Cpp

190190nativeMain = CppFunction "main"

191− [ ([], Just $ CppPrimitive "int")

192− , ([], Just $ CppPrimitive "char *[]")

191+ [ ([], Just $ Primitive "int")

192+ , ([], Just $ Primitive "char *[]")

193193 ]

194− (Just $ CppPrimitive "int")

194+ (Just $ Primitive "int")

195195 []

196196 (CppBlock [ CppUseNamespace "Main"

197197 , CppApp (CppVar "INITIALIZE_GC") []

src/Language/PureScript/CodeGen/Cpp/Optimizer/Inliner.hs+11−11

@@ -231,14 +231,14 @@ inlineCommonOperators = applyAll $

231231 -- where

232232 -- convert :: Cpp -> Cpp

233233 -- convert (CppApp mkFnN [CppLambda _ [_] _ (CppBlock cpp)]) | isNFn C.mkFn 0 mkFnN =

234− -- CppLambda [CppCaptureAll] [] Nothing (CppBlock cpp)

234+ -- CppLambda [CaptureAll] [] Nothing (CppBlock cpp)

235235 -- convert other = other

236236 -- mkFn n = everywhereOnCpp convert

237237 -- where

238238 -- convert :: Cpp -> Cpp

239239 -- convert orig@(CppApp mkFnN [fn]) | isNFn C.mkFn n mkFnN =

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

242242 -- Nothing -> orig

243243 -- convert other = other

244244 -- collectArgs :: Int -> [String] -> Cpp -> Maybe ([String], [Cpp])

@@ -277,17 +277,17 @@ inlineFnComposition = everywhereOnCppTopDownM convert

277277 convert (CppApp fn [dict', x, y])

278278 | isFnCompose dict' fn = do

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

281281 | isFnComposeFlipped dict' fn = do

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

284284 convert (CppApp (CppApp (CppApp fn [dict']) [x]) [y])

285285 | isFnCompose dict' fn = do

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

288288 | isFnComposeFlipped dict' fn = do

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

291291 convert other = return other

292292 isFnCompose :: Cpp -> Cpp -> Bool

293293 isFnCompose dict' fn = isDict semigroupoidFn dict' && isFn fnCompose fn

@@ -302,9 +302,9 @@ toAutoVars :: Cpp -> Cpp

302302toAutoVars = everywhereOnCpp convert

303303 where

304304 convert :: Cpp -> Cpp

305− convert cpp@(CppVariableIntroduction (ident, (Just (CppAny tqs))) qs (Just value))

306− | CppStatic `notElem` qs,

307− CppRef `notElem` tqs =

305+ convert cpp@(CppVariableIntroduction (ident, (Just (Any tqs))) qs (Just value))

306+ | Static `notElem` qs,

307+ Ref `notElem` tqs =

308308 case value of

309309 CppNumericLiteral {} -> var auto'

310310 CppBooleanLiteral {} -> var auto'

@@ -315,8 +315,8 @@ toAutoVars = everywhereOnCpp convert

315315 CppAccessor (CppVar {}) _ -> var autoref'

316316 _ -> cpp

317317 where

318− auto' = CppAuto tqs

319− autoref' | CppConst `elem` tqs = CppAuto (CppRef : tqs)

318+ auto' = Auto tqs

319+ autoref' | Const `elem` tqs = Auto (Ref : tqs)

320320 | otherwise = auto'

321321 var t = CppVariableIntroduction (ident, (Just t)) qs (Just value)

322322 convert cpp = cpp

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

@@ -74,12 +74,12 @@ magicDo' = everywhereOnCpp undo . everywhereOnCppTopDown convert

7474 | otherwise = CppVariableIntroduction arg [] (Just (CppApp m []))

7575 -- Desugar untilE

7676 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 []])) []

7878 -- Desugar whileE

7979 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 []])) []

8181 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 []])) []

8383 convert other = other

8484 -- Check if an expression represents a monomorphic call to >>= for the Eff monad

8585 isBind (CppApp fn [dict]) | isDict (C.eff, C.bindEffDictionary) dict && isBindPoly fn = True

@@ -98,7 +98,7 @@ magicDo' = everywhereOnCpp undo . everywhereOnCppTopDown convert

9898 -- Remove __do function applications which remain after desugaring

9999 undo :: Cpp -> Cpp

100100 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

102102 undo other = other

103103

104104 applyReturns :: Cpp -> Cpp

@@ -128,7 +128,7 @@ inlineST = everywhereOnCpp convertBlock

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

129129 -- agg(ressive) parameter.

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

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

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

134134 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

1818import Prelude.Compat

1919

2020import Data.List

21−import Data.Monoid

21+import qualified Data.Monoid as Monoid

2222

2323import Language.PureScript.Options

2424import Language.PureScript.CodeGen.Cpp.Types

@@ -111,7 +111,7 @@ tco' = everywhereOnCpp convert

111111

112112 toLoop :: String -> [String] -> Cpp -> Cpp

113113 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 ++

115115 [ CppWhile (CppBooleanLiteral True) (CppBlock loop) ]

116116 where

117117 loop :: [Cpp]

@@ -125,7 +125,7 @@ tco' = everywhereOnCpp convert

125125 allArgumentValues = concat $ collectSelfCallArgs [] ret

126126 in

127127 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

129129 ++ map (\arg ->

130130 CppAssignment (CppVar arg) (CppVar (tcoVar arg))) allArgs

131131 ++ [ CppContinue ]

@@ -145,7 +145,7 @@ tco' = everywhereOnCpp convert

145145 isSelfCallWithFnArgs _ _ _ = False

146146

147147 hasFunction :: Cpp -> Bool

148− hasFunction = getAny . everythingOnCpp mappend (Any . isFunction)

148+ hasFunction = Monoid.getAny . everythingOnCpp mappend (Monoid.Any . isFunction)

149149 where

150150 isFunction (CppFunction {}) = True

151151 isFunction _ = False

src/Language/PureScript/CodeGen/Cpp/Types.hs+39−39

@@ -28,79 +28,79 @@ import qualified Language.PureScript.Constants as C

2828

2929-- import Debug.Trace

3030

31−data CppType = CppPrimitive String | CppAuto [CppTypeQual] | CppAny [CppTypeQual]

31+data CppType = Primitive String | Auto [TypeQual] | Any [TypeQual]

3232 deriving (Show, Read, Eq)

3333

34−data CppTypeQual = CppConst | CppRef

34+data TypeQual = Const | Ref

3535 deriving (Show, Read, Eq)

3636

3737-- |

3838-- Value C++11 qualifiers

3939--

40−data CppValueQual

40+data ValueQual

4141 -- |

4242 -- C++ static qualifier

4343 --

44− = CppStatic

44+ = Static

4545 -- |

4646 -- Inline function

4747 --

48− | CppInline

48+ | Inline

4949 -- |

5050 -- C++11+ constant expression "constexpr"

5151 --

52− | CppConstExpr

52+ | ConstExpr

5353 -- |

5454 -- Extern value

5555 --

56− | CppExtern

56+ | Extern

5757 -- |

5858 -- Function or lambda is involved in recursion

5959 --

60− | CppRecursive

60+ | Recursive

6161 -- |

6262 -- Function or lambda is involved in recursion

6363 --

64− | CppTopLevel

64+ | TopLevel

6565 deriving (Show, Read, Eq)

6666

6767-- |

6868-- C++ lambda capture list

6969--

70−data CppCaptureType = CppCaptureAll

70+data CaptureType = CaptureAll

7171 deriving (Show, Read, Eq)

7272

7373-- |

7474-- C++ object/map literal type

7575--

76−data CppMapType = CppInstance | CppRecord

76+data MapType = Instance | Record

7777 deriving (Show, Eq)

7878

7979runType :: CppType -> String

80−runType (CppPrimitive t) = t

81−runType (CppAuto []) = "auto"

82−runType (CppAny []) = "any"

80+runType (Primitive t) = t

81+runType (Auto []) = "auto"

82+runType (Any []) = "any"

8383runType typ =

8484 case typ of

85− CppAuto qs -> rendered CppAuto qs

86− CppAny qs -> rendered CppAny qs

87− _ -> rendered CppAny []

85+ Auto qs -> rendered Auto qs

86+ Any qs -> rendered Any qs

87+ _ -> rendered Any []

8888 where

8989 rendered t qs

90− | CppConst `elem` qs = "const " ++ (runType . t $ delete CppConst qs)

91− | CppRef `elem` qs = runType (t $ delete CppRef qs) ++ "&"

90+ | Const `elem` qs = "const " ++ (runType . t $ delete Const qs)

91+ | Ref `elem` qs = runType (t $ delete Ref qs) ++ "&"

9292 | otherwise = runType (t qs)

9393

94−runValueQual :: CppValueQual -> String

95−runValueQual CppStatic = "static"

96−runValueQual CppInline = "inline"

97−runValueQual CppConstExpr = "constexpr"

98−runValueQual CppExtern = "extern"

99−runValueQual CppRecursive = ""

100−runValueQual CppTopLevel = ""

94+runValueQual :: ValueQual -> String

95+runValueQual Static = "static"

96+runValueQual Inline = "inline"

97+runValueQual ConstExpr = "constexpr"

98+runValueQual Extern = "extern"

99+runValueQual Recursive = ""

100+runValueQual TopLevel = ""

101101

102−runCaptureType :: CppCaptureType -> String

103−runCaptureType CppCaptureAll = "="

102+runCaptureType :: CaptureType -> String

103+runCaptureType CaptureAll = "="

104104

105105-- TODO: move or remove this

106106--

@@ -110,44 +110,44 @@ qualifiedToStr m f (Qualified (Just m') a) | m /= m' = moduleNameToCpp m' ++ "::

110110qualifiedToStr _ f (Qualified _ a) = identToCpp (f a)

111111

112112boolType :: CppType

113−boolType = CppPrimitive "bool"

113+boolType = Primitive "bool"

114114

115115intType :: CppType

116−intType = CppPrimitive "int"

116+intType = Primitive "int"

117117

118118doubleType :: CppType

119−doubleType = CppPrimitive "double"

119+doubleType = Primitive "double"

120120

121121stringType :: CppType

122−stringType = CppPrimitive "string"

122+stringType = Primitive "string"

123123

124124charType :: CppType

125−charType = CppPrimitive "char"

125+charType = Primitive "char"

126126

127127voidType :: CppType

128−voidType = CppPrimitive "void"

128+voidType = Primitive "void"

129129

130130mapType :: Int -> CppType

131131mapType = maptype

132132 where

133133 maptype 0 = mapprim "unknown_size"

134134 maptype n = mapprim $ show n

135− mapprim s = CppPrimitive $ "any::map<" ++ s ++ ">"

135+ mapprim s = Primitive $ "any::map<" ++ s ++ ">"

136136

137137dataType :: Int -> CppType

138−dataType n = CppPrimitive $ "any::data<" ++ show n ++ ">"

138+dataType n = Primitive $ "any::data<" ++ show n ++ ">"

139139

140140arrayType :: CppType

141−arrayType = CppPrimitive "any::array"

141+arrayType = Primitive "any::array"

142142

143143thunkMarkerType :: CppType

144−thunkMarkerType = CppPrimitive "any::as_thunk"

144+thunkMarkerType = Primitive "any::as_thunk"

145145

146146ctorKey :: String

147147ctorKey = "constructor"

148148

149149constAnyRef :: Maybe CppType

150−constAnyRef = Just $ CppAny [CppConst, CppRef]

150+constAnyRef = Just $ Any [Const, Ref]

151151

152152symbolname :: String -> String

153153symbolname = identToCpp . Ident

src/Language/PureScript/Pretty/Cpp.hs+3−3

@@ -247,7 +247,7 @@ literals = mkPattern' match

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

248248 fmap concat $ sequence

249249 [ return . concatMap (++ " ") . filter (not . null) $ runValueQual <$> qs

250− , return $ runType (fromMaybe (CppAny [CppConst]) typ) ++ " "

250+ , return $ runType (fromMaybe (Any [Const]) typ) ++ " "

251251 , return ident

252252 , maybe (return "") (fmap (" = " ++) . prettyPrintCpp') value

253253 ]

@@ -302,7 +302,7 @@ literals = mkPattern' match

302302 ]

303303 match (CppReturn value@(CppStringLiteral _)) = fmap concat $ sequence

304304 [ return "return "

305− , return . runType $ CppAny []

305+ , return . runType $ Any []

306306 , return "("

307307 , prettyPrintCpp' value

308308 , return ")"

@@ -515,7 +515,7 @@ dotsTo :: Char -> String -> String

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

516516

517517argstr :: (String, Maybe CppType) -> String

518−argstr (name, Nothing) = argStr name (CppAuto [])

518+argstr (name, Nothing) = argStr name (Auto [])

519519argstr (name, Just typ) | name == C.__unused = argStr [] typ

520520argstr (name, Just typ) = argStr name typ

521521