From: simonpj Date: Wed, 23 Feb 2005 13:46:46 +0000 (+0000) Subject: [project @ 2005-02-23 13:46:43 by simonpj] X-Git-Tag: Initial_conversion_from_CVS_complete~1030 X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=766c499e75fa1aa178694dc1a74d1ecbabef0332 [project @ 2005-02-23 13:46:43 by simonpj] --------------------------------------------- Make type synonyms uniform with data types so far as infix operators are concerned --------------------------------------------- Merge to STABLE This allows type (a :+: b) c d = ... which was prevented before by accident. I've also documented the fact that classes can be infix; and arranged that class constraints in types can be in infix form. f :: (a :=: b) => .... --- diff --git a/ghc/compiler/parser/Parser.y.pp b/ghc/compiler/parser/Parser.y.pp index 01ad579..d143540 100644 --- a/ghc/compiler/parser/Parser.y.pp +++ b/ghc/compiler/parser/Parser.y.pp @@ -16,7 +16,7 @@ INCLUDE "HsVersions.h" import HsSyn import RdrHsSyn -import HscTypes ( ModIface, IsBootInterface, DeprecTxt ) +import HscTypes ( IsBootInterface, DeprecTxt ) import Lexer import RdrName import TysWiredIn ( unitTyCon, unitDataCon, tupleTyCon, tupleCon, nilDataCon, @@ -36,7 +36,6 @@ import Type ( Kind, mkArrowKind, liftedTypeKind ) import BasicTypes ( Boxity(..), Fixity(..), FixityDirection(..), IPName(..), Activation(..) ) import OrdList -import Bag ( emptyBag ) import Panic import FastString @@ -437,15 +436,20 @@ topdecl :: { OrdList (LHsDecl RdrName) } | decl { unLoc $1 } tycl_decl :: { LTyClDecl RdrName } - : 'type' syn_hdr '=' ctype - -- Note ctype, not sigtype. + : 'type' type '=' ctype + -- Note type on the left of the '='; this allows + -- infix type constructors to be declared + -- + -- Note ctype, not sigtype, on the right -- We allow an explicit for-all but we don't insert one -- in type Foo a = (b,b) -- Instead we just say b is out of scope - { LL $ let (tc,tvs) = $2 in TySynonym tc tvs $4 } + {% do { (tc,tvs) <- checkSynHdr $2 + ; return (LL (TySynonym tc tvs $4)) } } | 'data' tycl_hdr constrs deriving - { L (comb4 $1 $2 $3 $4) + { L (comb4 $1 $2 $3 $4) -- We need the location on tycl_hdr + -- in case constrs and deriving are both empty (mkTyData DataType $2 Nothing (reverse (unLoc $3)) (unLoc $4)) } | 'data' tycl_hdr opt_kind_sig 'where' gadt_constrlist -- No deriving for GADTs @@ -467,12 +471,6 @@ opt_kind_sig :: { Maybe Kind } : { Nothing } | '::' kind { Just $2 } -syn_hdr :: { (Located RdrName, [LHsTyVarBndr RdrName]) } - -- We don't retain the syntax of an infix - -- type synonym declaration. Oh well. - : tycon tv_bndrs { ($1, $2) } - | tv_bndr tyconop tv_bndr { ($2, [$1,$3]) } - -- tycl_hdr parses the header of a type or class decl, -- which takes the form -- T a b @@ -480,7 +478,7 @@ syn_hdr :: { (Located RdrName, [LHsTyVarBndr RdrName]) } -- (Eq a, Ord b) => T a b -- Rather a lot of inlining here, else we get reduce/reduce errors tycl_hdr :: { Located (LHsContext RdrName, Located RdrName, [LHsTyVarBndr RdrName]) } - : context '=>' type {% checkTyClHdr $1 $3 >>= return.LL } + : context '=>' type {% checkTyClHdr $1 $3 >>= return.LL } | type {% checkTyClHdr (noLoc []) $1 >>= return.L1 } ----------------------------------------------------------------------------- diff --git a/ghc/compiler/parser/RdrHsSyn.lhs b/ghc/compiler/parser/RdrHsSyn.lhs index c99a8d5..e94eb61 100644 --- a/ghc/compiler/parser/RdrHsSyn.lhs +++ b/ghc/compiler/parser/RdrHsSyn.lhs @@ -34,7 +34,8 @@ module RdrHsSyn ( , checkPrecP -- Int -> P Int , checkContext -- HsType -> P HsContext , checkPred -- HsType -> P HsPred - , checkTyClHdr -- HsType -> (name,[tyvar]) + , checkTyClHdr + , checkSynHdr , checkInstType -- HsType -> P HsType , checkPattern -- HsExp -> P HsPat , checkPatterns -- SrcLoc -> [HsExp] -> P [HsPat] @@ -48,25 +49,16 @@ module RdrHsSyn ( #include "HsVersions.h" import HsSyn -- Lots of it -import IfaceType -import Packages ( PackageIdH(..) ) -import HscTypes ( ModIface(..), emptyModIface, mkIfaceVerCache, - Dependencies(..), IsBootInterface, noDependencies ) -import IfaceSyn ( IfaceDecl(..), IfaceIdInfo(..), IfaceConDecl(..), IfaceConDecls(..) ) import RdrName ( RdrName, isRdrTyVar, mkUnqual, rdrNameOcc, isRdrTyVar, isRdrDataCon, isUnqual, getRdrName, isQual, - setRdrNameSpace, rdrNameModule ) -import BasicTypes ( RecFlag(..), mapIPName, maxPrecedence, initialVersion ) + setRdrNameSpace ) +import BasicTypes ( RecFlag(..), maxPrecedence ) import Lexer ( P, failSpanMsgP ) -import Kind ( liftedTypeKind ) -import HscTypes ( GenAvailInfo(..) ) import TysWiredIn ( unitTyCon ) import ForeignCall ( CCallConv, Safety, CCallTarget(..), CExportSpec(..), DNCallSpec(..), DNKind(..), CLabelString ) -import OccName ( OccName, srcDataName, varName, isDataOcc, isTcOcc, - occNameUserString, isValOcc ) -import BasicTypes ( initialVersion, StrictnessMark(..) ) -import Module ( Module ) +import OccName ( srcDataName, varName, isDataOcc, isTcOcc, + occNameUserString ) import SrcLoc import OrdList ( OrdList, fromOL ) import Bag ( Bag, emptyBag, snocBag, consBag, foldrBag ) @@ -389,6 +381,10 @@ checkTyVars tvs chk (L l other) = parseError l "Type found where type variable expected" +checkSynHdr :: LHsType RdrName -> P (Located RdrName, [LHsTyVarBndr RdrName]) +checkSynHdr ty = do { (_, tc, tvs) <- checkTyClHdr (noLoc []) ty + ; return (tc, tvs) } + checkTyClHdr :: LHsContext RdrName -> LHsType RdrName -> P (LHsContext RdrName, Located RdrName, [LHsTyVarBndr RdrName]) -- The header of a type or class decl should look like @@ -450,11 +446,12 @@ checkPred (L spn ty) where checkl (L l ty) args = check l ty args - check loc (HsTyVar t) args | not (isRdrTyVar t) - = return (L spn (HsClassP t args)) - check loc (HsAppTy l r) args = checkl l (r:args) - check loc (HsParTy t) args = checkl t args - check loc _ _ = parseError loc "malformed class assertion" + check _loc (HsTyVar t) args | not (isRdrTyVar t) + = return (L spn (HsClassP t args)) + check _loc (HsAppTy l r) args = checkl l (r:args) + check _loc (HsOpTy l (L loc tc) r) args = check loc (HsTyVar tc) (l:r:args) + check _loc (HsParTy t) args = checkl t args + check loc _ _ = parseError loc "malformed class assertion" checkDictTy :: LHsType RdrName -> P (LHsType RdrName) checkDictTy (L spn ty) = check ty [] diff --git a/ghc/docs/users_guide/glasgow_exts.xml b/ghc/docs/users_guide/glasgow_exts.xml index ff46b39..93237d0 100644 --- a/ghc/docs/users_guide/glasgow_exts.xml +++ b/ghc/docs/users_guide/glasgow_exts.xml @@ -925,18 +925,34 @@ Nevertheless, they can be useful when defining "phantom types". -Infix type constructors +Infix type constructors and classes -GHC allows type constructors to be operators, and to be written infix, very much +GHC allows type constructors and classes to be operators, and to be written infix, very much like expressions. More specifically: - A type constructor can be an operator, beginning with a colon; e.g. :*:. + A type constructor or class can be an operator, beginning with a colon; e.g. :*:. The lexical syntax is the same as that for data constructors. - Types can be written infix. For example Int :*: Bool. + Data type and type-synonym declarations can be written infix, parenthesised + if you want further arguments. E.g. + + data a :*: b = Foo a b + type a :+: b = Either a b + class a :=: b where ... + + data (a :**: b) x = Baz a b x + type (a :++: b) y = Either (a,b) y + + + + Types, and class constraints, can be written infix. For example + + x :: Int :*: Bool + f :: (a :=: b) => a -> b + Back-quotes work @@ -944,7 +960,7 @@ like expressions. More specifically: Int `a` Bool. Similarly, parentheses work the same; e.g. (:*:) Int Bool. - Fixities may be declared for type constructors just as for data constructors. However, + Fixities may be declared for type constructors, or classes, just as for data constructors. However, one cannot distinguish between the two in a fixity declaration; a fixity declaration sets the fixity for a data constructor and the corresponding type constructor. For example: @@ -958,13 +974,6 @@ like expressions. More specifically: Function arrow is infixr with fixity 0. (This might change; I'm not sure what it should be.) - Data type and type-synonym declarations can be written infix. E.g. - - data a :*: b = Foo a b - type a :+: b = Either a b - - - The only thing that differs between operators in types and operators in expressions is that ordinary non-constructor operators, such as + and * are not allowed in types. Reason: the uniform thing to do would be to make them type