2 #include "HsVersions.h"
3 module ParseType ( parseType ) where
7 import HsSyn -- quite a bit of stuff
8 import RdrHsSyn -- oodles of synonyms
9 import HsDecls ( HsIdInfo(..), HsStrictnessInfo )
10 import HsTypes ( mkHsForAllTy )
13 import HsPragmas ( noGenPragmas, noDataPragmas, noClassPragmas, noClassOpPragmas, noInstancePragmas )
14 import IdInfo ( exactArity, mkStrictnessInfo, mkBottomStrictnessInfo,
15 ArgUsageInfo, FBTypeInfo
17 import Kind ( Kind, mkArrowKind, mkBoxedTypeKind )
20 import RnMonad ( SYN_IE(ImportVersion), SYN_IE(LocalVersion), ParsedIface(..),
21 SYN_IE(RdrNamePragma), SYN_IE(ExportItem), GenAvailInfo
23 import Bag ( emptyBag, unitBag, snocBag )
24 import FiniteMap ( emptyFM, unitFM, addToFM, plusFM, bagToFM, FiniteMap )
25 import Name ( OccName(..), isTCOcc, Provenance )
26 import SrcLoc ( mkIfaceSrcLoc )
27 import Util ( panic{-, pprPanic ToDo:rm-} )
29 import Outputable ( PprStyle(..) )
30 import Maybes ( MaybeErr(..) )
32 ------------------------------------------------------------------
34 parseType :: StringBuffer -> MaybeErr RdrNameHsType (PprStyle -> Doc)
40 Failed err -> panic (show (err PprDebug))
47 %tokentype { IfaceToken }
48 %monad { IfM }{ thenIf }{ returnIf }
49 %lexer { lexIface } { ITeof }
66 VARSYM { ITvarsym $$ }
67 CONSYM { ITconsym $$ }
68 QCONID { ITqconid $$ }
69 QCONSYM { ITqconsym $$ }
71 UNKNOWN { ITunknown $$ }
74 type :: { RdrNameHsType }
75 type : FORALL forall context DARROW type { mkHsForAllTy $2 $3 $5 }
76 | btype RARROW type { MonoFunTy $1 $3 }
79 forall : OBRACK tv_bndrs CBRACK { $2 }
81 context :: { RdrNameContext }
83 | OCURLY context_list1 CCURLY { $2 }
85 context_list1 :: { RdrNameContext }
86 context_list1 : class { [$1] }
87 | class COMMA context_list1 { $1 : $3 }
89 class :: { (RdrName, RdrNameHsType) }
90 class : tc_name atype { ($1, $2) }
93 types2 :: { [RdrNameHsType] {- Two or more -} }
94 types2 : type COMMA type { [$1,$3] }
95 | type COMMA types2 { $1 : $3 }
97 btype :: { RdrNameHsType }
99 | btype atype { MonoTyApp $1 $2 }
101 atype :: { RdrNameHsType }
102 atype : tc_name { MonoTyVar $1 }
103 | tv_name { MonoTyVar $1 }
104 | OPAREN types2 CPAREN { MonoTupleTy dummyRdrTcName $2 }
105 | OBRACK type CBRACK { MonoListTy dummyRdrTcName $2 }
106 | OCURLY tc_name atype CCURLY { MonoDictTy $2 $3 }
107 | OPAREN type CPAREN { $2 }
109 atypes :: { [RdrNameHsType] {- Zero or more -} }
111 | atype atypes { $1 : $2
112 ---------------------------------------------------------------------
115 tv_bndr :: { HsTyVar RdrName }
116 tv_bndr : tv_name DCOLON akind { IfaceTyVar $1 $3 }
117 | tv_name { UserTyVar $1 }
119 tv_bndrs :: { [HsTyVar RdrName] }
121 | tv_bndr tv_bndrs { $1 : $2 }
125 | akind RARROW kind { mkArrowKind $1 $3 }
128 : VARSYM { mkBoxedTypeKind {- ToDo: check that it's "*" -} }
129 | OPAREN kind CPAREN { $2 }
131 tv_name :: { RdrName }
132 tv_name : VARID { Unqual (TvOcc $1) }
133 | VARSYM { Unqual (TvOcc $1) {- Allow t2 as a tyvar -} }
135 tv_names :: { [RdrName] }
137 | tv_name tv_names { $1 : $2 }
139 tc_name :: { RdrName }
140 tc_name : QCONID { lexTcQual $1 }
141 | QCONSYM { lexTcQual $1 }
142 | CONID { Unqual (TCOcc $1) }
143 | CONSYM { Unqual (TCOcc $1) }
144 | OPAREN RARROW CPAREN { Unqual (TCOcc SLIT("->")) }