Re: Questions about time and space profiling for non-strict langs paper and cost centre impl. of GHC

2014-05-18 Thread Ömer Sinan Ağacan
Thanks Peter. Simon Marlow's talk was really interesting. After reading the slides I read related GHC code and realized that cost-centre stack and the stack trace printed using GHC.Stack is same thing. `libraries/base/GHC/Stack.hsc` has this definition: currentCallStack :: IO [String]

Re: Questions about time and space profiling for non-strict langs paper and cost centre impl. of GHC

2014-05-18 Thread Peter Wortmann
Ömer Sinan Ağacan wrote: (off-topic: I'm wondering why an empty tuple is passed to `getCurrentCSS`?) See the comment on getCurrentCCS# in compiler/prelude/primops.txt.pp - it's a token to prevent GHC optimisations from floating the primop up (which obviously might change the call stack). Now

Re: Questions about time and space profiling for non-strict langs paper and cost centre impl. of GHC

2014-05-18 Thread Ömer Sinan Ağacan
Thanks again for the answer. Not sure what _call_ is suppose to be. What's the context? In Simon Marlow's slides, stack traces are implemented in terms of call and push operations. I guess `push` in STG syntax is stands for push operation explained in the slides but as far as I can see call is

Non-exhaustive pattern-match warning in code-example from Dependently Typed Programming with Singletons

2014-05-18 Thread Herbert Valerio Riedel
Hello *, I've been experimenting with the code from the Dependently Typed Programming with Singletons paper[1] from the following is derived (modulo some irrelevant renamings): {-# LANGUAGE TypeOperators, DataKinds, GADTs, TypeFamilies #-} module CheckedList where data Nat = Z

TypeLits vs. Z|Sn naturals

2014-05-18 Thread Herbert Valerio Riedel
Hello again, ...while experimenting with TypeLits I stumbled over the following simple case failing to type-check with GHC 7.8.2: {-# LANGUAGE DataKinds, GADTs #-} data List l t where Nil :: List 0 t Cons :: { lstHead :: t, lstTail :: List l t } - List (l+1) t with

Re: TypeLits vs. Z|Sn naturals

2014-05-18 Thread Carter Schonwald
Type lits currently can't do an abstract reasoning. It can only decide if two concrete literals are equal or reduce an expression made from concrete literals to a new concrete literal. For that reason I'm using peano style Nats in my own lib engineering. On Sunday, May 18, 2014, Herbert

Re: Validate failures

2014-05-18 Thread Joachim Breitner
Hi, a small reminder to the masteres of the stable branch: The ghc-7.8 branch currently still does not validate on Travis: Am Samstag, den 03.05.2014, 22:08 +0200 schrieb Joachim Breitner: ghc-7.8: Unexpected failures: annotations/should_compile/th annth_compunits [bad exit code]

Re: Non-exhaustive pattern-match warning in code-example from Dependently Typed Programming with Singletons

2014-05-18 Thread Richard Eisenberg
The short answer here (to Is there a way to avoid the non-exhaustive pattern-match warning?) is no, not in general. See #3927 (https://ghc.haskell.org/trac/ghc/ticket/3927). And, after some playing around, I couldn't find a way to do this in your specific example, either. I will say that I've

Re: TypeLits vs. Z|Sn naturals

2014-05-18 Thread Richard Eisenberg
Yes, the TypeLits solver is still in early stages, but there's active work being done to improve the situation. For better concrete syntax with Peano naturals, I recommend the following construction: type family U n where -- U stands for unary U 0 = Z U n = S (n - 1) It works well in

Re: Status updates

2014-05-18 Thread Manuel M T Chakravarty
Austin, Could we please make sure to include this bug for 7.8.3? https://ghc.haskell.org/trac/ghc/ticket/9078 The ticket already includes a patch that solves the problem for us. As remarked by Levent, this bug will probably affect all EDSL that use Andy’s StableName-based observable sharing

Re: Non-exhaustive pattern-match warning in code-example from Dependently Typed Programming with Singletons

2014-05-18 Thread Richard Eisenberg
A little more tinkering got this working, with the definitions in my earlier email, below (with ScopedTypeVariables): index :: forall i n t. (i :? S n) = List (S n) t - SNat i - t index (x :- _)SZ= x index (_ :- xs) (SS (i :: SNat i')) = case ltProof :: i' : n of