src/Language/PureScript/Declarations.hs · rowtype-yoga/purescript-native

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

on beaef52 help sign in

rowtype-yoga/purescript-native/src/Language/PureScript/Declarations.hs

638 lines 22 kB history raw

1-----------------------------------------------------------------------------

2--

3-- Module : Language.PureScript.Declarations

4-- Copyright : (c) Phil Freeman 2013

5-- License : MIT

6--

7-- Maintainer : Phil Freeman <paf31@cantab.net>

8-- Stability : experimental

9-- Portability :

10--

11-- | Data types for modules and declarations

12--

13-----------------------------------------------------------------------------

15{-# LANGUAGE DeriveDataTypeable #-}

17module Language.PureScript.Declarations where

19import Data.Monoid (Monoid(..), mconcat)

21import qualified Data.Data as D

23import Control.Applicative

24import Control.Monad

26import Language.PureScript.Types

27import Language.PureScript.Names

28import Language.PureScript.Kinds

29import Language.PureScript.TypeClassDictionaries

30import Language.PureScript.CodeGen.JS.AST

31import Language.PureScript.Environment

32import Language.PureScript.Traversals

34-- |

35-- A precedence level for an infix operator

36--

37type Precedence = Integer

39-- |

40-- Associativity for infix operators

41--

42data Associativity = Infixl | Infixr | Infix deriving (D.Data, D.Typeable)

44instance Show Associativity where

45 show Infixl = "infixl"

46 show Infixr = "infixr"

47 show Infix = "infix"

49-- |

50-- Source position information

51--

52data SourcePos = SourcePos

53 { -- |

54 -- Source name

55 --

56 sourceName :: String

57 -- |

58 -- Line number

59 --

60 , sourcePosLine :: Int

61 -- |

62 -- Column number

63 --

64 , sourcePosColumn :: Int

65 } deriving (D.Data, D.Typeable)

67instance Show SourcePos where

68 show sp = (sourceName sp) ++ " line " ++ show (sourcePosLine sp) ++ ", column " ++ show (sourcePosColumn sp)

70-- |

71-- Fixity data for infix operators

72--

73data Fixity = Fixity Associativity Precedence deriving (Show, D.Data, D.Typeable)

75-- |

76-- A module declaration, consisting of a module name, a list of declarations, and a list of the

77-- declarations that are explicitly exported. If the export list is Nothing, everything is exported.

78--

79data Module = Module ModuleName [Declaration] (Maybe [DeclarationRef]) deriving (Show, D.Data, D.Typeable)

81-- |

82-- An item in a list of explicit imports or exports

83--

84data DeclarationRef

85 -- |

86 -- A type constructor with data constructors

87 --

88 = TypeRef ProperName (Maybe [ProperName])

89 -- |

90 -- A value

91 --

92 | ValueRef Ident

93 -- |

94 -- A type class

95 --

96 | TypeClassRef ProperName

97 -- |

98 -- A type class instance, created during typeclass desugaring (name, class name, instance types)

99 --

100 | TypeInstanceRef Ident

101 -- |

102 -- A declaration reference with source position information

103 --

104 | PositionedDeclarationRef SourcePos DeclarationRef

105 deriving (Show, D.Data, D.Typeable)

106

107instance Eq DeclarationRef where

108 (TypeRef name dctors) == (TypeRef name' dctors') = name == name' && dctors == dctors'

109 (ValueRef name) == (ValueRef name') = name == name'

110 (TypeClassRef name) == (TypeClassRef name') = name == name'

111 (TypeInstanceRef name) == (TypeInstanceRef name') = name == name'

112 (PositionedDeclarationRef _ r) == r' = r == r'

113 r == (PositionedDeclarationRef _ r') = r == r'

114 _ == _ = False

115

116-- |

117-- The data type of declarations

118--

119data Declaration

120 -- |

121 -- A data type declaration (name, arguments, data constructors)

122 --

123 = DataDeclaration ProperName [String] [(ProperName, [Type])]

124 -- |

125 -- A minimal mutually recursive set of data type declarations

126 --

127 | DataBindingGroupDeclaration [Declaration]

128 -- |

129 -- A type synonym declaration (name, arguments, type)

130 --

131 | TypeSynonymDeclaration ProperName [String] Type

132 -- |

133 -- A type declaration for a value (name, ty)

134 --

135 | TypeDeclaration Ident Type

136 -- |

137 -- A value declaration (name, top-level binders, optional guard, value)

138 --

139 | ValueDeclaration Ident NameKind [Binder] (Maybe Guard) Value

140 -- |

141 -- A minimal mutually recursive set of value declarations

142 --

143 | BindingGroupDeclaration [(Ident, NameKind, Value)]

144 -- |

145 -- A foreign import declaration (type, name, optional inline Javascript, type)

146 --

147 | ExternDeclaration ForeignImportType Ident (Maybe JS) Type

148 -- |

149 -- A data type foreign import (name, kind)

150 --

151 | ExternDataDeclaration ProperName Kind

152 -- |

153 -- A type class instance foreign import

154 --

155 | ExternInstanceDeclaration Ident [(Qualified ProperName, [Type])] (Qualified ProperName) [Type]

156 -- |

157 -- A fixity declaration (fixity data, operator name)

158 --

159 | FixityDeclaration Fixity String

160 -- |

161 -- A module import (module name, optional set of identifiers to import, optional "qualified as"

162 -- name)

163 --

164 | ImportDeclaration ModuleName (Maybe [DeclarationRef]) (Maybe ModuleName)

165 -- |

166 -- A type class declaration (name, argument, implies, member declarations)

167 --

168 | TypeClassDeclaration ProperName [String] [(Qualified ProperName, [Type])] [Declaration]

169 -- |

170 -- A type instance declaration (name, dependencies, class name, instance types, member

171 -- declarations)

172 --

173 | TypeInstanceDeclaration Ident [(Qualified ProperName, [Type])] (Qualified ProperName) [Type] [Declaration]

174 -- |

175 -- A declaration with source position information

176 --

177 | PositionedDeclaration SourcePos Declaration

178 deriving (Show, D.Data, D.Typeable)

179

180-- |

181-- Test if a declaration is a value declaration

182--

183isValueDecl :: Declaration -> Bool

184isValueDecl ValueDeclaration{} = True

185isValueDecl (PositionedDeclaration _ d) = isValueDecl d

186isValueDecl _ = False

187

188-- |

189-- Test if a declaration is a data type or type synonym declaration

190--

191isDataDecl :: Declaration -> Bool

192isDataDecl DataDeclaration{} = True

193isDataDecl TypeSynonymDeclaration{} = True

194isDataDecl (PositionedDeclaration _ d) = isDataDecl d

195isDataDecl _ = False

196

197-- |

198-- Test if a declaration is a module import

199--

200isImportDecl :: Declaration -> Bool

201isImportDecl ImportDeclaration{} = True

202isImportDecl (PositionedDeclaration _ d) = isImportDecl d

203isImportDecl _ = False

204

205-- |

206-- Test if a declaration is a data type foreign import

207--

208isExternDataDecl :: Declaration -> Bool

209isExternDataDecl ExternDataDeclaration{} = True

210isExternDataDecl (PositionedDeclaration _ d) = isExternDataDecl d

211isExternDataDecl _ = False

212

213-- |

214-- Test if a declaration is a type class instance foreign import

215--

216isExternInstanceDecl :: Declaration -> Bool

217isExternInstanceDecl ExternInstanceDeclaration{} = True

218isExternInstanceDecl (PositionedDeclaration _ d) = isExternInstanceDecl d

219isExternInstanceDecl _ = False

220

221-- |

222-- Test if a declaration is a fixity declaration

223--

224isFixityDecl :: Declaration -> Bool

225isFixityDecl FixityDeclaration{} = True

226isFixityDecl (PositionedDeclaration _ d) = isFixityDecl d

227isFixityDecl _ = False

228

229-- |

230-- Test if a declaration is a foreign import

231--

232isExternDecl :: Declaration -> Bool

233isExternDecl ExternDeclaration{} = True

234isExternDecl (PositionedDeclaration _ d) = isExternDecl d

235isExternDecl _ = False

236

237-- |

238-- Test if a declaration is a type class or instance declaration

239--

240isTypeClassDeclaration :: Declaration -> Bool

241isTypeClassDeclaration TypeClassDeclaration{} = True

242isTypeClassDeclaration TypeInstanceDeclaration{} = True

243isTypeClassDeclaration (PositionedDeclaration _ d) = isTypeClassDeclaration d

244isTypeClassDeclaration _ = False

245

246-- |

247-- A guard is just a boolean-valued expression that appears alongside a set of binders

248--

249type Guard = Value

250

251-- |

252-- Data type for values

253--

254data Value

255 -- |

256 -- A numeric literal

257 --

258 = NumericLiteral (Either Integer Double)

259 -- |

260 -- A string literal

261 --

262 | StringLiteral String

263 -- |

264 -- A boolean literal

265 --

266 | BooleanLiteral Bool

267 -- |

268 -- A prefix -, will be desugared

269 --

270 | UnaryMinus Value

271 -- |

272 -- Binary operator application. During the rebracketing phase of desugaring, this data constructor

273 -- will be removed.

274 --

275 | BinaryNoParens (Qualified Ident) Value Value

276 -- |

277 -- Explicit parentheses. During the rebracketing phase of desugaring, this data constructor

278 -- will be removed.

279 --

280 | Parens Value

281 -- |

282 -- An array literal

283 --

284 | ArrayLiteral [Value]

285 -- |

286 -- An object literal

287 --

288 | ObjectLiteral [(String, Value)]

289 -- |

290 -- An record property accessor expression

291 --

292 | Accessor String Value

293 -- |

294 -- Partial record update

295 --

296 | ObjectUpdate Value [(String, Value)]

297 -- |

298 -- Function introduction

299 --

300 | Abs (Either Ident Binder) Value

301 -- |

302 -- Function application

303 --

304 | App Value Value

305 -- |

306 -- Variable

307 --

308 | Var (Qualified Ident)

309 -- |

310 -- Conditional (if-then-else expression)

311 --

312 | IfThenElse Value Value Value

313 -- |

314 -- A data constructor

315 --

316 | Constructor (Qualified ProperName)

317 -- |

318 -- A case expression. During the case expansion phase of desugaring, top-level binders will get

319 -- desugared into case expressions, hence the need for guards and multiple binders per branch here.

320 --

321 | Case [Value] [CaseAlternative]

322 -- |

323 -- A value with a type annotation

324 --

325 | TypedValue Bool Value Type

326 -- |

327 -- A let binding

328 --

329 | Let [Declaration] Value

330 -- |

331 -- A do-notation block

332 --

333 | Do [DoNotationElement]

334 -- |

335 -- A placeholder for a type class dictionary to be inserted later. At the end of type checking, these

336 -- placeholders will be replaced with actual expressions representing type classes dictionaries which

337 -- can be evaluated at runtime. The constructor arguments represent (in order): whether or not to look

338 -- at superclass implementations when searching for a dictionary, the type class name and

339 -- instance type, and the type class dictionaries in scope.

340 --

341 | TypeClassDictionary Bool (Qualified ProperName, [Type]) [TypeClassDictionaryInScope]

342 -- |

343 -- A placeholder for a superclass dictionary to be turned into a TypeClassDictionary during typechecking

344 --

345 | SuperClassDictionary (Qualified ProperName) [Type]

346 -- |

347 -- A value with source position information

348 --

349 | PositionedValue SourcePos Value deriving (Show, D.Data, D.Typeable)

350

351-- |

352-- An alternative in a case statement

353--

354data CaseAlternative = CaseAlternative

355 { -- |

356 -- A collection of binders with which to match the inputs

357 --

358 caseAlternativeBinders :: [Binder]

359 -- |

360 -- An optional guard

361 --

362 , caseAlternativeGuard :: Maybe Guard

363 -- |

364 -- The result expression

365 --

366 , caseAlternativeResult :: Value

367 } deriving (Show, D.Data, D.Typeable)

368

369-- |

370-- Find the original dictionary which a type class dictionary in scope refers to

371--

372canonicalizeDictionary :: TypeClassDictionaryInScope -> Qualified Ident

373canonicalizeDictionary (TypeClassDictionaryInScope { tcdType = TCDRegular, tcdName = nm }) = nm

374canonicalizeDictionary (TypeClassDictionaryInScope { tcdType = TCDAlias nm }) = nm

375

376-- |

377-- A statement in a do-notation block

378--

379data DoNotationElement

380 -- |

381 -- A monadic value without a binder

382 --

383 = DoNotationValue Value

384 -- |

385 -- A monadic value with a binder

386 --

387 | DoNotationBind Binder Value

388 -- |

389 -- A let statement, i.e. a pure value with a binder

390 --

391 | DoNotationLet [Declaration]

392 -- |

393 -- A do notation element with source position information

394 --

395 | PositionedDoNotationElement SourcePos DoNotationElement deriving (Show, D.Data, D.Typeable)

396

397-- |

398-- Data type for binders

399--

400data Binder

401 -- |

402 -- Wildcard binder

403 --

404 = NullBinder

405 -- |

406 -- A binder which matches a boolean literal

407 --

408 | BooleanBinder Bool

409 -- |

410 -- A binder which matches a string literal

411 --

412 | StringBinder String

413 -- |

414 -- A binder which matches a numeric literal

415 --

416 | NumberBinder (Either Integer Double)

417 -- |

418 -- A binder which binds an identifier

419 --

420 | VarBinder Ident

421 -- |

422 -- A binder which matches a data constructor

423 --

424 | ConstructorBinder (Qualified ProperName) [Binder]

425 -- |

426 -- A binder which matches a record and binds its properties

427 --

428 | ObjectBinder [(String, Binder)]

429 -- |

430 -- A binder which matches an array and binds its elements

431 --

432 | ArrayBinder [Binder]

433 -- |

434 -- A binder which matches an array and binds its head and tail

435 --

436 | ConsBinder Binder Binder

437 -- |

438 -- A binder which binds its input to an identifier

439 --

440 | NamedBinder Ident Binder

441 -- |

442 -- A binder with source position information

443 --

444 | PositionedBinder SourcePos Binder deriving (Show, D.Data, D.Typeable)

445

446-- |

447-- Collect all names introduced in binders in an expression

448--

449binderNames :: Binder -> [Ident]

450binderNames = go []

451 where

452 go ns (VarBinder name) = name : ns

453 go ns (ConstructorBinder _ bs) = foldl go ns bs

454 go ns (ObjectBinder bs) = foldl go ns (map snd bs)

455 go ns (ArrayBinder bs) = foldl go ns bs

456 go ns (ConsBinder b1 b2) = go (go ns b1) b2

457 go ns (NamedBinder name b) = go (name : ns) b

458 go ns (PositionedBinder _ b) = go ns b

459 go ns _ = ns

460

461--

462-- Traversals

463--

464

465everywhereOnValues :: (Declaration -> Declaration) ->

466 (Value -> Value) ->

467 (Binder -> Binder) ->

468 (Declaration -> Declaration, Value -> Value, Binder -> Binder)

469everywhereOnValues f g h = (f', g', h')

470 where

471 f' :: Declaration -> Declaration

472 f' (DataBindingGroupDeclaration ds) = f (DataBindingGroupDeclaration (map f' ds))

473 f' (ValueDeclaration name nameKind bs grd val) = f (ValueDeclaration name nameKind (map h' bs) (fmap g' grd) (g' val))

474 f' (BindingGroupDeclaration ds) = f (BindingGroupDeclaration (map (\(name, nameKind, val) -> (name, nameKind, g' val)) ds))

