| Commit message (Collapse) | Author | Age | Files | Lines |
|
|
|
|
|
|
| |
This reverts commit 35672072b4091d6f0031417bc160c568f22d0469.
Conflicts:
compiler/main/DriverPipeline.hs
|
| |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
| |
Summary:
In preparation for indirecting all references to closures,
we rename _closure to _static_closure to ensure any old code
will get an undefined symbol error. In order to reference
a closure foobar_closure (which is now undefined), you should instead
use STATIC_CLOSURE(foobar). For convenience, a number of these
old identifiers are macro'd.
Across C-- and C (Windows and otherwise), there were differing
conventions on whether or not foobar_closure or &foobar_closure
was the address of the closure. Now, all foobar_closure references
are addresses, and no & is necessary.
CHARLIKE/INTLIKE were not changed, simply alpha-renamed.
Part of remove HEAP_ALLOCED patch set (#8199)
Depends on D265
Signed-off-by: Edward Z. Yang <ezyang@mit.edu>
Test Plan: validate
Reviewers: simonmar, austin
Subscribers: simonmar, ezyang, carter, thomie
Differential Revision: https://phabricator.haskell.org/D267
GHC Trac Issues: #8199
|
| |
|
| |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
| |
This finally exposes also the methods of these 3 classes in the Prelude
in order to allow to define basic class instances w/o needing imports.
This almost completes the primary goal of #9586
NOTE: `fold`, `foldl'`, `foldr'`, and `toList` are not exposed yet,
as they require upstream fixes for at least `containers` and
`bytestring`, and are not required for defining basic instances.
Reviewed By: ekmett, austin
Differential Revision: https://phabricator.haskell.org/D236
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
| |
Summary:
This includes pretty much all the changes needed to make `Applicative`
a superclass of `Monad` finally. There's mostly reshuffling in the
interests of avoid orphans and boot files, but luckily we can resolve
all of them, pretty much. The only catch was that
Alternative/MonadPlus also had to go into Prelude to avoid this.
As a result, we must update the hsc2hs and haddock submodules.
Signed-off-by: Austin Seipp <austin@well-typed.com>
Test Plan: Build things, they might not explode horribly.
Reviewers: hvr, simonmar
Subscribers: simonmar
Differential Revision: https://phabricator.haskell.org/D13
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
| |
Summary:
This is a first step toward allowing generic traversals of the AST without 'landmines', by removing the `panic`s located throughout `placeHolderType`, `placeHolderKind` & co.
See more on the discussion at https://www.mail-archive.com/ghc-devs@haskell.org/msg05564.html
(This also makes a corresponding update to the `haddock` submodule.)
Test Plan: `sh validate` and new tests pass.
Reviewers: austin, simonpj, goldfire
Reviewed By: austin, simonpj, goldfire
Subscribers: edsko, Fuuzetsu, thomasw, holzensp, goldfire, simonmar, relrod, ezyang, carter
Projects: #ghc
Differential Revision: https://phabricator.haskell.org/D157
|
| |
|
|
|
|
| |
It's morally pure, and we'll need it in a pure context.
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
| |
There are two main refactorings here
1. Move the uf_arity field
out of CoreUnfolding
into UnfWhen
It's a lot tidier there. If I've got this right, no behaviour
should change.
2. Define specUnfolding and use it in DsBinds and Specialise
a) commons-up some shared code
b) makes sure that Specialise correctly specialises DFun
unfoldings (which it didn't before)
The two got put together because both ended up interacting in the
specialiser.
They cause zero difference to nofib.
|
|
|
|
| |
Signed-off-by: Austin Seipp <austin@well-typed.com>
|
|
|
|
|
|
|
|
| |
This is actually the bug that triggered Trac #9390. We had
an unboxed tuple (# writeArray# ..., () #), and that writeArray#
argument isn't ok-for-speculation, so disobeys the invariant.
The desugaring of unboxed tuples was to blame; the fix is easy.
|
|
|
|
|
| |
I'd forgotten the possiblity that desugaring could generate
dead dictionary bindings; easily fixed by calling occurAnalyseExpr
|
|
|
|
|
|
|
|
|
|
|
|
| |
In the code for Trac #8331 we were not getting a complaint, but
we *were* getting a terrible (and virtually useless) RULE, looking
like
useAbstractMonad (complicated-dictionary-expresion) = $fuseAbstractMonad
where we wanted
useAbstractMonad d = $fuseAbstractMonad
This commit improves the desugaring algorithm. More comments
explain; see Note [Drop dictionary bindings on rule LHS]
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
| |
Summary:
Previously, both Cabal and GHC defined the type PackageId, and we expected
them to be roughly equivalent (but represented differently). This refactoring
separates these two notions.
A package ID is a user-visible identifier; it's the thing you write in a
Cabal file, e.g. containers-0.9. The components of this ID are semantically
meaningful, and decompose into a package name and a package vrsion.
A package key is an opaque identifier used by GHC to generate linking symbols.
Presently, it just consists of a package name and a package version, but
pursuant to #9265 we are planning to extend it to record other information.
Within a single executable, it uniquely identifies a package. It is *not* an
InstalledPackageId, as the choice of a package key affects the ABI of a package
(whereas an InstalledPackageId is computed after compilation.) Cabal computes
a package key for the package and passes it to GHC using -package-name (now
*extremely* misnamed).
As an added bonus, we don't have to worry about shadowing anymore.
As a follow on, we should introduce -current-package-key having the same role as
-package-name, and deprecate the old flag. This commit is just renaming.
The haddock submodule needed to be updated.
Signed-off-by: Edward Z. Yang <ezyang@cs.stanford.edu>
Test Plan: validate
Reviewers: simonpj, simonmar, hvr, austin
Subscribers: simonmar, relrod, carter
Differential Revision: https://phabricator.haskell.org/D79
Conflicts:
compiler/main/HscTypes.lhs
compiler/main/Packages.lhs
utils/haddock
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
| |
In looking at Trac #9063 I decided to re-design the default
instances for associated type synonyms. Previously it was all
jolly complicated, to support generality that no one wanted, and
was arguably undesirable.
Specifically
* The default instance for an associated type can have only
type variables on the LHS. (Not type patterns.)
* There can be at most one default instances declaration for
each associated type.
To achieve this I had to do a surprisingly large amount of refactoring
of HsSyn, specifically to parameterise HsDecls.TyFamEqn over the type
of the LHS patterns.
That change in HsDecls has a (trivial) knock-on effect in Haddock, so
this commit does a submodule update too.
The net result is good though. The code is simpler; the language
specification is simpler. Happy days.
Trac #9263 and #9264 are thereby fixed as well.
|
| |
|
|
|
|
| |
This bug was causing Trac #9199
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
| |
This was a serious bug, exposed by Trac #9175. The matcher and wrapper
must be LocalIds, like record selectors and dictionary functions, for
the reasons now documented in Note [Exported LocalIds] in Id.lhs
In fixing this I found
- PatSyn should have an Id inside it (apart from the wrapper and matcher)
It should be a Name. Hence psId --> psName, with knock-on consequences
- Tidying of PatSyns in TidyPgm was wrong
- The keep-alive set in Desugar.deSugar (now) doesn't need pattern synonyms
in it
I also cleaned up the interface to PatSyn a little, so there's a tiny knock-on
effect in Haddock; hence the haddock submodule update.
It's very hard to make a test for this bug, so I haven't.
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
| |
We simply weren't giving anything like the right instantiating types
to patSynInstArgTys in matchOneConLike.
To get these instantiating types would have involved matching the
result type of the pattern synonym with the pattern type, which is
tiresome. So instead I changed ConPatOut so that instead of recording
the type of the *whole* pattern (in old field pat_ty), it not records
the *instantiating* types (in new field pat_arg_tys). Then we canuse
TcHsSyn.conLikeResTy to get the pattern type when needed.
There are lots of knock-on incidental effects, but they mostly made
the code simpler, so I'm happy.
|
| |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
| |
In some cases, the layout of the LANGUAGE/OPTIONS_GHC lines has been
reorganized, while following the convention, to
- place `{-# LANGUAGE #-}` pragmas at the top of the source file, before
any `{-# OPTIONS_GHC #-}`-lines.
- Moreover, if the list of language extensions fit into a single
`{-# LANGUAGE ... -#}`-line (shorter than 80 characters), keep it on one
line. Otherwise split into `{-# LANGUAGE ... -#}`-lines for each
individual language extension. In both cases, try to keep the
enumeration alphabetically ordered.
(The latter layout is preferable as it's more diff-friendly)
While at it, this also replaces obsolete `{-# OPTIONS ... #-}` pragma
occurences by `{-# OPTIONS_GHC ... #-}` pragmas.
|
| |
|
|
|
|
|
| |
This patch implements a simpler, and nicer, desugaring for
lazy pattern matching, fixing Trac #9098
|
| |
|
|
|
|
| |
A palpable bug, although one that will rarely bite
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
| |
I've added detailed comments with
Note [Decomposing the left-hand side of a RULE]
The result is a noticeable improvement. Previously
* we rejected a perfectly decent SPECIALISE (Trac #8848)
* and for something like
f :: (Eq a) => b -> a -> a
{-# SPECIALISE f :: b -> [Int] -> [Int] #-}
we ended up with
RULE f ($fdEqList $dfEqInt) = f_spec
whereas we wanted
RULES forall (d:Eq [Int]). f d = f_spec
|
| |
|
|
|
|
|
|
|
|
| |
It turns out that the enhanced repPred function in DsMeta assumed
that the head of any constraint would be a tycon. This assumption
is false. Happily, the solution involved *deleting* code. I
just removed repPred in favor of repTy, and added the HsEqTy case
to repTy, where it should be anyway.
|
|
|
|
|
| |
There was a small mixup here, exposed by Trac #8762.
Now clarified with better function names and comments.
|
| |
|
| |
|
| |
|
|
|
|
|
| |
we want a rule "map coerce = coerce" to match the core generated for
"map Age" (this is #2110).
|
| |
|
|
|
|
| |
Signed-off-by: Richard Eisenberg <eir@cis.upenn.edu>
|
|
|
|
| |
We should still have pattern synonyms in TH, though.
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
| |
This patch implements Pattern Synonyms (enabled by -XPatternSynonyms),
allowing y ou to assign names to a pattern and abstract over it.
The rundown is this:
* Named patterns are introduced by the new 'pattern' keyword, and can
be either *unidirectional* or *bidirectional*. A unidirectional
pattern is, in the simplest sense, simply an 'alias' for a pattern,
where the LHS may mention variables to occur in the RHS. A
bidirectional pattern synonym occurs when a pattern may also be used
in expression context.
* Unidirectional patterns are declared like thus:
pattern P x <- x:_
The synonym 'P' may only occur in a pattern context:
foo :: [Int] -> Maybe Int
foo (P x) = Just x
foo _ = Nothing
* Bidirectional patterns are declared like thus:
pattern P x y = [x, y]
Here, P may not only occur as a pattern, but also as an expression
when given values for 'x' and 'y', i.e.
bar :: Int -> [Int]
bar x = P x 10
* Patterns can't yet have their own type signatures; signatures are inferred.
* Pattern synonyms may not be recursive, c.f. type synonyms.
* Pattern synonyms are also exported/imported using the 'pattern'
keyword in an import/export decl, i.e.
module Foo (pattern Bar) where ...
Note that pattern synonyms share the namespace of constructors, so
this disambiguation is required as a there may also be a 'Bar'
type in scope as well as the 'Bar' pattern.
* The semantics of a pattern synonym differ slightly from a typical
pattern: when using a synonym, the pattern itself is matched,
followed by all the arguments. This means that the strictness
differs slightly:
pattern P x y <- [x, y]
f (P True True) = True
f _ = False
g [True, True] = True
g _ = False
In the example, while `g (False:undefined)` evaluates to False,
`f (False:undefined)` results in undefined as both `x` and `y`
arguments are matched to `True`.
For more information, see the wiki:
https://ghc.haskell.org/trac/ghc/wiki/PatternSynonyms
https://ghc.haskell.org/trac/ghc/wiki/PatternSynonyms/Implementation
Reviewed-by: Simon Peyton Jones <simonpj@microsoft.com>
Signed-off-by: Austin Seipp <austin@well-typed.com>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
| |
The basic idea here is simple, and described in Note [The interactive package]
in HscTypes, which starts thus:
Note [The interactive package]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Type and class declarations at the command prompt are treated as if
they were defined in modules
interactive:Ghci1
interactive:Ghci2
...etc...
with each bunch of declarations using a new module, all sharing a
common package 'interactive' (see Module.interactivePackageId, and
PrelNames.mkInteractiveModule).
This scheme deals well with shadowing. For example:
ghci> data T = A
ghci> data T = B
ghci> :i A
data Ghci1.T = A -- Defined at <interactive>:2:10
Here we must display info about constructor A, but its type T has been
shadowed by the second declaration. But it has a respectable
qualified name (Ghci1.T), and its source location says where it was
defined.
So the main invariant continues to hold, that in any session an original
name M.T only refers to oe unique thing. (In a previous iteration both
the T's above were called :Interactive.T, albeit with different uniques,
which gave rise to all sorts of trouble.)
This scheme deals nicely with the original problem. It allows us to
eliminate a couple of grotseque hacks
- Note [Outputable Orig RdrName] in HscTypes
- Note [interactive name cache] in IfaceEnv
(both these comments have gone, because the hacks they describe are no
longer necessary). I was also able to simplify Outputable.QueryQualifyName,
so that it takes a Module/OccName as args rather than a Name.
However, matters are never simple, and this change took me an
unreasonably long time to get right. There are some details in
Note [The interactive package] in HscTypes.
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
| |
If you say
ghci> import Foo( T )
ghci> data T = MkT
ghci> data T = XXX
then the second 'data T' should shadow the first. But the qualified
Foo.T should still be available. We really weren't handling this
correctly at all, resulting in Trac #8639 and #8628 among others
This patch:
* Add RdrName.extendGlobalRdrEnv, which does shadowing properly
* Change HscTypes.icExtendGblRdrEnv (was badly-named icPlusGblRdrEnv)
to use the new function
* Change RnNames.extendGobalRdrEnvRn to use the new function
* Move gresFrom Avails into RdrName
* Better pprGlobalRdrEnv function in RdrName
|
|
|
|
| |
This fixes Trac #8625
|
| |
|
|
|
|
|
|
|
|
| |
This is a kludge to workaround Clang's CPP lacking traditional-mode CPP
(This was reported by Kazu Yamamoto)
Signed-off-by: Herbert Valerio Riedel <hvr@gnu.org>
|
|
|
|
|
|
|
|
|
|
| |
This fixes #8540 (again), and simplifies matters a bit more. In
particular, I got rid of ic_sys_vars altogether. Mostly they can just
go in ic_tythings, apart from dfuns, which are readily gettable from
the instances anyway.
See documentation in Note [Initialising the type environment for GHCi]
in TcEnv.
|
|
|
|
| |
as the coercions for type literals are of that role.
|
|
|
|
| |
and use EvCoercion to describe the evidence for Coercible instances.
|
|
|
|
|
|
|
|
|
|
|
|
| |
Previously, TcCoercion were only used to represent boxed Nominal
coercions. In order to also talk about boxed Representational coercions
in the type checker, we add Roles to TcCoercion. Again, we closely
mirror Coercion.
The roles are verified by a few assertions, and at the latest after
conversion to Coercion. I have put my trust in the comprehensiveness of
the testsuite here, but any role error after desugaring popping up now
might be caused by this refactoring.
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
| |
The handling of typed and untyped brackets was extremely convoluted,
partly because of the evolutionary history. I've tidied it all up.
See Note [How brackets and nested splices are handled] in TcSplice
for the full story
Main changes:
* Untyped brackets: after the renamer, HsRnBracketOut carries
PendingRnSplices for splices in untyped brackets. In the
typechecker, these pending splices are typechecked quite
straigtforwardly, with no ps_var nonsense.
* Typed brackets: after the renamer typed brackest still look
like HsBracket. The type checker does the ps_var thing.
* In TcRnTypes.ThStage, the Brack constructor, we distinguish
the renaming from typehecking pending-stuff. Much more
perspicuous!
* The "typed" flag is in HsSpliceE, not in HsSplice, because
only expressions can be typed. Patterns, types, declarations
cannot.
There is further improvement to be done to make the handling of
declaration splices more uniform.
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
| |
We were re-using the super-magical "state token" type (which has
VoidRep and is zero bits wide) for situations in which we simply want
to lambda-abstract over a zero-bit argument. For example, join points:
case (case x of { True -> e1; False -> e2 }) of
Red -> f1
Blue -> True
==>
let $j1 = \voidArg::Void# -> f1
in
case x of
True -> case e1 of
Red -> $j1 void
Blue -> True
False -> case e2 of
Red -> $j1 void
Blue -> True
This patch introduces
* The new primitive type GHC.Prim.Void#, with PrimRep = VoidRep
* A new global Id GHC.Prim.voidPrimId :: Void#.
This has no binding because the code generator drops it,
but is used as an argument (eg in the call of $j1)
* A new local Id, MkId.voidArgId, which can be lambda-bound
when you need to lambda-abstract over it.
and uses them throughout.
Now the State# thing is used only when we need state!
|