> 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
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
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
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 -
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
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 _ _) _ =
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
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
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
[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,
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
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
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.
>>
>
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-
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
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
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
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
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
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
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
> 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
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
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
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
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
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
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
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
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 !?
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
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
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]
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..]
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
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
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
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
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
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.
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
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
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
"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
44 matches
Mail list logo