475 f' (TypeClassDeclaration name args implies ds) = f (TypeClassDeclaration name args implies (map f' ds))

476 f' (TypeInstanceDeclaration name cs className args ds) = f (TypeInstanceDeclaration name cs className args (map f' ds))

477 f' (PositionedDeclaration pos d) = f (PositionedDeclaration pos (f' d))

478 f' other = f other

479

480 g' :: Value -> Value

481 g' (UnaryMinus v) = g (UnaryMinus (g' v))

482 g' (BinaryNoParens op v1 v2) = g (BinaryNoParens op (g' v1) (g' v2))

483 g' (Parens v) = g (Parens (g' v))

484 g' (ArrayLiteral vs) = g (ArrayLiteral (map g' vs))

485 g' (ObjectLiteral vs) = g (ObjectLiteral (map (fmap g') vs))

486 g' (Accessor prop v) = g (Accessor prop (g' v))

487 g' (ObjectUpdate obj vs) = g (ObjectUpdate (g' obj) (map (fmap g') vs))

488 g' (Abs name v) = g (Abs name (g' v))

489 g' (App v1 v2) = g (App (g' v1) (g' v2))

490 g' (IfThenElse v1 v2 v3) = g (IfThenElse (g' v1) (g' v2) (g' v3))

491 g' (Case vs alts) = g (Case (map g' vs) (map handleCaseAlternative alts))

