fb7efe0 · rowtype-yoga/purescript-native

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

Rename identifiers from Cpp/cpp to IL/il

commitfb7efe0cbca1a347fc0aecbcd9e233d14a62d117 authorAndy Arvanitis <andyarvanitis@gmail.com> dateWed 19 Jun 2019, 22:27 (7 years ago) parentb30c023

6 files changed+249−249

compare with golang

unifiedsplit

app/Main.hs+6−6 src/CodeGen/IL.hs+135−135 src/CodeGen/IL/Common.hs+26−26 src/CodeGen/IL/Optimizer.hs+11−11 src/CodeGen/IL/Optimizer/TCO.hs+2−2 src/CodeGen/IL/Printer.hs+69−69

app/Main.hs+6−6

@@ -33,9 +33,9 @@ import Language.PureScript.AST.Literals

3333import Language.PureScript.CoreFn

3434import Language.PureScript.CoreFn.FromJSON

3535

36−import CodeGen.Cpp

37−import CodeGen.Cpp.Common

38−import CodeGen.Cpp.Printer

36+import CodeGen.IL

37+import CodeGen.IL.Common

38+import CodeGen.IL.Printer

3939

4040import Tests

4141

@@ -93,9 +93,9 @@ transpile :: [String] -> FilePath -> FilePath -> IO ()

9393transpile opts baseOutpath jsonFile = do

9494 jsonText <- T.decodeUtf8 <$> B.readFile jsonFile

9595 let module' = jsonToModule $ parseJson jsonText

