[Haskell-cafe] Re: Haskell performance (again)!

2006-10-10 Thread Stefan Monnier
> Assuming your machine architecture supports something like condition codes. > On, e.g., the MIPS you would need to test for < and == separately. And even if your machine supports condition codes, you'll need one test plus two conditional jumps. Not much better than MIPS's 2 independent tests

[Haskell-cafe] Re: Trying to understand HList / hSequence now [why it works]

2006-10-10 Thread oleg
Matthias Fischmann wrote: > instance (Monad m, HSequence m HNil HNil) => HSequence m HNil HNil > where hSequence _ = return HNil > > how can i use the goal of the declaration as one of the conditions > without causing some sort of black hole in the type inference > algorithm? Very easily: th

Re: [Haskell-cafe] Profiling CAFs (re-post)

2006-10-10 Thread Ian Lynagh
On Tue, Oct 10, 2006 at 05:21:52PM +0200, Matthias Fischmann wrote: > > > Compiling with -caf-all might give you more useful information. > > Oops. I thought i had that in my Makefile, but appearently i was > wrong... If I add it, this is what happens: > > $ ghc -prof -caf-all Main.hs -o Main

[Haskell-cafe] GHC Core still supported?

2006-10-10 Thread Jim Apple
In http://www.haskell.org/ghc/dist/current/docs/users_guide/ext-core.html , I see two notes that I can't verify: 1. I don't see any CORE pragma on http://www.haskell.org/ghc/dist/current/docs/users_guide/pragmas.html 2. Using GHC 6.5.20060920, I compile module Core where data Foo = Bar with -

Re: [Haskell-cafe] a monad for secret information

2006-10-10 Thread Felipe Almeida Lessa
2006/10/10, David Roundy <[EMAIL PROTECTED]>: >declassify :: Secret a -> String -> Maybe a>declassify (Secret pw x) pw' | pw' == pw = Just x>declassify (Secret _ _) _ = NothingWhy does this works? "Yet Another Haskell Tutorial" teaches that pattern matching occurs at one stage and guard processing

Re: [Haskell-cafe] Re: a monad for secret information

2006-10-10 Thread Seth Gordon
David Roundy wrote: Try module Secret (Secret, classify, declassify) where data Secret a = Secret String a classify :: String -> a -> Secret a classify pw x = Secret pw x declassify :: Secret a -> String -> Maybe a declassify (Secret pw x) pw' | pw' == pw = Just x declassify (Secret _ _) _ =

[Haskell-cafe] Re: [off-topic / administrative] List Reply-to

2006-10-10 Thread Benjamin Franksen
Aaron Denney wrote: > On 2006-10-10, Misha Aizatulin <[EMAIL PROTECTED]> wrote: >> Matthias Fischmann wrote: >>> Some lists have the Reply-To: set to the list address. I think you >>> can even configure the From: to be haskell-cafe instead of the poster, >>> making the poster merely identifiable b

[Haskell-cafe] casting

2006-10-10 Thread Thomas Conway
On 10/11/06, Bulat Ziganshin <[EMAIL PROTECTED]> wrote: it's a sort of problem that bites me many times when i start to wrote Streams library :) although you said that you discovered the dictionaries mechanism, i propose you to read http://haskell.org/haskellwiki/OOP_vs_type_classes page where

Re: [Haskell-cafe] Re: Haskell performance (again)!

2006-10-10 Thread Lennart Augustsson
On Oct 10, 2006, at 14:58 , Jón Fairbairn wrote: Bulat Ziganshin <[EMAIL PROTECTED]> writes: Hello Jon, Tuesday, October 10, 2006, 1:18:52 PM, you wrote: Surely all but one of the comparisons is unnecessary? If you use `compare` instead of (==) and friends, won't one do (I'm assuming that

Re: [Haskell-cafe] beginner's problem about lists

2006-10-10 Thread Twan van Laarhoven
[EMAIL PROTECTED] wrote: Hi all, I'm trying to implement a function that returns the shorter one of two given lists, something like shorter :: [a] -> [a] -> [a] such that shorter [1..10] [1..5] returns [1..5], and it's okay for shorter [1..5] [2..6] to return either. Simple, right? However,

Re: Re: [Haskell-cafe] beginner's problem about lists

2006-10-10 Thread ihope
On 10/10/06, Nicolas Frisby <[EMAIL PROTECTED]> wrote: > data Fin > data Inf > data List l a = Cons a (List l a) | Nil It's possible to make both "infinite list" and "finite list" datatypes: data Inf a = InfCons a (Inf a) data Fin a = FinCons a !(Fin a) | FinNil At least, I think the Fin typ