492 g' (TypedValue check v ty) = g (TypedValue check (g' v) ty)

493 g' (Let ds v) = g (Let (map f' ds) (g' v))

494 g' (Do es) = g (Do (map handleDoNotationElement es))

495 g' (PositionedValue pos v) = g (PositionedValue pos (g' v))

496 g' other = g other

497

498 h' :: Binder -> Binder

499 h' (ConstructorBinder ctor bs) = h (ConstructorBinder ctor (map h' bs))

500 h' (ObjectBinder bs) = h (ObjectBinder (map (fmap h') bs))

501 h' (ArrayBinder bs) = h (ArrayBinder (map h' bs))

502 h' (ConsBinder b1 b2) = h (ConsBinder (h' b1) (h' b2))

503 h' (NamedBinder name b) = h (NamedBinder name (h' b))

504 h' (PositionedBinder pos b) = h (PositionedBinder pos (h' b))

505 h' other = h other

506

507 handleCaseAlternative :: CaseAlternative -> CaseAlternative

508 handleCaseAlternative ca =

509 ca { caseAlternativeBinders = map h' (caseAlternativeBinders ca)

510 , caseAlternativeGuard = fmap g' (caseAlternativeGuard ca)

511 , caseAlternativeResult = g' (caseAlternativeResult ca)

512 }

