Re: [ANNOUNCE] GHC 8.4.1-rc1 available

2018-03-05 Thread 山本和彦
Hello Ben,

> As always, do let us know if you encounter any trouble in the course of
> testing. Thanks for your help!

I tried GHC 8.4.1rc1 to understand how SemigroupMonoid and MonadFail
proposals work.

GHC 8.4.1rc1 surely detects Monoid data types if they are not
instances of Semigroup. However, GHC users guide still says that both
-Wcompat and -Wsemigroup are disabled by default. Should we update the
document or am I missing something?

GHC 8.4.1rc does not find Monad data types which define "fail" even
with -Wcompat. Now I understand that
-Wnoncanonical-monadfail-instances is necessary. Why doesn't -Wcampat
include -Wnoncanonical-monadfail-instances?

Anyway, I hope that the proposals will be updated with the concurete
warning flag names so that I can understand them easily.

--Kazu
___
ghc-devs mailing list
ghc-devs@haskell.org
http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs


Re: FFI-free NaN checks? (isDoubleNan and friends)

2018-03-05 Thread Brandon Allbery
If the FFI version is done with "safe", consider using "unsafe" instead.
There are technical reasons why this is slightly incorrect, but unless
you're fiddling with the CPU's FP control flags they're mostly irrelevant
and you can treat isNaN as pure and non-side-effectful, significantly
reducing the overhead. You may also be able to use "ccall" to take
advantage of C compiler level optimizations, or simply to directly invoke a
CPU-based test with asm(); but you'll need to hide that in a C preprocessor
#define, so that it looks syntactically like a function call to the FFI.