[Haskell-cafe] Re: Haskell performance (again)!

2006-10-10 Thread Jón Fairbairn
Bulat Ziganshin <[EMAIL PROTECTED]> writes: > Hello Jon, > > Tuesday, October 10, 2006, 1:18:52 PM, you wrote: > > > Surely all but one of the comparisons is unnecessary? If you > > use `compare` instead of (==) and friends, won't one do (I'm > > assuming that the compiler can convert cases on L

[Haskell-cafe] Re: [off-topic / administrative] List Reply-to

2006-10-10 Thread Aaron Denney
On 2006-10-10, Misha Aizatulin <[EMAIL PROTECTED]> wrote: > Matthias Fischmann wrote: >> Some lists have the Reply-To: set to the list address. I think you >> can even configure the From: to be haskell-cafe instead of the poster, >> making the poster merely identifiable by the Sender: field. >> >

Re: [Haskell-cafe] Trying to understand HList / hMapOut

2006-10-10 Thread Bulat Ziganshin
Hello oleg, Saturday, October 7, 2006, 11:25:07 AM, you wrote: > Well, `foo' is a polymorphic function -- which is not, strictly > speaking, a first-class object in Haskell. btw, GHC 6.6 supports impredicative polymorphism described in User Guide 7.4.9. is this makes polymorphic functions first-

[Haskell-cafe] Re: a monad for secret information

2006-10-10 Thread Arie Peterson
David Roundy wrote: > Try > >>module Secret (Secret, classify, declassify) >>where >> >>data Secret a = Secret String a >> >>classify :: String -> a -> Secret a >>classify pw x = Secret pw x >> >>declassify :: Secret a -> String -> Maybe a >>declassify (Secret pw x) pw' | pw' == pw = Just x >>decl

Re: [Haskell-cafe] Profiling CAFs (re-post)

2006-10-10 Thread Jason Dagit
On 10/10/06, Ian Lynagh <[EMAIL PROTECTED]> wrote: On Tue, Oct 10, 2006 at 01:31:58PM +0200, Matthias Fischmann wrote: > > What qualifies as constant applicable form, and why is it not > labelled in a more informative way? CAFs are, AIUI, things that are just values (i.e. things that don't t

Re: [Haskell-cafe] a monad for secret information

2006-10-10 Thread Brandon Moore
Seth Gordon wrote: I finally (think I) understand monads well enough to make one up: ... Is it even possible to have a type like this that still observes the monad rules? Is this the sort of thing that I need to understand arrows to pull off? I think the monads people have given you will w

[Haskell-cafe] Multiple stages in Template Haskell

2006-10-10 Thread Lyle Kopnicky
Hi folks, I noticed that in Template Haskell, you can only have one level of splicing or quasi-quoting. E.g., you can't write: $(zipN ($(sel 2 3) ("zip level",3,( ['a'..'Z'] [1..] (words "now is the time") Because you can't have a splice inside a splice. But wouldn't it be handy to

[Haskell-cafe] Re: Is Haskell a 5GL?

2006-10-10 Thread Henning Thielemann
On Thu, 5 Oct 2006, Ch. A. Herrmann wrote: > Henning Thielemann wrote: > > > ... > > > > The notation > > [f x | x <- xs] > > describes operations on list elements, and looks like the imperative > > "forall x in xs do f x", > > whereas > > map f xs > > is a list transformation. The second o

Re: [Haskell-cafe] a monad for secret information

2006-10-10 Thread David Roundy
On Mon, Oct 09, 2006 at 11:06:35PM -0400, Seth Gordon wrote: > I finally (think I) understand monads well enough to make one up: [...] > The not-so-nice thing is that the literal text of the password is baked > into the data definition. I'd like to have a more general version of > Secret that allo

Re: [Haskell-cafe] a monad for secret information

2006-10-10 Thread Robert Dockins
On Oct 10, 2006, at 12:04 PM, Seth Gordon wrote: data Secret a = Secret {password :: String, value :: a} classify :: String -> a -> Secret a classify = Secret declassify :: String -> Secret a -> Maybe a declassify guess (Secret pw v) | guess == pw = Just v

Re: [Haskell-cafe] a monad for secret information

2006-10-10 Thread Seth Gordon
> data Secret a = Secret {password :: String, value :: a} > > classify :: String -> a -> Secret a > classify = Secret > > declassify :: String -> Secret a -> Maybe a > declassify guess (Secret pw v) | guess == pw = Just v > | otherwise = Nothing > > Pu

Re: [Haskell-cafe] [off-topic / administrative] List Reply-to

2006-10-10 Thread Misha Aizatulin
Matthias Fischmann wrote: > Some lists have the Reply-To: set to the list address. I think you > can even configure the From: to be haskell-cafe instead of the poster, > making the poster merely identifiable by the Sender: field. > > Do you have strong opinions on this subject? Here is an ar

Re: [Haskell-cafe] Profiling CAFs (re-post)

2006-10-10 Thread Matthias Fischmann
On Tue, Oct 10, 2006 at 01:59:23PM +0100, Ian Lynagh wrote: > To: Matthias Fischmann <[EMAIL PROTECTED]> > Cc: haskell-cafe@haskell.org > From: Ian Lynagh <[EMAIL PROTECTED]> > Date: Tue, 10 Oct 2006 13:59:23 +0100 > Subject: Re: [Haskell-cafe] Profiling CAFs (re-post) > > On Tue, Oct 10, 2006 at

[Haskell-cafe] [off-topic / administrative] List Reply-to

2006-10-10 Thread Matthias Fischmann
In my last post, I hit the wrong button again, with the effect of some noise in innocent mailboxes (sorry!). Some lists have the Reply-To: set to the list address. I think you can even configure the From: to be haskell-cafe instead of the poster, making the poster merely identifiable by the Sen

Re: [Haskell-cafe] beginner's problem about lists

2006-10-10 Thread Matthias Fischmann
On Tue, Oct 10, 2006 at 08:58:05AM -0400, Lennart Augustsson wrote: > >a function that takes two lists and decides whether one of them is > >finite or not , without being given further information on the lists, > >does not exist. > > A function that takes two lists and decides if one is finite do

Re: Re: [Haskell-cafe] beginner's problem about lists

2006-10-10 Thread Nicolas Frisby
I suppose using indicative types (dependent style) is out of the question? I presume i) that would over-simplify the problem and ii) we're tied to the [-] type. It deserves mention no less. data Fin data Inf data List l a = Cons a (List l a) | Nil shorter :: List Inf a -> List Inf a -> Li

Re: [Haskell-cafe] Re: Haskell performance (again)!

2006-10-10 Thread Bulat Ziganshin
Hello Jon, Tuesday, October 10, 2006, 1:18:52 PM, you wrote: > Surely all but one of the comparisons is unnecessary? If you > use `compare` instead of (==) and friends, won't one do (I'm > assuming that the compiler can convert cases on LT, EQ and > GT into something sensible -- after all, wasn't

Re: [Haskell-cafe] casting

2006-10-10 Thread Bulat Ziganshin
Hello Thomas, Monday, October 9, 2006, 3:47:05 PM, you wrote: > constraints on its type. Rather than being just any type that is an > instance of A, I want to do a runtime check and do something different it's a sort of problem that bites me many times when i start to wrote Streams library :) a

[Haskell-cafe] A type in search of a name...

2006-10-10 Thread Brian Hulley
Hi, You'll never believe it but I've been struggling last night and all of today to try and think up a name for the following type and I'm still nowhere near a solution: data ??? = VarId | VarSym | ConId | ConSym this is part of a type to describe Haskell lexemes: data Token = TName !?

Re: [Haskell-cafe] beginner's problem about lists

2006-10-10 Thread Neil Mitchell
Hi However this will result in a non-terminating loop for shorter [1..] [2..], since the first two patterns of f shall never match. The specification of your problem makes this a guarantee. How do you know that a list is finite? You find the [] at the end. How do you know a list is infinite? Y

Re: [Haskell-cafe] beginner's problem about lists

2006-10-10 Thread falseep
Thanks for your reply. I tried a few ways but none worked.One is like: shorter as bs = f id id as bs wheref ca cb [] _ = ca [] f ca cb _ [] = cb []f ca cb (a:as) (b:bs) = f (ca.(a:)) (cb.(b:)) as bs However this will result in a non-terminating loop for shorter [1..] [2..],since the f

Re: [Haskell-cafe] beginner's problem about lists

2006-10-10 Thread Henning Thielemann
On Tue, 10 Oct 2006, Henning Thielemann wrote: > > On Tue, 10 Oct 2006 [EMAIL PROTECTED] wrote: > > > Hi all, > > > > I'm trying to implement a function that returns the shorter one of two given > > lists, > > something like > > shorter :: [a] -> [a] -> [a] > > such that shorter [1..10] [1..5]

Re: [Haskell-cafe] beginner's problem about lists

2006-10-10 Thread Colin DeVilbiss
On 10/10/06, [EMAIL PROTECTED] <[EMAIL PROTECTED]> wrote: I'm trying to implement a function that returns the shorter one of two given lists, something like shorter :: [a] -> [a] -> [a] However, it becomes difficult when dealing with infinite lists, for example, shorter [1..5] (shorter [2..]

Re: [Haskell-cafe] beginner's problem about lists

2006-10-10 Thread Henning Thielemann
On Tue, 10 Oct 2006 [EMAIL PROTECTED] wrote: > Hi all, > > I'm trying to implement a function that returns the shorter one of two given > lists, > something like > shorter :: [a] -> [a] -> [a] > such that shorter [1..10] [1..5] returns [1..5], > and it's okay for shorter [1..5] [2..6] to return

Re: [Haskell-cafe] Profiling CAFs (re-post)

2006-10-10 Thread Ian Lynagh
On Tue, Oct 10, 2006 at 01:31:58PM +0200, Matthias Fischmann wrote: > > What qualifies as constant applicable form, and why is it not > labelled in a more informative way? CAFs are, AIUI, things that are just values (i.e. things that don't take an argument) that have been floated up to the to

Re: [Haskell-cafe] beginner's problem about lists

2006-10-10 Thread Lennart Augustsson
On Oct 10, 2006, at 08:49 , Matthias Fischmann wrote: On Tue, Oct 10, 2006 at 08:10:44PM +0800, [EMAIL PROTECTED] wrote: To: haskell-cafe@haskell.org From: [EMAIL PROTECTED] Date: Tue, 10 Oct 2006 20:10:44 +0800 Subject: [Haskell-cafe] beginner's problem about lists Hi all, I'm trying to imp

Re: [Haskell-cafe] beginner's problem about lists

2006-10-10 Thread Matthias Fischmann
On Tue, Oct 10, 2006 at 08:10:44PM +0800, [EMAIL PROTECTED] wrote: > To: haskell-cafe@haskell.org > From: [EMAIL PROTECTED] > Date: Tue, 10 Oct 2006 20:10:44 +0800 > Subject: [Haskell-cafe] beginner's problem about lists > > Hi all, > > I'm trying to implement a function that returns the shorter

Re: [Haskell-cafe] a monad for secret information

2006-10-10 Thread Neil Mitchell
Hi, I'm not sure what you are after, but: data Secret a = Secret {password :: String, value :: a} classify :: String -> a -> Secret a classify = Secret declassify :: String -> Secret a -> Maybe a declassify guess (Secret pw v) | guess == pw = Just v

Re: [Haskell-cafe] a monad for secret information

2006-10-10 Thread Seth Gordon
Cale Gibbard wrote: > Why not just: > > secret :: a -> Classification String a > secret = Classification "xyzzy" > > The password string isn't part of the type, it doesn't even > necessarily exist at compile time. You might have just got confused > between type and data constructors for a moment.

Re: [Haskell-cafe] beginner's problem about lists

2006-10-10 Thread Neil Mitchell
Hi, The trick is not call "length", since length demands the whole of a list, and won't terminate on an infinite list. You will want to recurse down the lists. Is this a homework problem? It's best to declare if it is, and show what you've managed to do so far. Thanks Neil On 10/10/06, [EMAIL

[Haskell-cafe] beginner's problem about lists

2006-10-10 Thread falseep
Hi all,I'm trying to implement a function that returns the shorter one of two given lists,something likeshorter :: [a] -> [a] -> [a]such that shorter [1..10] [1..5] returns [1..5],and it's okay for shorter [1..5] [2..6] to return either. Simple, right?However, it becomes difficult when deali

[Haskell-cafe] Profiling CAFs (re-post)

2006-10-10 Thread Matthias Fischmann
Hi again, I posted a bunch of questions on profiling here a few days back, but couldn't tickle anybody to post a reply. Since I am not tired any more today, but still can't understand the documentation, or the output of the profiler, here it goes again: What qualifies as constant applicable

[Haskell-cafe] Re: Haskell performance (again)!

2006-10-10 Thread Jón Fairbairn
"Brian Hulley" <[EMAIL PROTECTED]> writes: > Lennart Augustsson wrote: > > I think your first try looks good. > [snip] > > ... > > addPoly1 p1@(p1h@(Nom p1c p1d):p1t) p2@(p2h@(Nom p2c p2d):p2t) > >| p1d == p2d = Nom (p1c + p2c) p1d : addPoly1 p1t p2t > >| p1d < p2d = p1h : addPoly1 p1t p2