513

514 handleDoNotationElement :: DoNotationElement -> DoNotationElement

515 handleDoNotationElement (DoNotationValue v) = DoNotationValue (g' v)

516 handleDoNotationElement (DoNotationBind b v) = DoNotationBind (h' b) (g' v)

517 handleDoNotationElement (DoNotationLet ds) = DoNotationLet (map f' ds)

518 handleDoNotationElement (PositionedDoNotationElement pos e) = PositionedDoNotationElement pos (handleDoNotationElement e)

519

520everywhereOnValuesTopDownM :: (Functor m, Applicative m, Monad m) =>

521 (Declaration -> m Declaration) ->

522 (Value -> m Value) ->

523 (Binder -> m Binder) ->

524 (Declaration -> m Declaration, Value -> m Value, Binder -> m Binder)

525everywhereOnValuesTopDownM f g h = (f' <=< f, g' <=< g, h' <=< h)

526 where

527 f' (DataBindingGroupDeclaration ds) = DataBindingGroupDeclaration <$> mapM (f' <=< f) ds

528 f' (ValueDeclaration name nameKind bs grd val) = ValueDeclaration name nameKind <$> mapM (h' <=< h) bs <*> maybeM (g' <=< g) grd <*> (g val >>= g')

529 f' (BindingGroupDeclaration ds) = BindingGroupDeclaration <$> mapM (\(name, nameKind, val) -> (,,) name nameKind <$> (g val >>= g')) ds