(One of the technical reasons is that various OSes have been known to
introduce bugs in their FP register and state handling across system calls,
in which case the "safe" version may turn "complete FP chaos" into merely
"wrong answer". It's your call whether, or which side, of this bothers you.)

On Mon, Mar 5, 2018 at 4:53 PM, Mateusz Kowalczyk 
wrote:

> Hi,
>
> Recently at a client I was profiling some code and isDoubleNaN lit up.
> We were checking a lot of doubles for NaN as that's what customer would
> send in.
>
> I went to investigate and I found that FFI is used to achieve this. I
> was always under the impression that FFI costs a little. I had at the
> time replaced the code with a hack with great results:
>
> ```
> isNaN' :: Double -> Bool
> isNaN' d = d /= d
> ```
>
> While this worked and provided good speedup in my case, this fails
> catastrophically if the program is compiled with -ffast-math. This is
> expected. I have since reverted it. Seeking an alternative solution I
> have thought about re-implementing the C code with a native Haskell
> version: after all it just checks a few bits. Apparently unsafeCoerce#
> and friends were a big no-no but I found
> https://phabricator.haskell.org/D3358 . I have implemented the code at
> the bottom of this post. Obviously it's missing endianness (compile-time
> switch).
>
> This seems to be faster for smaller `mkInput` list than Prelude.isNaN
> but slower slightly on the one below. The `/=` version is the fastest
> but very fragile.
>
> My question to you all is whether implementing a version of this
> function in Haskell makes sense and if not, why not? The
> stgDoubleToWord64 is implemented in CMM and I don't know anything about
> the costs of that.
>
> * Is there a cheaper alternative to FFI way?
> * If yes, does anyone know how to write it such that it compiles to same
> code but without the call overhead? I must have failed below as it's
> slower on some inputs.
>
> Basically if a faster way exists for isNaN, something I have to do a
> lot, I'd love to hear about it.
>
> I leave you with basic code I managed to come up with. 8.4.x only.
>
>
> ```
> {-# LANGUAGE MagicHash#-}
> {-# OPTIONS_GHC -O2 -ddump-simpl -ddump-stg -ddump-to-file -ddump-asm #-}
> module Main (main) where
>
> import GHC.Float
> import GHC.Prim
>
> isNaN' :: Double -> Bool
> isNaN' d = d /= d
>
> isNaNBits :: Double -> Bool
> isNaNBits (D# d) = case (bits `and#` expMask) `eqWord#` expMask of
>   1# -> case bits `and#` mantissaMask of
> 0## -> False
> _ -> True
>   _ -> False
>   where
> bits :: Word#
> bits = stgDoubleToWord64 d
>
> expMask, mantissaMask :: Word#
> expMask = 0x7FF0##
> mantissaMask = 0x000F##
>
> main :: IO ()
> main = sumFilter isNaN {-isNaN'-} {-isNaNBits-} (mkInput 1)
> `seq` pure ()
>   where
> nan :: Double
> nan = log (-1)
>
> mkInput :: Int -> [Double]
> mkInput n = take n $ cycle [1, nan]
>
> sumFilter :: (Double -> Bool) -> [Double] -> Double
> sumFilter p = Prelude.sum . Prelude.filter (not . p)
> ```
>
> --
> Mateusz K.
> ___
> ghc-devs mailing list
> ghc-devs@haskell.org
> http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs
>



-- 
brandon s allbery kf8nh   sine nomine associates
allber...@gmail.com  ballb...@sinenomine.net
unix, openafs, kerberos, infrastructure, xmonadhttp://sinenomine.net
___
ghc-devs mailing list
ghc-devs@haskell.org
http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs


FFI-free NaN checks? (isDoubleNan and friends)

2018-03-05 Thread Mateusz Kowalczyk
Hi,

Recently at a client I was profiling some code and isDoubleNaN lit up.
We were checking a lot of doubles for NaN as that's what customer would
send in.

I went to investigate and I found that FFI is used to achieve this. I
was always under the impression that FFI costs a little. I had at the
time replaced the code with a hack with great results:

```
isNaN' :: Double -> Bool
isNaN' d = d /= d
```

While this worked and provided good speedup in my case, this fails
catastrophically if the program is compiled with -ffast-math. This is
expected. I have since reverted it. Seeking an alternative solution I
have thought about re-implementing the C code with a native Haskell
version: after all it just checks a few bits. Apparently unsafeCoerce#
and friends were a big no-no but I found
https://phabricator.haskell.org/D3358 . I have implemented the code at
the bottom of this post. Obviously it's missing endianness (compile-time
switch).

This seems to be faster for smaller `mkInput` list than Prelude.isNaN
but slower slightly on the one below. The `/=` version is the fastest
but very fragile.

My question to you all is whether implementing a version of this
function in Haskell makes sense and if not, why not? The
stgDoubleToWord64 is implemented in CMM and I don't know anything about
the costs of that.

* Is there a cheaper alternative to FFI way?
* If yes, does anyone know how to write it such that it compiles to same
code but without the call overhead? I must have failed below as it's
slower on some inputs.

Basically if a faster way exists for isNaN, something I have to do a
lot, I'd love to hear about it.

I leave you with basic code I managed to come up with. 8.4.x only.


```
{-# LANGUAGE MagicHash#-}
{-# OPTIONS_GHC -O2 -ddump-simpl -ddump-stg -ddump-to-file -ddump-asm #-}
module Main (main) where

import GHC.Float
import GHC.Prim

isNaN' :: Double -> Bool
isNaN' d = d /= d

isNaNBits :: Double -> Bool
isNaNBits (D# d) = case (bits `and#` expMask) `eqWord#` expMask of
  1# -> case bits `and#` mantissaMask of
0## -> False
_ -> True
  _ -> False
  where
bits :: Word#
bits = stgDoubleToWord64 d

expMask, mantissaMask :: Word#
expMask = 0x7FF0##
mantissaMask = 0x000F##

main :: IO ()
main = sumFilter isNaN {-isNaN'-} {-isNaNBits-} (mkInput 1)
`seq` pure ()
  where
nan :: Double
nan = log (-1)

mkInput :: Int -> [Double]
mkInput n = take n $ cycle [1, nan]

sumFilter :: (Double -> Bool) -> [Double] -> Double
sumFilter p = Prelude.sum . Prelude.filter (not . p)
```

-- 
Mateusz K.
___
ghc-devs mailing list
ghc-devs@haskell.org
http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs


Re: End of Windows Vista support in GHC-8.6?

2018-03-05 Thread Simon Jakobi via ghc-devs
Thanks everyone!

I have updated https://ghc.haskell.org/trac/ghc/wiki/Platforms/Windows
accordingly.

Cheers,
Simon

2018-03-05 18:29 GMT+01:00 Phyx :

>
>
> On Mon, Mar 5, 2018, 17:23 Ben Gamari  wrote:
>
>> Simon Jakobi via ghc-devs  writes:
>>
>> > Hi!
>> >
>> > Given that Vista’s EOL was in April 2017
>> > > vista-end-of-support>
>> > i assume that there’s no intention to keep supporting it in GHC-8.6!?
>> >
>> > I’m asking because I intend to use a function
>> > > >
>> > that requires Windows 7 or newer for #13362
>> > .
>> >
>> Given that it's EOL'd, dropping Vista sounds reasonable to me.
>>
>> Tamar, any objection?
>>
>
> No objections, however do make sure to test both 32 and 64 bit builds of
> ghc when you use the API, it's new enough and rare enough that it may not
> be implemented in both mingw-64 tool chains (we've had similar issues
> before).
>
> Thanks,
> Tamar
>
>
>> Cheers,
>>
>> - Ben
>>
>
___
ghc-devs mailing list
ghc-devs@haskell.org
http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs


Re: End of Windows Vista support in GHC-8.6?

2018-03-05 Thread Phyx
On Mon, Mar 5, 2018, 17:23 Ben Gamari  wrote:

> Simon Jakobi via ghc-devs  writes:
>
> > Hi!
> >
> > Given that Vista’s EOL was in April 2017
> > <
> https://support.microsoft.com/en-us/help/22882/windows-vista-end-of-support
> >
> > i assume that there’s no intention to keep supporting it in GHC-8.6!?
> >
> > I’m asking because I intend to use a function
> > 
> > that requires Windows 7 or newer for #13362
> > .
> >
> Given that it's EOL'd, dropping Vista sounds reasonable to me.
>
> Tamar, any objection?
>

No objections, however do make sure to test both 32 and 64 bit builds of
ghc when you use the API, it's new enough and rare enough that it may not
be implemented in both mingw-64 tool chains (we've had similar issues
before).

Thanks,
Tamar


> Cheers,
>
> - Ben
>
___
ghc-devs mailing list
ghc-devs@haskell.org
http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs


Re: End of Windows Vista support in GHC-8.6?

2018-03-05 Thread Ben Gamari
Simon Jakobi via ghc-devs  writes:

> Hi!
>
> Given that Vista’s EOL was in April 2017
> 
> i assume that there’s no intention to keep supporting it in GHC-8.6!?
>
> I’m asking because I intend to use a function
> 
> that requires Windows 7 or newer for #13362
> .
>
Given that it's EOL'd, dropping Vista sounds reasonable to me.

Tamar, any objection?

Cheers,

- Ben


signature.asc
Description: PGP signature
___
ghc-devs mailing list
ghc-devs@haskell.org
http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs


Re: Type checking expressions

2018-03-05 Thread Peter Podlovics
Simon:

I would like to keep the constraints as much as possible. So if x :: C a =>
a then [x] :: C a => [a]. Also in the case of patterns if I have f 5 = 5,
then the pattern 5 should have type Num a => a, but currently the type is
stored without the Num context (using hsPatType). I don't to imitate the
complete type checking process, but is there a way to retrieve these
context information as well?

Robin:

The current solution uses the feature you mentioned. This is needed in
order to extract the incompletely typed AST from the compiler. The tool
then would perform some transformations on the syntax tree to correct the
type errors, but for that it must be able to type subexpressions as well.
The -fdefer-type-errors flag doesn't help to solve this problem, it only
enables us to extract the AST.

Any advice on typing expressions using API functions and retrieving context
information would help a great deal.

On Mon, Mar 5, 2018 at 5:25 PM, Robin Palotai 
wrote:

> I wondered if https://downloads.haskell.org/~ghc/7.8.1/docs/html/users_
> guide/defer-type-errors.html could help.
>
> I tried to click around in the GHC 8.2 tree of http://stuff.codereview.me/
> ghc/#ghc/compiler/typecheck/TcErrors.hs?corpus=ghc-8.2.1-
> rc2=120, but it seems deferring type errors just reports
> via a different means, and doesn't change the type-checking behavior. But
> correct me if I'm wrong.
>
> 2018-03-05 17:11 GMT+01:00 Simon Peyton Jones via ghc-devs <
> ghc-devs@haskell.org>:
>
>> Always cc ghc-devs!   Bottle-necking on me may well yield a slow
>> response!   Or even Haskell-café.
>>
>>
>>
>> What is the type of (\x -> [x,y])?   Where y is in scope with type
>> y::a.   Presumably something like   a -> [a]?  Or is it forall a. a ->
>> [a]?  And would your answer change if you had just (\x -> [x,x])?
>>
>>
>>
>> Generalisation is tricky, and for terms with non-closed types it is hard
>> to know what you need in your use-case.  A type like ‘a’ might be a very
>> fine answer!
>>
>>
>>
>> A lot depends on precisely what you are trying to do.
>>
>>
>>
>> Simon
>>
>>
>>
>> *From:* Peter Podlovics [mailto:peter.d.podlov...@gmail.com]
>> *Sent:* 05 March 2018 14:54
>> *To:* Simon Peyton Jones 
>> *Subject:* Re: Type checking expressions
>>
>>
>>
>> My main concern with that approach is that it might not give the correct
>> type. For example the hsPatType function only gives unconstrained types, so
>> it is incorrect for any numeric literal, since it gives "a" instead of "Num
>> a => a".
>>
>> So the question is whether it is possible to retrieve the context of the
>> type variables as well. Also this problem may arise in the case of
>> expressions as well, that is why I scrapped that approach and tried to type
>> check the AST with the TcM monad directly, but without any success.
>>
>> Could you give me any leads on how to solve this problem?
>>
>> Thanks in advance,
>>
>> Peter
>>
>>
>>
>> On Mon, Mar 5, 2018 at 9:44 AM, Simon Peyton Jones 
>> wrote:
>>
>> Peter
>>
>>
>>
>> My goal is to determine the type of every expression, pattern etc. in the
>> syntax tree
>>
>>
>>
>> After type checking is complete, the syntax tree is liberally annotated
>> with types.
>>
>>
>>
>> We do not yet have a function
>>
>> hsExprType :: HsExpr Id -> Type
>>
>> but we do have
>>
>> TcHsTyn.hsPatType :: Pat GhcTc -> Type
>>
>> and you or someone could readily make an equivalent for HsExpr.
>>
>>
>>
>> Most type errors are reported by adding an error constraint, but still
>> returning an annotated tree.
>>
>> Some, I’m afraid, are still done in the old way, by throwing an exception
>> – so you don’t get back an annotated tree in that case.  But they are
>> relatively rare.
>>
>>
>>
>> Others must have wanted something like this…
>>
>>
>>
>> Simon
>>
>>
>>
>> *From:* ghc-devs [mailto:ghc-devs-boun...@haskell.org] *On Behalf Of *Peter
>> Podlovics
>> *Sent:* 02 March 2018 12:05
>> *To:* ghc-devs@haskell.org
>> *Subject:* Fwd: Type checking expressions
>>
>>
>>
>> Hello everyone,
>>
>> I would like to ask for some advice regarding the type checker part of
>> GHC.
>> My goal is to determine the type of every expression, pattern etc. in the
>> syntax tree. Currently the compiler doesn't store this information, so I
>> have
>> to type check manually. One important aspect is that the program may be
>> ill-typed,
>> but I still want to extract as much information as possible.
>>
>> I tried using local type checking functions (eg.: tcInferSigma), but
>> whenever
>> I used it on an expression that had some "out-of-scope" names in it, it
>> failed.
>>
>> > f xs = length xs
>>
>> The reason was that xs was not in the local environment.
>>
>> My question is: how could I provide the necessary local environment for
>> these
>> type checking functions? Also in the general case, is it possible to
>> somehow
>> annotate each expression with its type during the type 

Re: Perf for T5837

2018-03-05 Thread Ben Gamari
Simon Peyton Jones via ghc-devs  writes:

> Ben
> Why did you revert this?
>
As Bartosz mentioned, Harbormaster didn't reproduce the change.
I've also not seen it locally. Admittedly, it possible that it does
change on Harbormaster, just by a much different amount than what you
observed.

Cheers,

- Ben


signature.asc
Description: PGP signature
___
ghc-devs mailing list
ghc-devs@haskell.org
http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs


Re: Type checking expressions

2018-03-05 Thread Robin Palotai
I wondered if
https://downloads.haskell.org/~ghc/7.8.1/docs/html/users_guide/defer-type-errors.html
could help.

I tried to click around in the GHC 8.2 tree of
http://stuff.codereview.me/ghc/#ghc/compiler/typecheck/TcErrors.hs?corpus=ghc-8.2.1-rc2=120,
but it seems deferring type errors just reports via a different means, and
doesn't change the type-checking behavior. But correct me if I'm wrong.

2018-03-05 17:11 GMT+01:00 Simon Peyton Jones via ghc-devs <
ghc-devs@haskell.org>:

> Always cc ghc-devs!   Bottle-necking on me may well yield a slow
> response!   Or even Haskell-café.
>
>
>
> What is the type of (\x -> [x,y])?   Where y is in scope with type y::a.
> Presumably something like   a -> [a]?  Or is it forall a. a -> [a]?  And
> would your answer change if you had just (\x -> [x,x])?
>
>
>
> Generalisation is tricky, and for terms with non-closed types it is hard
> to know what you need in your use-case.  A type like ‘a’ might be a very
> fine answer!
>
>
>
> A lot depends on precisely what you are trying to do.
>
>
>
> Simon
>
>
>
> *From:* Peter Podlovics [mailto:peter.d.podlov...@gmail.com]
> *Sent:* 05 March 2018 14:54
> *To:* Simon Peyton Jones 
> *Subject:* Re: Type checking expressions
>
>
>
> My main concern with that approach is that it might not give the correct
> type. For example the hsPatType function only gives unconstrained types, so
> it is incorrect for any numeric literal, since it gives "a" instead of "Num
> a => a".
>
> So the question is whether it is possible to retrieve the context of the
> type variables as well. Also this problem may arise in the case of
> expressions as well, that is why I scrapped that approach and tried to type
> check the AST with the TcM monad directly, but without any success.
>
> Could you give me any leads on how to solve this problem?
>
> Thanks in advance,
>
> Peter
>
>
>
> On Mon, Mar 5, 2018 at 9:44 AM, Simon Peyton Jones 
> wrote:
>
> Peter
>
>
>
> My goal is to determine the type of every expression, pattern etc. in the
> syntax tree
>
>
>
> After type checking is complete, the syntax tree is liberally annotated
> with types.
>
>
>
> We do not yet have a function
>
> hsExprType :: HsExpr Id -> Type
>
> but we do have
>
> TcHsTyn.hsPatType :: Pat GhcTc -> Type
>
> and you or someone could readily make an equivalent for HsExpr.
>
>
>
> Most type errors are reported by adding an error constraint, but still
> returning an annotated tree.
>
> Some, I’m afraid, are still done in the old way, by throwing an exception
> – so you don’t get back an annotated tree in that case.  But they are
> relatively rare.
>
>
>
> Others must have wanted something like this…
>
>
>
> Simon
>
>
>
> *From:* ghc-devs [mailto:ghc-devs-boun...@haskell.org] *On Behalf Of *Peter
> Podlovics
> *Sent:* 02 March 2018 12:05
> *To:* ghc-devs@haskell.org
> *Subject:* Fwd: Type checking expressions
>
>
>
> Hello everyone,
>
> I would like to ask for some advice regarding the type checker part of GHC.
> My goal is to determine the type of every expression, pattern etc. in the
> syntax tree. Currently the compiler doesn't store this information, so I
> have
> to type check manually. One important aspect is that the program may be
> ill-typed,
> but I still want to extract as much information as possible.
>
> I tried using local type checking functions (eg.: tcInferSigma), but
> whenever
> I used it on an expression that had some "out-of-scope" names in it, it
> failed.
>
> > f xs = length xs
>
> The reason was that xs was not in the local environment.
>
> My question is: how could I provide the necessary local environment for
> these
> type checking functions? Also in the general case, is it possible to
> somehow
> annotate each expression with its type during the type checking?
>
> The motivation for this is that I want to implement a tool that
> automatically
> corrects ill-typed programs based heuristics. For that I need to know the
> types
> of certain AST nodes.
>
> Peter Podlovics
>
>
>
>
>
> ___
> ghc-devs mailing list
> ghc-devs@haskell.org
> http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs
>
>
___
ghc-devs mailing list
ghc-devs@haskell.org
http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs


RE: Type checking expressions

2018-03-05 Thread Simon Peyton Jones via ghc-devs
Always cc ghc-devs!   Bottle-necking on me may well yield a slow response!   Or 
even Haskell-café.

What is the type of (\x -> [x,y])?   Where y is in scope with type y::a.   
Presumably something like   a -> [a]?  Or is it forall a. a -> [a]?  And would 
your answer change if you had just (\x -> [x,x])?

Generalisation is tricky, and for terms with non-closed types it is hard to 
know what you need in your use-case.  A type like ‘a’ might be a very fine 
answer!

A lot depends on precisely what you are trying to do.

Simon

From: Peter Podlovics [mailto:peter.d.podlov...@gmail.com]
Sent: 05 March 2018 14:54
To: Simon Peyton Jones 
Subject: Re: Type checking expressions

My main concern with that approach is that it might not give the correct type. 
For example the hsPatType function only gives unconstrained types, so it is 
incorrect for any numeric literal, since it gives "a" instead of "Num a => a".

So the question is whether it is possible to retrieve the context of the type 
variables as well. Also this problem may arise in the case of expressions as 
well, that is why I scrapped that approach and tried to type check the AST with 
the TcM monad directly, but without any success.
Could you give me any leads on how to solve this problem?
Thanks in advance,
Peter

On Mon, Mar 5, 2018 at 9:44 AM, Simon Peyton Jones 
> wrote:
Peter

My goal is to determine the type of every expression, pattern etc. in the
syntax tree

After type checking is complete, the syntax tree is liberally annotated with 
types.

We do not yet have a function
hsExprType :: HsExpr Id -> Type
but we do have
TcHsTyn.hsPatType :: Pat GhcTc -> Type
and you or someone could readily make an equivalent for HsExpr.

Most type errors are reported by adding an error constraint, but still 
returning an annotated tree.
Some, I’m afraid, are still done in the old way, by throwing an exception – so 
you don’t get back an annotated tree in that case.  But they are relatively 
rare.

Others must have wanted something like this…

Simon

From: ghc-devs 
[mailto:ghc-devs-boun...@haskell.org] On 
Behalf Of Peter Podlovics
Sent: 02 March 2018 12:05
To: ghc-devs@haskell.org
Subject: Fwd: Type checking expressions

Hello everyone,

I would like to ask for some advice regarding the type checker part of GHC.
My goal is to determine the type of every expression, pattern etc. in the
syntax tree. Currently the compiler doesn't store this information, so I have
to type check manually. One important aspect is that the program may be 
ill-typed,
but I still want to extract as much information as possible.

I tried using local type checking functions (eg.: tcInferSigma), but whenever
I used it on an expression that had some "out-of-scope" names in it, it failed.

> f xs = length xs

The reason was that xs was not in the local environment.

My question is: how could I provide the necessary local environment for these
type checking functions? Also in the general case, is it possible to somehow
annotate each expression with its type during the type checking?

The motivation for this is that I want to implement a tool that automatically
corrects ill-typed programs based heuristics. For that I need to know the types
of certain AST nodes.

Peter Podlovics


___
ghc-devs mailing list
ghc-devs@haskell.org
http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs


Re: Perf for T5837

2018-03-05 Thread Bartosz Nitka
I commented on 
https://phabricator.haskell.org/rGHCd675a354e8db67d87d1f257c3d1d2bf2d58c2b3f
that Harbormaster started failing after this.
It reproduced locally for me.
You can see here:
https://phabricator.haskell.org/diffusion/GHC/history/master/ that the
revert fixed the build.

2018-03-05 8:50 GMT+00:00 Simon Peyton Jones via ghc-devs
:
> Ben
>
> Why did you revert this?
>
> commit 2756117bd26c2cb70d3f51954a88b7d7bdf3d3f2
>
> Author: Ben Gamari 
>
> Date:   Thu Mar 1 14:06:04 2018 -0500
>
>
>
> Revert "Better stats for T5837"
>
>
>
> This reverts commit d675a354e8db67d87d1f257c3d1d2bf2d58c2b3f.
>
>
>
> -   (wordsize(64), 55813608, 7)])
>
> +   (wordsize(64), 51294232, 7)])
>
>
>
> It’s consistently 8% better for me, but I guess not for you.
>
> Does anyone else find this?
>
> Simon
>
>
> ___
> ghc-devs mailing list
> ghc-devs@haskell.org
> http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs
>
___
ghc-devs mailing list
ghc-devs@haskell.org
http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs


ghcpkg05

2018-03-05 Thread Simon Peyton Jones via ghc-devs
ghcpkg05 is failing on my Linux box.  Any ideas?
This is a clean build.
Simon

=> ghcpkg05(normal) 1 of 1 [0, 0, 0]

cd "./ghcpkg05.run" && $MAKE -s --no-print-directory ghcpkg05

Actual stderr output differs from expected:

diff -uw "./ghcpkg05.run/ghcpkg05.stderr.normalised" 
"./ghcpkg05.run/ghcpkg05.run.stderr.normalised"

--- ./ghcpkg05.run/ghcpkg05.stderr.normalised  2018-03-05 12:02:14.828489599 
+

+++ ./ghcpkg05.run/ghcpkg05.run.stderr.normalised2018-03-05 
12:02:14.828489599 +

@@ -10,6 +10,13 @@

   cannot find any of ["C/D.hi","C/D.p_hi","C/D.dyn_hi"]

   cannot find any of ["C/E.hi","C/E.p_hi","C/E.dyn_hi"]

   cannot find any of 
["libtestpkg-2.0-XXX.a","libtestpkg-2.0-XXX.p_a","libtestpkg-2.0-XXX-ghc.so","libtestpkg-2.0-XXX-ghc.dylib","testpkg-2.0-XXX-ghc.dll"]
 on library path

+Warning: include-dirs: /5playpen/simonpj/HEAD-1/compiler/stage2/build/utils 
doesn't exist or isn't a directory

+Warning: include-dirs: 
/5playpen/simonpj/HEAD-1/compiler/stage2/build/../rts/dist/build doesn't exist 
or isn't a directory

+Warning: include-dirs: /5playpen/simonpj/HEAD-1/compiler/stage2/build/stage2 
doesn't exist or isn't a directory

+Warning: include-dirs: 
/5playpen/simonpj/HEAD-1/libraries/haskeline/dist-install/build/includes 
doesn't exist or isn't a directory

+Warning: include-dirs: 
/5playpen/simonpj/HEAD-1/libraries/text/dist-install/build/include doesn't 
exist or isn't a directory

+Warning: include-dirs: 
/5playpen/simonpj/HEAD-1/libraries/containers/dist-install/build/include 
doesn't exist or isn't a directory

+Warning: include-dirs: 
/5playpen/simonpj/HEAD-1/libraries/bytestring/dist-install/build/include 
doesn't exist or isn't a directory

 The following packages are broken, either because they have a problem

listed above, or because they depend on a broken package.

*** unexpected failure for ghcpkg05(normal)



Unexpected results from:

TEST="ghcpkg05"



SUMMARY for test run started at Mon Mar  5 12:02:14 2018 GMT

0:00:01 spent to go through

   1 total tests, which gave rise to

   1 test cases, of which

   0 were skipped



   0 had missing libraries

   0 expected passes

   0 expected failures



   0 caused framework failures

   0 caused framework warnings

   0 unexpected passes

   1 unexpected failures

   0 unexpected stat failures



Unexpected failures:

   ghcpkg05.run  ghcpkg05 [bad stderr] (normal)
___
ghc-devs mailing list
ghc-devs@haskell.org
http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs


RE: tigetnum etc -- help!

2018-03-05 Thread Simon Peyton Jones via ghc-devs
I think that was it (submodule update).  It's building away now.

Sorry for the noise, everyone.

Simon

|  -Original Message-
|  From: Simon Peyton Jones
|  Sent: 05 March 2018 10:57
|  To: 'Herbert Valerio Riedel' 
|  Cc: ghc-devs@haskell.org
|  Subject: RE: tigetnum etc -- help!
|  
|  |  just to check the obvious, have you made sure to `git submodule
|  | update` everything? have you properly cleaned your build-tree?
|  
|  Thanks.
|  
|  I did clean; and I usually obsessively do git submodule update, but I
|  may have forgotten this time. I think for cabal and hsc2hs.
|  
|  Trying again now...
|  
|  Simon
|  
|  |  -Original Message-
|  |  From: Herbert Valerio Riedel [mailto:hvrie...@gmail.com]
|  |  Sent: 05 March 2018 10:55
|  |  To: Simon Peyton Jones 
|  |  Subject: Re: tigetnum etc -- help!
|  |
|  |  Hi Simon,
|  |
|  |  just to check the obvious, have you made sure to `git submodule
|  | update` everything? have you properly cleaned your build-tree?
|  |
|  |  -- hvr
___
ghc-devs mailing list
ghc-devs@haskell.org
http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs


RE: tigetnum etc -- help!

2018-03-05 Thread Simon Peyton Jones via ghc-devs
|  just to check the obvious, have you made sure to `git submodule
|  update` everything? have you properly cleaned your build-tree?

Thanks.

I did clean; and I usually obsessively do git submodule update, but I may have 
forgotten this time. I think for cabal and hsc2hs.

Trying again now...

Simon

|  -Original Message-
|  From: Herbert Valerio Riedel [mailto:hvrie...@gmail.com]
|  Sent: 05 March 2018 10:55
|  To: Simon Peyton Jones 
|  Subject: Re: tigetnum etc -- help!
|  
|  Hi Simon,
|  
|  just to check the obvious, have you made sure to `git submodule
|  update` everything? have you properly cleaned your build-tree?
|  
|  -- hvr
___
ghc-devs mailing list
ghc-devs@haskell.org
http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs


RE: tigetnum etc -- help!

2018-03-05 Thread Simon Peyton Jones via ghc-devs
Thanks

libraries/terminfo/config.log is attached.  Does not look informative.

Simon



From: Brandon Allbery [mailto:allber...@gmail.com]
Sent: 05 March 2018 09:35
To: Simon Peyton Jones 
Cc: ghc-devs@haskell.org
Subject: Re: tigetnum etc -- help!

Do you have configure / build log output for the terminfo package?

On Mon, Mar 5, 2018 at 4:25 AM, Simon Peyton Jones via ghc-devs 
> wrote:
My stage-1 build (from clean) has started failing thus (on Linux).  Any ideas?  
It’s pretty disabling because I can’t build GHC any more.
Simon


make

===--- building phase 0

make --no-print-directory -f 
ghc.mk
 phase=0 phase_0_builds

make[1]: Nothing to be done for 'phase_0_builds'.

===--- building phase 1

make --no-print-directory -f 
ghc.mk
 phase=1 phase_1_builds

"/usr/local/bin/ghc" -o utils/ghc-pkg/dist/build/tmp/ghc-pkg -hisuf hi -osuf  o 
-hcsuf hc -static  -O0 -H64m -Wall   -package-db libraries/bootstrapping.conf  
-hide-all-packages -i -iutils/ghc-pkg/. -iutils/ghc-pkg/dist/build 
-Iutils/ghc-pkg/dist/build -iutils/ghc-pkg/dist/build/ghc-pkg/autogen 
-Iutils/ghc-pkg/dist/build/ghc-pkg/autogen-optP-DWITH_TERMINFO 
-optP-include -optPutils/ghc-pkg/dist/build/ghc-pkg/autogen/cabal_macros.h 
-package-id Cabal-2.1.0.0 -package-id base-4.10.0.0 -package-id binary-0.8.5.1 
-package-id bytestring-0.10.8.2 -package-id containers-0.5.10.2 -package-id 
directory-1.3.0.2 -package-id filepath-1.4.1.2 -package-id ghc-boot-8.5 
-package-id process-1.6.1.0 -package-id terminfo-0.4.1.1 -package-id 
unix-2.7.2.2 -XHaskell2010  -no-user-package-db -rtsopts-odir 
utils/ghc-pkg/dist/build -hidir utils/ghc-pkg/dist/build -stubdir 
utils/ghc-pkg/dist/build -static  -O0 -H64m -Wall   -package-db 
libraries/bootstrapping.conf  -hide-all-packages -i -iutils/ghc-pkg/. 
-iutils/ghc-pkg/dist/build -Iutils/ghc-pkg/dist/build 
-iutils/ghc-pkg/dist/build/ghc-pkg/autogen 
-Iutils/ghc-pkg/dist/build/ghc-pkg/autogen-optP-DWITH_TERMINFO 
-optP-include -optPutils/ghc-pkg/dist/build/ghc-pkg/autogen/cabal_macros.h 
-package-id Cabal-2.1.0.0 -package-id base-4.10.0.0 -package-id binary-0.8.5.1 
-package-id bytestring-0.10.8.2 -package-id containers-0.5.10.2 -package-id 
directory-1.3.0.2 -package-id filepath-1.4.1.2 -package-id ghc-boot-8.5 
-package-id process-1.6.1.0 -package-id terminfo-0.4.1.1 -package-id 
unix-2.7.2.2 -XHaskell2010  -no-user-package-db -rtsopts
utils/ghc-pkg/dist/build/Main.o utils/ghc-pkg/dist/build/Version.o

/5playpen/simonpj/HEAD-1/libraries/terminfo/dist-boot/build/libHSterminfo-0.4.1.1.a(Base.o):r6De_info:
 error: undefined reference to 'tigetnum'

/5playpen/simonpj/HEAD-1/libraries/terminfo/dist-boot/build/libHSterminfo-0.4.1.1.a(Base.o):r6Df_info:
 error: undefined reference to 'tigetflag'

/5playpen/simonpj/HEAD-1/libraries/terminfo/dist-boot/build/libHSterminfo-0.4.1.1.a(Base.o):r6Dg_info:
 error: undefined reference to 'tigetstr'

/5playpen/simonpj/HEAD-1/libraries/terminfo/dist-boot/build/libHSterminfo-0.4.1.1.a(Base.o):s6Gn_info:
 error: undefined reference to 'set_curterm'

/5playpen/simonpj/HEAD-1/libraries/terminfo/dist-boot/build/libHSterminfo-0.4.1.1.a(Base.o):s6Gb_info:
 error: undefined reference to 'set_curterm'

/5playpen/simonpj/HEAD-1/libraries/terminfo/dist-boot/build/libHSterminfo-0.4.1.1.a(Base.o):s6I7_info:
 error: undefined reference to 'tparm'

/5playpen/simonpj/HEAD-1/libraries/terminfo/dist-boot/build/libHSterminfo-0.4.1.1.a(Base.o):s6JP_info:
 error: undefined reference to 'set_curterm'

/5playpen/simonpj/HEAD-1/libraries/terminfo/dist-boot/build/libHSterminfo-0.4.1.1.a(Base.o):s6JA_info:
 error: undefined reference to 'setupterm'

/5playpen/simonpj/HEAD-1/libraries/terminfo/dist-boot/build/libHSterminfo-0.4.1.1.a(Base.o):s6Jn_info:
 error: undefined reference to 'set_curterm'

/5playpen/simonpj/HEAD-1/libraries/terminfo/dist-boot/build/libHSterminfo-0.4.1.1.a(Base.o):s6KR_info:
 error: undefined reference to 'tputs'

/5playpen/simonpj/HEAD-1/libraries/terminfo/dist-boot/build/libHSterminfo-0.4.1.1.a(Base.o)(.data+0xdc8):
 error: undefined reference to 'del_curterm'

collect2: error: ld returned 1 exit status

`gcc' failed in phase `Linker'. (Exit code: 1)


Re: tigetnum etc -- help!

2018-03-05 Thread Brandon Allbery
Do you have configure / build log output for the terminfo package?

On Mon, Mar 5, 2018 at 4:25 AM, Simon Peyton Jones via ghc-devs <
ghc-devs@haskell.org> wrote:

> My stage-1 build (from clean) has started failing thus (on Linux).  Any
> ideas?  It’s pretty disabling because I can’t build GHC any more.
>
> Simon
>
>
>
> make
>
> ===--- building phase 0
>
> make --no-print-directory -f ghc.mk phase=0 phase_0_builds
>
> make[1]: Nothing to be done for 'phase_0_builds'.
>
> ===--- building phase 1
>
> make --no-print-directory -f ghc.mk phase=1 phase_1_builds
>
> "/usr/local/bin/ghc" -o utils/ghc-pkg/dist/build/tmp/ghc-pkg -hisuf hi
> -osuf  o -hcsuf hc -static  -O0 -H64m -Wall   -package-db
> libraries/bootstrapping.conf  -hide-all-packages -i -iutils/ghc-pkg/.
> -iutils/ghc-pkg/dist/build -Iutils/ghc-pkg/dist/build
> -iutils/ghc-pkg/dist/build/ghc-pkg/autogen 
> -Iutils/ghc-pkg/dist/build/ghc-pkg/autogen
> -optP-DWITH_TERMINFO -optP-include 
> -optPutils/ghc-pkg/dist/build/ghc-pkg/autogen/cabal_macros.h
> -package-id Cabal-2.1.0.0 -package-id base-4.10.0.0 -package-id
> binary-0.8.5.1 -package-id bytestring-0.10.8.2 -package-id
> containers-0.5.10.2 -package-id directory-1.3.0.2 -package-id
> filepath-1.4.1.2 -package-id ghc-boot-8.5 -package-id process-1.6.1.0
> -package-id terminfo-0.4.1.1 -package-id unix-2.7.2.2 -XHaskell2010
> -no-user-package-db -rtsopts-odir utils/ghc-pkg/dist/build -hidir
> utils/ghc-pkg/dist/build -stubdir utils/ghc-pkg/dist/build -static  -O0
> -H64m -Wall   -package-db libraries/bootstrapping.conf  -hide-all-packages
> -i -iutils/ghc-pkg/. -iutils/ghc-pkg/dist/build -Iutils/ghc-pkg/dist/build
> -iutils/ghc-pkg/dist/build/ghc-pkg/autogen 
> -Iutils/ghc-pkg/dist/build/ghc-pkg/autogen
> -optP-DWITH_TERMINFO -optP-include 
> -optPutils/ghc-pkg/dist/build/ghc-pkg/autogen/cabal_macros.h
> -package-id Cabal-2.1.0.0 -package-id base-4.10.0.0 -package-id
> binary-0.8.5.1 -package-id bytestring-0.10.8.2 -package-id
> containers-0.5.10.2 -package-id directory-1.3.0.2 -package-id
> filepath-1.4.1.2 -package-id ghc-boot-8.5 -package-id process-1.6.1.0
> -package-id terminfo-0.4.1.1 -package-id unix-2.7.2.2 -XHaskell2010
> -no-user-package-db -rtsoptsutils/ghc-pkg/dist/build/Main.o
> utils/ghc-pkg/dist/build/Version.o
>
> /5playpen/simonpj/HEAD-1/libraries/terminfo/dist-boot/
> build/libHSterminfo-0.4.1.1.a(Base.o):r6De_info: error: undefined
> reference to 'tigetnum'
>
> /5playpen/simonpj/HEAD-1/libraries/terminfo/dist-boot/
> build/libHSterminfo-0.4.1.1.a(Base.o):r6Df_info: error: undefined
> reference to 'tigetflag'
>
> /5playpen/simonpj/HEAD-1/libraries/terminfo/dist-boot/
> build/libHSterminfo-0.4.1.1.a(Base.o):r6Dg_info: error: undefined
> reference to 'tigetstr'
>
> /5playpen/simonpj/HEAD-1/libraries/terminfo/dist-boot/
> build/libHSterminfo-0.4.1.1.a(Base.o):s6Gn_info: error: undefined
> reference to 'set_curterm'
>
> /5playpen/simonpj/HEAD-1/libraries/terminfo/dist-boot/
> build/libHSterminfo-0.4.1.1.a(Base.o):s6Gb_info: error: undefined
> reference to 'set_curterm'
>
> /5playpen/simonpj/HEAD-1/libraries/terminfo/dist-boot/
> build/libHSterminfo-0.4.1.1.a(Base.o):s6I7_info: error: undefined
> reference to 'tparm'
>
> /5playpen/simonpj/HEAD-1/libraries/terminfo/dist-boot/
> build/libHSterminfo-0.4.1.1.a(Base.o):s6JP_info: error: undefined
> reference to 'set_curterm'
>
> /5playpen/simonpj/HEAD-1/libraries/terminfo/dist-boot/
> build/libHSterminfo-0.4.1.1.a(Base.o):s6JA_info: error: undefined
> reference to 'setupterm'
>
> /5playpen/simonpj/HEAD-1/libraries/terminfo/dist-boot/
> build/libHSterminfo-0.4.1.1.a(Base.o):s6Jn_info: error: undefined
> reference to 'set_curterm'
>
> /5playpen/simonpj/HEAD-1/libraries/terminfo/dist-boot/
> build/libHSterminfo-0.4.1.1.a(Base.o):s6KR_info: error: undefined
> reference to 'tputs'
>
> /5playpen/simonpj/HEAD-1/libraries/terminfo/dist-boot/
> build/libHSterminfo-0.4.1.1.a(Base.o)(.data+0xdc8): error: undefined
> reference to 'del_curterm'
>
> collect2: error: ld returned 1 exit status
>
> `gcc' failed in phase `Linker'. (Exit code: 1)
>
> utils/ghc-pkg/ghc.mk:70: recipe for target 
> 'utils/ghc-pkg/dist/build/tmp/ghc-pkg'
> failed
>
> make[1]: *** [utils/ghc-pkg/dist/build/tmp/ghc-pkg] Error 1
>
> Makefile:122: recipe for target 'all' failed
>
> make: *** [all] Error 2
>
> simonpj@cam-05-unx:~/5builds/HEAD-1$
>
> ___
> ghc-devs mailing list
> ghc-devs@haskell.org
> http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs
>
>


-- 
brandon s allbery kf8nh   sine nomine associates
allber...@gmail.com  ballb...@sinenomine.net
unix, openafs, kerberos, infrastructure, xmonadhttp://sinenomine.net
___
ghc-devs mailing list
ghc-devs@haskell.org
http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs


tigetnum etc -- help!

2018-03-05 Thread Simon Peyton Jones via ghc-devs
My stage-1 build (from clean) has started failing thus (on Linux).  Any ideas?  
It's pretty disabling because I can't build GHC any more.
Simon


make

===--- building phase 0

make --no-print-directory -f ghc.mk phase=0 phase_0_builds

make[1]: Nothing to be done for 'phase_0_builds'.

===--- building phase 1

make --no-print-directory -f ghc.mk phase=1 phase_1_builds

"/usr/local/bin/ghc" -o utils/ghc-pkg/dist/build/tmp/ghc-pkg -hisuf hi -osuf  o 
-hcsuf hc -static  -O0 -H64m -Wall   -package-db libraries/bootstrapping.conf  
-hide-all-packages -i -iutils/ghc-pkg/. -iutils/ghc-pkg/dist/build 
-Iutils/ghc-pkg/dist/build -iutils/ghc-pkg/dist/build/ghc-pkg/autogen 
-Iutils/ghc-pkg/dist/build/ghc-pkg/autogen-optP-DWITH_TERMINFO 
-optP-include -optPutils/ghc-pkg/dist/build/ghc-pkg/autogen/cabal_macros.h 
-package-id Cabal-2.1.0.0 -package-id base-4.10.0.0 -package-id binary-0.8.5.1 
-package-id bytestring-0.10.8.2 -package-id containers-0.5.10.2 -package-id 
directory-1.3.0.2 -package-id filepath-1.4.1.2 -package-id ghc-boot-8.5 
-package-id process-1.6.1.0 -package-id terminfo-0.4.1.1 -package-id 
unix-2.7.2.2 -XHaskell2010  -no-user-package-db -rtsopts-odir 
utils/ghc-pkg/dist/build -hidir utils/ghc-pkg/dist/build -stubdir 
utils/ghc-pkg/dist/build -static  -O0 -H64m -Wall   -package-db 
libraries/bootstrapping.conf  -hide-all-packages -i -iutils/ghc-pkg/. 
-iutils/ghc-pkg/dist/build -Iutils/ghc-pkg/dist/build 
-iutils/ghc-pkg/dist/build/ghc-pkg/autogen 
-Iutils/ghc-pkg/dist/build/ghc-pkg/autogen-optP-DWITH_TERMINFO 
-optP-include -optPutils/ghc-pkg/dist/build/ghc-pkg/autogen/cabal_macros.h 
-package-id Cabal-2.1.0.0 -package-id base-4.10.0.0 -package-id binary-0.8.5.1 
-package-id bytestring-0.10.8.2 -package-id containers-0.5.10.2 -package-id 
directory-1.3.0.2 -package-id filepath-1.4.1.2 -package-id ghc-boot-8.5 
-package-id process-1.6.1.0 -package-id terminfo-0.4.1.1 -package-id 
unix-2.7.2.2 -XHaskell2010  -no-user-package-db -rtsopts
utils/ghc-pkg/dist/build/Main.o utils/ghc-pkg/dist/build/Version.o

/5playpen/simonpj/HEAD-1/libraries/terminfo/dist-boot/build/libHSterminfo-0.4.1.1.a(Base.o):r6De_info:
 error: undefined reference to 'tigetnum'

/5playpen/simonpj/HEAD-1/libraries/terminfo/dist-boot/build/libHSterminfo-0.4.1.1.a(Base.o):r6Df_info:
 error: undefined reference to 'tigetflag'

/5playpen/simonpj/HEAD-1/libraries/terminfo/dist-boot/build/libHSterminfo-0.4.1.1.a(Base.o):r6Dg_info:
 error: undefined reference to 'tigetstr'

/5playpen/simonpj/HEAD-1/libraries/terminfo/dist-boot/build/libHSterminfo-0.4.1.1.a(Base.o):s6Gn_info:
 error: undefined reference to 'set_curterm'

/5playpen/simonpj/HEAD-1/libraries/terminfo/dist-boot/build/libHSterminfo-0.4.1.1.a(Base.o):s6Gb_info:
 error: undefined reference to 'set_curterm'

/5playpen/simonpj/HEAD-1/libraries/terminfo/dist-boot/build/libHSterminfo-0.4.1.1.a(Base.o):s6I7_info:
 error: undefined reference to 'tparm'

/5playpen/simonpj/HEAD-1/libraries/terminfo/dist-boot/build/libHSterminfo-0.4.1.1.a(Base.o):s6JP_info:
 error: undefined reference to 'set_curterm'

/5playpen/simonpj/HEAD-1/libraries/terminfo/dist-boot/build/libHSterminfo-0.4.1.1.a(Base.o):s6JA_info:
 error: undefined reference to 'setupterm'

/5playpen/simonpj/HEAD-1/libraries/terminfo/dist-boot/build/libHSterminfo-0.4.1.1.a(Base.o):s6Jn_info:
 error: undefined reference to 'set_curterm'

/5playpen/simonpj/HEAD-1/libraries/terminfo/dist-boot/build/libHSterminfo-0.4.1.1.a(Base.o):s6KR_info:
 error: undefined reference to 'tputs'

/5playpen/simonpj/HEAD-1/libraries/terminfo/dist-boot/build/libHSterminfo-0.4.1.1.a(Base.o)(.data+0xdc8):
 error: undefined reference to 'del_curterm'

collect2: error: ld returned 1 exit status

`gcc' failed in phase `Linker'. (Exit code: 1)

utils/ghc-pkg/ghc.mk:70: recipe for target 
'utils/ghc-pkg/dist/build/tmp/ghc-pkg' failed

make[1]: *** [utils/ghc-pkg/dist/build/tmp/ghc-pkg] Error 1

Makefile:122: recipe for target 'all' failed

make: *** [all] Error 2

simonpj@cam-05-unx:~/5builds/HEAD-1$
___
ghc-devs mailing list
ghc-devs@haskell.org
http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs


Perf for T5837

2018-03-05 Thread Simon Peyton Jones via ghc-devs
Ben
Why did you revert this?

commit 2756117bd26c2cb70d3f51954a88b7d7bdf3d3f2

Author: Ben Gamari 

Date:   Thu Mar 1 14:06:04 2018 -0500



Revert "Better stats for T5837"



This reverts commit d675a354e8db67d87d1f257c3d1d2bf2d58c2b3f.


-   (wordsize(64), 55813608, 7)])

+   (wordsize(64), 51294232, 7)])

It's consistently 8% better for me, but I guess not for you.
Does anyone else find this?
Simon
___
ghc-devs mailing list
ghc-devs@haskell.org
http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs


RE: Type checking expressions

2018-03-05 Thread Simon Peyton Jones via ghc-devs
Peter

My goal is to determine the type of every expression, pattern etc. in the
syntax tree

After type checking is complete, the syntax tree is liberally annotated with 
types.

We do not yet have a function
hsExprType :: HsExpr Id -> Type
but we do have
TcHsTyn.hsPatType :: Pat GhcTc -> Type
and you or someone could readily make an equivalent for HsExpr.

Most type errors are reported by adding an error constraint, but still 
returning an annotated tree.
Some, I’m afraid, are still done in the old way, by throwing an exception – so 
you don’t get back an annotated tree in that case.  But they are relatively 
rare.

Others must have wanted something like this…

Simon

From: ghc-devs [mailto:ghc-devs-boun...@haskell.org] On Behalf Of Peter 
Podlovics
Sent: 02 March 2018 12:05
To: ghc-devs@haskell.org
Subject: Fwd: Type checking expressions

Hello everyone,

I would like to ask for some advice regarding the type checker part of GHC.
My goal is to determine the type of every expression, pattern etc. in the
syntax tree. Currently the compiler doesn't store this information, so I have
to type check manually. One important aspect is that the program may be 
ill-typed,
but I still want to extract as much information as possible.

I tried using local type checking functions (eg.: tcInferSigma), but whenever
I used it on an expression that had some "out-of-scope" names in it, it failed.

> f xs = length xs

The reason was that xs was not in the local environment.

My question is: how could I provide the necessary local environment for these
type checking functions? Also in the general case, is it possible to somehow
annotate each expression with its type during the type checking?

The motivation for this is that I want to implement a tool that automatically
corrects ill-typed programs based heuristics. For that I need to know the types
of certain AST nodes.

Peter Podlovics

___
ghc-devs mailing list
ghc-devs@haskell.org
http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs