[Haskell] Re: how to write a list builder? fixpoint?

Ben.Yu at combined.com Ben.Yu at combined.com
Thu Jun 3 13:12:28 EDT 2004





I'm sorry. I'm new to haskell, new to this group, don't even know what this
"cafe" refers to. Is there a special place for discussing further details?

As for the build, I was really surprised by your examples. with brain
adapted to Java and C++ so deeply, seems like I just cannot think well in
Haskell.

Each of your example made me feel :" Wow, that's cool! How come I never
thought of it?". But I just cannot get everything organized in my mind. I'm
ordering the "Haskell school of expression" book, hopefully it can refactor
my Object Orientized brain more Haskellsih.

But anyway, let's move on.

Inspired by you, I wrote (most copy-paste from yours) my generic Builder
which can build not only list.


class Builder c a r | r -> a where
  build :: (c->c) -> (a -> c -> c) -> c -> a -> r

instance Builder [a] a [a] where
  build pub acc l a = pub $ acc a l

instance Builder c a r => Builder c a (a->r) where
  build pub acc l a x = build pub acc (acc a l) x

With this generic builder, list builder can be written as:

buildl :: (Builder [a] a r) => a -> r
buildl = build reverse (:) []

Similarly, a builder can be built for binary functions like addToFM.

class Builder2 c a b r | r -> a, r->b where
  build2 :: (c->c) (a->b->c->c) -> c -> a -> r
instance Builder2 c a b r => Builder c a b (a->r) where
  build2 pub acc l a b x y = build2 pub acc (acc a b l) x y
instance Builder2 (FiniteMap k v) k v (FiniteMap k v) where
  build2 pub acc m k v = pub $ acc k v m

buildm :: (Ord k, Builder2 (FiniteMap k v) k v r) => k -> v -> r
buildm = build2 id _put emptyFM where
  _put k v m = addToFM m k v

test3 = addToFM(buildm "a" "b" "c" "d") "x" "y"

I'm not bothered too much for explicitly writing the signature. It is good
practice to write explicit signature anyway.

However, I don't quite like having to say buildl (1::Int). If I can say
[1,2,3], which types to Num a => [a], why can't I say buildl 1 2 3 which
also types to Num a => [a]?



                                                                                                                              
                      oleg at pobox.com                                                                                          
                      Sent by:                 To:       haskell at haskell.org                                                  
                      haskell-bounces at h        cc:                                                                            
                      askell.org               Subject:  [Haskell] Re: how to write a list builder? fixpoint?                 
                                                                                                                              
                                                                                                                              
                      06/02/2004 07:07                                                                                        
                      PM                                                                                                      
                      Please respond to                                                                                       
                      oleg                                                                                                    
                                                                                                                              





I'm sorry I couldn't resist another example -- which requires fewer
signatures. It also illustrates storing build in data structures.
In the example below (which works with the code posted earlier) build
is used to build itself. It really has quite a few faces...

data W = W (forall r a. (BuildList a r) => (a->r))

test2 = let t1 = build (W build)
            t2 = build (W build) (W build)
                 t3 = t1 ++ t2
                 f (W b) = b (1::Int) ++
                           b (1::Int) (2::Int) ++
                               b (1::Int) (2::Int) (3::Int)
             in map f t3

We should probably move to Cafe for further discussions, if any...

_______________________________________________
Haskell mailing list
Haskell at haskell.org
http://www.haskell.org/mailman/listinfo/haskell




This message is intended only for the addressee and may contain information
that is confidential or privileged. Unauthorized use is strictly prohibited
and may be unlawful. If you are not the intended recipient, or the person
responsible for delivering to the intended recipient, you should not read,
copy, disclose or otherwise use this message, except for the purpose of
delivery to the addressee. If you have received this email in error, please
delete and advise us immediately.



More information about the Haskell mailing list