530 f' (TypeClassDeclaration name args implies ds) = TypeClassDeclaration name args implies <$> mapM (f' <=< f) ds

531 f' (TypeInstanceDeclaration name cs className args ds) = TypeInstanceDeclaration name cs className args <$> mapM (f' <=< f) ds

532 f' (PositionedDeclaration pos d) = PositionedDeclaration pos <$> (f d >>= f')

533 f' other = f other

534

535 g' (UnaryMinus v) = UnaryMinus <$> (g v >>= g')

536 g' (BinaryNoParens op v1 v2) = BinaryNoParens op <$> (g v1 >>= g') <*> (g v2 >>= g')

537 g' (Parens v) = Parens <$> (g v >>= g')

538 g' (ArrayLiteral vs) = ArrayLiteral <$> mapM (g' <=< g) vs

539 g' (ObjectLiteral vs) = ObjectLiteral <$> mapM (sndM (g' <=< g)) vs

540 g' (Accessor prop v) = Accessor prop <$> (g v >>= g')

541 g' (ObjectUpdate obj vs) = ObjectUpdate <$> (g obj >>= g') <*> mapM (sndM (g' <=< g)) vs

542 g' (Abs name v) = Abs name <$> (g v >>= g')

543 g' (App v1 v2) = App <$> (g v1 >>= g') <*> (g v2 >>= g')

544 g' (IfThenElse v1 v2 v3) = IfThenElse <$> (g v1 >>= g') <*> (g v2 >>= g') <*> (g v3 >>= g')

