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

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

on 5c51fb8 help sign in

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

564 lines 18 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 Language.PureScript.Types

20import Language.PureScript.Names

21import Language.PureScript.Kinds

22import Language.PureScript.TypeClassDictionaries

23import Language.PureScript.CodeGen.JS.AST

24import Language.PureScript.Environment

26import qualified Data.Data as D

28-- |

29-- A precedence level for an infix operator

30--

31type Precedence = Integer

33-- |

34-- Associativity for infix operators

35--

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

38instance Show Associativity where

39 show Infixl = "infixl"

40 show Infixr = "infixr"

41 show Infix = "infix"

43-- |

44-- Source position information

45--

46data SourcePos = SourcePos

47 { -- |

48 -- Source name

49 --

50 sourceName :: String

51 -- |

52 -- Line number

53 --

54 , sourcePosLine :: Int

55 -- |

56 -- Column number

57 --

58 , sourcePosColumn :: Int

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

61instance Show SourcePos where

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

64-- |

65-- Fixity data for infix operators

66--

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

69-- |

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

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

72--

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

75-- |

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

77--

78data DeclarationRef

79 -- |

80 -- A type constructor with data constructors

81 --

82 = TypeRef ProperName (Maybe [ProperName])

83 -- |

84 -- A value

85 --

86 | ValueRef Ident

87 -- |

88 -- A type class

89 --

90 | TypeClassRef ProperName

91 -- |

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

93 --

94 | TypeInstanceRef Ident

95 -- |

96 -- A declaration reference with source position information

97 --

98 | PositionedDeclarationRef SourcePos DeclarationRef

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

100

101instance Eq DeclarationRef where

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

103 (ValueRef name) == (ValueRef name') = name == name'

104 (TypeClassRef name) == (TypeClassRef name') = name == name'

105 (TypeInstanceRef name) == (TypeInstanceRef name') = name == name'

106 (PositionedDeclarationRef _ r) == r' = r == r'

107 r == (PositionedDeclarationRef _ r') = r == r'

108 _ == _ = False

109

110-- |

111-- The data type of declarations

112--

113data Declaration

114 -- |

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

116 --

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

118 -- |

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

120 --

121 | DataBindingGroupDeclaration [Declaration]

122 -- |

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

124 --

125 | TypeSynonymDeclaration ProperName [String] Type

126 -- |

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

128 --

129 | TypeDeclaration Ident Type

130 -- |

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

132 --

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

134 -- |

135 -- A minimal mutually recursive set of value declarations

136 --

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

138 -- |

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

140 --

141 | ExternDeclaration ForeignImportType Ident (Maybe JS) Type

142 -- |

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

144 --

145 | ExternDataDeclaration ProperName Kind

146 -- |

147 -- A type class instance foreign import

148 --

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

150 -- |

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

152 --

153 | FixityDeclaration Fixity String

154 -- |

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

156 -- name)

157 --

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

159 -- |

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

161 --

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

163 -- |

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

165 -- declarations)

166 --

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

168 -- |

169 -- A declaration with source position information

170 --

171 | PositionedDeclaration SourcePos Declaration

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

173

174-- |

175-- Test if a declaration is a value declaration

176--

177isValueDecl :: Declaration -> Bool

178isValueDecl ValueDeclaration{} = True

179isValueDecl (PositionedDeclaration _ d) = isValueDecl d

180isValueDecl _ = False

181

182-- |

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

184--

185isDataDecl :: Declaration -> Bool

186isDataDecl DataDeclaration{} = True

187isDataDecl TypeSynonymDeclaration{} = True

188isDataDecl (PositionedDeclaration _ d) = isDataDecl d

189isDataDecl _ = False

190

191-- |

192-- Test if a declaration is a module import

193--

194isImportDecl :: Declaration -> Bool

195isImportDecl ImportDeclaration{} = True

196isImportDecl (PositionedDeclaration _ d) = isImportDecl d

197isImportDecl _ = False

198

199-- |

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

201--

202isExternDataDecl :: Declaration -> Bool

203isExternDataDecl ExternDataDeclaration{} = True

204isExternDataDecl (PositionedDeclaration _ d) = isExternDataDecl d

205isExternDataDecl _ = False

206

207-- |

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

209--

210isExternInstanceDecl :: Declaration -> Bool

211isExternInstanceDecl ExternInstanceDeclaration{} = True

212isExternInstanceDecl (PositionedDeclaration _ d) = isExternInstanceDecl d

213isExternInstanceDecl _ = False

214

215-- |

216-- Test if a declaration is a fixity declaration

217--

218isFixityDecl :: Declaration -> Bool

219isFixityDecl FixityDeclaration{} = True

220isFixityDecl (PositionedDeclaration _ d) = isFixityDecl d

221isFixityDecl _ = False

222

223-- |

224-- Test if a declaration is a foreign import

225--

226isExternDecl :: Declaration -> Bool

227isExternDecl ExternDeclaration{} = True

228isExternDecl (PositionedDeclaration _ d) = isExternDecl d

229isExternDecl _ = False

230

231-- |

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

233--

234isTypeClassDeclaration :: Declaration -> Bool

235isTypeClassDeclaration TypeClassDeclaration{} = True

236isTypeClassDeclaration TypeInstanceDeclaration{} = True

237isTypeClassDeclaration (PositionedDeclaration _ d) = isTypeClassDeclaration d

238isTypeClassDeclaration _ = False

239

240-- |

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

242--

243type Guard = Value

244

245-- |

246-- Data type for values

247--

248data Value

249 -- |

250 -- A numeric literal

251 --

252 = NumericLiteral (Either Integer Double)

253 -- |

254 -- A string literal

255 --

256 | StringLiteral String

257 -- |

258 -- A boolean literal

259 --

260 | BooleanLiteral Bool

261 -- |

262 -- A prefix -, will be desugared

263 --

264 | UnaryMinus Value

265 -- |

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

267 -- will be removed.

268 --

269 | BinaryNoParens (Qualified Ident) Value Value

270 -- |

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

272 -- will be removed.

273 --

274 | Parens Value

275 -- |

276 -- An array literal

277 --

278 | ArrayLiteral [Value]

279 -- |

280 -- An object literal

281 --

282 | ObjectLiteral [(String, Value)]

283 -- |

284 -- An record property accessor expression

285 --

286 | Accessor String Value

287 -- |

288 -- Partial record update

289 --

290 | ObjectUpdate Value [(String, Value)]

291 -- |

292 -- Function introduction

293 --

294 | Abs (Either Ident Binder) Value

295 -- |

296 -- Function application

297 --

298 | App Value Value

299 -- |

300 -- Variable

301 --

302 | Var (Qualified Ident)

303 -- |

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

305 --

306 | IfThenElse Value Value Value

307 -- |

308 -- A data constructor

309 --

310 | Constructor (Qualified ProperName)

311 -- |

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

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

314 --

315 | Case [Value] [CaseAlternative]

316 -- |

317 -- A value with a type annotation

318 --

319 | TypedValue Bool Value Type

320 -- |

321 -- A let binding

322 --

323 | Let [Declaration] Value

324 -- |

325 -- A do-notation block

326 --

327 | Do [DoNotationElement]

328 -- |

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

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

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

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

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

334 --

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

336 -- |

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

338 --

339 | SuperClassDictionary (Qualified ProperName) [Type]

340 -- |

341 -- A value with source position information

342 --

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

344

345-- |

346-- An alternative in a case statement

347--

348data CaseAlternative = CaseAlternative

349 { -- |

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

351 --

352 caseAlternativeBinders :: [Binder]

353 -- |

354 -- An optional guard

355 --

356 , caseAlternativeGuard :: Maybe Guard

357 -- |

358 -- The result expression

359 --

360 , caseAlternativeResult :: Value

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

362

363-- |

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

365--

366canonicalizeDictionary :: TypeClassDictionaryInScope -> Qualified Ident

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

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

369

370-- |

371-- A statement in a do-notation block

372--

373data DoNotationElement

374 -- |

375 -- A monadic value without a binder

376 --

377 = DoNotationValue Value

378 -- |

379 -- A monadic value with a binder

380 --

381 | DoNotationBind Binder Value

382 -- |

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

384 --

385 | DoNotationLet [Declaration]

386 -- |

387 -- A do notation element with source position information

388 --

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

390

391-- |

392-- Data type for binders

393--

394data Binder

395 -- |

396 -- Wildcard binder

397 --

398 = NullBinder

399 -- |

400 -- A binder which matches a boolean literal

401 --

402 | BooleanBinder Bool

403 -- |

404 -- A binder which matches a string literal

405 --

406 | StringBinder String

407 -- |

408 -- A binder which matches a numeric literal

409 --

410 | NumberBinder (Either Integer Double)

411 -- |

412 -- A binder which binds an identifier

413 --

414 | VarBinder Ident

415 -- |

416 -- A binder which matches a data constructor

417 --

418 | ConstructorBinder (Qualified ProperName) [Binder]

419 -- |

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

421 --

422 | ObjectBinder [(String, Binder)]

423 -- |

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

425 --

426 | ArrayBinder [Binder]

427 -- |

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

429 --

430 | ConsBinder Binder Binder

431 -- |

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

433 --

434 | NamedBinder Ident Binder

435 -- |

436 -- A binder with source position information

437 --

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

439

440-- |

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

442--

443binderNames :: Binder -> [Ident]

444binderNames = go []

445 where

446 go ns (VarBinder name) = name : ns

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

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

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

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

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

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

453 go ns _ = ns

454

455--

456-- Traversals

457--

458

459everywhereOnValues :: (Declaration -> Declaration) ->

460 (Value -> Value) ->

461 (Binder -> Binder) ->

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

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

464 where

465 f' :: Declaration -> Declaration

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

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

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

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

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

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

472 f' other = f other

473

474 g' :: Value -> Value

475 g' (UnaryMinus v) = g (UnaryMinus (g' v))

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

477 g' (Parens v) = g (Parens (g' v))

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

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

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

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

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

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

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

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

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

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

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

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

490 g' other = g other

491

492 h' :: Binder -> Binder

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

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

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

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

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

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

499 h' other = h other

500

501 handleCaseAlternative :: CaseAlternative -> CaseAlternative

502 handleCaseAlternative ca =

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

504 , caseAlternativeGuard = fmap g' (caseAlternativeGuard ca)

505 , caseAlternativeResult = g' (caseAlternativeResult ca)

506 }

507

508 handleDoNotationElement :: DoNotationElement -> DoNotationElement

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

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

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

512 handleDoNotationElement (PositionedDoNotationElement pos e) = PositionedDoNotationElement pos (handleDoNotationElement e)

513

514everythingOnValues :: (r -> r -> r) ->

515 (Declaration -> r) ->

516 (Value -> r) ->

517 (Binder -> r) ->

518 (CaseAlternative -> r) ->

519 (DoNotationElement -> r) ->

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

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

522 where

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

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

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

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

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

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

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

530 f' d = f d

531

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

547 g' v = g v

548

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

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

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

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

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

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

555 h' b = h b

556

557 i' ca = case caseAlternativeGuard ca of

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

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

560

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

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

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

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