import HsSyn -- quite a bit of stuff
import RdrHsSyn -- oodles of synonyms
-import HsTypes ( mkHsForAllTy )
+import HsTypes ( mkHsForAllTy, mkHsUsForAllTy )
import HsCore
import Const ( Literal(..), mkMachInt_safe )
import BasicTypes ( Fixity(..), FixityDirection(..),
import RdrName ( RdrName, mkRdrUnqual, mkSysQual, mkSysUnqual )
import Name ( OccName, Provenance )
import OccName ( mkSysOccFS,
- tcName, varName, dataName, clsName, tvName,
+ tcName, varName, dataName, clsName, tvName, uvName,
EncodedFS
)
import Module ( ModuleName, mkSysModuleFS )
'__scc' { ITscc }
'__sccC' { ITsccAllCafs }
- '__o' { ITonce }
- '__m' { ITmany }
+ '__u' { ITusage }
+ '__fuall' { ITfuall }
'__A' { ITarity }
'__P' { ITspecialise }
--------------------------------------------------------------------------
type :: { RdrNameHsType }
-type : '__forall' forall context '=>' type
+type : '__fuall' fuall '=>' type { mkHsUsForAllTy $2 $4 }
+ | '__forall' forall context '=>' type
{ mkHsForAllTy $2 $3 $5 }
| btype '->' type { MonoFunTy $1 $3 }
| btype { $1 }
+fuall :: { [RdrName] }
+fuall : '[' uv_bndrs ']' { $2 }
+
forall :: { [HsTyVar RdrName] }
forall : '[' tv_bndrs ']' { $2 }
btype :: { RdrNameHsType }
btype : atype { $1 }
| btype atype { MonoTyApp $1 $2 }
- | '__o' atype { MonoUsgTy UsOnce $2 }
- | '__m' atype { MonoUsgTy UsMany $2 }
+ | '__u' usage atype { MonoUsgTy $2 $3 }
+
+usage :: { MonoUsageAnn RdrName }
+usage : '-' { MonoUsOnce }
+ | '!' { MonoUsMany }
+ | uv_name { MonoUsVar $1 }
atype :: { RdrNameHsType }
atype : qtc_name { MonoTyVar $1 }
| qdata_fs { mkSysQual clsName $1 }
---------------------------------------------------
+uv_name :: { RdrName }
+ : VARID { mkSysUnqual uvName $1 }
+
+uv_bndr :: { RdrName }
+ : uv_name { $1 }
+
+uv_bndrs :: { [RdrName] }
+ : { [] }
+ | uv_bndr uv_bndrs { $1 : $2 }
+
+---------------------------------------------------
tv_name :: { RdrName }
: VARID { mkSysUnqual tvName $1 }
| VARSYM { mkSysUnqual tvName $1 {- Allow t2 as a tyvar -} }
id_info :: { [HsIdInfo RdrName] }
: { [] }
| id_info_item id_info { $1 : $2 }
- | strict_info id_info { $1 ++ $2 }
id_info_item :: { HsIdInfo RdrName }
- : '__A' arity_info { HsArity $2 }
+ : '__A' INTEGER { HsArity (exactArity (fromInteger $2)) }
| '__U' core_expr { HsUnfold $1 (Just $2) }
| '__U' { HsUnfold $1 Nothing }
+ | '__M' { HsCprInfo $1 }
+ | '__S' { HsStrictness (HsStrictnessInfo $1) }
| '__C' { HsNoCafRefs }
-
-strict_info :: { [HsIdInfo RdrName] }
- : cpr worker { ($1:$2) }
- | strict worker { ($1:$2) }
- | cpr strict worker { ($1:$2:$3) }
-
-cpr :: { HsIdInfo RdrName }
- : '__M' { HsCprInfo $1 }
-
-strict :: { HsIdInfo RdrName }
- : '__S' { HsStrictness (HsStrictnessInfo $1) }
-
-worker :: { [HsIdInfo RdrName] }
- : qvar_name { [HsWorker $1] }
- | {- nothing -} { [] }
-
-arity_info :: { ArityInfo }
- : INTEGER { exactArity (fromInteger $1) }
+ | '__P' qvar_name { HsWorker $2 }
-------------------------------------------------------
core_expr :: { UfExpr RdrName }