96− ((interface, foreigns, asts, implHeader, implFooter), _) <- runSupplyT 5 (moduleToCpp module' Nothing)

97− let mn = moduleNameToCpp $ moduleName module'

98− implementation = prettyPrintCpp asts

96+ ((interface, foreigns, asts, implHeader, implFooter), _) <- runSupplyT 5 (moduleToIL module' Nothing)

97+ let mn = moduleNameToIL $ moduleName module'

98+ implementation = prettyPrintIL asts

9999 outpath = joinPath [baseOutpath, T.unpack mn]

100100 interfacePath = outpath </> interfaceFileName (T.unpack mn)

101101 implPath = outpath </> implFileName mn

src/CodeGen/IL.hs+135−135

@@ -1,9 +1,9 @@

11-- | This module generates code in the core imperative representation from

22-- elaborated PureScript code.

3−module CodeGen.Cpp

3+module CodeGen.IL

44 ( module AST

55 , module Common

6− , moduleToCpp

6+ , moduleToIL

77 ) where

99import Prelude.Compat

@@ -35,39 +35,39 @@ import qualified Language.PureScript.Constants as C

3535

3636import System.FilePath.Posix ((</>))

3737

38−import CodeGen.Cpp.Common as Common

39−import CodeGen.Cpp.Optimizer

40−import CodeGen.Cpp.Printer

38+import CodeGen.IL.Common as Common

39+import CodeGen.IL.Optimizer

40+import CodeGen.IL.Printer

4141

4242data DeclType = ModuleDecl | LetDecl | RecLetDecl deriving (Eq)

4343

4444-- | Generate code in the simplified intermediate representation for all declarations in a

4545-- module.

46−moduleToCpp

46+moduleToIL

4747 :: forall m

4848 -- . (Monad m, MonadReader Options m, MonadSupply m, MonadError MultipleErrors m)

4949 . (Monad m, MonadSupply m)

5050 => Module Ann

5151 -> Maybe AST

5252 -> m (Text, [Text], [AST], Text, Text)

53−moduleToCpp (Module _ coms mn _ imps _ foreigns decls) _ =

53+moduleToIL (Module _ coms mn _ imps _ foreigns decls) _ =

5454 do

5555 let usedNames = concatMap getNames decls

5656 let mnLookup = renameImports usedNames imps

57− cppImports <- traverse (importToCpp mnLookup) . (\\ (mn : C.primModules)) . (\\ [mn]) $ ordNub $ map snd imps

58− interfaceImport <- importToCpp (renameImports [] [(emptyAnn, mn)]) mn

57+ ilImports <- traverse (importToIL mnLookup) . (\\ (mn : C.primModules)) . (\\ [mn]) $ ordNub $ map snd imps

58+ interfaceImport <- importToIL (renameImports [] [(emptyAnn, mn)]) mn

5959 let decls' = renameModules mnLookup decls

60− cppDecls <- mapM (bindToCpp ModuleDecl) decls'

61− optimized <- traverse (traverse (optimize modName')) cppDecls

60+ ilDecls <- mapM (bindToIL ModuleDecl) decls'

61+ optimized <- traverse (traverse (optimize modName')) ilDecls

6262 let optimized' = concat optimized

6363 values = annotValue <$> optimized'

64− foreigns' = identToCpp <$> foreigns

64+ foreigns' = identToIL <$> foreigns

6565 interface = interfaceSource modName values foreigns

66− implHeader = implHeaderSource modName cppImports interfaceImport

66+ implHeader = implHeaderSource modName ilImports interfaceImport

6767 implFooter = implFooterSource modName foreigns

6868 return $ (interface, foreigns', optimized', implHeader, implFooter)

6969 where

70− modName = moduleNameToCpp mn

70+ modName = moduleNameToIL mn

7171 modName' = AST.Var Nothing modName

7272

7373 annotValue :: AST -> (Text, Bool)

@@ -104,10 +104,10 @@ moduleToCpp (Module _ coms mn _ imps _ foreigns decls) _ =

104104

105105 -- | Generates C++ code for a module import, binding the required module

106106 -- to the alternative

107− importToCpp :: M.Map ModuleName (Ann, ModuleName) -> ModuleName -> m Text

108− importToCpp mnLookup mn' = do

107+ importToIL :: M.Map ModuleName (Ann, ModuleName) -> ModuleName -> m Text

108+ importToIL mnLookup mn' = do

109109 let ((_, _, _, _), mnSafe) = fromMaybe (internalError "Missing value in mnLookup") $ M.lookup mn' mnLookup

110− mname = moduleNameToCpp mnSafe

110+ mname = moduleNameToIL mnSafe

111111 pure $ "#include \"" <> mname <> "/" <> mname <> ".h\"\n"

112112

113113 -- | Replaces the `ModuleName`s in the AST so that the generated code refers to

@@ -132,9 +132,9 @@ moduleToCpp (Module _ coms mn _ imps _ foreigns decls) _ =

132132 -- |

133133 -- Generate code in the simplified intermediate representation for a declaration

134134 --

135− bindToCpp :: DeclType -> Bind Ann -> m [AST]

136− bindToCpp dt (NonRec ann ident val) = return <$> nonRecToCpp dt ann ident val

137− bindToCpp dt (Rec vals) = forM vals (uncurry . uncurry $ nonRecToCpp dt')

135+ bindToIL :: DeclType -> Bind Ann -> m [AST]

136+ bindToIL dt (NonRec ann ident val) = return <$> nonRecToIL dt ann ident val

137+ bindToIL dt (Rec vals) = forM vals (uncurry . uncurry $ nonRecToIL dt')

138138 where

139139 dt' = if dt == LetDecl then RecLetDecl else dt

140140

@@ -142,39 +142,39 @@ moduleToCpp (Module _ coms mn _ imps _ foreigns decls) _ =

142142 -- declaration.

143143 --

144144 -- The main purpose of this function is to handle code generation for comments.

145− nonRecToCpp :: DeclType -> Ann -> Ident -> Expr Ann -> m AST

146− nonRecToCpp dt a i e@(extractAnn -> (_, com, _, _)) | not (null com) = do

145+ nonRecToIL :: DeclType -> Ann -> Ident -> Expr Ann -> m AST

146+ nonRecToIL dt a i e@(extractAnn -> (_, com, _, _)) | not (null com) = do

147147 -- withoutComment <- asks optionsNoComments

148148 let withoutComment = False

149149 if withoutComment

150− then nonRecToCpp dt a i (modifyAnn removeComments e)

151− else AST.Comment Nothing com <$> nonRecToCpp dt a i (modifyAnn removeComments e)

152− nonRecToCpp ModuleDecl (ss, _, _, _) ident val = do

153− cpp <- valueToCpp val

154− pure $ AST.Function Nothing (Just $ identToCpp ident) [] (AST.Block Nothing [AST.Return Nothing cpp])

155− nonRecToCpp RecLetDecl (ss, _, _, _) ident val = do

156− cpp <- valueToCpp val

150+ then nonRecToIL dt a i (modifyAnn removeComments e)

151+ else AST.Comment Nothing com <$> nonRecToIL dt a i (modifyAnn removeComments e)

152+ nonRecToIL ModuleDecl (ss, _, _, _) ident val = do

153+ il <- valueToIL val

154+ pure $ AST.Function Nothing (Just $ identToIL ident) [] (AST.Block Nothing [AST.Return Nothing il])

155+ nonRecToIL RecLetDecl (ss, _, _, _) ident val = do

156+ il <- valueToIL val

157157 pure $

158− let retainedName = identToCpp ident

158+ let retainedName = identToIL ident

159159 retained = AST.Var Nothing $ retainedName

160160 unretainedName = retainedName <> unretainedSuffix

161161 unretained = AST.Var Nothing $ unretainedName

162162 boxed = AST.Var Nothing . -- Note: prevents optimizer from eliminating this

163− prettyPrintCpp1 $

163+ prettyPrintIL1 $

164164 AST.VariableIntroduction

165165 Nothing

166166 retainedName

167167 (Just unretained)

168168 alias = AST.Var Nothing $ "auto& " <> retainedName <> " = " <> unretainedName

169169 in

170− case cpp of

171− AST.Function _ name args (AST.Block Nothing cpps) ->

170+ case il of

171+ AST.Function _ name args (AST.Block Nothing ils) ->

172172 AST.Assignment Nothing

173173 retained

174174 (AST.Function Nothing

175175 name

176176 args

177− (AST.Block Nothing (boxed : cpps)))

177+ (AST.Block Nothing (boxed : ils)))

178178 _ ->

179179 AST.Assignment Nothing

180180 retained

@@ -183,80 +183,80 @@ moduleToCpp (Module _ coms mn _ imps _ foreigns decls) _ =

183183 Nothing

184184 []

185185 (AST.Block Nothing ([ alias

186− , AST.Return Nothing cpp

186+ , AST.Return Nothing il

187187 ])))

188188 [])

189− nonRecToCpp _ (ss, _, _, _) ident val = do

190− cpp <- valueToCpp val

191− pure $ AST.VariableIntroduction Nothing (identToCpp ident) (Just cpp)

189+ nonRecToIL _ (ss, _, _, _) ident val = do

190+ il <- valueToIL val

191+ pure $ AST.VariableIntroduction Nothing (identToIL ident) (Just il)

192192

193193 -- | Generate code in the simplified intermediate representation for a variable based on a

194194 -- PureScript identifier.

195195 var :: Ident -> AST

196− var = AST.Var Nothing . identToCpp

196+ var = AST.Var Nothing . identToIL

197197

198198 accessorString :: PSString -> AST -> AST

199199 accessorString prop = AST.Indexer Nothing (AST.StringLiteral Nothing prop)

200200

201201 -- | Generate code in the simplified intermediate representation for a value or expression.

202202

203− valueToCpp :: Expr Ann -> m AST

204− valueToCpp (Literal (pos, _, _, _) l) = literalToValueCpp pos l

205− valueToCpp (Accessor _ prop val) =

206− accessorString prop <$> valueToCpp val

207− valueToCpp (ObjectUpdate _ o ps) = do

208− obj <- valueToCpp o

209− updates <- mapM (sndM valueToCpp) ps

203+ valueToIL :: Expr Ann -> m AST

204+ valueToIL (Literal (pos, _, _, _) l) = literalToValueIL pos l

205+ valueToIL (Accessor _ prop val) =

206+ accessorString prop <$> valueToIL val

207+ valueToIL (ObjectUpdate _ o ps) = do

208+ obj <- valueToIL o

209+ updates <- mapM (sndM valueToIL) ps

210210 obj' <- freshName'

211211 let objVar = AST.Var Nothing obj'

212212 copy = AST.VariableIntroduction Nothing obj' (Just $ AST.App Nothing (AST.Var Nothing (unbox dictType)) [obj])

213213 assign (k, v) = AST.Assignment Nothing (accessorString k objVar) v

214214 sts = copy : (assign <$> updates) ++ [AST.Return Nothing objVar]

215215 return $ AST.App Nothing (AST.Function Nothing Nothing [] (AST.Block Nothing sts)) []

216− valueToCpp (Abs _ arg val) = do

217− ret <- valueToCpp val

218− let cppArg = case arg of

216+ valueToIL (Abs _ arg val) = do

217+ ret <- valueToIL val

218+ let ilArg = case arg of

219219 UnusedIdent -> []

220− _ -> [identToCpp arg]

221− return $ AST.Function Nothing Nothing cppArg (AST.Block Nothing [AST.Return Nothing ret])

222− valueToCpp e@App{} = do

220+ _ -> [identToIL arg]

221+ return $ AST.Function Nothing Nothing ilArg (AST.Block Nothing [AST.Return Nothing ret])

222+ valueToIL e@App{} = do

223223 let (f, args) = unApp e []

224− args' <- mapM valueToCpp args

224+ args' <- mapM valueToIL args

225225 case f of

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

227− _ -> flip (foldl (\fn a -> AST.App Nothing fn [a])) args' <$> valueToCpp f

227+ _ -> flip (foldl (\fn a -> AST.App Nothing fn [a])) args' <$> valueToIL f

228228 where

229229 unApp :: Expr Ann -> [Expr Ann] -> (Expr Ann, [Expr Ann])

230230 unApp (App _ val arg) args = unApp val (arg : args)

231231 unApp other args = (other, args)

232− -- valueToCpp (Var (_, _, _, Just IsForeign) qi@(Qualified (Just mn') ident)) =

232+ -- valueToIL (Var (_, _, _, Just IsForeign) qi@(Qualified (Just mn') ident)) =

233233 -- return $ if mn' == mn

234− -- then AST.Var Nothing (moduleNameToCpp mn' <> "::" <> identToCpp ident)

235− -- else varToCpp qi

236− -- valueToCpp (Var (_, _, _, Just IsForeign) (Qualified (Just mn') ident)) =

237− -- return $ AST.Var Nothing (moduleNameToCpp mn' <> "::" <> identToCpp ident)

238− -- valueToCpp (Var (_, _, _, Just IsForeign) qi@(Qualified (Just mn') ident)) =

234+ -- then AST.Var Nothing (moduleNameToIL mn' <> "::" <> identToIL ident)

235+ -- else varToIL qi

236+ -- valueToIL (Var (_, _, _, Just IsForeign) (Qualified (Just mn') ident)) =

237+ -- return $ AST.Var Nothing (moduleNameToIL mn' <> "::" <> identToIL ident)

238+ -- valueToIL (Var (_, _, _, Just IsForeign) qi@(Qualified (Just mn') ident)) =

239239 -- return $ if mn' == mn

240240 -- then foreignIdent ident

241− -- else varToCpp qi

242− -- valueToCpp (Var (_, _, _, Just IsForeign) ident) =

241+ -- else varToIL qi

242+ -- valueToIL (Var (_, _, _, Just IsForeign) ident) =

243243 -- internalError $ "Encountered an unqualified reference to a foreign ident " ++ T.unpack (showQualified showIdent ident)

244− valueToCpp (Var _ ident) = return $ varToCpp ident

245− valueToCpp (Case (ss, _, _, _) values binders) = do

246− vals <- mapM valueToCpp values

247− bindersToCpp ss binders vals

248− valueToCpp (Let _ ds val) = do

244+ valueToIL (Var _ ident) = return $ varToIL ident

245+ valueToIL (Case (ss, _, _, _) values binders) = do

246+ vals <- mapM valueToIL values

247+ bindersToIL ss binders vals

248+ valueToIL (Let _ ds val) = do

249249 let recurs = concatMap getNames $ filter isRec ds

250− recurDs = (\v -> AST.Var Nothing $ "boxed::recur " <> identToCpp v) <$> recurs

250+ recurDs = (\v -> AST.Var Nothing $ "boxed::recur " <> identToIL v) <$> recurs

251251 recurDsWeak = (\v -> AST.Var

252252 Nothing

253− ("boxed::recur::weak " <> identToCpp v <> unretainedSuffix <> "(" <> identToCpp v <> ")")

253+ ("boxed::recur::weak " <> identToIL v <> unretainedSuffix <> "(" <> identToIL v <> ")")

254254 ) <$> recurs

255255 mutualRecurWarning = if any isMutRec $ filter isRec ds

256256 then [AST.Var Nothing "#pragma message(\"Mutually recursive lets will cause retain cycles (memory leaks)\") //"]

257257 else []

258− ds' <- concat <$> mapM (bindToCpp LetDecl) ds

259− ret <- valueToCpp val

258+ ds' <- concat <$> mapM (bindToIL LetDecl) ds

259+ ret <- valueToIL val

260260 return $

261261 AST.App Nothing

262262 (AST.Function Nothing

@@ -271,92 +271,92 @@ moduleToCpp (Module _ coms mn _ imps _ foreigns decls) _ =

271271 isMutRec :: Bind Ann -> Bool

272272 isMutRec b | (length . nub $ getNames b) > 1 = True

273273 | otherwise = False

274− valueToCpp (Constructor (_, _, _, Just IsNewtype) _ (ProperName ctor) _) = error "IsNewtype"

275− valueToCpp (Constructor _ _ (ProperName ctor) fields) =

274+ valueToIL (Constructor (_, _, _, Just IsNewtype) _ (ProperName ctor) _) = error "IsNewtype"

275+ valueToIL (Constructor _ _ (ProperName ctor) fields) =

276276 let body = AST.ObjectLiteral Nothing $ (mkString ctor, AST.BooleanLiteral Nothing True) :

277− ((\field -> (mkString (identToCpp field), var field)) `map` fields)

278− fn = foldr (\f inner -> AST.Function Nothing Nothing [identToCpp f] (AST.Block Nothing [AST.Return Nothing inner])) body fields

277+ ((\field -> (mkString (identToIL field), var field)) `map` fields)

278+ fn = foldr (\f inner -> AST.Function Nothing Nothing [identToIL f] (AST.Block Nothing [AST.Return Nothing inner])) body fields

279279 in return fn

280280

281281

282282 iife :: Text -> [AST] -> AST

283283 iife v exprs = AST.App Nothing (AST.Function Nothing Nothing [] (AST.Block Nothing $ exprs ++ [AST.Return Nothing $ AST.Var Nothing v])) []

284284

285− literalToValueCpp :: SourceSpan -> Literal (Expr Ann) -> m AST

286− literalToValueCpp ss (NumericLiteral (Left i)) = return $ AST.NumericLiteral (Just ss) (Left i)

287− literalToValueCpp ss (NumericLiteral (Right n)) = return $ AST.NumericLiteral (Just ss) (Right n)

288− literalToValueCpp ss (StringLiteral s) = return $ AST.StringLiteral (Just ss) s

289− literalToValueCpp ss (CharLiteral c) = return $ AST.StringLiteral (Just ss) (fromString [c])

290− literalToValueCpp ss (BooleanLiteral b) = return $ AST.BooleanLiteral (Just ss) b

291− literalToValueCpp ss (ArrayLiteral xs) = AST.ArrayLiteral (Just ss) <$> mapM valueToCpp xs

292− literalToValueCpp ss (ObjectLiteral ps) = AST.ObjectLiteral (Just ss) <$> mapM (sndM valueToCpp) ps

285+ literalToValueIL :: SourceSpan -> Literal (Expr Ann) -> m AST

286+ literalToValueIL ss (NumericLiteral (Left i)) = return $ AST.NumericLiteral (Just ss) (Left i)

287+ literalToValueIL ss (NumericLiteral (Right n)) = return $ AST.NumericLiteral (Just ss) (Right n)

288+ literalToValueIL ss (StringLiteral s) = return $ AST.StringLiteral (Just ss) s

289+ literalToValueIL ss (CharLiteral c) = return $ AST.StringLiteral (Just ss) (fromString [c])

290+ literalToValueIL ss (BooleanLiteral b) = return $ AST.BooleanLiteral (Just ss) b

291+ literalToValueIL ss (ArrayLiteral xs) = AST.ArrayLiteral (Just ss) <$> mapM valueToIL xs

292+ literalToValueIL ss (ObjectLiteral ps) = AST.ObjectLiteral (Just ss) <$> mapM (sndM valueToIL) ps

293293

294294 -- | Generate code in the simplified intermediate representation for a reference to a

295295 -- variable.

296− varToCpp :: Qualified Ident -> AST

297− varToCpp (Qualified Nothing ident) = var ident

298− varToCpp qual = qualifiedToCpp id qual

296+ varToIL :: Qualified Ident -> AST

297+ varToIL (Qualified Nothing ident) = var ident

298+ varToIL qual = qualifiedToIL id qual

299299

300300 -- | Generate code in the simplified intermediate representation for a reference to a

301301 -- variable that may have a qualified name.

302− qualifiedToCpp :: (a -> Ident) -> Qualified a -> AST

303− qualifiedToCpp f (Qualified (Just (ModuleName [ProperName mn'])) a) | mn' == C.prim = AST.Var Nothing . runIdent $ f a

304− qualifiedToCpp f (Qualified (Just mn') a) = AST.Indexer Nothing (AST.Var Nothing . identToCpp $ f a) (AST.Var Nothing (moduleNameToCpp mn'))

305− qualifiedToCpp f (Qualified _ a) = AST.Var Nothing $ identToCpp (f a)

302+ qualifiedToIL :: (a -> Ident) -> Qualified a -> AST

303+ qualifiedToIL f (Qualified (Just (ModuleName [ProperName mn'])) a) | mn' == C.prim = AST.Var Nothing . runIdent $ f a

304+ qualifiedToIL f (Qualified (Just mn') a) = AST.Indexer Nothing (AST.Var Nothing . identToIL $ f a) (AST.Var Nothing (moduleNameToIL mn'))

305+ qualifiedToIL f (Qualified _ a) = AST.Var Nothing $ identToIL (f a)

306306

307307 -- foreignIdent :: Ident -> AST

308308 -- foreignIdent ident = accessorString (mkString $ runIdent ident) (AST.Var Nothing "$foreign")

309309

310310 -- | Generate code in the simplified intermediate representation for pattern match binders

311311 -- and guards.

312− bindersToCpp :: SourceSpan -> [CaseAlternative Ann] -> [AST] -> m AST

313− bindersToCpp ss binders vals = do

312+ bindersToIL :: SourceSpan -> [CaseAlternative Ann] -> [AST] -> m AST

313+ bindersToIL ss binders vals = do

314314 valNames <- replicateM (length vals) freshName'

315315 let assignments = zipWith (AST.VariableIntroduction Nothing) valNames (map Just vals)

316− cpps <- forM binders $ \(CaseAlternative bs result) -> do

317− ret <- guardsToCpp result

316+ ils <- forM binders $ \(CaseAlternative bs result) -> do

317+ ret <- guardsToIL result

318318 go valNames ret bs

319− return $ AST.App Nothing (AST.Function Nothing Nothing [] (AST.Block Nothing (assignments ++ concat cpps ++ [AST.Throw Nothing (AST.StringLiteral Nothing $ mkString failedPatternMessage)])))

319+ return $ AST.App Nothing (AST.Function Nothing Nothing [] (AST.Block Nothing (assignments ++ concat ils ++ [AST.Throw Nothing (AST.StringLiteral Nothing $ mkString failedPatternMessage)])))

320320 []

321321 where

322322 go :: [Text] -> [AST] -> [Binder Ann] -> m [AST]

323323 go _ done [] = return done

324324 go (v:vs) done' (b:bs) = do

325325 done'' <- go vs done' bs

326− binderToCpp v done'' b

327− go _ _ _ = internalError "Invalid arguments to bindersToCpp"

326+ binderToIL v done'' b

327+ go _ _ _ = internalError "Invalid arguments to bindersToIL"

328328

329329 failedPatternMessage :: Text

330330 failedPatternMessage = "Failed pattern match at " <> runModuleName mn <> " " <> displayStartEndPos ss <> ": "

331331

332− guardsToCpp :: Either [(Guard Ann, Expr Ann)] (Expr Ann) -> m [AST]

333− guardsToCpp (Left gs) = traverse genGuard gs where

332+ guardsToIL :: Either [(Guard Ann, Expr Ann)] (Expr Ann) -> m [AST]

333+ guardsToIL (Left gs) = traverse genGuard gs where

334334 genGuard (cond, val) = do

335− cond' <- valueToCpp cond

336− val' <- valueToCpp val

335+ cond' <- valueToIL cond

336+ val' <- valueToIL val

337337 return

338338 (AST.IfElse Nothing (AST.Binary Nothing AST.EqualTo cond' (AST.BooleanLiteral Nothing True))

339339 (AST.Block Nothing [AST.Return Nothing val']) Nothing)

340340

341− guardsToCpp (Right v) = return . AST.Return Nothing <$> valueToCpp v

341+ guardsToIL (Right v) = return . AST.Return Nothing <$> valueToIL v

342342

343343 -- | Generate code in the simplified intermediate representation for a pattern match

344344 -- binder.

345− binderToCpp :: Text -> [AST] -> Binder Ann -> m [AST]

346− binderToCpp _ done NullBinder{} = return done

347− binderToCpp varName done (LiteralBinder _ l) =

348− literalToBinderCpp varName done l

349− binderToCpp varName done (VarBinder _ ident) =

350− return (AST.VariableIntroduction Nothing (identToCpp ident) (Just (AST.Var Nothing varName)) : done)

351− binderToCpp varName done (ConstructorBinder (_, _, _, Just IsNewtype) _ _ [b]) =

352− binderToCpp varName done b

353− binderToCpp varName done (ConstructorBinder (_, _, _, Just (IsConstructor ctorType fields)) _ (Qualified _ (ProperName ctor)) bs) = do

354− cpp <- go (zip fields bs) done

345+ binderToIL :: Text -> [AST] -> Binder Ann -> m [AST]

346+ binderToIL _ done NullBinder{} = return done

347+ binderToIL varName done (LiteralBinder _ l) =

348+ literalToBinderIL varName done l

349+ binderToIL varName done (VarBinder _ ident) =

350+ return (AST.VariableIntroduction Nothing (identToIL ident) (Just (AST.Var Nothing varName)) : done)

351+ binderToIL varName done (ConstructorBinder (_, _, _, Just IsNewtype) _ _ [b]) =

352+ binderToIL varName done b

353+ binderToIL varName done (ConstructorBinder (_, _, _, Just (IsConstructor ctorType fields)) _ (Qualified _ (ProperName ctor)) bs) = do

354+ il <- go (zip fields bs) done

355355 return $ case ctorType of

356− ProductType -> cpp

356+ ProductType -> il

357357 SumType ->

358358 [AST.IfElse Nothing (AST.InstanceOf Nothing (AST.Var Nothing varName) (AST.StringLiteral Nothing (mkString ctor)))

359− (AST.Block Nothing cpp)

359+ (AST.Block Nothing il)

360360 Nothing]

361361 where

362362 go :: [(Ident, Binder Ann)] -> [AST] -> m [AST]

@@ -364,50 +364,50 @@ moduleToCpp (Module _ coms mn _ imps _ foreigns decls) _ =

364364 go ((field, binder) : remain) done' = do

365365 argVar <- freshName'

366366 done'' <- go remain done'

367− cpp <- binderToCpp argVar done'' binder

368− return (AST.VariableIntroduction Nothing argVar (Just $ accessorString (mkString $ identToCpp field) $ AST.Var Nothing varName) : cpp)

367+ il <- binderToIL argVar done'' binder

368+ return (AST.VariableIntroduction Nothing argVar (Just $ accessorString (mkString $ identToIL field) $ AST.Var Nothing varName) : il)

369369

370− binderToCpp _ _ ConstructorBinder{} =

371− internalError "binderToCpp: Invalid ConstructorBinder in binderToCpp"

372− binderToCpp varName done (NamedBinder _ ident binder) = do

373− cpp <- binderToCpp varName done binder

374− return (AST.VariableIntroduction Nothing (identToCpp ident) (Just (AST.Var Nothing varName)) : cpp)

370+ binderToIL _ _ ConstructorBinder{} =

371+ internalError "binderToIL: Invalid ConstructorBinder in binderToIL"

372+ binderToIL varName done (NamedBinder _ ident binder) = do

373+ il <- binderToIL varName done binder

374+ return (AST.VariableIntroduction Nothing (identToIL ident) (Just (AST.Var Nothing varName)) : il)

375375

376− literalToBinderCpp :: Text -> [AST] -> Literal (Binder Ann) -> m [AST]

377− literalToBinderCpp varName done (NumericLiteral num) =

376+ literalToBinderIL :: Text -> [AST] -> Literal (Binder Ann) -> m [AST]

377+ literalToBinderIL varName done (NumericLiteral num) =

378378 return [AST.IfElse Nothing (AST.Binary Nothing AST.EqualTo (AST.Var Nothing varName) (AST.NumericLiteral Nothing num)) (AST.Block Nothing done) Nothing]

379− literalToBinderCpp varName done (CharLiteral c) =

379+ literalToBinderIL varName done (CharLiteral c) =

380380 return [AST.IfElse Nothing (AST.Binary Nothing AST.EqualTo (AST.Var Nothing varName) (AST.StringLiteral Nothing (fromString [c]))) (AST.Block Nothing done) Nothing]

381− literalToBinderCpp varName done (StringLiteral str) =

381+ literalToBinderIL varName done (StringLiteral str) =

382382 return [AST.IfElse Nothing (AST.Binary Nothing AST.EqualTo (AST.Var Nothing varName) (AST.StringLiteral Nothing str)) (AST.Block Nothing done) Nothing]

383− literalToBinderCpp varName done (BooleanLiteral True) =

383+ literalToBinderIL varName done (BooleanLiteral True) =

384384 return [AST.IfElse Nothing (AST.Binary Nothing AST.EqualTo (AST.Var Nothing varName) (AST.BooleanLiteral Nothing True)) (AST.Block Nothing done) Nothing]

385− literalToBinderCpp varName done (BooleanLiteral False) =

385+ literalToBinderIL varName done (BooleanLiteral False) =

386386 return [AST.IfElse Nothing (AST.Binary Nothing AST.EqualTo (AST.Var Nothing varName) (AST.BooleanLiteral Nothing False)) (AST.Block Nothing done) Nothing]

387387 -- return [AST.IfElse Nothing (AST.Unary Nothing AST.Not (AST.Var Nothing varName)) (AST.Block Nothing done) Nothing]

388− literalToBinderCpp varName done (ObjectLiteral bs) = go done bs

388+ literalToBinderIL varName done (ObjectLiteral bs) = go done bs

389389 where

390390 go :: [AST] -> [(PSString, Binder Ann)] -> m [AST]

391391 go done' [] = return done'

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

393393 propVar <- freshName'

394394 done'' <- go done' bs'

395− cpp <- binderToCpp propVar done'' binder

396− return (AST.VariableIntroduction Nothing propVar (Just (accessorString prop (AST.Var Nothing varName))) : cpp)

397− literalToBinderCpp varName done (ArrayLiteral bs) = do

398− cpp <- go done 0 bs

395+ il <- binderToIL propVar done'' binder

396+ return (AST.VariableIntroduction Nothing propVar (Just (accessorString prop (AST.Var Nothing varName))) : il)

397+ literalToBinderIL varName done (ArrayLiteral bs) = do

398+ il <- go done 0 bs

399399 return [AST.IfElse Nothing (AST.Binary Nothing AST.EqualTo

400400 (arrayLength $ AST.Var Nothing varName)

401401 (AST.NumericLiteral Nothing (Left (fromIntegral $ length bs))))

402− (AST.Block Nothing cpp) Nothing]

402+ (AST.Block Nothing il) Nothing]

403403 where

404404 go :: [AST] -> Integer -> [Binder Ann] -> m [AST]

405405 go done' _ [] = return done'

406406 go done' index (binder:bs') = do

407407 elVar <- freshName'

408408 done'' <- go done' (index + 1) bs'

409− cpp <- binderToCpp elVar done'' binder

410− return (AST.VariableIntroduction Nothing elVar (Just (AST.Indexer Nothing (AST.NumericLiteral Nothing (Left index)) (AST.Var Nothing varName))) : cpp)

409+ il <- binderToIL elVar done'' binder

410+ return (AST.VariableIntroduction Nothing elVar (Just (AST.Indexer Nothing (AST.NumericLiteral Nothing (Left index)) (AST.Var Nothing varName))) : il)

411411

412412emptyAnn :: Ann

413413emptyAnn = (SourceSpan "" (SourcePos 0 0) (SourcePos 0 0), [], Nothing, Nothing)

src/CodeGen/IL/Common.hs+26−26

@@ -1,5 +1,5 @@

11-- | Common code generation utility functions

2−module CodeGen.Cpp.Common where

2+module CodeGen.IL.Common where

44import Prelude.Compat

@@ -11,10 +11,10 @@ import qualified Data.Text as T

1111import Language.PureScript.Crash

1212import Language.PureScript.Names

1313

14−moduleNameToCpp :: ModuleName -> Text

15−moduleNameToCpp (ModuleName pns) =

14+moduleNameToIL :: ModuleName -> Text

15+moduleNameToIL (ModuleName pns) =

1616 let name = T.intercalate "_" (runProperName `map` pns)

17− in if nameIsCppBuiltIn name then ("_" <> name <> "_") else name

17+ in if nameIsILBuiltIn name then ("_" <> name <> "_") else name

1818

1919-- | Convert an 'Ident' into a valid C++ identifier:

2020--

@@ -22,23 +22,23 @@ moduleNameToCpp (ModuleName pns) =

2222--

2323-- * Reserved C++ identifiers are wrapped with '_'.

2424--

25−identToCpp :: Ident -> Text

26−identToCpp UnusedIdent = unusedName

27−identToCpp (Ident "$__unused") = unusedName

28−identToCpp (Ident name) = properToCpp name

29−identToCpp (GenIdent _ _) = internalError "GenIdent in identToCpp"

25+identToIL :: Ident -> Text

26+identToIL UnusedIdent = unusedName

27+identToIL (Ident "$__unused") = unusedName

28+identToIL (Ident name) = properToIL name

29+identToIL (GenIdent _ _) = internalError "GenIdent in identToIL"

3030

3131unusedName :: Text

3232unusedName = "_Unused_"

3333

34−properToCpp :: Text -> Text

35−properToCpp name

36− | nameIsCppReserved name || nameIsCppBuiltIn name || prefixIsReserved name = "_" <> name <> "_"

34+properToIL :: Text -> Text

35+properToIL name

36+ | nameIsILReserved name || nameIsILBuiltIn name || prefixIsReserved name = "_" <> name <> "_"

3737 | otherwise = T.concatMap identCharToText name

3838

3939-- | Test if a string is a valid AST identifier without escaping.

4040identNeedsEscaping :: Text -> Bool

41−identNeedsEscaping s = s /= properToCpp s || T.null s

41+identNeedsEscaping s = s /= properToIL s || T.null s

4242

4343-- | Attempts to find a human-readable name for a symbol, if none has been specified returns the

4444-- ordinal value.

@@ -50,13 +50,13 @@ identCharToText '$' = "$"

5050identCharToText c = "_Code_Point_" <> T.pack (show (ord c))

5151

5252-- | Checks whether an identifier name is reserved in C++.

53−nameIsCppReserved :: Text -> Bool

54−nameIsCppReserved name =

55− name `elem` cppAnyReserved

53+nameIsILReserved :: Text -> Bool

54+nameIsILReserved name =

55+ name `elem` ilAnyReserved

5656

5757-- | Checks whether a name matches a built-in value in C++.

58−nameIsCppBuiltIn :: Text -> Bool

59−nameIsCppBuiltIn name =

58+nameIsILBuiltIn :: Text -> Bool

59+nameIsILBuiltIn name =

6060 name `elem`

6161 [ "final"

6262 , "override"

@@ -64,15 +64,15 @@ nameIsCppBuiltIn name =

6464 , "std"

6565 ]

6666

67−cppAnyReserved :: [Text]

68−cppAnyReserved =

67+ilAnyReserved :: [Text]

68+ilAnyReserved =

6969 concat

70− [ cppKeywords

71− , cppLiterals

70+ [ ilKeywords

71+ , ilLiterals

7272 ]

7373

74−cppKeywords :: [Text]

75−cppKeywords =

74+ilKeywords :: [Text]

75+ilKeywords =

7676 [ "alignas"

7777 , "alignof"

7878 , "and"

@@ -177,8 +177,8 @@ prefixIsReserved name =

177177 [ "__"

178178 ]

179179

180−cppLiterals :: [Text]

181−cppLiterals =

180+ilLiterals :: [Text]

181+ilLiterals =

182182 [ "box"

183183 , "boxed"

184184 , "copy"

src/CodeGen/IL/Optimizer.hs+11−11

@@ -1,5 +1,5 @@

11-- | This module optimizes code in the intermediate representation.

2−module CodeGen.Cpp.Optimizer (optimize) where

2+module CodeGen.IL.Optimizer (optimize) where

44import Prelude.Compat

@@ -12,8 +12,8 @@ import Language.PureScript.CoreImp.Optimizer.Inliner hiding (inlineUnsafeCoerce,

1212import Language.PureScript.CoreImp.Optimizer.Unused

1313import Language.PureScript.PSString (PSString, decodeString)

1414

15−import CodeGen.Cpp.Common (unusedName)

16−import CodeGen.Cpp.Optimizer.TCO

15+import CodeGen.IL.Common (unusedName)

16+import CodeGen.IL.Optimizer.TCO

1717

1818import qualified Language.PureScript.Constants as C

1919

@@ -21,11 +21,11 @@ import qualified Language.PureScript.Constants as C

2121-- | Apply a series of optimizer passes to simplified C++ code

2222optimize :: MonadSupply m => AST -> AST -> m AST

2323-- optimize = untilFixedPoint $ return . inlineUnsafeCoerce . inlineUnsafePartial . tidyUp . tco

24−optimize mn cpp = do

25− cpp' <- untilFixedPoint (return . inlineApply . inlineUnsafeCoerce . inlineUnsafePartial . tidyUp) cpp

24+optimize mn il = do

25+ il' <- untilFixedPoint (return . inlineApply . inlineUnsafeCoerce . inlineUnsafePartial . tidyUp) il

2626 untilFixedPoint (return . tidyUp) . tco mn

2727 =<< untilFixedPoint (return . magicDo')

28− =<< untilFixedPoint (return . magicDo) cpp'

28+ =<< untilFixedPoint (return . magicDo) il'

2929

3030

3131 where

@@ -98,11 +98,11 @@ magicDo'' effectModule C.EffectDictionaries{..} = everywhereTopDown convert

9898 -- Desugar pure

9999 convert (App _ (App _ pure' [val]) []) | isPure pure' = val

100100 -- Desugar discard

101− convert (App _ (App _ bind [m]) [Function s1 Nothing [unused] (Block s2 cpp)]) | isDiscard bind && unused == unusedName =

102− Function s1 Nothing [] $ Block s2 (App s2 m [] : map applyReturns cpp )

101+ convert (App _ (App _ bind [m]) [Function s1 Nothing [unused] (Block s2 il)]) | isDiscard bind && unused == unusedName =

102+ Function s1 Nothing [] $ Block s2 (App s2 m [] : map applyReturns il )

103103 -- Desugar bind

104− convert (App _ (App _ bind [m]) [Function s1 Nothing [arg] (Block s2 cpp)]) | isBind bind =

105− Function s1 Nothing [] $ Block s2 (VariableIntroduction s2 arg (Just (App s2 m [])) : map applyReturns cpp)

104+ convert (App _ (App _ bind [m]) [Function s1 Nothing [arg] (Block s2 il)]) | isBind bind =

105+ Function s1 Nothing [] $ Block s2 (VariableIntroduction s2 arg (Just (App s2 m [])) : map applyReturns il)

106106 -- Inline double applications

107107 convert (App _ (App s1 (Function s2 Nothing [] (Block ss body)) []) []) =

108108 App s1 (Function s2 Nothing [] (Block ss (applyReturns `fmap` body))) []

@@ -130,7 +130,7 @@ magicDo'' effectModule C.EffectDictionaries{..} = everywhereTopDown convert

130130

131131 applyReturns :: AST -> AST

132132 applyReturns (Return ss ret) = Return ss (App ss ret [])

133− applyReturns (Block ss cpps) = Block ss (map applyReturns cpps)

133+ applyReturns (Block ss ils) = Block ss (map applyReturns ils)

134134 applyReturns (IfElse ss cond t f) = IfElse ss cond (applyReturns t) (applyReturns `fmap` f)

135135 applyReturns other = other

136136

src/CodeGen/IL/Optimizer/TCO.hs+2−2

@@ -1,4 +1,4 @@

1−module CodeGen.Cpp.Optimizer.TCO (tco) where

1+module CodeGen.IL.Optimizer.TCO (tco) where

33import Prelude.Compat

@@ -7,7 +7,7 @@ import Data.Monoid ((<>))

77import Language.PureScript.CoreImp.AST

88import Language.PureScript.AST.SourcePos (SourceSpan)

99import Safe (headDef, tailSafe)

10−import CodeGen.Cpp.Common

10+import CodeGen.IL.Common

1111

1212import qualified Language.PureScript.Constants as C

1313

src/CodeGen/IL/Printer.hs+69−69

@@ -1,8 +1,8 @@

11-- | Pretty printer for the AST

2−module CodeGen.Cpp.Printer

3− ( prettyPrintCpp

4− , prettyPrintCpp1

5− , prettyPrintCppWithSourceMaps

2+module CodeGen.IL.Printer

3+ ( prettyPrintIL

4+ , prettyPrintIL1

5+ , prettyPrintILWithSourceMaps

66 , interfaceSource

77 , implHeaderSource

88 , implFooterSource

@@ -31,7 +31,7 @@ import Language.PureScript.Crash

3131import Language.PureScript.Names (Ident, runIdent)

3232import Language.PureScript.Pretty.Common

3333import Language.PureScript.PSString (PSString, decodeString, mkString)

34−import CodeGen.Cpp.Common

34+import CodeGen.IL.Common

3535

3636import qualified Language.PureScript.Constants as C

3737

@@ -41,7 +41,7 @@ literals :: (Emit gen) => Pattern PrinterState AST gen

4141literals = mkPattern' match'

4242 where

4343 match' :: (Emit gen) => AST -> StateT PrinterState Maybe gen

44− match' cpp = (addMapping' (getSourceSpan cpp) <>) <$> match cpp

44+ match' il = (addMapping' (getSourceSpan il) <>) <$> match il

4545

4646 match :: (Emit gen) => AST -> StateT PrinterState Maybe gen

4747 match (NumericLiteral _ n) = return $ emit $ T.pack $ either show show n

@@ -50,18 +50,18 @@ literals = mkPattern' match'

5050 match (BooleanLiteral _ False) = return $ emit "false"

5151 match (ArrayLiteral _ xs) = mconcat <$> sequence

5252 [ return . emit $ arrayType <> "{ "

53− , intercalate (emit ", ") <$> forM xs prettyPrintCpp'

53+ , intercalate (emit ", ") <$> forM xs prettyPrintIL'

5454 , return $ emit " }"

5555 ]

5656 -- match (ObjectLiteral _ []) = return $ emit "std::initializer_list<std::pair<const string, boxed>>{}"

5757 match (ObjectLiteral _ ps) = mconcat <$> sequence

5858 [ return . emit $ dictType <> "{\n"

5959 , withIndent $ do

60− cpps <- forM ps $ \(key, value) -> do

61− value' <- prettyPrintCpp' value

60+ ils <- forM ps $ \(key, value) -> do

61+ value' <- prettyPrintIL' value

6262 return $ emit "{ " <> objectPropertyToString key <> value' <> emit " }"

6363 indentString <- currentIndent

64− return $ intercalate (emit ",\n") $ map (indentString <>) cpps

64+ return $ intercalate (emit ",\n") $ map (indentString <>) ils

6565 , return $ emit "\n"

6666 , currentIndent

6767 , return $ emit "}"

@@ -79,15 +79,15 @@ literals = mkPattern' match'

7979 match (Var _ ident) = return $ emit ident

8080 match (VariableIntroduction _ ident value) = mconcat <$> sequence

8181 [ return $ emit $ "boxed " <> ident

82− , maybe (return mempty) (fmap (emit " = " <>) . prettyPrintCpp') value

82+ , maybe (return mempty) (fmap (emit " = " <>) . prettyPrintIL') value

8383 ]

8484 match (Assignment _ target value) = mconcat <$> sequence

85− [ prettyPrintCpp' target

85+ [ prettyPrintIL' target

8686 , return $ emit " = "

87− , prettyPrintCpp' value

87+ , prettyPrintIL' value

8888 ]

8989 match (App _ val []) = mconcat <$> sequence

90− [ prettyPrintCpp' val

90+ [ prettyPrintIL' val

9191 , return $ emit "()"

9292 ]

9393 match (App ss (App _ (App _ (Indexer _ (Var _ fn) (Var _ fnMod)) [Indexer _ (Var _ dict) (Var _ dictMod)]) [x]) [y])

@@ -113,16 +113,16 @@ literals = mkPattern' match'

113113 match (App _ (App _ (Indexer _ (Var _ fn) (Var _ fnMod)) [Indexer _ (Var _ dict) (Var _ dictMod)]) [n])

114114 | fnMod == dictMod

115115 , dictMod == C.dataHeytingAlgebra

116− , fn == properToCpp C.not

116+ , fn == properToIL C.not

117117 , Just t <- unboxType dict

118118 = mconcat <$> sequence

119119 [ return $ emit "!"

120120 , return $ emit $ unbox' t n

121121 ]

122122 match (App _ val args) = mconcat <$> sequence

123− [ prettyPrintCpp' val

123+ [ prettyPrintIL' val

124124 , return $ emit "("

125− , intercalate (emit ", ") <$> forM args prettyPrintCpp'

125+ , intercalate (emit ", ") <$> forM args prettyPrintIL'

126126 , return $ emit ")"

127127 ]

128128 match (Function _ (Just name) [] (Block _ [Return _ ret]))

@@ -140,10 +140,10 @@ literals = mkPattern' match'

140140 [ return $ emit "[]("

141141 , return $ emit $ intercalate ", " (renderArg <$> args)

142142 , return $ emit ") -> boxed "

143− , prettyPrintCpp' body

143+ , prettyPrintIL' body

144144 ]

145145 _ -> do

146− prettyPrintCpp' ret

146+ prettyPrintIL' ret

147147 , return $ emit ";\n"

148148 , withIndent $ do

149149 indentString <- currentIndent

@@ -154,79 +154,79 @@ literals = mkPattern' match'

154154 [ return $ emit "auto "

155155 , return $ emit name

156156 , return $ emit "() -> boxed "

157− , prettyPrintCpp' ret

157+ , prettyPrintIL' ret

158158 ]

159159 match (Function _ name args ret) = mconcat <$> sequence

160160 [ return $ emit captures

161161 , return $ emit "("

162162 , return $ emit $ intercalate ", " (render <$> args)

163163 , return $ emit ") -> boxed "

164− , prettyPrintCpp' ret

164+ , prettyPrintIL' ret

165165 ]

166166 where

167167 (captures, render)

168168 | name == Just tcoLoop = ("[&]", renderArgByVal)

169169 | otherwise = ("[=]", renderArg)

170170 match (Indexer _ prop@(Var _ name) val) = mconcat <$> sequence

171− [ prettyPrintCpp' val

171+ [ prettyPrintIL' val

172172 , return $ emit "::"

173− , prettyPrintCpp' prop

173+ , prettyPrintIL' prop

174174 , return $ emit "()"

175175 ]

176176 match (Indexer _ prop val) = mconcat <$> sequence

177− [ prettyPrintCpp' val

177+ [ prettyPrintIL' val

178178 , return $ emit "["

179− , prettyPrintCpp' prop

179+ , prettyPrintIL' prop

180180 , return $ emit "]"

181181 ]

182182 match (InstanceOf _ val ty) = mconcat <$> sequence

183183 [ return . emit $ unbox' dictType val

184184 , return $ emit ".contains("

185− , prettyPrintCpp' ty

185+ , prettyPrintIL' ty

186186 , return $ emit ")"

187187 ]

188188 match (While _ cond sts) = mconcat <$> sequence

189189 [ return $ emit "while ("

190− , prettyPrintCpp' cond

190+ , prettyPrintIL' cond

191191 , return $ emit ") "

192− , prettyPrintCpp' sts

192+ , prettyPrintIL' sts

193193 ]

194194 match (For _ ident start end sts) = mconcat <$> sequence

195195 [ return $ emit $ "for (boxed " <> ident <> " = "

196− , prettyPrintCpp' start

196+ , prettyPrintIL' start

197197 , return $ emit $ "; " <> ident <> " < "

198− , prettyPrintCpp' end

198+ , prettyPrintIL' end

199199 , return $ emit $ "; " <> ident <> "++) "

200− , prettyPrintCpp' sts

200+ , prettyPrintIL' sts

201201 ]

202202 match (ForIn _ ident obj sts) = mconcat <$> sequence

203203 [ return $ emit $ "for (boxed " <> ident <> " in "

204− , prettyPrintCpp' obj

204+ , prettyPrintIL' obj

205205 , return $ emit ") "

206− , prettyPrintCpp' sts

206+ , prettyPrintIL' sts

207207 ]

208208 match (IfElse _ (Binary _ EqualTo cond (BooleanLiteral Nothing True)) thens elses) = mconcat <$> sequence

209209 [ return $ emit "if ("

210210 , return $ emit $ unbox' "bool" cond

211211 , return $ emit ") "

212− , prettyPrintCpp' thens

213− , maybe (return mempty) (fmap (emit " else " <>) . prettyPrintCpp') elses

212+ , prettyPrintIL' thens

213+ , maybe (return mempty) (fmap (emit " else " <>) . prettyPrintIL') elses

214214 ]

215215 match (IfElse _ (Binary _ EqualTo cond (BooleanLiteral Nothing False)) thens elses) = mconcat <$> sequence

216216 [ return $ emit "if (!("

217217 , return $ emit $ unbox' "bool" cond

218218 , return $ emit ")) "

219− , prettyPrintCpp' thens

220− , maybe (return mempty) (fmap (emit " else " <>) . prettyPrintCpp') elses

219+ , prettyPrintIL' thens

220+ , maybe (return mempty) (fmap (emit " else " <>) . prettyPrintIL') elses

221221 ]

222222 match (IfElse _ (Binary _ EqualTo x y@(NumericLiteral _ n)) thens elses) = mconcat <$> sequence

223223 [ return $ emit "if ("

224224 , return $ emit $ unbox' t x

225225 , return $ emit $ " == "

226− , prettyPrintCpp' y

226+ , prettyPrintIL' y

227227 , return $ emit ") "

228− , prettyPrintCpp' thens

229− , maybe (return mempty) (fmap (emit " else " <>) . prettyPrintCpp') elses

228+ , prettyPrintIL' thens

229+ , maybe (return mempty) (fmap (emit " else " <>) . prettyPrintIL') elses

230230 ]

231231 where

232232 t | Left _ <- n = int

@@ -235,34 +235,34 @@ literals = mkPattern' match'

235235 [ return $ emit "if ("

236236 , return $ emit $ unbox' string a

237237 , return $ emit $ " == "

238− , prettyPrintCpp' b

238+ , prettyPrintIL' b

239239 , return $ emit ") "

240− , prettyPrintCpp' thens

241− , maybe (return mempty) (fmap (emit " else " <>) . prettyPrintCpp') elses

240+ , prettyPrintIL' thens

241+ , maybe (return mempty) (fmap (emit " else " <>) . prettyPrintIL') elses

242242 ]

243243 match (IfElse _ cond thens elses) = mconcat <$> sequence

244244 [ return $ emit "if ("

245− , prettyPrintCpp' cond

245+ , prettyPrintIL' cond

246246 , return $ emit ") "

247− , prettyPrintCpp' thens

248− , maybe (return mempty) (fmap (emit " else " <>) . prettyPrintCpp') elses

247+ , prettyPrintIL' thens

248+ , maybe (return mempty) (fmap (emit " else " <>) . prettyPrintIL') elses

249249 ]

250250 match (Return _ value) = mconcat <$> sequence

251251 [ return $ emit "return "

252− , prettyPrintCpp' value

252+ , prettyPrintIL' value

253253 ]

254254 match (ReturnNoResult _) = return $ emit "return undefined"

255255 -- match (Throw _ _) = return mempty

256256 match (Throw _ value) = mconcat <$> sequence

257257 [ return $ emit "THROW_("

258258 , return $ emit "\"PatternMatchFailure: \""

259− , prettyPrintCpp' value

259+ , prettyPrintIL' value

260260 , return $ emit ")"

261261 ]

262− match (Comment _ com cpp) = mconcat <$> sequence

262+ match (Comment _ com il) = mconcat <$> sequence

263263 [ return $ emit "\n"

264264 , mconcat <$> forM com comment

265− , prettyPrintCpp' cpp

265+ , prettyPrintIL' il

266266 ]

267267 match _ = mzero

268268

@@ -304,7 +304,7 @@ unary' op mkStr = Wrap match (const)

304304 match' _ = Nothing

305305

306306unary :: (Emit gen) => UnaryOperator -> Text -> Operator PrinterState AST gen

307−unary op str = unary' op (\v -> str <> "(" <> prettyPrintCpp1 v <> ")")

307+unary op str = unary' op (\v -> str <> "(" <> prettyPrintIL1 v <> ")")

308308

309309negateOperator :: (Emit gen) => Operator PrinterState AST gen

310310negateOperator = unary' Negate (\v -> if isNegate v then "- " else "-")

@@ -332,22 +332,22 @@ isLiteral _ = False

332332

333333prettyStatements :: (Emit gen) => [AST] -> StateT PrinterState Maybe gen

334334prettyStatements sts = do

335− cpps <- forM sts prettyPrintCpp'

335+ ils <- forM sts prettyPrintIL'

336336 indentString <- currentIndent

337− return $ intercalate (emit "\n") $ map ((<> emit ";") . (indentString <>)) cpps

337+ return $ intercalate (emit "\n") $ map ((<> emit ";") . (indentString <>)) ils

338338

339339-- | Generate a pretty-printed string representing a collection of C++ expressions at the same indentation level

340−prettyPrintCppWithSourceMaps :: [AST] -> (Text, [SMap])

341−prettyPrintCppWithSourceMaps cpp =

342− let StrPos (_, s, mp) = (fromMaybe (internalError "Incomplete pattern") . flip evalStateT (PrinterState 0) . prettyStatements) cpp

340+prettyPrintILWithSourceMaps :: [AST] -> (Text, [SMap])

341+prettyPrintILWithSourceMaps il =

342+ let StrPos (_, s, mp) = (fromMaybe (internalError "Incomplete pattern") . flip evalStateT (PrinterState 0) . prettyStatements) il

343343 in (s, mp)

344344

345−prettyPrintCpp :: [AST] -> Text

346−prettyPrintCpp = maybe (internalError "Incomplete pattern") runPlainString . flip evalStateT (PrinterState 0) . prettyStatements

345+prettyPrintIL :: [AST] -> Text

346+prettyPrintIL = maybe (internalError "Incomplete pattern") runPlainString . flip evalStateT (PrinterState 0) . prettyStatements

347347

348348-- | Generate an indented, pretty-printed string representing a C++ expression

349−prettyPrintCpp' :: (Emit gen) => AST -> StateT PrinterState Maybe gen

350−prettyPrintCpp' = A.runKleisli $ runPattern matchValue

349+prettyPrintIL' :: (Emit gen) => AST -> StateT PrinterState Maybe gen

350+prettyPrintIL' = A.runKleisli $ runPattern matchValue

351351 where

352352 matchValue :: (Emit gen) => Pattern PrinterState AST gen

353353 matchValue = buildPrettyPrinter operators (literals <+> fmap parensPos matchValue)

@@ -379,8 +379,8 @@ prettyPrintCpp' = A.runKleisli $ runPattern matchValue

379379 , [ binary Or "||" ]

380380 ]

381381

382−prettyPrintCpp1 :: AST -> Text

383−prettyPrintCpp1 = maybe (internalError "Incomplete pattern") runPlainString . flip evalStateT (PrinterState 0) . prettyPrintCpp'

382+prettyPrintIL1 :: AST -> Text

383+prettyPrintIL1 = maybe (internalError "Incomplete pattern") runPlainString . flip evalStateT (PrinterState 0) . prettyPrintIL'

384384

385385stringLiteral :: PSString -> Text

386386stringLiteral pss | Just s <- decodeString pss =

@@ -404,10 +404,10 @@ stringLiteral pss | Just s <- decodeString pss =

404404stringLiteral _ = "\"\\uFFFD\""

405405

406406unbox' :: Text -> AST -> Text

407−unbox' _ v@(NumericLiteral{}) = prettyPrintCpp1 v

408−unbox' _ v@(BooleanLiteral{}) = prettyPrintCpp1 v

409−unbox' _ v@(StringLiteral{}) = prettyPrintCpp1 v

410−unbox' t v = unbox t <> "(" <> prettyPrintCpp1 v <> ")"

407+unbox' _ v@(NumericLiteral{}) = prettyPrintIL1 v

408+unbox' _ v@(BooleanLiteral{}) = prettyPrintIL1 v

409+unbox' _ v@(StringLiteral{}) = prettyPrintIL1 v

410+unbox' t v = unbox t <> "(" <> prettyPrintIL1 v <> ")"

411411

412412unboxType :: Text -> Maybe Text

413413unboxType t

@@ -437,12 +437,12 @@ renderOp op

437437

438438interfaceSource :: Text -> [(Text,Bool)] -> [Ident] -> Text

439439interfaceSource mn values foreigns =

440− let foreigns' = identToCpp <$> foreigns

440+ let foreigns' = identToIL <$> foreigns

441441 valueNames = fst <$> values

442442 values' = filter ((`notElem` foreigns') . fst) values ++

443443 zip (foreigns' \\ valueNames) (repeat True)

444444 in

445− "// Generated by pscpp compiler\n\n" <>

445+ "// Generated by psil compiler\n\n" <>

446446 "#ifndef " <> mn <> "_H\n" <>

447447 "#define " <> mn <> "_H\n\n" <>

448448 "#include \"purescript.h\"\n\n" <>

@@ -468,7 +468,7 @@ implFooterSource mn foreigns =

468468 else ("// Foreign values\n\n" <>

469469 "DEFINE_FOREIGN_DICTIONARY_AND_ACCESSOR()\n\n" <>

470470 (T.concat $ (\foreign' -> "auto " <>

471− identToCpp foreign' <>

471+ identToIL foreign' <>

472472 "() -> const boxed& { " <>

473473 staticValueBegin <>

474474 foreignDict <> "().at(" <>