545 g' (Case vs alts) = Case <$> mapM (g' <=< g) vs <*> mapM handleCaseAlternative alts

546 g' (TypedValue check v ty) = TypedValue check <$> (g v >>= g') <*> pure ty

547 g' (Let ds v) = Let <$> mapM (f' <=< f) ds <*> (g v >>= g')

548 g' (Do es) = Do <$> mapM handleDoNotationElement es

549 g' (PositionedValue pos v) = PositionedValue pos <$> (g v >>= g')

550 g' other = g other

551

552 h' (ConstructorBinder ctor bs) = ConstructorBinder ctor <$> mapM (h' <=< h) bs

553 h' (ObjectBinder bs) = ObjectBinder <$> mapM (sndM (h' <=< h)) bs

554 h' (ArrayBinder bs) = ArrayBinder <$> mapM (h' <=< h) bs

555 h' (ConsBinder b1 b2) = ConsBinder <$> (h b1 >>= h') <*> (h b2 >>= h')

556 h' (NamedBinder name b) = NamedBinder name <$> (h b >>= h')

557 h' (PositionedBinder pos b) = PositionedBinder pos <$> (h b >>= h')

558 h' other = h other

559

560 handleCaseAlternative (CaseAlternative bs grd val) = CaseAlternative <$> mapM (h' <=< h) bs

561 <*> maybeM (g' <=< g) grd

562 <*> (g' <=< g) val

563

564 handleDoNotationElement (DoNotationValue v) = DoNotationValue <$> (g' <=< g) v

565 handleDoNotationElement (DoNotationBind b v) = DoNotationBind <$> (h' <=< h) b <*> (g' <=< g) v

566 handleDoNotationElement (DoNotationLet ds) = DoNotationLet <$> mapM (f' <=< f) ds

567 handleDoNotationElement (PositionedDoNotationElement pos e) = PositionedDoNotationElement pos <$> handleDoNotationElement e

568

569everythingOnValues :: (r -> r -> r) ->

570 (Declaration -> r) ->

571 (Value -> r) ->

572 (Binder -> r) ->

573 (CaseAlternative -> r) ->

574 (DoNotationElement -> r) ->

575 (Declaration -> r, Value -> r, Binder -> r, CaseAlternative -> r, DoNotationElement -> r)

576everythingOnValues (<>) f g h i j = (f', g', h', i', j')

577 where

578 f' d@(DataBindingGroupDeclaration ds) = foldl (<>) (f d) (map f' ds)

579 f' d@(ValueDeclaration _ _ bs Nothing val) = foldl (<>) (f d) (map h' bs) <> g' val

580 f' d@(ValueDeclaration _ _ bs (Just grd) val) = foldl (<>) (f d) (map h' bs) <> g' grd <> g' val

581 f' d@(BindingGroupDeclaration ds) = foldl (<>) (f d) (map (\(_, _, val) -> g' val) ds)

582 f' d@(TypeClassDeclaration _ _ _ ds) = foldl (<>) (f d) (map f' ds)

583 f' d@(TypeInstanceDeclaration _ _ _ _ ds) = foldl (<>) (f d) (map f' ds)

