diff options
73 files changed, 183 insertions, 162 deletions
diff --git a/compiler/GHC/Core/DataCon.hs b/compiler/GHC/Core/DataCon.hs index 04570f9af7..87e6bf10c9 100644 --- a/compiler/GHC/Core/DataCon.hs +++ b/compiler/GHC/Core/DataCon.hs @@ -1321,7 +1321,7 @@ dataConStupidTheta dc = dcStupidTheta dc Note [Displaying linear fields] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ A constructor with a linear field can be written either as -MkT :: a #-> T a (with -XLinearTypes) +MkT :: a %1 -> T a (with -XLinearTypes) or MkT :: a -> T a (with -XNoLinearTypes) @@ -1330,7 +1330,7 @@ They differ in how linear fields are handled. 1. dataConWrapperType: The type of the wrapper in Core. -For example, dataConWrapperType for Maybe is a #-> Just a. +For example, dataConWrapperType for Maybe is a %1 -> Just a. 2. dataConNonlinearType: The type of the constructor, with linear arrows replaced by unrestricted ones. diff --git a/compiler/GHC/Core/Multiplicity.hs b/compiler/GHC/Core/Multiplicity.hs index 8c3ad88fc2..73535a3e15 100644 --- a/compiler/GHC/Core/Multiplicity.hs +++ b/compiler/GHC/Core/Multiplicity.hs @@ -216,7 +216,7 @@ That is, in We have - Just :: a #-> Just a + Just :: a %1 -> Just a The goal is to maximise reuse of types between linear code and traditional code. This is argued at length in the proposal and the article (links in Note @@ -232,7 +232,7 @@ backwards compatibility. Consider We have map :: (a -> b) -> f a -> f b - Just :: a #-> Just a + Just :: a %1 -> Just a Types don't match, we should get a type error. But this is legal Haskell 98 code! Bad! Bad! Bad! @@ -242,7 +242,7 @@ polymorphism. Instead, we generalise the type of Just, when used as term: - Just :: forall {p}. a #p-> Just a + Just :: forall {p}. a %p-> Just a This is solely a concern for higher-order code like this: when called fully applied linear constructors are more general than constructors with unrestricted diff --git a/compiler/GHC/Core/Opt/Arity.hs b/compiler/GHC/Core/Opt/Arity.hs index 2471470814..1526be01ca 100644 --- a/compiler/GHC/Core/Opt/Arity.hs +++ b/compiler/GHC/Core/Opt/Arity.hs @@ -1490,7 +1490,7 @@ pushCoValArg co -- We can't push the coercion in the case where co_mult isn't reflexivity: -- it could be an unsafe axiom, and losing this information could yield -- ill-typed terms. For instance (fun x ::(1) Int -> (fun _ -> () |> co) x) - -- with co :: (Int -> ()) ~ (Int #-> ()), would reduce to (fun x ::(1) Int + -- with co :: (Int -> ()) ~ (Int %1 -> ()), would reduce to (fun x ::(1) Int -- -> (fun _ ::(Many) Int -> ()) x) which is ill-typed -- If co :: (tyL1 -> tyL2) ~ (tyR1 -> tyR2) diff --git a/compiler/GHC/Core/Opt/Monad.hs b/compiler/GHC/Core/Opt/Monad.hs index 070ea11cc2..e7298fef54 100644 --- a/compiler/GHC/Core/Opt/Monad.hs +++ b/compiler/GHC/Core/Opt/Monad.hs @@ -412,7 +412,7 @@ EtaExpansion: fail = \void. (\s. (e |> g) s) |> sym g where g :: IO () ~ S -> (S,()) --> Next iteration of simplify fail1 = \void. \s. (e |> g) s - fail = fail1 |> Void#->sym g + fail = fail1 |> Void# -> sym g And now inline 'fail' CaseMerge: diff --git a/compiler/GHC/Core/Opt/Simplify.hs b/compiler/GHC/Core/Opt/Simplify.hs index 6c207766bd..96d9cfc61e 100644 --- a/compiler/GHC/Core/Opt/Simplify.hs +++ b/compiler/GHC/Core/Opt/Simplify.hs @@ -2640,7 +2640,7 @@ rebuildCase env scrut case_bndr alts cont -- -- As an illustration, consider the following -- case[Many] case[1] of { C x -> C x } of { C x -> (x, x) } - -- Where C :: A #-> T is linear + -- Where C :: A %1 -> T is linear -- If we were to produce a case[1], like the inner case, we would get -- case[1] of { C x -> (x, x) } -- Which is ill-typed with respect to linearity. So it needs to be a diff --git a/compiler/GHC/Core/Opt/Simplify/Env.hs b/compiler/GHC/Core/Opt/Simplify/Env.hs index 7049e3e578..7d53a2db2b 100644 --- a/compiler/GHC/Core/Opt/Simplify/Env.hs +++ b/compiler/GHC/Core/Opt/Simplify/Env.hs @@ -953,7 +953,7 @@ adjustJoinPointType mult new_res_ty join_id ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider a join point which is linear in its variable, in some context E: -E[join j :: a #-> a +E[join j :: a %1 -> a j x = x in case v of A -> j 'x' @@ -961,7 +961,7 @@ E[join j :: a #-> a The simplifier changes to: -join j :: a #-> a +join j :: a %1 -> a j x = E[x] in case v of A -> j 'x' diff --git a/compiler/GHC/Core/SimpleOpt.hs b/compiler/GHC/Core/SimpleOpt.hs index 67f08cdd23..d066535e30 100644 --- a/compiler/GHC/Core/SimpleOpt.hs +++ b/compiler/GHC/Core/SimpleOpt.hs @@ -1342,5 +1342,3 @@ exprIsLambda_maybe (in_scope_set, id_unf) e exprIsLambda_maybe _ _e = -- pprTrace "exprIsLambda_maybe:Fail" (vcat [ppr _e]) Nothing - - diff --git a/compiler/GHC/Hs/Decls.hs b/compiler/GHC/Hs/Decls.hs index 1eeb42d73e..c0b8baa435 100644 --- a/compiler/GHC/Hs/Decls.hs +++ b/compiler/GHC/Hs/Decls.hs @@ -1538,7 +1538,7 @@ types of a GADT constructor, since there are some non-obvious details involved. While splitting the argument types of a record GADT constructor is easy (they are stored in an HsRecTy), splitting the arguments of a prefix GADT constructor is trickier. The basic idea is that we must split along the outermost function -arrows ((->) and (#->)) in the type, which GHC.Hs.Type.splitHsFunType +arrows ((->) and (%1 ->)) in the type, which GHC.Hs.Type.splitHsFunType accomplishes. But what about type operators? Consider: C :: a :*: b -> a :*: b -> a :+: b diff --git a/compiler/GHC/Hs/Type.hs b/compiler/GHC/Hs/Type.hs index c2da3857d4..818fe75475 100644 --- a/compiler/GHC/Hs/Type.hs +++ b/compiler/GHC/Hs/Type.hs @@ -936,9 +936,9 @@ data HsArrow pass = HsUnrestrictedArrow -- ^ a -> b | HsLinearArrow - -- ^ a #-> b + -- ^ a %1 -> b | HsExplicitMult (LHsType pass) - -- ^ a # m -> b (very much including `a # Many -> b`! This is how the + -- ^ a %m -> b (very much including `a %Many -> b`! This is how the -- programmer wrote it). It is stored as an `HsType` so as to preserve the -- syntax as written in the program. diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y index efd8831418..12f5b8be3b 100644 --- a/compiler/GHC/Parser.y +++ b/compiler/GHC/Parser.y @@ -280,7 +280,7 @@ Context: context -> btype . type -> btype . type -> btype . '->' ctype - type -> btype . '#->' ctype + type -> btype . '->.' ctype Example: a :: Maybe Integer -> Bool @@ -636,7 +636,7 @@ are the most common patterns, rewritten as regular expressions for clarity: '|' { L _ ITvbar } '<-' { L _ (ITlarrow _) } '->' { L _ (ITrarrow _) } - '#->' { L _ (ITlolly _) } + '->.' { L _ ITlolly } TIGHT_INFIX_AT { L _ ITat } '=>' { L _ (ITdarrow _) } '-' { L _ ITminus } @@ -650,6 +650,7 @@ are the most common patterns, rewritten as regular expressions for clarity: '>>-' { L _ (ITRarrowtail _) } -- for arrow notation '.' { L _ ITdot } PREFIX_AT { L _ ITtypeApp } + PREFIX_PERCENT { L _ ITpercent } -- for linear types '{' { L _ ITocurly } -- special symbols '}' { L _ ITccurly } @@ -2062,12 +2063,16 @@ type :: { LHsType GhcPs } >> ams (sLL $1 $> $ HsFunTy noExtField HsUnrestrictedArrow $1 $3) [mu AnnRarrow $2] } - | btype '#->' ctype {% hintLinear (getLoc $2) >> - ams (sLL $1 $> $ HsFunTy noExtField HsLinearArrow $1 $3) - [mu AnnLolly $2] } + | btype mult '->' ctype {% hintLinear (getLoc $2) >> + ams (sLL $1 $> $ HsFunTy noExtField (unLoc $2) $1 $4) + [mu AnnRarrow $3] } -mult :: { LHsType GhcPs } - : btype { $1 } + | btype '->.' ctype {% hintLinear (getLoc $2) >> + ams (sLL $1 $> $ HsFunTy noExtField HsLinearArrow $1 $3) + [mu AnnLollyU $2] } + +mult :: { Located (HsArrow GhcPs) } + : PREFIX_PERCENT atype { sLL $1 $> (mkMultTy $2) } btype :: { LHsType GhcPs } : infixtype {% runPV $1 } @@ -3823,7 +3828,7 @@ isUnicode (L _ (ITcparenbar iu)) = iu == UnicodeSyntax isUnicode (L _ (ITopenExpQuote _ iu)) = iu == UnicodeSyntax isUnicode (L _ (ITcloseQuote iu)) = iu == UnicodeSyntax isUnicode (L _ (ITstar iu)) = iu == UnicodeSyntax -isUnicode (L _ (ITlolly iu)) = iu == UnicodeSyntax +isUnicode (L _ ITlolly) = True isUnicode _ = False hasE :: Located Token -> Bool diff --git a/compiler/GHC/Parser/Annotation.hs b/compiler/GHC/Parser/Annotation.hs index 0db029ba02..f6fbe47fe6 100644 --- a/compiler/GHC/Parser/Annotation.hs +++ b/compiler/GHC/Parser/Annotation.hs @@ -259,8 +259,7 @@ data AnnKeywordId | AnnLarrow -- ^ '<-' | AnnLarrowU -- ^ '<-', unicode variant | AnnLet - | AnnLolly -- ^ '#->' - | AnnLollyU -- ^ '#->', unicode variant + | AnnLollyU -- ^ The '⊸' unicode arrow | AnnMdo | AnnMinus -- ^ '-' | AnnModule @@ -364,7 +363,6 @@ unicodeAnn AnnOpenB = AnnOpenBU unicodeAnn AnnCloseB = AnnCloseBU unicodeAnn AnnOpenEQ = AnnOpenEQU unicodeAnn AnnCloseQ = AnnCloseQU -unicodeAnn AnnLolly = AnnLollyU unicodeAnn ann = ann diff --git a/compiler/GHC/Parser/Lexer.x b/compiler/GHC/Parser/Lexer.x index c346df1d0d..ad93226112 100644 --- a/compiler/GHC/Parser/Lexer.x +++ b/compiler/GHC/Parser/Lexer.x @@ -768,14 +768,15 @@ data Token | ITvbar | ITlarrow IsUnicodeSyntax | ITrarrow IsUnicodeSyntax - | ITlolly IsUnicodeSyntax | ITdarrow IsUnicodeSyntax + | ITlolly -- The (⊸) arrow (for LinearTypes) | ITminus -- See Note [Minus tokens] | ITprefixminus -- See Note [Minus tokens] | ITbang -- Prefix (!) only, e.g. f !x = rhs | ITtilde -- Prefix (~) only, e.g. f ~x = rhs | ITat -- Tight infix (@) only, e.g. f x@pat = rhs | ITtypeApp -- Prefix (@) only, e.g. f @t + | ITpercent -- Prefix (%) only, e.g. a %1 -> b | ITstar IsUnicodeSyntax | ITdot @@ -1024,8 +1025,7 @@ reservedSymsFM = listToUFM $ ,("→", ITrarrow UnicodeSyntax, UnicodeSyntax, 0 ) ,("←", ITlarrow UnicodeSyntax, UnicodeSyntax, 0 ) - ,("#->", ITlolly NormalSyntax, NormalSyntax, 0) - ,("⊸", ITlolly UnicodeSyntax, UnicodeSyntax, 0) + ,("⊸", ITlolly, UnicodeSyntax, 0) ,("⤙", ITlarrowtail UnicodeSyntax, UnicodeSyntax, xbit ArrowsBit) ,("⤚", ITrarrowtail UnicodeSyntax, UnicodeSyntax, xbit ArrowsBit) @@ -1577,6 +1577,8 @@ varsym_prefix :: Action varsym_prefix = sym $ \exts s -> if | s == fsLit "@" -- regardless of TypeApplications for better error messages -> return ITtypeApp + | LinearTypesBit `xtest` exts, s == fsLit "%" + -> return ITpercent | ThQuotesBit `xtest` exts, s == fsLit "$" -> return ITdollar | ThQuotesBit `xtest` exts, s == fsLit "$$" diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs index 9014c9f159..ee95880bba 100644 --- a/compiler/GHC/Parser/PostProcess.hs +++ b/compiler/GHC/Parser/PostProcess.hs @@ -70,6 +70,7 @@ module GHC.Parser.PostProcess ( addFatalError, hintBangPat, mkBangTy, UnpackednessPragma(..), + mkMultTy, -- Help with processing exports ImpExpSubSpec(..), @@ -661,7 +662,7 @@ mkConDeclH98 name mb_forall mb_cxt args -- -- * If -XLinearTypes is not enabled, the function arrows in a prefix GADT -- constructor are always interpreted as linear. If -XLinearTypes is enabled, --- we faithfully record whether -> or #-> was used. +-- we faithfully record whether -> or %1 -> was used. mkGadtDecl :: [Located RdrName] -> LHsType GhcPs -> P (ConDecl GhcPs) @@ -2875,6 +2876,10 @@ mkLHsOpTy x op y = let loc = getLoc x `combineSrcSpans` getLoc op `combineSrcSpans` getLoc y in L loc (mkHsOpTy x op y) +mkMultTy :: LHsType GhcPs -> HsArrow GhcPs +mkMultTy (L _ (HsTyLit _ (HsNumTy _ 1))) = HsLinearArrow +mkMultTy t = HsExplicitMult t + ----------------------------------------------------------------------------- -- Token symbols diff --git a/compiler/GHC/Types/Id/Make.hs b/compiler/GHC/Types/Id/Make.hs index fa445ea25f..63a7d5a02a 100644 --- a/compiler/GHC/Types/Id/Make.hs +++ b/compiler/GHC/Types/Id/Make.hs @@ -398,11 +398,11 @@ Projections of records can't be linear: If we had - a :: Foo #-> A + a :: Foo %1 -> A We could write - bad :: A #-> B #-> A + bad :: A %1 -> B %1 -> A bad x y = a (MkFoo { a=x, b=y }) There is an exception: if `b` (more generally all the fields besides `a`) is @@ -411,7 +411,7 @@ linear projection has as simple definition. data Bar = MkBar { c :: C, d # Many :: D } - c :: Bar #-> C + c :: Bar %1 -> C c MkBar{ c=x, d=_} = x The `# Many` syntax, for records, does not exist yet. But there is one important diff --git a/compiler/GHC/Utils/Outputable.hs b/compiler/GHC/Utils/Outputable.hs index 5c337fd5b4..6dd5b88fbb 100644 --- a/compiler/GHC/Utils/Outputable.hs +++ b/compiler/GHC/Utils/Outputable.hs @@ -654,7 +654,7 @@ lparen, rparen, lbrack, rbrack, lbrace, rbrace, blankLine :: SDoc blankLine = docToSDoc $ Pretty.text "" dcolon = unicodeSyntax (char '∷') (docToSDoc $ Pretty.text "::") arrow = unicodeSyntax (char '→') (docToSDoc $ Pretty.text "->") -lollipop = unicodeSyntax (char '⊸') (docToSDoc $ Pretty.text "#->") +lollipop = unicodeSyntax (char '⊸') (docToSDoc $ Pretty.text "%1 ->") larrow = unicodeSyntax (char '←') (docToSDoc $ Pretty.text "<-") darrow = unicodeSyntax (char '⇒') (docToSDoc $ Pretty.text "=>") arrowt = unicodeSyntax (char '⤚') (docToSDoc $ Pretty.text ">-") diff --git a/docs/users_guide/9.0.1-notes.rst b/docs/users_guide/9.0.1-notes.rst index 1b48f874f6..cee0e1a7ed 100644 --- a/docs/users_guide/9.0.1-notes.rst +++ b/docs/users_guide/9.0.1-notes.rst @@ -11,7 +11,7 @@ Highlights ---------- * The :extension:`LinearTypes` extension enables linear function syntax - ``a #-> b``, as described in the `Linear Types GHC proposal + ``a %1 -> b``, as described in the `Linear Types GHC proposal <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0111-linear-types.rst>`__. The GADT syntax can be used to define data types with linear and nonlinear fields. diff --git a/docs/users_guide/exts/linear_types.rst b/docs/users_guide/exts/linear_types.rst index 48d102331f..b15f75ef0c 100644 --- a/docs/users_guide/exts/linear_types.rst +++ b/docs/users_guide/exts/linear_types.rst @@ -6,8 +6,8 @@ Linear types :since: 9.0.1 - Enable the linear arrow ``a #-> b`` and the multiplicity-polymorphic arrow - ``a # m -> b``. + Enable the linear arrow ``a %1 -> b`` and the multiplicity-polymorphic arrow + ``a %m -> b``. **This extension is currently considered experimental, expect bugs, warts, and bad error messages; everything down to the syntax is @@ -29,30 +29,28 @@ means that in every branch of the definition of ``f``, its argument * Calling it as a function and using the result exactly once in the same fashion. -With ``-XLinearTypes``, you can write ``f :: a #-> b`` to mean that +With ``-XLinearTypes``, you can write ``f :: a %1 -> b`` to mean that ``f`` is a linear function from ``a`` to ``b``. If -:extension:`UnicodeSyntax` is enabled, the ``#->`` arrow can be +:extension:`UnicodeSyntax` is enabled, the ``%1 ->`` arrow can be written as ``⊸``. -To allow uniform handling of linear ``a #-> b`` and unrestricted ``a --> b`` functions, there is a new function type ``a # m -> b``. This -syntax is, however, not implemented yet, see -:ref:`linear-types-limitations`. Here, ``m`` is a type of new kind -``Multiplicity``. We have: +To allow uniform handling of linear ``a %1 -> b`` and unrestricted ``a +-> b`` functions, there is a new function type ``a %m -> b``. +Here, ``m`` is a type of new kind ``Multiplicity``. We have: :: data Multiplicity = One | Many -- Defined in GHC.Types - type a #-> b = a # 'One -> b - type a -> b = a # 'Many -> b + type a %1 -> b = a %One -> b + type a -> b = a %Many -> b (See :ref:`promotion`). We say that a variable whose multiplicity constraint is ``Many`` is *unrestricted*. -The multiplicity-polymorphic arrow ``a # m -> b`` is available in a prefix +The multiplicity-polymorphic arrow ``a %m -> b`` is available in a prefix version as ``GHC.Exts.FUN m a b``, which can be applied partially. See, however :ref:`linear-types-limitations`. @@ -74,14 +72,14 @@ the value ``MkT1 x`` can be constructed and deconstructed in a linear context: :: - construct :: a #-> MkT1 a + construct :: a %1 -> MkT1 a construct x = MkT1 x - deconstruct :: MkT1 a #-> a + deconstruct :: MkT1 a %1 -> a deconstruct (MkT1 x) = x -- must consume `x` exactly once When used as a value, ``MkT1`` is given a multiplicity-polymorphic -type: ``MkT1 :: forall {m} a. a # m -> T1 a``. This makes it possible +type: ``MkT1 :: forall {m} a. a %m -> T1 a``. This makes it possible to use ``MkT1`` in higher order functions. The additional multiplicity argument ``m`` is marked as inferred (see :ref:`inferred-vs-specified`), so that there is no conflict with @@ -103,7 +101,7 @@ Whether a data constructor field is linear or not can be customized using the GA :: data T2 a b c where - MkT2 :: a -> b #-> c #-> T2 a b -- Note unrestricted arrow in the first argument + MkT2 :: a -> b %1 -> c %1 -> T2 a b -- Note unrestricted arrow in the first argument the value ``MkT2 x y z`` can be constructed only if ``x`` is unrestricted. On the other hand, a linear function which is matching @@ -124,7 +122,7 @@ Printing multiplicity-polymorphic types If :extension:`LinearTypes` is disabled, multiplicity variables in types are defaulted to ``Many`` when printing, in the same manner as described in :ref:`printing-levity-polymorphic-types`. In other words, without :extension:`LinearTypes`, multiplicity-polymorphic functions -``a # m -> b`` are printed as normal Haskell2010 functions ``a -> b``. This allows +``a %m -> b`` are printed as normal Haskell2010 functions ``a -> b``. This allows existing libraries to be generalized to linear types in a backwards-compatible manner; the general types are visible only if the user has enabled :extension:`LinearTypes`. @@ -141,22 +139,20 @@ limitations. If you have read the full design in the proposal (see :ref:`linear-types-references` below), here is a run down of the missing pieces. -- The syntax ``a # p -> b`` is not yet implemented. You can use ``GHC.Exts.FUN - p a b`` instead. However, be aware of the next point. - Multiplicity polymorphism is incomplete and experimental. You may have success using it, or you may not. Expect it to be really unreliable. - There is currently no support for multiplicity annotations such as - ``x :: a # p``, ``\(x :: a # p) -> ...``. + ``x :: a %p``, ``\(x :: a %p) -> ...``. - All ``case``, ``let`` and ``where`` statements consume their right-hand side, or scrutiny, ``Many`` times. That is, the following will not type check: :: - g :: A #-> (A, B) - h :: A #-> B #-> C + g :: A %1 -> (A, B) + h :: A %1 -> B %1 -> C - f :: A #-> C + f :: A %1 -> C f x = case g x of (y, z) -> h y z @@ -166,13 +162,13 @@ missing pieces. :: - g :: A #-> (A, B) - h :: A #-> B #-> C + g :: A %1 -> (A, B) + h :: A %1 -> B %1 -> C - f :: A #-> C + f :: A %1 -> C f x = f' (g x) where - f' :: (A, B) #-> C + f' :: (A, B) %1 -> C f' (y, z) = h y z - There is no support for linear pattern synonyms. - ``@``-patterns and view patterns are not linear. diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index 7ac590a829..e1ad3ed3fe 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -311,7 +311,7 @@ instance Ord (TypeRep a) where -- | A non-indexed type representation. data SomeTypeRep where - SomeTypeRep :: forall k (a :: k). !(TypeRep a) #-> SomeTypeRep + SomeTypeRep :: forall k (a :: k). !(TypeRep a) %1 -> SomeTypeRep instance Eq SomeTypeRep where SomeTypeRep a == SomeTypeRep b = @@ -461,9 +461,9 @@ pattern App f x <- (splitApp -> IsApp f x) data AppOrCon (a :: k) where IsApp :: forall k k' (f :: k' -> k) (x :: k'). () - => TypeRep f #-> TypeRep x #-> AppOrCon (f x) + => TypeRep f %1 -> TypeRep x %1 -> AppOrCon (f x) -- See Note [Con evidence] - IsCon :: IsApplication a ~ "" => TyCon #-> [SomeTypeRep] #-> AppOrCon a + IsCon :: IsApplication a ~ "" => TyCon %1 -> [SomeTypeRep] %1 -> AppOrCon a type family IsApplication (x :: k) :: Symbol where IsApplication (_ _) = "An error message about this unifying with \"\" " @@ -640,7 +640,7 @@ unkindedTypeRep (SomeKindedTypeRep x) = SomeTypeRep x data SomeKindedTypeRep k where SomeKindedTypeRep :: forall k (a :: k). TypeRep a - #-> SomeKindedTypeRep k + %1 -> SomeKindedTypeRep k kApp :: SomeKindedTypeRep (k -> k') -> SomeKindedTypeRep k @@ -730,7 +730,7 @@ bareArrow (TrFun _ m a b) = bareArrow _ = error "Data.Typeable.Internal.bareArrow: impossible" data IsTYPE (a :: Type) where - IsTYPE :: forall (r :: RuntimeRep). TypeRep r #-> IsTYPE (TYPE r) + IsTYPE :: forall (r :: RuntimeRep). TypeRep r %1 -> IsTYPE (TYPE r) -- | Is a type of the form @TYPE rep@? isTYPE :: TypeRep (a :: Type) -> Maybe (IsTYPE a) diff --git a/libraries/template-haskell/Language/Haskell/TH/Ppr.hs b/libraries/template-haskell/Language/Haskell/TH/Ppr.hs index 337017a958..92b2238f72 100644 --- a/libraries/template-haskell/Language/Haskell/TH/Ppr.hs +++ b/libraries/template-haskell/Language/Haskell/TH/Ppr.hs @@ -820,10 +820,10 @@ So we always print a SigT with parens (see #10050). -} pprTyApp :: (Type, [TypeArg]) -> Doc pprTyApp (MulArrowT, [TANormal (PromotedT c), TANormal arg1, TANormal arg2]) - | c == oneName = sep [pprFunArgType arg1 <+> text "#->", ppr arg2] + | c == oneName = sep [pprFunArgType arg1 <+> text "%1 ->", ppr arg2] | c == manyName = sep [pprFunArgType arg1 <+> text "->", ppr arg2] pprTyApp (MulArrowT, [TANormal argm, TANormal arg1, TANormal arg2]) = - sep [pprFunArgType arg1 <+> text "#" <+> ppr argm <+> text "->", ppr arg2] + sep [pprFunArgType arg1 <+> text "%" <> ppr argm <+> text "->", ppr arg2] pprTyApp (ArrowT, [TANormal arg1, TANormal arg2]) = sep [pprFunArgType arg1 <+> text "->", ppr arg2] pprTyApp (EqualityT, [TANormal arg1, TANormal arg2]) = sep [pprFunArgType arg1 <+> text "~", ppr arg2] diff --git a/testsuite/tests/linear/should_compile/Linear1Rule.hs b/testsuite/tests/linear/should_compile/Linear1Rule.hs index 0553c61e84..4a1984c3a0 100644 --- a/testsuite/tests/linear/should_compile/Linear1Rule.hs +++ b/testsuite/tests/linear/should_compile/Linear1Rule.hs @@ -2,8 +2,8 @@ module Linear1Rule where -- Test the 1 <= p rule -f :: a #-> b +f :: a %1 -> b f = f -g :: a # p -> b +g :: a %p -> b g x = f x diff --git a/testsuite/tests/linear/should_compile/LinearConstructors.hs b/testsuite/tests/linear/should_compile/LinearConstructors.hs index 0e0f1b547e..59886a216b 100644 --- a/testsuite/tests/linear/should_compile/LinearConstructors.hs +++ b/testsuite/tests/linear/should_compile/LinearConstructors.hs @@ -4,26 +4,26 @@ module LinearConstructors where data T a b = MkT a b -f1 :: a #-> b #-> T a b +f1 :: a %1 -> b %1 -> T a b f1 = MkT -f2 :: a #-> b -> T a b +f2 :: a %1 -> b -> T a b f2 = MkT -f3 :: a -> b #-> T a b +f3 :: a -> b %1 -> T a b f3 = MkT f4 :: a -> b -> T a b f4 = MkT -- tuple sections -g1 :: a #-> b #-> (a, b, Int) +g1 :: a %1 -> b %1 -> (a, b, Int) g1 = (,,0) -g2 :: a #-> b -> (a, b, Int) +g2 :: a %1 -> b -> (a, b, Int) g2 = (,,0) -g3 :: a -> b #-> (a, b, Int) +g3 :: a -> b %1 -> (a, b, Int) g3 = (,,0) g4 :: a -> b -> (a, b, Int) diff --git a/testsuite/tests/linear/should_compile/LinearEmptyCase.hs b/testsuite/tests/linear/should_compile/LinearEmptyCase.hs index daa1918b56..63bfd017fd 100644 --- a/testsuite/tests/linear/should_compile/LinearEmptyCase.hs +++ b/testsuite/tests/linear/should_compile/LinearEmptyCase.hs @@ -4,5 +4,5 @@ module LinearEmptyCase where data Void -f :: a #-> Void -> b +f :: a %1 -> Void -> b f x y = case y of {} diff --git a/testsuite/tests/linear/should_compile/LinearGuards.hs b/testsuite/tests/linear/should_compile/LinearGuards.hs index fae1208176..3ae3f039a5 100644 --- a/testsuite/tests/linear/should_compile/LinearGuards.hs +++ b/testsuite/tests/linear/should_compile/LinearGuards.hs @@ -1,6 +1,6 @@ {-# LANGUAGE LinearTypes #-} module LinearGuards where -f :: Bool -> a #-> a +f :: Bool -> a %1 -> a f b a | b = a | True = a diff --git a/testsuite/tests/linear/should_compile/LinearHole.hs b/testsuite/tests/linear/should_compile/LinearHole.hs index e4c5181d9e..e3016339d1 100644 --- a/testsuite/tests/linear/should_compile/LinearHole.hs +++ b/testsuite/tests/linear/should_compile/LinearHole.hs @@ -3,5 +3,5 @@ module LinearHole where -- #18491 -f :: Int #-> Bool #-> Char +f :: Int %1 -> Bool %1 -> Char f x y = _1 diff --git a/testsuite/tests/linear/should_compile/LinearTH2.hs b/testsuite/tests/linear/should_compile/LinearTH2.hs index a35f9a1c7e..8d3a251c76 100644 --- a/testsuite/tests/linear/should_compile/LinearTH2.hs +++ b/testsuite/tests/linear/should_compile/LinearTH2.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE LinearTypes, TemplateHaskell, RankNTypes #-} +{-# LANGUAGE LinearTypes, TemplateHaskell, RankNTypes, NoMonomorphismRestriction #-} module LinearTH2 where -x1 = [t|forall p. Int # p -> Int|] +x1 = [t|forall p. Int %p -> Int|] diff --git a/testsuite/tests/linear/should_compile/MultConstructor.hs b/testsuite/tests/linear/should_compile/MultConstructor.hs index 6e631774ba..780c906099 100644 --- a/testsuite/tests/linear/should_compile/MultConstructor.hs +++ b/testsuite/tests/linear/should_compile/MultConstructor.hs @@ -4,10 +4,10 @@ module MultConstructor where import GHC.Types data T p a where - MkT :: a # p -> T p a + MkT :: a %p -> T p a {- this currently fails -g :: forall (b :: Type). T 'Many b #-> (b,b) +g :: forall (b :: Type). T 'Many b %1 -> (b,b) g (MkT x) = (x,x) -} diff --git a/testsuite/tests/linear/should_compile/OldList.hs b/testsuite/tests/linear/should_compile/OldList.hs index 2ed7b8aaf2..e84b5bb927 100644 --- a/testsuite/tests/linear/should_compile/OldList.hs +++ b/testsuite/tests/linear/should_compile/OldList.hs @@ -24,11 +24,11 @@ sortBy cmp = [] | a `cmp` b == GT = descending b (a:as) bs descending a as bs = (a:as): sequences bs - ascending :: a -> (forall i . [a] # i -> [a]) -> [a] -> [[a]] + ascending :: a -> (forall i . [a] %i -> [a]) -> [a] -> [[a]] ascending a as (b:bs) | a `cmp` b /= GT = ascending b foo bs where - foo :: [a] # k -> [a] + foo :: [a] %k -> [a] foo ys = as (a:ys) ascending a as bs = let !x = as [a] in x : sequences bs diff --git a/testsuite/tests/linear/should_compile/Pr110.hs b/testsuite/tests/linear/should_compile/Pr110.hs index a3311cb7b8..1bce24895f 100644 --- a/testsuite/tests/linear/should_compile/Pr110.hs +++ b/testsuite/tests/linear/should_compile/Pr110.hs @@ -3,8 +3,8 @@ module Pr110 where data Bloop = Bloop Bool -g :: Bloop #-> Bool +g :: Bloop %1 -> Bool g (Bloop x) = x -h :: Bool #-> Bloop +h :: Bool %1 -> Bloop h x = Bloop x diff --git a/testsuite/tests/linear/should_compile/T18731.hs b/testsuite/tests/linear/should_compile/T18731.hs index c7899efb54..44a8e8d282 100644 --- a/testsuite/tests/linear/should_compile/T18731.hs +++ b/testsuite/tests/linear/should_compile/T18731.hs @@ -1,5 +1,5 @@ {-# LANGUAGE LinearTypes #-} module T18731 where -f :: a #-> b +f :: a %1 -> b f x = undefined x diff --git a/testsuite/tests/linear/should_compile/all.T b/testsuite/tests/linear/should_compile/all.T index d624a337ba..0fa5750794 100644 --- a/testsuite/tests/linear/should_compile/all.T +++ b/testsuite/tests/linear/should_compile/all.T @@ -1,5 +1,3 @@ -broken_multiplicity_syntax = 94 # https://github.com/tweag/ghc/issues/94 - test('anf', normal, compile, ['']) test('Arity2', normal, compile, ['']) test('Branches', normal, compile, ['']) @@ -10,7 +8,7 @@ test('DollarTest', normal, compile, ['']) test('Foldr', normal, compile, ['']) test('Iden', normal, compile, ['']) test('List', normal, compile, ['']) -test('OldList', expect_broken(broken_multiplicity_syntax), compile, ['']) +test('OldList', normal, compile, ['']) test('Op', normal, compile, ['']) test('RankN', normal, compile, ['']) test('T1735Min', normal, compile, ['']) @@ -28,12 +26,12 @@ test('Linear8', normal, compile, ['']) test('LinearGuards', normal, compile, ['']) test('LinearPolyDollar', normal, compile, ['']) test('LinearConstructors', normal, compile, ['']) -test('Linear1Rule', expect_broken(broken_multiplicity_syntax), compile, ['']) +test('Linear1Rule', normal, compile, ['']) test('LinearEmptyCase', normal, compile, ['']) test('Tunboxer', normal, compile, ['']) -test('MultConstructor', expect_broken(broken_multiplicity_syntax), compile, ['']) +test('MultConstructor', normal, compile, ['']) test('LinearLetRec', expect_broken(405), compile, ['-O -dlinear-core-lint']) test('LinearTH1', normal, compile, ['']) -test('LinearTH2', expect_broken(broken_multiplicity_syntax), compile, ['']) +test('LinearTH2', normal, compile, ['']) test('LinearHole', normal, compile, ['']) test('T18731', normal, compile, ['']) diff --git a/testsuite/tests/linear/should_fail/Linear13.hs b/testsuite/tests/linear/should_fail/Linear13.hs index 7b9e09c52b..7d36a33570 100644 --- a/testsuite/tests/linear/should_fail/Linear13.hs +++ b/testsuite/tests/linear/should_fail/Linear13.hs @@ -5,7 +5,7 @@ module Linear13 where incorrectLet :: a ⊸ () incorrectLet a = let x = a in () -incorrectLetWithSignature :: (Bool->Bool) #-> () +incorrectLetWithSignature :: (Bool->Bool) %1 -> () incorrectLetWithSignature x = let y :: Bool->Bool; y = x in () incorrectLazyMatch :: (a,b) ⊸ b diff --git a/testsuite/tests/linear/should_fail/LinearAsPat.hs b/testsuite/tests/linear/should_fail/LinearAsPat.hs index e756f4369f..86b557c66b 100644 --- a/testsuite/tests/linear/should_fail/LinearAsPat.hs +++ b/testsuite/tests/linear/should_fail/LinearAsPat.hs @@ -2,5 +2,5 @@ module LinearAsPat where -shouldFail :: Bool #-> Bool +shouldFail :: Bool %1 -> Bool shouldFail x@True = x diff --git a/testsuite/tests/linear/should_fail/LinearBottomMult.hs b/testsuite/tests/linear/should_fail/LinearBottomMult.hs index 03bf8731a7..b3d00069fe 100644 --- a/testsuite/tests/linear/should_fail/LinearBottomMult.hs +++ b/testsuite/tests/linear/should_fail/LinearBottomMult.hs @@ -6,8 +6,8 @@ module LinearBottomMult where data Void data U a where U :: a -> U a -elim :: U a #-> () +elim :: U a %1 -> () elim (U _) = () -f :: a #-> () +f :: a %1 -> () f x = elim (U (\(a :: Void) -> case a of {})) diff --git a/testsuite/tests/linear/should_fail/LinearConfusedDollar.hs b/testsuite/tests/linear/should_fail/LinearConfusedDollar.hs index 2cd1628eeb..a679a50431 100644 --- a/testsuite/tests/linear/should_fail/LinearConfusedDollar.hs +++ b/testsuite/tests/linear/should_fail/LinearConfusedDollar.hs @@ -5,8 +5,8 @@ module LinearConfusedDollar where -- hold anymore. But, as it stands, it produces untyped desugared code, hence -- must be rejected. -f :: a #-> a +f :: a %1 -> a f x = x -g :: a #-> a +g :: a %1 -> a g x = f $ x diff --git a/testsuite/tests/linear/should_fail/LinearConfusedDollar.stderr b/testsuite/tests/linear/should_fail/LinearConfusedDollar.stderr index 61d7aa2f45..51dc7cdd91 100644 --- a/testsuite/tests/linear/should_fail/LinearConfusedDollar.stderr +++ b/testsuite/tests/linear/should_fail/LinearConfusedDollar.stderr @@ -2,7 +2,7 @@ LinearConfusedDollar.hs:12:7: error: • Couldn't match type ‘'One’ with ‘'Many’ Expected: a -> a - Actual: a #-> a + Actual: a %1 -> a • In the first argument of ‘($)’, namely ‘f’ In the expression: f $ x In an equation for ‘g’: g x = f $ x diff --git a/testsuite/tests/linear/should_fail/LinearErrOrigin.hs b/testsuite/tests/linear/should_fail/LinearErrOrigin.hs index 1eeb149959..3368c723b2 100644 --- a/testsuite/tests/linear/should_fail/LinearErrOrigin.hs +++ b/testsuite/tests/linear/should_fail/LinearErrOrigin.hs @@ -3,5 +3,5 @@ module LinearErrOrigin where -- The error message should mention "arising from multiplicity of x". -foo :: (a # p -> b) -> a # q -> b +foo :: (a %p -> b) -> a %q -> b foo f x = f x diff --git a/testsuite/tests/linear/should_fail/LinearErrOrigin.stderr b/testsuite/tests/linear/should_fail/LinearErrOrigin.stderr index 10b889a9a8..02dc7216db 100644 --- a/testsuite/tests/linear/should_fail/LinearErrOrigin.stderr +++ b/testsuite/tests/linear/should_fail/LinearErrOrigin.stderr @@ -3,14 +3,17 @@ LinearErrOrigin.hs:7:7: error: • Couldn't match type ‘p’ with ‘q’ arising from multiplicity of ‘x’ ‘p’ is a rigid type variable bound by the type signature for: - foo :: forall a b. (a -> b) -> a -> b - at LinearErrOrigin.hs:6:1-35 + foo :: forall a b (p :: GHC.Types.Multiplicity) + (q :: GHC.Types.Multiplicity). + (a # p -> b) -> a # q -> b + at LinearErrOrigin.hs:6:1-31 ‘q’ is a rigid type variable bound by the type signature for: - foo :: forall a b. (a -> b) -> a -> b - at LinearErrOrigin.hs:6:1-35 + foo :: forall a b (p :: GHC.Types.Multiplicity) + (q :: GHC.Types.Multiplicity). + (a # p -> b) -> a # q -> b + at LinearErrOrigin.hs:6:1-31 • In an equation for ‘foo’: foo f x = f x • Relevant bindings include f :: a # p -> b (bound at LinearErrOrigin.hs:7:5) - foo :: (a # p -> b) -> a # q -> b - (bound at LinearErrOrigin.hs:7:1) + foo :: (a # p -> b) -> a # q -> b (bound at LinearErrOrigin.hs:7:1) diff --git a/testsuite/tests/linear/should_fail/LinearFFI.hs b/testsuite/tests/linear/should_fail/LinearFFI.hs index 6c6e1c562a..4c58c9eecd 100644 --- a/testsuite/tests/linear/should_fail/LinearFFI.hs +++ b/testsuite/tests/linear/should_fail/LinearFFI.hs @@ -3,6 +3,6 @@ module LinearFFI where -- #18472 import Foreign.Ptr -foreign import ccall "exp" c_exp :: Double #-> Double -foreign import stdcall "dynamic" d8 :: FunPtr (IO Int) #-> IO Int -foreign import ccall "wrapper" mkF :: IO () #-> IO (FunPtr (IO ())) +foreign import ccall "exp" c_exp :: Double %1 -> Double +foreign import stdcall "dynamic" d8 :: FunPtr (IO Int) %1 -> IO Int +foreign import ccall "wrapper" mkF :: IO () %1 -> IO (FunPtr (IO ())) diff --git a/testsuite/tests/linear/should_fail/LinearFFI.stderr b/testsuite/tests/linear/should_fail/LinearFFI.stderr index 41dd5e66a7..6d0707252e 100644 --- a/testsuite/tests/linear/should_fail/LinearFFI.stderr +++ b/testsuite/tests/linear/should_fail/LinearFFI.stderr @@ -3,18 +3,18 @@ LinearFFI.hs:6:1: error: • Unacceptable argument type in foreign declaration: Linear types are not supported in FFI declarations, see #18472 • When checking declaration: - foreign import ccall safe "exp" c_exp :: Double #-> Double + foreign import ccall safe "exp" c_exp :: Double %1 -> Double LinearFFI.hs:7:1: error: • Unacceptable argument type in foreign declaration: Linear types are not supported in FFI declarations, see #18472 • When checking declaration: foreign import stdcall safe "dynamic" d8 - :: FunPtr (IO Int) #-> IO Int + :: FunPtr (IO Int) %1 -> IO Int LinearFFI.hs:8:1: error: • Unacceptable argument type in foreign declaration: Linear types are not supported in FFI declarations, see #18472 • When checking declaration: foreign import ccall safe "wrapper" mkF - :: IO () #-> IO (FunPtr (IO ())) + :: IO () %1 -> IO (FunPtr (IO ())) diff --git a/testsuite/tests/linear/should_fail/LinearIf.hs b/testsuite/tests/linear/should_fail/LinearIf.hs index b19873120c..9ddd5ce50b 100644 --- a/testsuite/tests/linear/should_fail/LinearIf.hs +++ b/testsuite/tests/linear/should_fail/LinearIf.hs @@ -9,7 +9,7 @@ ifThenElse :: Bool -> a -> a -> a ifThenElse True x _ = x ifThenElse False _ y = y -f :: Bool #-> Char #-> Char #-> Char +f :: Bool %1 -> Char %1 -> Char %1 -> Char f b x y = if b then x else y -- 'f' ought to be unrestricted in all three arguments because it desugars to -- > ifThenElse b x y diff --git a/testsuite/tests/linear/should_fail/LinearKind.hs b/testsuite/tests/linear/should_fail/LinearKind.hs index a60554a7a7..6455249c6c 100644 --- a/testsuite/tests/linear/should_fail/LinearKind.hs +++ b/testsuite/tests/linear/should_fail/LinearKind.hs @@ -1,4 +1,4 @@ {-# LANGUAGE LinearTypes, KindSignatures #-} module LinearKind where -data A :: * #-> * +data A :: * %1 -> * diff --git a/testsuite/tests/linear/should_fail/LinearKind.stderr b/testsuite/tests/linear/should_fail/LinearKind.stderr index 5ac2825b21..9ba3f744cf 100644 --- a/testsuite/tests/linear/should_fail/LinearKind.stderr +++ b/testsuite/tests/linear/should_fail/LinearKind.stderr @@ -1,5 +1,5 @@ LinearKind.hs:4:11: error: - • Linear arrows disallowed in kinds: * #-> * - • In the kind ‘* #-> *’ + • Linear arrows disallowed in kinds: * %1 -> * + • In the kind ‘* %1 -> *’ In the data type declaration for ‘A’ diff --git a/testsuite/tests/linear/should_fail/LinearLazyPat.hs b/testsuite/tests/linear/should_fail/LinearLazyPat.hs index 8ed4024c40..be87629cc9 100644 --- a/testsuite/tests/linear/should_fail/LinearLazyPat.hs +++ b/testsuite/tests/linear/should_fail/LinearLazyPat.hs @@ -1,5 +1,5 @@ {-# LANGUAGE LinearTypes #-} module LinearLazyPat where -f :: (a,b) #-> (b,a) +f :: (a,b) %1 -> (b,a) f ~(x,y) = (y,x) diff --git a/testsuite/tests/linear/should_fail/LinearLet.hs b/testsuite/tests/linear/should_fail/LinearLet.hs index bf822a8a6e..9ad7f4932f 100644 --- a/testsuite/tests/linear/should_fail/LinearLet.hs +++ b/testsuite/tests/linear/should_fail/LinearLet.hs @@ -1,5 +1,5 @@ {-# LANGUAGE LinearTypes #-} module LinearLet where -f :: a #-> (a,a) +f :: a %1 -> (a,a) f x = let y = x in (y,y) diff --git a/testsuite/tests/linear/should_fail/LinearNoExt.hs b/testsuite/tests/linear/should_fail/LinearNoExt.hs index 2671246f21..47c3ea85f9 100644 --- a/testsuite/tests/linear/should_fail/LinearNoExt.hs +++ b/testsuite/tests/linear/should_fail/LinearNoExt.hs @@ -1,3 +1,3 @@ module LinearNoExt where -type T = a #-> a +type T a = a %1 -> a diff --git a/testsuite/tests/linear/should_fail/LinearNoExt.stderr b/testsuite/tests/linear/should_fail/LinearNoExt.stderr index 452409586d..9277e29ea5 100644 --- a/testsuite/tests/linear/should_fail/LinearNoExt.stderr +++ b/testsuite/tests/linear/should_fail/LinearNoExt.stderr @@ -1,3 +1,10 @@ -LinearNoExt.hs:3:12: error: - Enable LinearTypes to allow linear functions +LinearNoExt.hs:3:14: error: + Not in scope: type constructor or class ‘%’ + +LinearNoExt.hs:3:14: error: + Illegal operator ‘%’ in type ‘a % 1’ + Use TypeOperators to allow operators in types + +LinearNoExt.hs:3:15: error: + Illegal type: ‘1’ Perhaps you intended to use DataKinds diff --git a/testsuite/tests/linear/should_fail/LinearNoExtU.hs b/testsuite/tests/linear/should_fail/LinearNoExtU.hs new file mode 100644 index 0000000000..1e7ffad4e8 --- /dev/null +++ b/testsuite/tests/linear/should_fail/LinearNoExtU.hs @@ -0,0 +1,4 @@ +{-# LANGUAGE UnicodeSyntax #-} +module LinearNoExtU where + +type T a = a ⊸ a diff --git a/testsuite/tests/linear/should_fail/LinearNoExtU.stderr b/testsuite/tests/linear/should_fail/LinearNoExtU.stderr new file mode 100644 index 0000000000..ac187aee4a --- /dev/null +++ b/testsuite/tests/linear/should_fail/LinearNoExtU.stderr @@ -0,0 +1,3 @@ + +LinearNoExtU.hs:4:14: error: + Enable LinearTypes to allow linear functions diff --git a/testsuite/tests/linear/should_fail/LinearPartialSig.hs b/testsuite/tests/linear/should_fail/LinearPartialSig.hs index 01dbeddfba..cbda746317 100644 --- a/testsuite/tests/linear/should_fail/LinearPartialSig.hs +++ b/testsuite/tests/linear/should_fail/LinearPartialSig.hs @@ -2,5 +2,5 @@ module LinearPartialSig where -- We should suggest that _ :: Multiplicity -f :: a # _ -> a +f :: a %_ -> a f x = x diff --git a/testsuite/tests/linear/should_fail/LinearPartialSig.stderr b/testsuite/tests/linear/should_fail/LinearPartialSig.stderr index 4d25260bf2..704fcb258c 100644 --- a/testsuite/tests/linear/should_fail/LinearPartialSig.stderr +++ b/testsuite/tests/linear/should_fail/LinearPartialSig.stderr @@ -1,5 +1,5 @@ -LinearPartialSig.hs:5:13: error: +LinearPartialSig.hs:5:9: error: • Found type wildcard ‘_’ standing for ‘'Many :: GHC.Types.Multiplicity’ To use the inferred type, enable PartialTypeSignatures diff --git a/testsuite/tests/linear/should_fail/LinearPatSyn.hs b/testsuite/tests/linear/should_fail/LinearPatSyn.hs index 3e947dba2e..3e87bfc078 100644 --- a/testsuite/tests/linear/should_fail/LinearPatSyn.hs +++ b/testsuite/tests/linear/should_fail/LinearPatSyn.hs @@ -7,8 +7,8 @@ module LinearPatSyn where -- seems to require changes to the desugarer. So currently pattern synonyms are -- disallowed in linear patterns. -pattern P :: b #-> a #-> (a, b) +pattern P :: b %1 -> a %1 -> (a, b) pattern P y x = (x, y) -s :: (a, b) #-> (b, a) +s :: (a, b) %1 -> (b, a) s (P y x) = (y, x) diff --git a/testsuite/tests/linear/should_fail/LinearPatternGuardWildcard.hs b/testsuite/tests/linear/should_fail/LinearPatternGuardWildcard.hs index be837fd80b..de04b28f49 100644 --- a/testsuite/tests/linear/should_fail/LinearPatternGuardWildcard.hs +++ b/testsuite/tests/linear/should_fail/LinearPatternGuardWildcard.hs @@ -3,5 +3,5 @@ module LinearPatternGuardWildcard where -- See #18439 -unsafeConsume :: a #-> () +unsafeConsume :: a %1 -> () unsafeConsume x | _ <- x = () diff --git a/testsuite/tests/linear/should_fail/LinearPolyType.hs b/testsuite/tests/linear/should_fail/LinearPolyType.hs index bcf46eed9f..21c09247b5 100644 --- a/testsuite/tests/linear/should_fail/LinearPolyType.hs +++ b/testsuite/tests/linear/should_fail/LinearPolyType.hs @@ -11,6 +11,6 @@ type family If b t f where If True t _ = t If False _ f = f -dep :: SBool b -> Int # If b One Many -> Int +dep :: SBool b -> Int %(If b One Many) -> Int dep STrue x = x dep SFalse _ = 0 diff --git a/testsuite/tests/linear/should_fail/LinearPolyType.stderr b/testsuite/tests/linear/should_fail/LinearPolyType.stderr index fab6dfcc9b..884b8991fb 100644 --- a/testsuite/tests/linear/should_fail/LinearPolyType.stderr +++ b/testsuite/tests/linear/should_fail/LinearPolyType.stderr @@ -1,3 +1,6 @@ LinearPolyType.hs:15:1: error: Multiplicity coercions are currently not supported + +LinearPolyType.hs:15:1: error: + Multiplicity coercions are currently not supported diff --git a/testsuite/tests/linear/should_fail/LinearRecordUpdate.hs b/testsuite/tests/linear/should_fail/LinearRecordUpdate.hs index e143dbd604..c9df293624 100644 --- a/testsuite/tests/linear/should_fail/LinearRecordUpdate.hs +++ b/testsuite/tests/linear/should_fail/LinearRecordUpdate.hs @@ -4,5 +4,5 @@ module LinearRecordUpdate where data R = R { x :: Int, y :: Bool } -shouldFail :: R #-> R +shouldFail :: R %1 -> R shouldFail r = r { y = False } diff --git a/testsuite/tests/linear/should_fail/LinearSeq.hs b/testsuite/tests/linear/should_fail/LinearSeq.hs index 0f2ed39c93..efe102c510 100644 --- a/testsuite/tests/linear/should_fail/LinearSeq.hs +++ b/testsuite/tests/linear/should_fail/LinearSeq.hs @@ -2,5 +2,5 @@ module LinearSeq where -bad :: a #-> () +bad :: a %1 -> () bad x = seq x () diff --git a/testsuite/tests/linear/should_fail/LinearSequenceExpr.hs b/testsuite/tests/linear/should_fail/LinearSequenceExpr.hs index ff3ac9cedb..2643c78252 100644 --- a/testsuite/tests/linear/should_fail/LinearSequenceExpr.hs +++ b/testsuite/tests/linear/should_fail/LinearSequenceExpr.hs @@ -3,6 +3,6 @@ module LinearSequenceExpr where -f :: Char #-> Char #-> [Char] +f :: Char %1 -> Char %1 -> [Char] f x y = [x .. y] -- This ought to fail, because `fromList` in base, is unrestricted diff --git a/testsuite/tests/linear/should_fail/LinearVar.hs b/testsuite/tests/linear/should_fail/LinearVar.hs index 7b4cde3647..9a3abb8c89 100644 --- a/testsuite/tests/linear/should_fail/LinearVar.hs +++ b/testsuite/tests/linear/should_fail/LinearVar.hs @@ -1,5 +1,5 @@ {-# LANGUAGE LinearTypes #-} module LinearVar where -f :: a # m -> b +f :: a %m -> b f = undefined :: a -> b diff --git a/testsuite/tests/linear/should_fail/LinearVar.stderr b/testsuite/tests/linear/should_fail/LinearVar.stderr index 04014ce79b..cdbb4de1c9 100644 --- a/testsuite/tests/linear/should_fail/LinearVar.stderr +++ b/testsuite/tests/linear/should_fail/LinearVar.stderr @@ -1,12 +1,12 @@ LinearVar.hs:5:5: error: • Couldn't match type ‘m’ with ‘'Many’ + Expected: a # m -> b + Actual: a -> b ‘m’ is a rigid type variable bound by the type signature for: - f :: forall a b. a -> b - at LinearVar.hs:4:1-16 - Expected type: a # m -> b - Actual type: a -> b + f :: forall a b (m :: GHC.Types.Multiplicity). a # m -> b + at LinearVar.hs:4:1-14 • In the expression: undefined :: a -> b In an equation for ‘f’: f = undefined :: a -> b • Relevant bindings include diff --git a/testsuite/tests/linear/should_fail/LinearViewPattern.hs b/testsuite/tests/linear/should_fail/LinearViewPattern.hs index 737393911b..55058e4263 100644 --- a/testsuite/tests/linear/should_fail/LinearViewPattern.hs +++ b/testsuite/tests/linear/should_fail/LinearViewPattern.hs @@ -7,5 +7,5 @@ module LinearViewPattern where -- incorrect Core being emitted by the desugarer. When we understand linear view -- pattern better, we will probably want to remove this test. -f :: Bool #-> Bool +f :: Bool %1 -> Bool f (not -> True) = True diff --git a/testsuite/tests/linear/should_fail/all.T b/testsuite/tests/linear/should_fail/all.T index 5a79b031b6..bcba344268 100644 --- a/testsuite/tests/linear/should_fail/all.T +++ b/testsuite/tests/linear/should_fail/all.T @@ -1,5 +1,3 @@ -broken_multiplicity_syntax = 94 # https://github.com/tweag/ghc/issues/94 - test('TypeClass', normal, compile_fail, ['']) test('Linear11', normal, compile_fail, ['']) test('Linear13', normal, compile_fail, ['']) @@ -10,6 +8,7 @@ test('Linear5', normal, compile_fail, ['']) test('Linear7', normal, compile_fail, ['']) test('Linear9', normal, compile_fail, ['']) test('LinearNoExt', normal, compile_fail, ['']) +test('LinearNoExtU', normal, compile_fail, ['']) test('LinearAsPat', normal, compile_fail, ['']) test('LinearLet', normal, compile_fail, ['']) test('LinearLazyPat', normal, compile_fail, ['']) @@ -19,11 +18,11 @@ test('LinearViewPattern', normal, compile_fail, ['']) test('LinearConfusedDollar', normal, compile_fail, ['']) test('LinearPatSyn', normal, compile_fail, ['']) test('LinearGADTNewtype', normal, compile_fail, ['']) -test('LinearPartialSig', expect_broken(broken_multiplicity_syntax), compile_fail, ['']) +test('LinearPartialSig', normal, compile_fail, ['']) test('LinearKind', normal, compile_fail, ['']) -test('LinearVar', expect_broken(broken_multiplicity_syntax), compile_fail, ['']) -test('LinearErrOrigin', expect_broken(broken_multiplicity_syntax), compile_fail, ['']) -test('LinearPolyType', expect_broken([436, broken_multiplicity_syntax]), compile_fail, ['']) # not supported yet (#354) +test('LinearVar', normal, compile_fail, ['-XLinearTypes']) +test('LinearErrOrigin', normal, compile_fail, ['-XLinearTypes']) +test('LinearPolyType', normal, compile_fail, ['']) # not supported yet (#390) test('LinearBottomMult', normal, compile_fail, ['']) test('LinearSequenceExpr', normal, compile_fail, ['']) test('LinearIf', normal, compile_fail, ['']) diff --git a/testsuite/tests/linear/should_run/LinearGhci.script b/testsuite/tests/linear/should_run/LinearGhci.script index cd55fe73bd..b8fa13a4ca 100644 --- a/testsuite/tests/linear/should_run/LinearGhci.script +++ b/testsuite/tests/linear/should_run/LinearGhci.script @@ -3,7 +3,7 @@ data T a = MkT a :set -XLinearTypes :type MkT :set -XGADTs -data T a where MkT :: a #-> a -> T a +data T a where MkT :: a %1 -> a -> T a :info T data T a b m n r = MkT a b m n r :set -fprint-explicit-foralls diff --git a/testsuite/tests/linear/should_run/LinearGhci.stdout b/testsuite/tests/linear/should_run/LinearGhci.stdout index ed5c9cfe64..29cfa88b11 100644 --- a/testsuite/tests/linear/should_run/LinearGhci.stdout +++ b/testsuite/tests/linear/should_run/LinearGhci.stdout @@ -2,6 +2,6 @@ MkT :: a -> T a MkT :: a -> T a type T :: * -> * data T a where - MkT :: a #-> a -> T a + MkT :: a %1 -> a -> T a -- Defined at <interactive>:6:1 MkT :: forall a b m n r. a -> b -> m -> n -> r -> T a b m n r diff --git a/testsuite/tests/linear/should_run/LinearTypeable.hs b/testsuite/tests/linear/should_run/LinearTypeable.hs index 69772f7b33..f22d6c445a 100644 --- a/testsuite/tests/linear/should_run/LinearTypeable.hs +++ b/testsuite/tests/linear/should_run/LinearTypeable.hs @@ -4,7 +4,7 @@ module Main (main) where import Data.Typeable import Data.Maybe -x :: Maybe ((Int -> Int) :~: (Int #-> Int)) +x :: Maybe ((Int -> Int) :~: (Int %1 -> Int)) x = eqT main = print (isJust x) diff --git a/testsuite/tests/qualifieddo/should_run/Monad/Linear.hs b/testsuite/tests/qualifieddo/should_run/Monad/Linear.hs index df7f2775c8..05eadd3d04 100644 --- a/testsuite/tests/qualifieddo/should_run/Monad/Linear.hs +++ b/testsuite/tests/qualifieddo/should_run/Monad/Linear.hs @@ -8,10 +8,10 @@ data T where T :: Int -> T data TM a = TM a class Monad m where - return :: a #-> m a - (>>=) :: m a #-> (a #-> m b) #-> m b + return :: a %1 -> m a + (>>=) :: m a %1 -> (a %1 -> m b) %1 -> m b -(>>) :: Monad m => m () #-> m b #-> m b +(>>) :: Monad m => m () %1 -> m b %1 -> m b m1 >> m2 = m1 >>= \() -> m2 instance Monad TM where @@ -27,11 +27,11 @@ runTM (TM (Unrestricted a)) = a newT :: TM T newT = return (T 0) -increaseT :: T #-> TM T +increaseT :: T %1 -> TM T increaseT (T i) = return (T (i+1)) -extractT :: T #-> TM (T, Unrestricted Int) +extractT :: T %1 -> TM (T, Unrestricted Int) extractT (T i) = return (T i, Unrestricted i) -deleteT :: T #-> TM () +deleteT :: T %1 -> TM () deleteT (T _) = return () diff --git a/testsuite/tests/simplCore/should_compile/T7360.stderr b/testsuite/tests/simplCore/should_compile/T7360.stderr index ccf2147977..6958eceeca 100644 --- a/testsuite/tests/simplCore/should_compile/T7360.stderr +++ b/testsuite/tests/simplCore/should_compile/T7360.stderr @@ -4,7 +4,7 @@ Result size of Tidy Core = {terms: 106, types: 47, coercions: 0, joins: 0/0} -- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0} -T7360.$WFoo3 [InlPrag=INLINE[final] CONLIKE] :: Int #-> Foo +T7360.$WFoo3 [InlPrag=INLINE[final] CONLIKE] :: Int %1 -> Foo [GblId[DataConWrapper], Arity=1, Caf=NoCafRefs, diff --git a/testsuite/tests/stranal/should_compile/T16029.stdout b/testsuite/tests/stranal/should_compile/T16029.stdout index 5b3a03a603..59507ee4ce 100644 --- a/testsuite/tests/stranal/should_compile/T16029.stdout +++ b/testsuite/tests/stranal/should_compile/T16029.stdout @@ -1,4 +1,4 @@ -T16029.$WMkT [InlPrag=INLINE[final] CONLIKE] :: Int #-> Int #-> T + :: Int %1 -> Int %1 -> T Tmpl= \ (dt [Occ=Once1!] :: Int) (dt [Occ=Once1!] :: Int) -> = \ (dt [Occ=Once1!] :: Int) (dt [Occ=Once1!] :: Int) -> :: GHC.Prim.Int# -> GHC.Prim.Int# diff --git a/testsuite/tests/th/T10019.stdout b/testsuite/tests/th/T10019.stdout index 6acec6d98f..85510c1af1 100644 --- a/testsuite/tests/th/T10019.stdout +++ b/testsuite/tests/th/T10019.stdout @@ -1 +1 @@ -"Constructor from Ghci1.Option: Ghci1.Some :: forall (a_0 :: *) .\n a_0 #-> Ghci1.Option a_0" +"Constructor from Ghci1.Option: Ghci1.Some :: forall (a_0 :: *) .\n a_0 %1 -> Ghci1.Option a_0" diff --git a/testsuite/tests/th/T11345.stdout b/testsuite/tests/th/T11345.stdout index f710d847c8..782005a4fb 100644 --- a/testsuite/tests/th/T11345.stdout +++ b/testsuite/tests/th/T11345.stdout @@ -3,8 +3,8 @@ data Main.GADT (a_0 :: *) where GHC.Types.Int -> Main.GADT GHC.Types.Int (Main.:***:) :: GHC.Types.Int -> GHC.Types.Int -> Main.GADT GHC.Types.Int -Constructor from Main.GADT: (Main.:***:) :: GHC.Types.Int #-> - GHC.Types.Int #-> Main.GADT GHC.Types.Int +Constructor from Main.GADT: (Main.:***:) :: GHC.Types.Int %1 -> + GHC.Types.Int %1 -> Main.GADT GHC.Types.Int Nothing Just (Fixity 7 InfixR) 1 :****: 4 diff --git a/testsuite/tests/th/TH_reifyLinear.hs b/testsuite/tests/th/TH_reifyLinear.hs index c551ad9235..3a99dc79a6 100644 --- a/testsuite/tests/th/TH_reifyLinear.hs +++ b/testsuite/tests/th/TH_reifyLinear.hs @@ -4,7 +4,7 @@ module TH_reifyLinear where import Language.Haskell.TH import System.IO -type T = Int #-> Int +type T = Int %1 -> Int $( do x <- reify ''T diff --git a/testsuite/tests/th/TH_reifyLinear.stderr b/testsuite/tests/th/TH_reifyLinear.stderr index ed7866bfa8..5f2cceb12a 100644 --- a/testsuite/tests/th/TH_reifyLinear.stderr +++ b/testsuite/tests/th/TH_reifyLinear.stderr @@ -1 +1 @@ -type TH_reifyLinear.T = GHC.Types.Int #-> GHC.Types.Int +type TH_reifyLinear.T = GHC.Types.Int %1 -> GHC.Types.Int diff --git a/testsuite/tests/typecheck/should_fail/T15807.stderr b/testsuite/tests/typecheck/should_fail/T15807.stderr index bac4b5596e..8589ec1268 100644 --- a/testsuite/tests/typecheck/should_fail/T15807.stderr +++ b/testsuite/tests/typecheck/should_fail/T15807.stderr @@ -2,7 +2,7 @@ T15807.hs:12:3: error: • Cannot generalise type; skolem ‘f’ would escape its scope if I tried to quantify (f0 :: f -> *) in this type: - forall f (a :: f). f a #-> App @f @f0 a + forall f (a :: f). f a %1 -> App @f @f0 a (Indeed, I sometimes struggle even printing this correctly, due to its ill-scoped nature.) • In the definition of data constructor ‘MkApp’ diff --git a/utils/haddock b/utils/haddock -Subproject 8c8517d6c82411212452c3c5fca503c7af5ac3d +Subproject 37c47822d390b553ce24fe256c9700d5fd83bf9 |