28859ed · rowtype-yoga/purescript-native

1−-----------------------------------------------------------------------------

1+---------------------------------------------------------------------------------------------------

2--

3-- Module : Language.PureScript.CodeGen.Cpp

9-- Portability :

10--

11-- |

12−-- This module generates code in the simplified C++1x intermediate representation from Purescript code

12+-- This module generates code in the simplified C++1x intermediate representation from

13+-- Purescript code.

13--

14--

14−-----------------------------------------------------------------------------

15+---------------------------------------------------------------------------------------------------

15−

16{-# LANGUAGE GADTs #-}

17{-# LANGUAGE ViewPatterns #-}

18{-# LANGUAGE FlexibleContexts #-}

63 => E.Environment -> Module Ann -> m [Cpp]

64---------------------------------------------------------------------------------------------------

65moduleToCpp env (Module _ mn imps _ foreigns decls) = do

66+ cppImports <-

67+ traverse (pure . runModuleName) .

66− cppImports <- traverse (pure . runModuleName) . delete (ModuleName [ProperName C.prim]) . (\\ [mn]) $ imps

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

69+ imps

67− let cppImports' = "PureScript" : cppImports

70+ let cppImports' = "PureScript" : cppImports

68− cppDecls <- concat <$> mapM bindToCpp decls

71+ cppDecls <- concat <$> mapM bindToCpp decls

69− optimized <- traverse optimize cppDecls

72+ optimized <- traverse optimize cppDecls

70− let moduleHeader = fileBegin mn "HH"

73+ let moduleHeader =

74+ fileBegin mn "HH" ++

71− ++ P.linebreak

75+ P.linebreak ++

72− ++ ((\i -> CppInclude i i) <$> cppImports')

76+ ((\i -> CppInclude i i) <$> cppImports') ++

73− ++ (if not (null foreigns)

77+ (if not (null foreigns)

74− then [CppInclude [] (runModuleName mn ++ "_ffi")]

78+ then [CppInclude [] (runModuleName mn ++ "_ffi")]

75− else []

79+ else []) ++

76− )

77− ++ P.linebreak

80+ P.linebreak ++

78− ++ [CppNamespace (runModuleName mn) $

81+ [ CppNamespace (runModuleName mn) $

79− (CppUseNamespace <$> cppImports') ++ P.linebreak

82+ (CppUseNamespace <$> cppImports') ++

80− ++ toHeader optimized

81− ++ toHeaderFns optimized

83+ P.linebreak ++ toHeader optimized ++ toHeaderFns optimized ] ++

82− ]

83− ++ P.linebreak

84− ++ fileEnd mn "HH"

84+ P.linebreak ++ fileEnd mn "HH"

85− let bodyCpps = toBodyDecl optimized ++ toBody optimized

85+ let bodyCpps = toBodyDecl optimized ++ toBody optimized

86+ moduleBody =

86− moduleBody = CppInclude (runModuleName mn) (runModuleName mn) : P.linebreak

87+ CppInclude (runModuleName mn) (runModuleName mn) :

88+ P.linebreak ++

87− ++ (if null bodyCpps

89+ (if null bodyCpps

88− then []

90+ then []

89− else [CppNamespace (runModuleName mn) $

91+ else [ CppNamespace (runModuleName mn) $

90− (CppUseNamespace <$> cppImports') ++ P.linebreak ++ bodyCpps])

92+ (CppUseNamespace <$> cppImports') ++

93+ P.linebreak ++ bodyCpps ]) ++

91− ++ P.linebreak

94+ P.linebreak ++

95+ (if isMain mn

92− ++ (if isMain mn then [nativeMain] ++ P.linebreak else [])

96+ then [nativeMain] ++ P.linebreak

97+ else [])

93− return $ moduleHeader ++ CppEndOfHeader : moduleBody

98+ return $ moduleHeader ++ CppEndOfHeader : moduleBody

94−

95 where

99 where

96 -- |

100 -- |

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

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

115 body@(Accessor _ _ (Var _ (Qualified Nothing arg'))))

119 body@(Accessor _ _ (Var _ (Qualified Nothing arg'))))

116 | arg' == arg = do

120 | arg' == arg = do

117 block <- asReturnBlock <$> valueToCpp body

121 block <- asReturnBlock <$> valueToCpp body

118− let fn' = CppFunction (identToCpp ident)

122+ let fn' = CppFunction

123+ (identToCpp ident)

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

124+ [(identToCpp arg, Just $ CppAny [CppConst, CppRef])]

120− (Just $ CppAny [])

125+ (Just $ CppAny [])

121− []

126+ []

122− block

127+ block

123 return fn'

128 return fn'

124

129

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

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

126 block <- asReturnBlock <$> valueToCpp body

131 block <- asReturnBlock <$> valueToCpp body

127 let block' = convertNestedLambdas block

132 let block' = convertNestedLambdas block

133+ fn' = CppFunction

134+ (identToCpp ident)

128− fn' = CppFunction (identToCpp ident) [(identToCpp arg, Just $ CppAny [CppConst, CppRef])]

135+ [(identToCpp arg, Just $ CppAny [CppConst, CppRef])]

129− (Just $ CppAny [])

136+ (Just $ CppAny [])

130− vqs

137+ vqs

131− block'

138+ block'

132 return (CppComment com fn')

139 return (CppComment com fn')

133

140

134− declToCpp _ ident (Constructor _ _ (ProperName _) []) = return $

141+ declToCpp _ ident (Constructor _ _ (ProperName _) []) =

142+ return $

143+ CppFunction

135− CppFunction (identToCpp ident)

144+ (identToCpp ident)

145+ []

136− [] (Just $ CppAny [])

146+ (Just $ CppAny [])

137− [CppInline]

147+ [CppInline]

138− (CppBlock [CppReturn (CppDataLiteral [CppStringLiteral (identToCpp ident)])])

148+ (CppBlock [CppReturn (CppDataLiteral [CppStringLiteral (identToCpp ident)])])

139

149

140 declToCpp _ ident (Constructor _ _ (ProperName _) fields) = return . CppNamespace [] $

150 declToCpp _ ident (Constructor _ _ (ProperName _) fields) = return . CppNamespace [] $

151+ [ CppFunction

141− [ CppFunction ('$' : identToCpp ident) (farg <$> fields')

152+ ('$' : identToCpp ident)

153+ (farg <$> fields')

142− (Just $ CppAny [])

154+ (Just $ CppAny [])

143− [CppInline]

155+ [CppInline]

144− (CppBlock fullyConstructed)

156+ (CppBlock fullyConstructed)

157+ , CppFunction

145− , CppFunction (identToCpp ident) (farg <$> f)

158+ (identToCpp ident)

159+ (farg <$> f)

146− (Just $ CppAny [])

160+ (Just $ CppAny [])

147− []

161+ []

148− (CppBlock (fieldLambdas fs))

162+ (CppBlock (fieldLambdas fs))

149 ]

163 ]

150 where

164 where

151 name = identToCpp ident

165 name = identToCpp ident

154 | otherwise = ([], [])

168 | otherwise = ([], [])

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

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

156 fieldLambdas flds

170 fieldLambdas flds

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

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

172+ CppLambda

158− CppLambda [CppCaptureAll] (farg <$> [f'])

173+ [CppCaptureAll]

174+ (farg <$> [f'])

159− (Just $ CppAny [])

175+ (Just $ CppAny [])

160− (CppBlock $ fieldLambdas fs')]

176+ (CppBlock $ fieldLambdas fs') ]

161 | otherwise = fullyConstructed

177 | otherwise = fullyConstructed

162 fullyConstructed = [CppReturn (CppDataLiteral (CppStringLiteral name : (CppVar <$> fields')))]

178 fullyConstructed = [CppReturn (CppDataLiteral (CppStringLiteral name : (CppVar <$> fields')))]

163

179

164 declToCpp _ ident val = do

180 declToCpp _ ident val = do

165 val' <- valueToCpp val

181 val' <- valueToCpp val

182+ return $

183+ CppVariableIntroduction

166− return $ CppVariableIntroduction (identToCpp ident, Just $ CppAny [CppConst]) [] (Just val')

184+ (identToCpp ident, Just $ CppAny [CppConst])

185+ []

186+ (Just val')

167

187

168 -------------------------------------------------------------------------------------------------

188 -------------------------------------------------------------------------------------------------

169 fnToLambda :: Cpp -> Cpp

189 fnToLambda :: Cpp -> Cpp

170 -------------------------------------------------------------------------------------------------

190 -------------------------------------------------------------------------------------------------

171 fnToLambda (CppFunction name args _ qs body) =

191 fnToLambda (CppFunction name args _ qs body) =

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

192+ CppVariableIntroduction

193+ (name, Just $ CppAny [CppConst])

173− (filter (==CppStatic) qs)

194+ (filter (==CppStatic) qs)

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

195+ (Just $ CppLambda cs args (Just $ CppAny []) body)

175 where

196 where

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

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

177 | otherwise = [CppCaptureAll]

198 | otherwise = [CppCaptureAll]

211 removeRec cpp' = cpp'

232 removeRec cpp' = cpp'

212

233

213 dict :: Cpp

234 dict :: Cpp

214− dict = CppVariableIntroduction (topdict, Just $ CppAny [CppConst]) []

235+ dict = CppVariableIntroduction

236+ (topdict, Just $ CppAny [CppConst])

237+ []

215− (Just $ CppObjectLiteral fns)

238+ (Just $ CppObjectLiteral fns)

216

239

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

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

241+ accessor dictname (name, _) =

218− accessor dictname (name, _) = CppVariableIntroduction (name, Just $ CppAny [CppConst]) [] (Just accessed)

242+ CppVariableIntroduction

243+ (name, Just $ CppAny [CppConst])

244+ []

245+ (Just accessed)

219 where

246 where

220 dict' = CppVar dictname

247 dict' = CppVar dictname

221 accessed = CppApp (CppIndexer (CppStringLiteral name) dict') [dict']

248 accessed = CppApp (CppIndexer (CppStringLiteral name) dict') [dict']

222

249

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

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

224 toelem (CppFunction name args rtyp _ (CppBlock body)) =

251 toelem (CppFunction name args rtyp _ (CppBlock body)) =

225− (name, withdict . maybeRemCaps $ CppLambda [CppCaptureAll]

252+ (name, withdict . maybeRemCaps $ CppLambda

253+ [CppCaptureAll]

254+ args

255+ rtyp

226− args rtyp (CppBlock $ (accessor localdict <$> fns) ++ body))

256+ (CppBlock $ (accessor localdict <$> fns) ++ body))

227 toelem _ = error "not a function"

257 toelem _ = error "not a function"

228

258

229 withdict :: Cpp -> Cpp

259 withdict :: Cpp -> Cpp

230− withdict cpp' = maybeRemCaps $

260+ withdict cpp' = maybeRemCaps $ CppLambda

261+ [CppCaptureAll]

231− CppLambda [CppCaptureAll] [(localdict, Just $ CppAny [CppConst, CppRef])]

262+ [(localdict, Just $ CppAny [CppConst, CppRef])]

232− (Just $ CppAny [])

263+ (Just $ CppAny [])

233− (CppBlock [CppReturn cpp'])

264+ (CppBlock [CppReturn cpp'])

234 topdict :: String

265 topdict :: String

235 topdict = "__dict__"

266 topdict = "__dict__"

236 localdict :: String

267 localdict :: String

292 valueToCpp (Abs _ arg body) = do

323 valueToCpp (Abs _ arg body) = do

293 cpp <- valueToCpp body

324 cpp <- valueToCpp body

294 let cpp' = convertNestedLambdas cpp

325 let cpp' = convertNestedLambdas cpp

326+ return $

327+ CppLambda

328+ []

295− return $ CppLambda [] [(identToCpp arg, Just $ CppAny [CppConst, CppRef])] (Just $ CppAny []) (asReturnBlock cpp')

329+ [(identToCpp arg, Just $ CppAny [CppConst, CppRef])]

330+ (Just $ CppAny [])

331+ (asReturnBlock cpp')

296

332

297 -- valueToCpp (App _ e (Var _ (Qualified (Just (ModuleName [ProperName "Prim"])) (Ident "undefined")))) =

333 -- valueToCpp (App _ e (Var _ (Qualified (Just (ModuleName [ProperName "Prim"])) (Ident "undefined")))) =

298 -- valueToCpp e

334 -- valueToCpp e

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

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

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

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

309 return . CppObjectLiteral $ zip ((sort $ superClassDictionaryNames constraints) ++ (fst <$> fns)) args'

345 return . CppObjectLiteral $ zip ((sort $ superClassDictionaryNames constraints) ++ (fst <$> fns)) args'

310− _ -> -- TODO: verify this

346+ _ ->

311 flip (foldl (\fn a -> CppApp fn [a])) args' <$> valueToCpp f

347 flip (foldl (\fn a -> CppApp fn [a])) args' <$> valueToCpp f

312

348

313 valueToCpp (Case (maybeSpan, _, ty, _) values binders) = do

349 valueToCpp (Case (maybeSpan, _, ty, _) values binders) = do

322 then convertRecursiveFns ds''

358 then convertRecursiveFns ds''

323 else ds''

359 else ds''

324 let cpps = convertNestedLambdas <$> rs

360 let cpps = convertNestedLambdas <$> rs

361+ return $ CppApp

325− return $ CppApp (CppLambda [] [] Nothing (CppBlock (cpps ++ [CppReturn ret]))) []

362+ (CppLambda [] [] Nothing (CppBlock (cpps ++ [CppReturn ret])))

363+ []

326 where

364 where

327 hasRecursion :: [Cpp] -> Bool

365 hasRecursion :: [Cpp] -> Bool

328 hasRecursion cpps' = any (everythingOnCpp (||) hasRecursiveRef) cpps'

366 hasRecursion cpps' = any (everythingOnCpp (||) hasRecursiveRef) cpps'

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

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

368 ret <- guardsToCpp result

406 ret <- guardsToCpp result

369 go valNames ret bs

407 go valNames ret bs

408+ return $

409+ CppApp

370− return $ CppApp (CppLambda []

410+ (CppLambda

411+ []

371− []

412+ []

372− (Just $ CppAny [])

413+ (Just $ CppAny [])

373− (CppBlock (assignments ++ concat cpps ++ [failedPatternError valNames]))) []

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

415+ []

374 where

416 where

375 mkVarDecl :: String -> Maybe Cpp -> Cpp

417 mkVarDecl :: String -> Maybe Cpp -> Cpp

376 mkVarDecl name = CppVariableIntroduction (name, Nothing) []

418 mkVarDecl name = CppVariableIntroduction (name, Nothing) []

386 CppThrow $ CppApp (CppVar "runtime_error") [CppStringLiteral errorMessage]

428 CppThrow $ CppApp (CppVar "runtime_error") [CppStringLiteral errorMessage]

387

429

388 errorMessage :: String

430 errorMessage :: String

431+ errorMessage = "Failed pattern match" ++

389− errorMessage = "Failed pattern match" ++ maybe "" (((" at " ++ runModuleName mn ++ " ") ++) . displayStartEndPos) maybeSpan ++ ": "

432+ maybe "" (((" at " ++ runModuleName mn ++ " ") ++) . displayStartEndPos) maybeSpan ++

433+ ": "

390

434

391 guardsToCpp :: Either [(Guard Ann, Expr Ann)] (Expr Ann) -> m [Cpp]

435 guardsToCpp :: Either [(Guard Ann, Expr Ann)] (Expr Ann) -> m [Cpp]

392 guardsToCpp (Left gs) = forM gs $ \(cond, val) -> do

436 guardsToCpp (Left gs) = forM gs $ \(cond, val) -> do

408 literalToBinderCpp varName done l

452 literalToBinderCpp varName done l

409

453

410 binderToCpp varName done (VarBinder _ ident) =

454 binderToCpp varName done (VarBinder _ ident) =

455+ return $

456+ CppVariableIntroduction

411− return (CppVariableIntroduction (identToCpp ident, Just $ CppAny [CppConst]) [] (Just (CppVar varName)) : done)

457+ (identToCpp ident, Just $ CppAny [CppConst])

458+ []

459+ (Just $ CppVar varName)

460+ : done

412

461

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

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

414 binderToCpp varName done b

463 binderToCpp varName done b

418 (Qualified _ (ProperName ctor))

467 (Qualified _ (ProperName ctor))

419 bs) = do

468 bs) = do

420 cpps <- go (zip fields bs) done

469 cpps <- go (zip fields bs) done

470+ return $

421− return $ case ctorType of

471+ case ctorType of

422− ProductType -> cpps

472+ ProductType -> cpps

423− SumType ->

473+ SumType ->

474+ [ CppIfElse

475+ (CppBinary

476+ Equal

477+ (CppIndexer

478+ (CppVar ctorKey)

424− [ CppIfElse (CppBinary Equal (CppIndexer (CppVar ctorKey) (CppCast dataType $ CppVar varName))

479+ (CppCast dataType $ CppVar varName))

425− (CppStringLiteral ctor))

480+ (CppStringLiteral ctor))

426− (CppBlock cpps)

481+ (CppBlock cpps)

427− Nothing ]

482+ Nothing]

428 where

483 where

429 go :: [(Ident, Binder Ann)] -> [Cpp] -> m [Cpp]

484 go :: [(Ident, Binder Ann)] -> [Cpp] -> m [Cpp]

430 go [] done' = return done'

485 go [] done' = return done'

432 argVar <- freshName

487 argVar <- freshName

433 done'' <- go remain done'

488 done'' <- go remain done'

434 cpps <- binderToCpp argVar done'' binder

489 cpps <- binderToCpp argVar done'' binder

490+ return $

435− return (CppVariableIntroduction (argVar, Nothing)

491+ CppVariableIntroduction

492+ (argVar, Nothing)

436− []

493+ []

494+ (Just $ CppIndexer

495+ (fieldToIndex field)

437− (Just (CppIndexer (fieldToIndex field) (CppCast dataType $ CppVar varName)))

496+ (CppCast dataType $ CppVar varName))

438− : cpps)

497+ : cpps

439 fieldToIndex :: Ident -> Cpp

498 fieldToIndex :: Ident -> Cpp

440 fieldToIndex = CppNumericLiteral . Left . (+1) . read . dropWhile isLetter . runIdent

499 fieldToIndex = CppNumericLiteral . Left . (+1) . read . dropWhile isLetter . runIdent

441

500

444

503

445 binderToCpp varName done (NamedBinder _ ident binder) = do

504 binderToCpp varName done (NamedBinder _ ident binder) = do

446 cpp <- binderToCpp varName done binder

505 cpp <- binderToCpp varName done binder

506+ return $

507+ CppVariableIntroduction

447− return (CppVariableIntroduction (identToCpp ident, Just $ CppAny [CppConst]) [] (Just (CppVar varName)) : cpp)

508+ (identToCpp ident, Just $ CppAny [CppConst])

509+ []

510+ (Just $ CppVar varName)

511+ : cpp

448

512

449 -------------------------------------------------------------------------------------------------

513 -------------------------------------------------------------------------------------------------

450 literalToBinderCpp :: String -> [Cpp] -> Literal (Binder Ann) -> m [Cpp]

514 literalToBinderCpp :: String -> [Cpp] -> Literal (Binder Ann) -> m [Cpp]

451 -------------------------------------------------------------------------------------------------

515 -------------------------------------------------------------------------------------------------

452 literalToBinderCpp varName done (NumericLiteral num) =

516 literalToBinderCpp varName done (NumericLiteral num) =

517+ return [ CppIfElse

453− return [CppIfElse (CppBinary Equal (CppVar varName) (CppNumericLiteral num)) (CppBlock done) Nothing]

518+ (CppBinary Equal (CppVar varName) (CppNumericLiteral num))

519+ (CppBlock done)

520+ Nothing ]

454

521

455 literalToBinderCpp varName done (CharLiteral c) =

522 literalToBinderCpp varName done (CharLiteral c) =

523+ return [ CppIfElse

456− return [CppIfElse (CppBinary Equal (CppVar varName)

524+ (CppBinary Equal (CppVar varName) (CppCharLiteral c))

457− (CppCharLiteral c))

458− (CppBlock done)

525+ (CppBlock done)

459− Nothing]

526+ Nothing ]

460

527

461 literalToBinderCpp varName done (StringLiteral str) =

528 literalToBinderCpp varName done (StringLiteral str) =

529+ return [ CppIfElse

462− return [CppIfElse (CppBinary Equal (CppVar varName)

530+ (CppBinary Equal (CppVar varName) (CppStringLiteral str))

463− (CppStringLiteral str))

464− (CppBlock done)

531+ (CppBlock done)

465− Nothing]

532+ Nothing ]

466

533

467 literalToBinderCpp varName done (BooleanLiteral True) =

534 literalToBinderCpp varName done (BooleanLiteral True) =

468− return [CppIfElse (CppVar varName) (CppBlock done) Nothing]

535+ return [ CppIfElse

536+ (CppVar varName)

537+ (CppBlock done)

538+ Nothing ]

469

539

470 literalToBinderCpp varName done (BooleanLiteral False) =

540 literalToBinderCpp varName done (BooleanLiteral False) =

471− return [CppIfElse (CppUnary CppNot (CppVar varName)) (CppBlock done) Nothing]

541+ return [ CppIfElse

542+ (CppUnary

543+ CppNot

544+ (CppVar varName))

545+ (CppBlock done)

546+ Nothing ]

472

547

473 literalToBinderCpp varName done (ObjectLiteral bs) = go done bs

548 literalToBinderCpp varName done (ObjectLiteral bs) = go done bs

474 where

549 where

478 propVar <- freshName

553 propVar <- freshName

479 done'' <- go done' bs'

554 done'' <- go done' bs'

480 cpp <- binderToCpp propVar done'' binder

555 cpp <- binderToCpp propVar done'' binder

556+ return $

481− return (CppVariableIntroduction (propVar, Nothing)

557+ CppVariableIntroduction

558+ (propVar, Nothing)

482− []

559+ []

560+ (Just $ CppIndexer

483− (Just (CppIndexer (CppStringLiteral prop) (CppVar varName)))

561+ (CppStringLiteral prop)

562+ (CppVar varName))

484− : cpp)

563+ : cpp

485

564

486 literalToBinderCpp varName done (ArrayLiteral bs) = do

565 literalToBinderCpp varName done (ArrayLiteral bs) = do

487 cpp <- go done 0 bs

566 cpp <- go done 0 bs

567+ let cond =

488− let cond = case length bs of

568+ case length bs of

569+ 0 -> CppBinary

570+ Dot

489− 0 -> CppBinary Dot (CppCast arrayType $ CppVar varName)

571+ (CppCast arrayType $ CppVar varName)

490− (CppApp (CppVar "empty") [])

572+ (CppApp (CppVar "empty") [])

491− n -> let var = CppCast arrayType $ CppVar varName in

573+ n -> let var = CppCast arrayType $ CppVar varName

574+ in CppBinary

575+ Equal

492− CppBinary Equal (CppBinary Dot var (CppApp (CppVar "size") []))

576+ (CppBinary Dot var (CppApp (CppVar "size") []))

493− (CppNumericLiteral (Left (fromIntegral n)))

577+ (CppNumericLiteral (Left (fromIntegral n)))

494 return [ CppIfElse cond (CppBlock cpp) Nothing ]

578 return [ CppIfElse cond (CppBlock cpp) Nothing ]

495 where

579 where

496 go :: [Cpp] -> Integer -> [Binder Ann] -> m [Cpp]

580 go :: [Cpp] -> Integer -> [Binder Ann] -> m [Cpp]

499 elVar <- freshName

583 elVar <- freshName

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

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

501 cpp <- binderToCpp elVar done'' binder

585 cpp <- binderToCpp elVar done'' binder

586+ return $

502− return (CppVariableIntroduction (elVar, Nothing) []

587+ CppVariableIntroduction

588+ (elVar, Nothing)

589+ []

590+ (Just $ CppIndexer

503− (Just (CppIndexer (CppNumericLiteral (Left index)) (CppVar varName))) : cpp)

591+ (CppNumericLiteral (Left index))

592+ (CppVar varName))

593+ : cpp

504

594

505 -------------------------------------------------------------------------------------------------

595 -------------------------------------------------------------------------------------------------

506−

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

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

597+ -------------------------------------------------------------------------------------------------

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

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

509 unApp other args = (other, args)

599 unApp other args = (other, args)

510

600

601+ -------------------------------------------------------------------------------------------------

511 qualifiedToCpp :: (a -> Ident) -> Qualified a -> Cpp

602 qualifiedToCpp :: (a -> Ident) -> Qualified a -> Cpp

603+ -------------------------------------------------------------------------------------------------

512− qualifiedToCpp f (Qualified (Just (ModuleName [ProperName mn'])) a) | mn' == C.prim = CppVar . runIdent $ f a

604+ qualifiedToCpp f (Qualified (Just (ModuleName [ProperName mn'])) a)

605+ | mn' == C.prim = CppVar . runIdent $ f a

513 qualifiedToCpp f (Qualified (Just mn') a)

606 qualifiedToCpp f (Qualified (Just mn') a)

514 | mn /= mn' = CppAccessor (CppVar . identToCpp $ f a) (CppVar (moduleNameToCpp mn'))

607 | mn /= mn' = CppAccessor (CppVar . identToCpp $ f a) (CppVar (moduleNameToCpp mn'))

515 qualifiedToCpp f (Qualified _ a) = CppVar $ identToCpp (f a)

608 qualifiedToCpp f (Qualified _ a) = CppVar $ identToCpp (f a)

516

609

610+ -------------------------------------------------------------------------------------------------

517 qualifiedToStr' :: (a -> Ident) -> Qualified a -> String

611 qualifiedToStr' :: (a -> Ident) -> Qualified a -> String

612+ -------------------------------------------------------------------------------------------------

518 qualifiedToStr' = qualifiedToStr mn

613 qualifiedToStr' = qualifiedToStr mn

519

614

520 -- |

615 -- |

521 -- Find a class in scope by name, retrieving its list of constraints, function names and types.

616 -- Find a class in scope by name, retrieving its list of constraints, function names and types.

522 --

617 --

618+ -------------------------------------------------------------------------------------------------

523 findClass :: Qualified (ProperName ClassName) -> Maybe ([String], [T.Constraint], [(String, T.Type)])

619 findClass :: Qualified (ProperName ClassName) -> Maybe ([String], [T.Constraint], [(String, T.Type)])

620+ -------------------------------------------------------------------------------------------------

524 findClass name

621 findClass name

525 | Just (params, fns, constraints) <- M.lookup name (E.typeClasses env),

622 | Just (params, fns, constraints) <- M.lookup name (E.typeClasses env),

526 fns' <- (\(i,t) -> (runIdent i, t)) <$> fns

623 fns' <- (\(i,t) -> (runIdent i, t)) <$> fns