584 f' d@(PositionedDeclaration _ d1) = f d <> f' d1

585 f' d = f d

586

587 g' v@(UnaryMinus v1) = g v <> g' v1

588 g' v@(BinaryNoParens _ v1 v2) = g v <> g' v1 <> g' v2

589 g' v@(Parens v1) = g v <> g' v1

590 g' v@(ArrayLiteral vs) = foldl (<>) (g v) (map g' vs)

591 g' v@(ObjectLiteral vs) = foldl (<>) (g v) (map (g' . snd) vs)

592 g' v@(Accessor _ v1) = g v <> g' v1

593 g' v@(ObjectUpdate obj vs) = foldl (<>) (g v <> g' obj) (map (g' . snd) vs)

594 g' v@(Abs _ v1) = g v <> g' v1

595 g' v@(App v1 v2) = g v <> g' v1 <> g' v2

596 g' v@(IfThenElse v1 v2 v3) = g v <> g' v1 <> g' v2 <> g' v3

597 g' v@(Case vs alts) = foldl (<>) (foldl (<>) (g v) (map g' vs)) (map i' alts)

598 g' v@(TypedValue _ v1 _) = g v <> g' v1

599 g' v@(Let ds v1) = (foldl (<>) (g v) (map f' ds)) <> g' v1

600 g' v@(Do es) = foldl (<>) (g v) (map j' es)

601 g' v@(PositionedValue _ v1) = g v <> g' v1

602 g' v = g v

603

604 h' b@(ConstructorBinder _ bs) = foldl (<>) (h b) (map h' bs)

605 h' b@(ObjectBinder bs) = foldl (<>) (h b) (map (h' . snd) bs)

606 h' b@(ArrayBinder bs) = foldl (<>) (h b) (map h' bs)

607 h' b@(ConsBinder b1 b2) = h b <> h' b1 <> h' b2

608 h' b@(NamedBinder _ b1) = h b <> h' b1

609 h' b@(PositionedBinder _ b1) = h b <> h' b1

610 h' b = h b

611

612 i' ca = case caseAlternativeGuard ca of

613 Nothing -> foldl (<>) (i ca) (map h' (caseAlternativeBinders ca)) <> g' (caseAlternativeResult ca)

614 Just grd -> foldl (<>) (i ca) (map h' (caseAlternativeBinders ca)) <> g' grd <> g' (caseAlternativeResult ca)

615

616 j' e@(DoNotationValue v) = j e <> g' v

617 j' e@(DoNotationBind b v) = j e <> h' b <> g' v

618 j' e@(DoNotationLet ds) = foldl (<>) (j e) (map f' ds)

619 j' e@(PositionedDoNotationElement _ e1) = j e <> j' e1

620

621accumTypes :: (Monoid r) => (Type -> r) -> (Declaration -> r, Value -> r, Binder -> r, CaseAlternative -> r, DoNotationElement -> r)

622accumTypes f = everythingOnValues mappend forDecls forValues (const mempty) (const mempty) (const mempty)

623 where

624 forDecls (DataDeclaration _ _ dctors) = mconcat (concatMap (map f . snd) dctors)

625 forDecls (ExternDeclaration _ _ _ ty) = f ty

626 forDecls (ExternInstanceDeclaration _ cs _ tys) = mconcat (concatMap (map f . snd) cs) `mappend` mconcat (map f tys)

627 forDecls (TypeClassDeclaration _ _ implies _) = mconcat (concatMap (map f . snd) implies)

628 forDecls (TypeInstanceDeclaration _ cs _ tys _) = mconcat (concatMap (map f . snd) cs) `mappend` mconcat (map f tys)

629 forDecls (TypeSynonymDeclaration _ _ ty) = f ty

630 forDecls (TypeDeclaration _ ty) = f ty

631 forDecls _ = mempty

632

633 forValues (TypeClassDictionary _ (_, cs) _) = mconcat (map f cs)

634 forValues (SuperClassDictionary _ tys) = mconcat (map f tys)

635 forValues (TypedValue _ _ ty) = f ty

636 forValues _ = mempty

637

638