Re: [Haskell-cafe] Performance of functional priority queues

[Matt Morrow]

On 12/25/09, Matt Morrow  wrote:
> On 12/23/09, Jon Harrop  wrote:
>> And your results above indicate that the fastest imperative heap is over
>> 3x
>> faster than the fastest functional heap?

Also, I've now added you to (1) my list of people never to hire to
perform statistical computations for me where i'm looking for what's
actually going on, (2) my list of people to hire when i need to
mislead *via* statistics. However, (2) is pending verification that
you didn't actually think that. I can't imagine you did though. :)

Cheers,
Matt


>
> It's saying that
>
>   (1) Using an imprecise an
> inefficient-relative-to-a-accurate-GC-that-doesn't-
>
> have-to-assume-the-entire-memory-space-is-live-then-find-what's-dead
> is a recipe for inefficiency.
>   (2) And (1) even more so when you're comparing it to the same language
> with
>manual memory management and zero GC overhead.
>
>   (from here on out I disregard the C numbers (i like C, too))
>
>   (3) So now, it's saying that (given this sample, yada yada) among
> languages
> where this comparison is possible (i.e. the mutable version
> still has the GC running)
> the functional version is on average 1.8 times slower.
>
>   ghci> ((126/70) + (290/150) + (1895/1123)) / 3
>   1.8069258929454834
>
> Matt
>
>> On Tuesday 16 June 2009 23:50:45 Richard O'Keefe wrote:
>>> I've now done some benchmarks myself in C, Java, and Smalltalk,
>>> comparing "imperative" versions of leftist heaps with "functional" ones.
>>> For what it's worth, on a 2.16GHz Intel Core 2 Duo Mac, the
>>> coefficient in front of the log(n) part was
>>>
>>>  C   JavaST(A)   ST(B)
>>> "Imperative"40   70 150 1123
>>> "Functional"   240  126 290 1895
>>>
>>> where ST(A) was a native-code Smalltalk and ST(B) a byte-code one.
>>> The C/Functional case used the Boehm collector, untuned.
>>> Times are in nanoseconds.  Values of n ranged from 2 to 100; the
>>> correspondent was saying that small sizes were important.
>>>
>>> It seems that a factor of 2 for *this* problem is credible;
>>> a factor of 10 is not.
>
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe

Re: [Haskell-cafe] Performance of functional priority queues

[Matt Morrow]

On 12/23/09, Jon Harrop  wrote:
> And your results above indicate that the fastest imperative heap is over 3x
> faster than the fastest functional heap?

It's saying that

  (1) Using an imprecise an inefficient-relative-to-a-accurate-GC-that-doesn't-
have-to-assume-the-entire-memory-space-is-live-then-find-what's-dead
is a recipe for inefficiency.
  (2) And (1) even more so when you're comparing it to the same language with
   manual memory management and zero GC overhead.

  (from here on out I disregard the C numbers (i like C, too))

  (3) So now, it's saying that (given this sample, yada yada) among languages
where this comparison is possible (i.e. the mutable version
still has the GC running)
the functional version is on average 1.8 times slower.

  ghci> ((126/70) + (290/150) + (1895/1123)) / 3
  1.8069258929454834

Matt

> On Tuesday 16 June 2009 23:50:45 Richard O'Keefe wrote:
>> I've now done some benchmarks myself in C, Java, and Smalltalk,
>> comparing "imperative" versions of leftist heaps with "functional" ones.
>> For what it's worth, on a 2.16GHz Intel Core 2 Duo Mac, the
>> coefficient in front of the log(n) part was
>>
>>  C   JavaST(A)   ST(B)
>> "Imperative"40   70 150 1123
>> "Functional"   240  126 290 1895
>>
>> where ST(A) was a native-code Smalltalk and ST(B) a byte-code one.
>> The C/Functional case used the Boehm collector, untuned.
>> Times are in nanoseconds.  Values of n ranged from 2 to 100; the
>> correspondent was saying that small sizes were important.
>>
>> It seems that a factor of 2 for *this* problem is credible;
>> a factor of 10 is not.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe

Re: [Haskell-cafe] FGL/Haskell and Hierarchical Clustering/dendograms

[Matt Morrow]

For completeness, you might then do the actual clustering something like:


import Data.Tree
import Data.List
import Data.Function

-- ... code from before ...

cluster :: Ord cost
=> (a -> b)
-> (a -> cost)
-> Tree a -> Cluster (cost,[b])
cluster proj cost t =
-- List can't be empty since Tree can't.
  let o:os = sortBy (compare `on` fst)
. flatten
. agglom proj cost
$ t
  in foldl' cons (One o) os

data Cluster a
  = One a
  | Many [Cluster a]
  deriving(Eq,Ord,Read,Show)

instance Functor Cluster where
  fmap f (One a) = One (f a)
  fmap f (Many cs) = Many ((fmap . fmap) f cs)

cons :: Cluster a -> a -> Cluster a
cons c a = Many [c,One a]

{-
ghci> let c = cluster fst snd t

ghci> :t c
c :: Cluster (Cost, [Id])
ghci> c
Many [Many [Many [One (0,[4]),One (1,[3,1])],One (3,[2])],One (12,[5])]

ghci> :t fmap snd c
fmap snd c :: Cluster [Id]
ghci> fmap snd c
Many [Many [Many [One [4],One [3,1]],One [2]],One [5]]

ghci> :t fmap fst c
fmap fst c :: Cluster Cost
ghci> fmap fst c
Many [Many [Many [One 0,One 1],One 3],One 12]
-}
-------

Matt


On 12/23/09, Matt Morrow  wrote:
> Hi Nikolas,
>
> Interesting problem. I'd do something like the following, where
> the initial spanning tree from you example (re-tree-ified) is:
>
> {-
> ghci> :t t
> t :: Tree (Id, Cost)
> g
> ghci> ppT t
> (4,0)
> |
> +- (3,1)
> |  |
> |  `- (1,1)
> |
> `- (2,3)
>|
>`- (5,12)
> -}
>
> and which results in the tree:
>
> {-
> ghci> let s = agglom fst snd t
> ghci> :t s
> s :: Tree (Cost, [Id])
> ghci> ppT s
> (0,[4])
> |
> +- (1,[3,1])
> |
> `- (3,[2])
>|
>`- (12,[5])
> -}
>
> which can then be flattened/etc as needed by further steps of the algo.
>
> The code for `agglom':
>
> -
> import Data.Tree
> import Data.List
>
> type Id = Int
> type Cost = Int
>
> t :: Tree (Id,Cost)
> t = Node (4,0)
>   [Node (3,1) [Node (1,1) []]
>   ,Node (2,3) [Node (5,12) []]]
>
> ppT :: Show a => Tree a -> IO ()
> ppT = putStrLn . drawTree . fmap show
>
> -- | Compress the incoming @Tree a@ with @accu...@.
> agglom :: Eq cost
>=> (a -> b)
>-> (a -> cost)
>-> Tree a -> Tree (cost,[b])
> agglom proj cost = go
>   where accum = accumEq proj cost
> go (Node a []) = Node (cost a,[proj a]) []
> go (Node a ts) = let b = proj a
>  c = cost a
>  (bs,ss) = accum c ts
>   in Node (c,b:bs) (fmap go ss)
>
> -- | Repeatedly @splitEq@, and return a pair
> -- whose /first/ element is a list of the projected
> -- @b...@s from those root values along paths from
> -- the roots of the trees in the incoming @[Tree a]@
> -- which have @cost@ equal to the third function parameter,
> -- and whose /second/ element is the (concatenation of the)
> -- list(s) gotten from each of the @splitEq@ calls.
> accumEq :: Eq cost
> => (a -> b)
> -> (a -> cost) -> cost
> -> [Tree a] -> ([b],[Tree a])
> accumEq proj cost c = go [] []
>   where split ts = splitEq proj cost c ts
> go xs ys [] = (xs,ys)
> go xs ys ts = let (eqs,neqs) = split ts
>   in case eqs of
>   []-> ([],ts)
>   _ -> let (bs,tss) = unzip eqs
> in go (bs++xs)
>   (neqs++ys)
>   (concat tss)
>
> -- | Split the incoming trees into
> --  (1) a @[(b,Tree a)]@ of each @b@ is the
> -- @p...@ected value from an @a@ where
> -- the @cost@ of that @a@ is equal to
> -- the third function parameter, and (2)
> -- the members of the incoming @[Tree a]@
> -- whose roots' costs are /not/ equal to
> -- the third function parameter.
> splitEq :: Eq cost
> => (a -> b)
> -> (a -> cost) -> cost
> -> [Tree a] -> ([(b,[Tree a])],[Tree a])
> splitEq proj cost c = foldl' go ([],[])
>   where go (!eqs,!neqs)
>t@(Node a ts)
>   | c==cost a = ((proj a,ts):eqs,neqs)
>   | otherwise = (eqs,t:neqs)
> -
>
> Cheers,
> Matt
>
> On 12/23/09, Nikolas Borrel-Jensen  wrote:
>> Hi! I have some trouble imple

Re: [Haskell-cafe] FGL/Haskell and Hierarchical Clustering/dendograms

[Matt Morrow]

Hi Nikolas,

Interesting problem. I'd do something like the following, where
the initial spanning tree from you example (re-tree-ified) is:

{-
ghci> :t t
t :: Tree (Id, Cost)
g
ghci> ppT t
(4,0)
|
+- (3,1)
|  |
|  `- (1,1)
|
`- (2,3)
   |
   `- (5,12)
-}

and which results in the tree:

{-
ghci> let s = agglom fst snd t
ghci> :t s
s :: Tree (Cost, [Id])
ghci> ppT s
(0,[4])
|
+- (1,[3,1])
|
`- (3,[2])
   |
   `- (12,[5])
-}

which can then be flattened/etc as needed by further steps of the algo.

The code for `agglom':

-
import Data.Tree
import Data.List

type Id = Int
type Cost = Int

t :: Tree (Id,Cost)
t = Node (4,0)
  [Node (3,1) [Node (1,1) []]
  ,Node (2,3) [Node (5,12) []]]

ppT :: Show a => Tree a -> IO ()
ppT = putStrLn . drawTree . fmap show

-- | Compress the incoming @Tree a@ with @accu...@.
agglom :: Eq cost
   => (a -> b)
   -> (a -> cost)
   -> Tree a -> Tree (cost,[b])
agglom proj cost = go
  where accum = accumEq proj cost
go (Node a []) = Node (cost a,[proj a]) []
go (Node a ts) = let b = proj a
 c = cost a
 (bs,ss) = accum c ts
  in Node (c,b:bs) (fmap go ss)

-- | Repeatedly @splitEq@, and return a pair
-- whose /first/ element is a list of the projected
-- @b...@s from those root values along paths from
-- the roots of the trees in the incoming @[Tree a]@
-- which have @cost@ equal to the third function parameter,
-- and whose /second/ element is the (concatenation of the)
-- list(s) gotten from each of the @splitEq@ calls.
accumEq :: Eq cost
=> (a -> b)
-> (a -> cost) -> cost
-> [Tree a] -> ([b],[Tree a])
accumEq proj cost c = go [] []
  where split ts = splitEq proj cost c ts
go xs ys [] = (xs,ys)
go xs ys ts = let (eqs,neqs) = split ts
  in case eqs of
  []-> ([],ts)
  _ -> let (bs,tss) = unzip eqs
in go (bs++xs)
  (neqs++ys)
  (concat tss)

-- | Split the incoming trees into
--  (1) a @[(b,Tree a)]@ of each @b@ is the
-- @p...@ected value from an @a@ where
-- the @cost@ of that @a@ is equal to
-- the third function parameter, and (2)
-- the members of the incoming @[Tree a]@
-- whose roots' costs are /not/ equal to
-- the third function parameter.
splitEq :: Eq cost
=> (a -> b)
-> (a -> cost) -> cost
-> [Tree a] -> ([(b,[Tree a])],[Tree a])
splitEq proj cost c = foldl' go ([],[])
  where go (!eqs,!neqs)
   t@(Node a ts)
  | c==cost a = ((proj a,ts):eqs,neqs)
  | otherwise = (eqs,t:neqs)
-

Cheers,
Matt

On 12/23/09, Nikolas Borrel-Jensen  wrote:
> Hi! I have some trouble implementing single-linkage clustering algorithm by
> using a minimum-spanning tree, so I would appreciate if some of you could
> give me some advise.
>
> I am implementing a single-linkage clustering algorithm, and my approach is
> to use minimum spanning trees for that task. I am using the library FGL (
> http://web.engr.oregonstate.edu/~erwig/fgl/haskell/), and I have managed to
> compute a minimum spanning tree from an arbitrary fully connected graph with
> 5 nodes. I get [ [(4,0) ] , [ (3,1) , (4,0) ] , [ (1,1) , (3,1) , (4,0) ] ,
> [ (2,3) , (4,0) ] , [ (5,12) , (2,3) , (4,0) ] ], which is the root path
> tree of the minimum spanning tree created by the function msTreeAt.
>
> >From that I would create a dendrogram. [ (1,1) , (3,1) , (4,0) ]  is
> telling
> that node 1,3 and 4 has the same cost, namely cost 1. Therefore these are
> merged at level 1. At level 1 we now have 3 clusters: (1,3,4), 2 and 5. Now
> the second lowest should be merged, that is 2 and 4. BUT because 4 is
> already merged in the cluster (1,3,4), we should merge (1,3,4) and 2 at
> level 3 (because the cost is 3). Now at level 3 we have 2 clusters,
> (1,2,3,4) and 5. Now we merge the last one at level 12: (1,2,3,4,5), and we
> are finished.
>
> I have very hard to see, how this could be done efficiently without pointers
> (as in C). I have thought of just saving the nodes from the start of the
> root path, and traversing it, but a lot of searching should be done all the
> time.
>
> Can you please give me some advise on that?
>
> Kind regards
>
> Nikolas Borrel-Jensen
> Computer Science
> University Of Copenhagen
>
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe

Re: [Haskell-cafe] Boxed Mutable Arrays

[Matt Morrow]

What are peoples' thoughts on this?
http://hackage.haskell.org/trac/ghc/ticket/650#comment:16

Matt

On 12/14/09, Brad Larsen  wrote:
> Is anyone working on fixing ticket #650
> ?  In short, STArray
> and the garbage collector don't play well together, resulting in array
> updates being non-constant time operations.  This bug makes it very
> difficult/impossible to write efficient array algorithms that depend
> upon mutation in Haskell.
>
> On another note, does this (or perhaps better phrased, will this) bug
> also affect Data Parallel Haskell?
>
> I would really like to see highly efficient, mutable, boxed arrays in
> Haskell!  Unfortunately, I don't have the know-how to fix Ticket 650.
>
> Sincerely,
> Brad
> ___
> Haskell-Cafe mailing list
> Haskell-Cafe@haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe

Re: [Haskell-cafe] Re: can there be (hash-table using) O(n) version of this (I think currently) n log n algo?

[Matt Morrow]

Never underestimate teh power of the Int{Set,Map}:

{-# LANGUAGE BangPatterns #-}
import Data.Set(Set)
import Data.IntSet(IntSet)
import qualified Data.Set as S
import qualified Data.IntSet as IS
import Control.Parallel.Strategies(rnf)
import Data.Monoid(Monoid(..))
import Data.List

findsumsIS :: [Int] -> Int -> IntSet
findsumsIS xs wanted = snd . foldl' f mempty $ xs
  where f (!candidates,!successes) next =
  let x = wanted - next
  in case x `IS.member` candidates of
  True -> (candidates, IS.insert next successes)
  False -> (IS.insert next candidates,successes)

-- (i had to add bangs in f since it was blowing the stack)
findsums :: [Int] -> Int -> Set (Int,Int)
findsums xs wanted = snd . foldl' f (S.empty,S.empty) $ xs
  where f (!candidates,!successes) next =
  if  S.member (wanted-next) candidates
then (candidates, S.insert (next,wanted-next) successes)
else (S.insert next candidates,successes)

{-
  Note that the list has 10 million elements,
  (time is roughly 0.4s with 1 million with IntSet).
-}

{-
main = do
  let s = findsums (take 1000 (cycle [1..999])) 500
  print (rnf s `seq` ())

[...@monire ~]$ time ./FindSums
()

real0m8.793s
user0m8.762s
sys 0m0.022s
-}

{-
main = do
  let s = findsumsIS (take 1000 (cycle [1..999])) 500
  print (rnf s `seq` ())

[...@monire ~]$ time ./FindSumsIS
()

real0m4.488s
user0m4.459s
sys 0m0.023s
-}

Matt

> On Sunday 19 July 2009 09:26:14 Heinrich Apfelmus wrote:
>> Thomas Hartman wrote:
>> > The code below is, I think, n log n, a few seconds on a million +
>> > element
>> > list.
>> >
>> > I wonder if it's possible to get this down to O(N) by using a
>> > hashtable implemementation, or other better data structure.
>> >
>> > -- findsums locates pairs of integers in a list
>> > that add up to a wanted sum.
>> >
>> > findsums :: [Int] -> Int -> S.Set (Int,Int)
>> > findsums xs wanted = snd . foldl' f (S.empty,S.empty) $ xs
>> >   where f (candidates,successes) next =
>> >  if  S.member (wanted-next) candidates
>> >then (candidates, S.insert (next,wanted-next) successes)
>> >else (S.insert next candidates,successes)
>>
>> Remember that hash tables are actually O(key length) instead of O(1), so
>> I don't think you can break the  log n  for really large lists this
>> way since the key length increases as well (unless most elements are
>> equal anyway).
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe

Re: [Haskell-cafe] GHC magic optimization ?

[Matt Morrow]

Fixing my errors:

> x = sum [1..10^6] + product [1..10^6]
> x' = let l = [1..10^6] in sum l + product l

-- Define:
bar m n = foo (enumFromTo m n)
foo xs  = sum xs + prod xs

-- We're given:
sum = foldl (+) 0
product = foldl (*) 1
foldl f z xs =
  case xs of
[] -> []
x:xs -> foldl f (f z x) xs
enumFromTo m n =
  case n < m of
True -> []
False -> m : enumFromTo (m+1) n

-- The fused loop becomes:
foo xs = go0 0 1 xs
  where go0 a b xs =
  case xs of
[] -> a+b
x:xs -> go0 (a+x) (b*x) xs

-- Now inline foo in bar:
bar m n = go2 0 1 m n
  where go2 a b m n = go0 a b (go1 m n)
go0 a b xs =
  case xs of
[] -> a+b
x:xs -> go0 (a+x) (b*x) xs
go1 m n =
  case m < n of
True -> []
False -> m : go1 (m+1) n

-- considering go2
go2 a b m n = go0 a b (go1 m n)

==> case (go1 m n) of
  [] -> a+b
   x:xs -> go0 (a+x) (b*x) xs

==> case (case n < m of
   True -> []
   False -> m : go1 (m+1) n) of
  [] -> a+b
  x:xs -> go0 (a+x) (b*x) xs

==> case n < m of
  True -> case [] of
[] -> a+b
x:xs -> go0 (a+x) (b*x) xs

  False -> case (m : go1 (m+1) n) of
 [] -> a+b
 x:xs -> go0 (a+x) (b*x) xs

==> case n < m of
  True -> a+b
  False -> go0 (a+m) (b*m) (go1 (m+1) n)

-- So,
go2 a b m n =
  case n < m of
True -> a+b
False -> go0 (a+m) (b*m) (go1 (m+1) n)

-- And by the original def of go2
go2 a b m n = go0 a b (go1 m n)

-- We get
go2 a b m n =
  case m < n of
True -> a+b
False -> go2 (a+m) (b*m) (m+1) n

-- go0 and go1 and now dead in bar
bar m n = go2 0 1 m n
  where go2 a b m n =
  case n < m of
True -> a+b
False -> go2 (a+m) (b*m) (m+1) n

-- (furthermore, if (+) here is for Int/Double etc,
-- we can reduce go2 further to operate on machine
-- ints/doubles and be a register-only non-allocating loop)

-- So now finally returning to our original code:
> x = sum [1..10^6] + product [1..10^6]
> x' = let l = [1..10^6] in sum l + product l

-- We get:
x' = bar 1 (10^6)

Matt






On 12/4/09, Matt Morrow  wrote:
> Although, in Luke's example,
>
>> x = sum [1..10^6] + product [1..10^6]
>> x' = let l = [1..10^6] in sum l + product l
>
> We can do much much better, if we're sufficiently smart.
>
> -- Define:
> bar m n = foo (enumFromTo m n)
> foo xs  = sum xs + prod xs
>
> -- We're given:
> sum = foldl (+) 0
> product = foldl (*) 1
> foldl f z xs =
>   case xs of
> [] -> []
> x:xs -> foldl f (f z x) xs
> enumFromTo m n =
>   case m < n of
> True -> []
> False -> m : enumFromTo (m+1) n
>
> -- The fused loop becomes:
> foo xs = go0 0 1 xs
>   where go0 a b xs =
>   case xs of
> [] -> a+b
> x:xs -> go0 (a+x) (b*x) xs
>
> -- Now inline foo in bar:
> bar m n = go2 0 1 m n
>   where go2 = go0 a b (go1 m n)
> go0 a b xs =
>   case xs of
> [] -> a+b
> x:xs -> go0 (a+x) (b*x) xs
> go1 m n =
>   case m < n of
> True -> []
> False -> m : go1 (m+1) n
>
> -- considering go2
> go2 = go0 a b (go1 m n)
>
> ==> case (go1 m n) of
>   [] -> a+b
>x:xs -> go0 (a+x) (b*x) xs
>
> ==> case (case m < n of
>True -> []
>False -> m : go1 (m+1) n) of
>   [] -> a+b
>   x:xs -> go0 (a+x) (b*x) xs
>
> ==> case m < n of
>   True -> case [] of
> [] -> a+b
> x:xs -> go0 (a+x) (b*x) xs
>
>   False -> case (m : go1 (m+1) n) of
>  [] -> a+b
>  x:xs -> go0 (a+x) (b*x) xs
>
> ==> case m < n of
>   True -> a+b
>   False -> go0 (a+m) (b*m) (go1 (m+1) n)
>
> -- So,
> go2 = case m < n of
> True -> a+b
> False -> go0 (a+m) (b*m) (go1 (m+1) n)
>
> -- And by the original def of go2
> go2 = go0 a b (go1 m n)
>
> -- We get
> go2 = case m < n of
> True -> a+b
> False -> go2 (a+m) (b*m) (m+1) n
>
> -- go0 and go1 and now dead in bar
> bar m n = go2 0 1 m n
>   where go2 = case m < n of
> True -> a+b
> False -> go2 (a+m) (b*m) (m+1) n
>
> -- (furthermore, if (+) here is for Int/Double et

Re: [Haskell-cafe] inotify-alike for mac os x?

[Matt Morrow]

Conal,

If I were looking to do this, I'd read the relevant parts of the libev code.

Matt


On 12/3/09, Conal Elliott  wrote:
> I'd like to make some FRPish toys that keep files updated to have functional
> relationships with other files.  hinotify looks like just the sort of
> underlying magic I could use for efficient implementation on linux.  Is
> there any support for mac os x?  Could support be either added to hinotify
> or maybe inotify and a mac-friendly library be abstracted into a common
> Haskell interface?  I'm fine with an imperative interface, since I can
> abstract into a functional library, which I guess would be a sort of
> persistent simplified FRP.
>
>- Conal
>
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe

Re: [Haskell-cafe] GHC magic optimization ?

[Matt Morrow]

Although, in Luke's example,

> x = sum [1..10^6] + product [1..10^6]
> x' = let l = [1..10^6] in sum l + product l

We can do much much better, if we're sufficiently smart.

-- Define:
bar m n = foo (enumFromTo m n)
foo xs  = sum xs + prod xs

-- We're given:
sum = foldl (+) 0
product = foldl (*) 1
foldl f z xs =
  case xs of
[] -> []
x:xs -> foldl f (f z x) xs
enumFromTo m n =
  case m < n of
True -> []
False -> m : enumFromTo (m+1) n

-- The fused loop becomes:
foo xs = go0 0 1 xs
  where go0 a b xs =
  case xs of
[] -> a+b
x:xs -> go0 (a+x) (b*x) xs

-- Now inline foo in bar:
bar m n = go2 0 1 m n
  where go2 = go0 a b (go1 m n)
go0 a b xs =
  case xs of
[] -> a+b
x:xs -> go0 (a+x) (b*x) xs
go1 m n =
  case m < n of
True -> []
False -> m : go1 (m+1) n

-- considering go2
go2 = go0 a b (go1 m n)

==> case (go1 m n) of
  [] -> a+b
   x:xs -> go0 (a+x) (b*x) xs

==> case (case m < n of
   True -> []
   False -> m : go1 (m+1) n) of
  [] -> a+b
  x:xs -> go0 (a+x) (b*x) xs

==> case m < n of
  True -> case [] of
[] -> a+b
x:xs -> go0 (a+x) (b*x) xs

  False -> case (m : go1 (m+1) n) of
 [] -> a+b
 x:xs -> go0 (a+x) (b*x) xs

==> case m < n of
  True -> a+b
  False -> go0 (a+m) (b*m) (go1 (m+1) n)

-- So,
go2 = case m < n of
True -> a+b
False -> go0 (a+m) (b*m) (go1 (m+1) n)

-- And by the original def of go2
go2 = go0 a b (go1 m n)

-- We get
go2 = case m < n of
True -> a+b
False -> go2 (a+m) (b*m) (m+1) n

-- go0 and go1 and now dead in bar
bar m n = go2 0 1 m n
  where go2 = case m < n of
True -> a+b
False -> go2 (a+m) (b*m) (m+1) n

-- (furthermore, if (+) here is for Int/Double etc,
-- we can reduce go2 further to operate on machine
-- ints/doubles and be a register-only non-allocating loop)

-- So now finally returning to our original code:
> x = sum [1..10^6] + product [1..10^6]
> x' = let l = [1..10^6] in sum l + product l

-- We get:
x' = bar 1 (10^6)

And the intermediate list never exists at all.

Matt




On 12/4/09, Luke Palmer  wrote:
> On Fri, Dec 4, 2009 at 3:36 AM, Neil Brown  wrote:
>> But let's say you have:
>>
>> g x y = f x y * f x y
>>
>> Now the compiler (i.e. at compile-time) can do some magic.  It can spot
>> the
>> common expression and know the result of f x y must be the same both
>> times,
>> so it can convert to:
>>
>> g x y = let z = f x y in z * z
>
> GHC does *not* do this by default, quite intentionally, even when
> optimizations are enabled.  The reason is because it can cause major
> changes in the space complexity of a program.  Eg.
>
> x = sum [1..10^6] + product [1..10^6]
> x' = let l = [1..10^6] in sum l + product l
>
> x runs in constant space, but x' keeps the whole list in memory.  The
> CSE here has actually wasted both time and space, since it is harder
> to save [1..10^6] than to recompute it!  (Memory vs. arithmetic ops)
>
> So GHC leaves it to the user to specify sharing.  If you want an
> expression shared, let bind it and reuse.
>
> Luke
> ___
> Haskell-Cafe mailing list
> Haskell-Cafe@haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe

Re: [Haskell-cafe] x -> String

[Matt Morrow]

On 10/17/09, Andrew Coppin  wrote:
> Derek Elkins wrote:
>> See vacuum: http://hackage.haskell.org/package/vacuum
>>
> Could be useful... Thanks!
>

As Derek mentioned, vacuum would be perfect for this:



-

import Data.Word
import GHC.Vacuum
import GHC.Vacuum.ClosureType
import qualified Data.IntMap as IM


type Info = (ClosureType  -- what kind of heap node is this?
,[String] -- [pkg,mod,con] for constructors
,[Int]-- "pointers" refering to other nodes in IntMap
,[Word])  -- literal data in constructors

overview :: HNode -> Info
overview o =
  let ptrs = nodePtrs o
  lits = nodeLits o
  itab = nodeInfo o
  ctyp = itabType itab
  -- only available
  -- for constructors
  (pkg,mod,con) = itabName itab
  names = filter (not . null)
  [pkg,mod,con]
  in (ctyp
 ,names -- [] for non-data
 ,ptrs
 ,lits)

-- returns an adjacency-list graph
info :: a -> [(Int,Info)]
info = fmap (\(a,b)->(a,overview b))
. IM.toList . vacuum

-- returns an adjacency-list graph
infoLazy :: a -> [(Int,Info)]
infoLazy = fmap (\(a,b)->(a,overview b))
. IM.toList . vacuumLazy

-

-- example usage

data A a = A Int | B a | forall b. C b [A a]

val0 = [A 42, B (Left Nothing), C (pi,()) val0]
val1 = fmap (\n -> C n []) [0..]

{-
ghci> mapM_ print (info val0)
Loading package vacuum-1.0.0 ... linking ... done.
(0,(CONSTR_2_0,["ghc-prim","GHC.Types",":"],[1,2],[]))
(1,(CONSTR,["main","Main","A"],[3],[]))
(2,(CONSTR_2_0,["ghc-prim","GHC.Types",":"],[4,5],[]))
(3,(CONSTR_0_1,["ghc-prim","GHC.Types","I#"],[],[42]))
(4,(CONSTR,["main","Main","B"],[6],[]))
(5,(CONSTR_2_0,["ghc-prim","GHC.Types",":"],[8,9],[]))
(6,(CONSTR_1_0,["base","Data.Either","Left"],[7],[]))
(7,(CONSTR_NOCAF_STATIC,["base","Data.Maybe","Nothing"],[],[]))
(8,(CONSTR,["main","Main","C"],[10,0],[]))
(9,(CONSTR_NOCAF_STATIC,["ghc-prim","GHC.Types","[]"],[],[]))
(10,(CONSTR_2_0,["ghc-prim","GHC.Tuple","(,)"],[11,12],[]))
(11,(CONSTR_NOCAF_STATIC,["ghc-prim","GHC.Types","D#"],[],[4614256656552045848]))
(12,(CONSTR_NOCAF_STATIC,["ghc-prim","GHC.Unit","()"],[],[]))

ghci> mapM_ print (infoLazy val1)
(0,(AP,[],[],[]))

ghci> val1 `seq` ()
()

ghci> mapM_ print (infoLazy val1)
(0,(CONSTR_2_0,["ghc-prim","GHC.Types",":"],[1,2],[]))
(1,(THUNK_2_0,[],[],[]))
(2,(THUNK_2_0,[],[],[]))

ghci> length . take 2 $ val1
2

ghci> mapM_ print (infoLazy val1)
(0,(CONSTR_2_0,["ghc-prim","GHC.Types",":"],[1,2],[]))
(1,(THUNK_2_0,[],[],[]))
(2,(CONSTR_2_0,["ghc-prim","GHC.Types",":"],[3,4],[]))
(3,(THUNK_2_0,[],[],[]))
(4,(THUNK_2_0,[],[],[]))

ghci> case val1 of a:b:_ -> a `seq` b `seq` ()
()

ghci> mapM_ print (infoLazy val1)
(0,(CONSTR_2_0,["ghc-prim","GHC.Types",":"],[1,2],[]))
(1,(CONSTR,["main","Main","C"],[3,4],[]))
(2,(CONSTR_2_0,["ghc-prim","GHC.Types",":"],[5,6],[]))
(3,(CONSTR_0_1,["integer","GHC.Integer.Internals","S#"],[],[0]))
(4,(CONSTR_NOCAF_STATIC,["ghc-prim","GHC.Types","[]"],[],[]))
(5,(CONSTR,["main","Main","C"],[7,4],[]))
(6,(THUNK_2_0,[],[],[]))
(7,(CONSTR_0_1,["integer","GHC.Integer.Internals","S#"],[],[1]))
-}

-

Matt
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe

Re: [Haskell-cafe] Lightweight type-level dependent programming in Haskell

[Matt Morrow]

I like this one:

-

data N a where
  Z :: N ()
  N :: N a -> N (N a)

type family Nest  n  (f ::* -> *)a
nest ::   N n -> (forall a. a -> f a) -> a -> Nest n f a
type instance Nest  ()   f a = f a
nestZf a = f a
nest   (N n) f a = f (nest n f a)
type instance Nest (N n) f a = f (Nest n f a)

-

import Language.Haskell.TH.Lib(ExpQ)

{-
ghci> nest $(nat 18) (:[]) 42
[[[42]]]
-}

-- ghci> toInt $(nat 1000)
-- 1000
toInt :: N a -> Int
toInt = go 0
  where go :: Int -> N a -> Int
go n  Z = n
go n (N a) = go (n+1) a

-- TH, since no dep types
nat :: Int -> ExpQ
nat n
  | n < 1 = [|Z|]
  | otherwise = [|N $(nat (n-1))|]

instance Show (N a) where
  showsPrec _ Z = showString "Z"
  showsPrec p (N x_1)
= showParen (p > 10)
(showString "N" . (showChar ' ' . (showsPrec 11 x_1 . id)))

-

-- :(

{-
ghci> nest $(nat 19) (:[]) 42

Top level:
Context reduction stack overflow; size = 20
Use -fcontext-stack=N to increase stack size to N
`$dShow{a1Wy} :: {Show [t_a1U3]}'
  arising from a use of `print' at :1:0-22
`$dShow{a1Wx} :: {Show [[t_a1U3]]}'
  arising from a use of `print' at :1:0-22
`$dShow{a1Ww} :: {Show [[[t_a1U3]]]}'
  arising from a use of `print' at :1:0-22
`$dShow{a1Wv} :: {Show t_a1U3}'
  arising from a use of `print' at :1:0-22
`$dShow{a1Wu} :: {Show [t_a1U3]}'
  arising from a use of `print' at :1:0-22
`$dShow{a1Wt} :: {Show [[t_a1U3]]}'
  arising from a use of `print' at :1:0-22
`$dShow{a1Ws} :: {Show [[[t_a1U3]]]}'
  arising from a use of `print' at :1:0-22
`$dShow{a1Wr} :: {Show t_a1U3}'
  arising from a use of `print' at :1:0-22
`$dShow{a1Wq} :: {Show [t_a1U3]}'
  arising from a use of `print' at :1:0-22
`$dShow{a1Wp} :: {Show [[t_a1U3]]}'
  arising from a use of `print' at :1:0-22
`$dShow{a1Wo} :: {Show [[[t_a1U3]]]}'
  arising from a use of `print' at :1:0-22
`$dShow{a1Wn} :: {Show t_a1U3}'
  arising from a use of `print' at :1:0-22
`$dShow{a1Wm} :: {Show [t_a1U3]}'
  arising from a use of `print' at :1:0-22
`$dShow{a1Wl} :: {Show [[t_a1U3]]}'
  arising from a use of `print' at :1:0-22
`$dShow{a1Wk} :: {Show [[[t_a1U3]]]}'
  arising from a use of `print' at :1:0-22
`$dShow{a1Wj} :: {Show t_a1U3}'
  arising from a use of `print' at :1:0-22
`$dShow{a1Wi} :: {Show [t_a1U3]}'
  arising from a use of `print' at :1:0-22
`$dShow{a1Wh} :: {Show [[t_a1U3]]}'
  arising from a use of `print' at :1:0-22
`$dShow{a1Wg} :: {Show
[[[t_a1U3]]]}'
  arising from a use of `print' at :1:0-22
`$dShow{a1Um} :: {Show
t_a1U3}'
  arising from a use of `print' at :1:0-22
-}

-

Also, Dan Doel wrote an Agda version of `nest' which
eliminates the duplication, but interestingly requires
'--type-in-type':

http://moonpatio.com/fastcgi/hpaste.fcgi/view?id=2429

Matt

On Wed, Jun 10, 2009 at 10:01 PM, Ryan Ingram  wrote:

> > induction :: forall p n. Nat n => n -> p Z -> (forall x. Nat x => p x ->
> p (S x)) -> p n
> > induction n z s = caseNat n isZ isS where
> >isZ :: n ~ Z => p n
> >isZ = z
> >isS :: forall x. (n ~ S x, Nat x) => x -> p n
> >isS x = s (induction x z s)
>
> ___
> Haskell-Cafe mailing list
> Haskell-Cafe@haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe

Re: [Haskell-cafe] Haskell and symbolic references

[Matt Morrow]

(i always forget to reply-to-all)

If you'd like to reference C functions with Strings, one possible way is to
use System.Posix.DynamicLinker and the wrapper over libffi that's been
uploaded to hackage recently:

[...@monire asdf]$ ghci
GHCi, version 6.10.1: http://www.haskell.org/ghc/  :? for help
Loading package ghc-prim ... linking ... done.
Loading package integer ... linking ... done.
Loading package base ... linking ... done.

ghci> :m + Foreign.LibFFI
ghci> :m + Foreign.Ptr Foreign.Storable
ghci> :m + Foreign.C.Types Foreign.C.String
ghci> :m + System.Posix.DynamicLinker

ghci> malloc <- dlsym Default "malloc"
Loading package unix-2.3.1.0 ... linking ... done.
ghci> syscall <- dlsym Default "syscall"

ghci> :! echo -ne "#include \n__NR_execve\n" | cpp | tac | grep
-E "^[0-9]+$" | head -1 > NOODLES
ghci> nr_execve :: CLong <- (read . head . words) `fmap` readFile "NOODLES"
ghci> :! rm -f NOODLES

ghci> let sizeOfPtrCChar = sizeOf(undefined::Ptr())
ghci> argv <- callFFI malloc (retPtr (retPtr retCChar)) [argCSize
(2*fromIntegral sizeOfPtrCChar)]
Loading package bytestring-0.9.1.4 ... linking ... done.
Loading package libffi-0.1 ... linking ... done.

ghci> sh <- newCString "/bin/sh"
ghci> poke argv sh
ghci> poke (argv`plusPtr`sizeOfPtrCChar) 0

ghci> callFFI syscall retCLong [argCLong nr_execve, argPtr sh, argPtr argv,
argCInt 0] {-never returns-}
sh-3.2$ echo $0
/bin/sh
sh-3.2$ exit
exit
[...@monire asdf]$

Matt

On Fri, May 29, 2009 at 11:41 AM, Khudyakov Alexey <
alexey.sklad...@gmail.com> wrote:

> On Friday 29 of May 2009 19:34:44 Patrick LeBoutillier wrote:
> > Hi all,
> >
> > Is it possible with Haskell to call a function whose name is contained
> > in a String?
> > Something like:
> >
> > five = call_func "add" [2, 3]
> >
> > If not, perhaps this is acheivable using FFI?
> >
> Or maybe you are asking for template haskell[1]. With it you can actually
> generate function at compile time. It depends on waht you actually need.
>
> > {-# LANGUAGE TemplateHaskell #-}
> > import Language.Haskell.TH
> >
> > five = $( foldl appE (varE $ mkName "+") [ litE $ integerL 2
> >  , litE $ integerL 3 ] )
>
>
> [1] http://haskell.org/haskellwiki/Template_Haskell
>
> --
>   Khudyakov Alexey
> ___
> Haskell-Cafe mailing list
> Haskell-Cafe@haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe

Re: [Haskell-cafe] Template Haskell very wordy w/r/t Decs and Types

[Matt Morrow]

Spectacular!

How difficult would it be to implement splicing in decls? I'm interested in
having a go at it, and it seems like a perfect time since I can cheat off
the fresh diff. In particular I'd love to be able to do stuff like this
(without the current vicious hackery i'm using) (and granted, where i'm
splicing is somewhat willy-nilly, but some approximation of this):

-

{-# LANGUAGE TemplateHaskell, QuasiQuotes #-}
module DecTest where
import HsDec
import Data.List
import DecTestBoot
import Language.Haskell.TH.Lib
import Language.Haskell.TH.Syntax
import Language.Haskell.Meta.Utils

bootQ :: Q [Dec]
bootQ = bootQFunct
  primQStruct

primQStruct = (''[]
  ,(conT ''[] `appT`)
  ,[|[]|]
  ,[|null|]
  ,[|undefined|]
  ,[|union|]
  ,[|undefined|]
  ,[|undefined|])

bootQFunct
  (primN  :: Name
  ,primQ  :: TypeQ
  -> TypeQ  -- exists q. forall a. a -> q a
  ,emptyQ :: ExpQ   -- Q a
  ,isEmptyQ   :: ExpQ   -- q a -> Bool
  ,insertQ:: ExpQ   -- Int -> a -> q a -> q a
  ,mergeQ :: ExpQ   -- q a -> q a -> q a
  ,findMinQ   :: ExpQ   -- q a -> Maybe (Int, a)
  ,deleteMinQ :: ExpQ)  -- q a -> q a

  = do  n <- newName "a"
let primT = varT primN
a = varT n

[$dec|
  data BootQ $(a)
= Nil
| Node {-# UNPACK #-} !Int $(a) ($(primT) (BootQ $(a)))
deriving(Eq,Ord)

  empty :: BootQ $(a)
  isEmpty   :: BootQ $(a) -> Bool
  insert:: Int -> $(a) -> BootQ $(a) -> BootQ $(a)
  merge :: BootQ $(a) -> BootQ $(a) -> BootQ $(a)
  findMin   :: BootQ $(a) -> Maybe (Int, $(a))
  deleteMin :: BootQ $(a) -> BootQ $(a)

  empty = Nil
  isEmpty Nil = True
  isEmpty   _ = False
  findMin  Nil = Nothing
  findMin (Node n x _) = Just (n, x)
  insert n x q = merge (Node n x $(emptyQ)) q
  merge (Node n1 x1 q1)
(Node n2 x2 q2)
| n1 <= n2  = Node n1 x1 ($(insertQ) n2 (Node n2 x2 q2) q1)
| otherwise = Node n2 x2 ($(insertQ) n1 (Node n1 x1 q1) q2)
  merge Nil q  = q
  merge q  Nil = q
  deleteMin  Nil = Nil
  deleteMin (Node _ _ q)
= case $(findMinQ) q of
Nothing -> Nil
Just (_, Node m y q1)
  -> let q2 = $(deleteMinQ) q
  in Node m y ($(mergeQ) q1 q2)
|]

{-
-- FORGOT TO PUT AN (Eq a) CXT, but oh well
ghci> ppDoc `fmap` bootQ
data BootQ a_0_0 = Nil | Node !Int a_0_0 ([] (BootQ a_0_0))
deriving (Eq, Ord)
empty :: forall a_0_1 . BootQ a_0_1
isEmpty :: forall a_0_2 . BootQ a_0_2 -> Bool
insert :: forall a_0_3 . Int -> a_0_3 -> BootQ a_0_3 -> BootQ a_0_3
merge :: forall a_0_4 . BootQ a_0_4 -> BootQ a_0_4 -> BootQ a_0_4
findMin :: forall a_0_5 . BootQ a_0_5 -> Maybe ((Int, a_0_5))
deleteMin :: forall a_0_6 . BootQ a_0_6 -> BootQ a_0_6
empty = Nil
isEmpty (Nil) = True
isEmpty _ = False
findMin (Nil) = Nothing
findMin (Node n_7 x_8 _) = Just (n_7, x_8)
insert n_9 x_10 q_11 = merge (Node n_9 x_10 []) q_11
merge (Node n1_12 x1_13 q1_14) (Node n2_15
 x2_16
 q2_17) | n1_12 <= n2_15 = Node n1_12
x1_13 (undefined n2_15 (Node n2_15 x2_16 q2_17) q1_14)
| otherwise = Node n2_15 x2_16
(undefined n1_12 (Node n1_12 x1_13 q1_14) q2_17)
merge (Nil) q_18 = q_18
merge q_19 (Nil) = q_19
deleteMin (Nil) = Nil
deleteMin (Node _ _ q_20) = case undefined q_20 of
Nothing -> Nil
Just (_, Node m_21 y_22 q1_23) -> let q2_24
= undefined q_20
   in Node
m_21 y_22 (union q1_23 q2_24)
ghci>
-}

-

Thanks,
Matt



On Wed, May 27, 2009 at 2:38 PM, Simon Peyton-Jones
wrote:

> Folks
>
> Quite a few people have asked for splices in Template Haskell *types*, and
> I have finally gotten around to implementing them.  So now you can write
> things like
>
>instance Binary $(blah blah) where ...
> or  f :: $(wubble bubble) -> Int
>
> as requested, for example, in the message below.  Give it a whirl.  You
> need the HEAD; in a day or two you should find binary snapshots if you don't
> want to build from source.
>
>Simon
>
> PS: Note that you (still) cannot write a splice in a *binding* position.
> Thus you can't write
>f $(blah blah) = e
> or
>data T $(blah blah) = MkT Int
>
> I don't intend to change this; see the commentary at
> http://hackage.haskell.org/trac/ghc/ticket/1476
>
> | -Original Message-
> | From: haskell-cafe-boun...@haskell.org [mailto:
> haskell-cafe-boun...@haskell

[Haskell-cafe] Re: "O LANGUAGE DESIGNER, REMEMBER THE POOR USER""

[Matt Morrow]

Here are some choice-quotes that are one of {insightful, controversial,
arguable}:

Starting with my favorite quote ;):

"The ability to operate on the program as data is basic to the provision of
many desirable utilities, e.g. the Boyer-Moore theorem prover, and the
program
transformation work that was based on Hope, not to mention a compiler.
It seems unfortunate that recent functional languages are heteroousian in
the
sense that they are defined in the usual computer scientist's way of
specifying
a syntax, and not specifying a representation of a program as a
data-structure. This is a manifestation of the besetting vice of computer
scientists - they will insist in locking up goodies in a black box..."

On Lisp:

"There is a danger that this perspective will adversely affect the design of
a
language from the user's point of view. The most extreme case is that of
LISP,
which may be seen as a very flawed implementation of the Lambda Calculus,
which preserves the notation rather closely."

On Haskell syntax:

"However, if the use of upper case is not permitted for
ordinary variables a conflict arises between the language conventions and
the
conventions of mathematics,"
"Haskell is also in conflict with established programming conventions in
that
it it uses double colon to denote membership of a type (e.g. x::Int) rather
than the single colon that those millions of existing programmers will be
familiar with,.."

On Haskell arrays:

"The Haskell array operation is a related construct, from which a instances
of
the application of the POP-11 newarray could be implemented - it does
however
suffer from one practical draw-back, namely it takes an association list as
argument, which makes it inefficient as a means of memoising a function,
unless a very smart compiler is used."

On purity:

"I want a language that is not purely functional because functional
languages do not reflect the basic structure of computers. If you want to
write a matrix inversion algorithm it will be hard to do it efficiently
without assignment."

Matt


On Thu, Apr 16, 2009 at 7:04 PM, Matt Morrow  wrote:

> This is interesting (and from 1990):
>
> http://groups.google.co.uk/group/comp.lang.functional/msg/655bb7bbd0fd8586
>
> (Not sure if this is well-known. It seems like it either is, or it should
> be. Either way, I just stumbled across it.)
>
>
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe

[Haskell-cafe] "O LANGUAGE DESIGNER, REMEMBER THE POOR USER""

[Matt Morrow]

This is interesting (and from 1990):

http://groups.google.co.uk/group/comp.lang.functional/msg/655bb7bbd0fd8586

(Not sure if this is well-known. It seems like it either is, or it should
be. Either way, I just stumbled across it.)
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe

Re: [Haskell-cafe] Code Golf

[Matt Morrow]

And i forgot to include the defs of (co)prod:

coprod (<>) i1 i2 = (\a b -> i1 a <> i2 b)
prod   (><) p1 p2 = (\a   -> p1 a >< p2 a)

diag = foldr (curry (prod mappend
fst
snd
. uncurry (coprod mappend
(splitAt 2)
(splitAt 1 []

Matt
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe

Re: [Haskell-cafe] Code Golf

[Matt Morrow]

*..against Monoid's method names.

On Wed, Apr 15, 2009 at 9:59 PM, Matt Morrow  wrote:

> ... against the Monoid method's names.
>
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe

Re: [Haskell-cafe] Code Golf

[Matt Morrow]

I think this has the semantics you're looking for. (it would probably be
somewhat prettier if "mappend" wasn't such an ugly identifier (compared to,
say, (++)), but this is just me trying to sneak a shot in against the Monoid
method's names ;)

ghci> let diag = foldr (curry (prod mappend fst snd . uncurry (coprod
mappend (splitAt 2) (splitAt 1 []

ghci> diag [[1,2,3],[4,5,6],[7,8,9]]
[1,2,4,3,5,7,6,8,9]
ghci> diag [[1,2,3],[4],[5,6,7]]
[1,2,4,3,5,6,7]


On Wed, Apr 15, 2009 at 5:32 AM, Sebastian Fischer <
s...@informatik.uni-kiel.de> wrote:

> Fancy some Codegolf?
>
> I wrote the following function for list diagonalization:
>
> > diag l = foldr (.) id ((sel l . flip sel) ((:[]).(:))) []
> >  where
> >   sel = foldr (\a b c -> id : mrg (a c) (b c)) (const []) . map (flip id)
> >
> >   mrg [] ys = ys
> >   mrg xs [] = xs
> >   mrg (x:xs) (y:ys) = (x.y) : mrg xs ys
>
> Self explanatory, isn't it? Here is a test case:
>
>*Main> take 10 $ diag [[ (m,n) | n <- [1..]] | m <- [1..]]
>[(1,1),(1,2),(2,1),(1,3),(2,2),(3,1),(1,4),(2,3),(3,2),(4,1)]
>
> I was trying to golf it down [^1] but my brain explodes. If you succeed in
> reducing keystrokes, I'd be happy to know!
>
> Cheers,
> Sebastian
>
> [^1]: http://codegolf.com/
> ___
> Haskell-Cafe mailing list
> Haskell-Cafe@haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe

Re: [Haskell-cafe] Strange type error with associated type synonyms

[Matt Morrow]

On Mon, Apr 6, 2009 at 7:39 PM, Manuel M T Chakravarty  wrote:

> Peter Berry:
>
>> 3) we apply appl to x, so Memo d1 a = Memo d a. unify d = d1
>>
>> But for some reason, step 3 fails.
>>
>
> Step 3 is invalid - cf, <
> http://www.haskell.org/pipermail/haskell-cafe/2009-April/059196.html>.
>
> More generally, the signature of memo_fmap is ambiguous, and hence,
> correctly rejected.  We need to improve the error message, though.  Here is
> a previous discussion of the subject:
>
>  http://www.mail-archive.com/haskell-cafe@haskell.org/msg39673.html
>
> Manuel


The thing that confuses me about this case is how, if the type sig on
memo_fmap is omitted, ghci has no problem with it, and even gives it the
type that it rejected:



{-# LANGUAGE TypeFamilies #-}

class Fun d where
  type Memo d :: * -> *
  abst :: (d -> a) -> Memo d a
  appl :: Memo d a -> (d -> a)

memo_fmap f x = abst (f . appl x)

-- [...@monire a]$ ghci -ignore-dot-ghci
-- GHCi, version 6.10.1: http://www.haskell.org/ghc/  :? for help
--
-- Prelude> :l ./Memo.hs
-- [1 of 1] Compiling Main ( Memo.hs, interpreted )
-- Ok, modules loaded: Main.
--
-- *Main> :t memo_fmap
-- memo_fmap :: (Fun d) => (a -> c) -> Memo d a -> Memo d c

-- copy/paste the :t sig

memo_fmap_sig :: (Fun d) => (a -> c) -> Memo d a -> Memo d c
memo_fmap_sig f x = abst (f . appl x)

-- and,

-- *Main> :r
-- [1 of 1] Compiling Main ( Memo.hs, interpreted )
--
-- Memo.hs:26:35:
-- Couldn't match expected type `Memo d'
--against inferred type `Memo d1'
-- In the first argument of `appl', namely `x'
-- In the second argument of `(.)', namely `appl x'
-- In the first argument of `abst', namely `(f . appl x)'
-- Failed, modules loaded: none.



Matt
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe

Re: [Haskell-cafe] Re: ANNOUNCE: vacuum-cairo: a cairo frontend to vacuum for live Haskell data visualization

[Matt Morrow]

Very nice.

Gleb Alexeyev  wrote:
  http://hackage.haskell.org/cgi-bin/hackage-scripts/package/vacuum-ubigraph
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe

Re: [Haskell-cafe] Re: ANNOUNCE: vacuum-cairo: a cairo frontend to vacuum for live Haskell data visualization

[Matt Morrow]

Holy crap! That looks amazing. I think you should most definitely upload it.

2009/4/1 Gleb Alexeyev 

> Don Stewart wrote:
>
>> I am pleased to announce the release of vacuum-cairo, a Haskell library
>> for interactive rendering and display of values on the GHC heap using
>> Matt Morrow's vacuum library.
>>
>
> Awesome stuff, kudos to you and Matt Morrow!
>
> I thought it'd be fun to visualize data structures in three dimensions.
> Attached is quick and dirty hack based on your code and Ubigraph server (
> http://ubietylab.net/ubigraph/).
>
> The demo video (apologies for poor quality):
> http://www.youtube.com/watch?v=3mMH1cHWB6c
>
> If someone finds it fun enough, I'll cabalize it and upload to Hackage.
>
> ___
> Haskell-Cafe mailing list
> Haskell-Cafe@haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>
>
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe

[Haskell-cafe] ANNOUNCE: vacuum: extract graph representations of ghc heap values. (take 2)

[Matt Morrow]

I am pleased to announce the release of vacuum, a library for extracting
graph representations of values from the GHC heap, which may then be further
processed and/or translated to Graphviz dot format to be visualized.

The package website is at http://moonpatio.com/vacuum/ , which contains a
gallery section (which i hope to add to over time).

The most recent version is 0.0.6, which is available on Hackage:
http://hackage.haskell.org/cgi-bin/hackage-scripts/package/vacuum/ .

Feedback, comments, and gallery submissions will be gratefully received via
this email address (contrary to the email address currently on the vacuum
Hackage page (i fail at setting up email :)).

Matt
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe

[Haskell-cafe] ANNOUNCE: vacuum: extract graph representations of ghc heap values.

[Matt Morrow]

I am pleased to announce the release of vacuum, a
Haskelllibrary for extracting graph
representations of values from the GHC  heap, which
may then be further processed and/or
translated to Graphviz  dot format to be visualized.

The package website is at http://moonpatio.com/vacuum/, which contains a
gallery section
(which i intend to add to over time).

The most recent version is 0.0.6, which is available on Hackage:
http://hackage.haskell.org/cgi-bin/hackage-scripts/package/vacuum/.

Feedback, comments, and/or gallery submissions will be gratefully received
via this email
address (contrary to the email address currently on the vacuum Hackage page
(i fail at
setting up email :)).

Matt
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe

Re: [Haskell-cafe] haskell-src-meta Package

[Matt Morrow]

Hi,

I managed to miss not one, but two separate emails containing patches to
haskell-src meta. My sincere apologies to those who've sent me patches.
I'll be applying them among other improvement to src-meta and will update
the package on hackage in short time (today :).

Matt
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe

[Haskell-cafe] (no subject)

[Matt Morrow]

Hi,

I managed to miss not one, but two separate emails containing patches to
haskell-src meta. My sincere apologies to those who've sent me patches.
I'll be applying them among other improvement to src-meta and will update
the package on hackage in short time (today :).

Matt
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe

Re: [Haskell-cafe] Type Family Relations

[Matt Morrow]

Generalizing the previous post, with:

-
{-# LANGUAGE GADTs #-}

module Equ where

data a:==:b where
  Equ :: (a ~ b) => a:==:b

symm :: (a:==:a)
symm = Equ

refl :: (a:==:b) -> (b:==:a)
refl Equ = Equ

trans :: (a:==:b) -> (b:==:c) -> (a:==:c)
trans Equ Equ = Equ

cast :: (a:==:b) -> (a -> b)
cast Equ = id
-

We can do (e.g.):

> data IPv4Header = C1
> data IPv4   = C2
> type instance HeaderOf IPv4 = IPv4Header
> type instance AddressOf IPv4Header = IPv4

t0 :: IPv4 :==: AddressOf IPv4Header
t0 = Equ

t1 :: IPv4Header :==: HeaderOf IPv4
t1 = Equ

t2 :: IPv4 :==: AddressOf (HeaderOf IPv4)
t2 = Equ

t3 :: IPv4Header :==: HeaderOf (AddressOf IPv4Header)
t3 = Equ

-- And interestingly `t6' shows that the type family option
-- in the previous case is slightly stronger that the funcdeps
-- option, ie the type fams one corresponds to the funcdeps
-- addr -> hdr, hdr -> addr (instead of the weaker addr -> hdr).
-- If this isn't desired I'd bet there's a way to modify the type
-- instances to get the desired behavior.

t5 :: AddrHdrPair a b
-> a :==: AddressOf (HeaderOf a)
t5 AddrHdrPair = Equ

t6 :: AddrHdrPair a b
-> b :==: HeaderOf (AddressOf b)
t6 AddrHdrPair = Equ

Matt
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe

Re: [Haskell-cafe] Type Family Relations

[Matt Morrow]

Hi,

> I think that
> >>> class HeaderOf addr hdr | addr -> hdr
> does not enforce that there must be a corresponding instance
> AddressOf hdr addr. Hence, the type checker cannot use that information
> either. Do you have a way to remedy that?

I've often wanted something similar, and experimenting with this
the following two options seem to be equivalent and work as desired:

-

-- both options share this code:

-- | The crucial assertion
ipv4 :: AddrHdrPair IPv4 IPv4Header
ipv4 = AddrHdrPair

data IPv4Header = C1
data IPv4   = C2
data AppAddress = C3
data AppHeader  = C4

-

-- OPTION(1):
-- type families + GADT with equality constraints

type family HeaderOf addr
type family AddressOf hdr
data AddrHdrPair hdr addr
  where AddrHdrPair :: (hdr ~ HeaderOf addr
   ,addr ~ AddressOf hdr) => AddrHdrPair addr hdr

type instance HeaderOf IPv4 = IPv4Header
type instance AddressOf IPv4Header = IPv4

-

-- OPTION(2):
-- classes + GADT with instance constraints

class HeaderOf addr hdr | addr -> hdr
class AddressOf hdr addr | addr -> hdr
data AddrHdrPair hdr addr
  where AddrHdrPair :: (HeaderOf addr hdr
   ,AddressOf hdr addr) => AddrHdrPair addr hdr

instance AddressOf IPv4Header IPv4
instance HeaderOf IPv4 IPv4Header

-

-- And commenting out the above instances in turn
-- to verify that everything indeed works, and to
-- compare error message content:

{-
-- type instance HeaderOf IPv4 = IPv4Header
Cafe0.hs:9:0:
Couldn't match expected type `HeaderOf IPv4'
   against inferred type `IPv4Header'
When generalising the type(s) for `ipv4'
Failed, modules loaded: none.

-- type instance AddressOf IPv4Header = IPv4
Cafe0.hs:9:0:
Couldn't match expected type `AddressOf IPv4Header'
   against inferred type `IPv4'
When generalising the type(s) for `ipv4'
Failed, modules loaded: none.
-}

{-
-- instance AddressOf IPv4Header IPv4
Cafe0.hs:9:7:
No instance for (AddressOf IPv4Header IPv4)
  arising from a use of `AddrHdrPair' at Cafe0.hs:9:7-17
Possible fix:
  add an instance declaration for (AddressOf IPv4Header IPv4)
In the expression: AddrHdrPair
In the definition of `ipv4': ipv4 = AddrHdrPair
Failed, modules loaded: none.

-- instance HeaderOf IPv4 IPv4Header
Cafe0.hs:9:7:
No instance for (HeaderOf IPv4 IPv4Header)
  arising from a use of `AddrHdrPair' at Cafe0.hs:9:7-17
Possible fix:
  add an instance declaration for (HeaderOf IPv4 IPv4Header)
In the expression: AddrHdrPair
In the definition of `ipv4': ipv4 = AddrHdrPair
Failed, modules loaded: none.
-}

-- endcode
-

I'm not sure if there are any circumstances under
which these two don't behave equivalently.

All the best,
Matt
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe

Re: [Haskell-cafe] Haskell syntax inside QuasiQuote

[Matt Morrow]

Ooh, interesting. I'm going to look into this..

On 10/28/08, Reiner Pope <[EMAIL PROTECTED]> wrote:
> Unfortunately, I've uncovered a problem in the parser. For instance,
> with your module, [$hs|1+1*2|] evaluates to 4 rather than 3. This
> seems to be a general problem with infix operators, which I believe
> arises since haskell-src-exts isn't given the fixity declarations for
> + and *, so it doesn't know to bind (*) tighter than (+). I don't see
> how this problem can even be resolved without modifying Template
> Haskell: given that the operators reside in user code, there is no way
> to find their fixity.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe

Re: [Haskell-cafe] Haskell syntax inside QuasiQuote

[Matt Morrow]

I've just uploaded an alpha version of the translation to hackage:

http://hackage.haskell.org/cgi-bin/hackage-scripts/package/haskell-src-meta-0.0.1

(I starting thinking after I uploaded that maybe haskell-src-th is a
better name..)

Here's one strategy for a haskell QQ:


module HsQQ where

import Language.Haskell.Meta
import Language.Haskell.TH.Lib
import Language.Haskell.TH.Quote
import Language.Haskell.TH.Syntax

-- |
-- > ghci> [$hs|\x -> (x,x)|] 42
-- > (42,42)
-- > ghci> (\[$hs|a@(x,_)|] -> (a,x)) (42,88)
-- > ((42,88),42)
hs :: QuasiQuoter
hs = QuasiQuoter
  (either fail transformE . parseExp)
  (either fail transformP . parsePat)

transformE :: Exp -> ExpQ
transformE = return

transformP :: Pat -> PatQ
transformP = return


I'll post updates as I add to the pkg over the next few days.

Cheers,
Matt



On 10/21/08, Reiner Pope <[EMAIL PROTECTED]> wrote:
> It sounds like you're doing exactly what I'm looking for. I look forward to
> more.
>
> Reiner
>
> On Tue, Oct 21, 2008 at 4:28 PM, Matt Morrow <[EMAIL PROTECTED]> wrote:
>
>> > Is there a simple way to do this, i.e. using existing libraries?
>>
>> Yes indeed. I'll be traveling over the next two days, and am shooting
>> for a fully functional hackage release by mid next week.
>>
>> > What I need is a Haskell expression parser which outputs values of type
>> > Language.Haskell.TH.Syntax.QExp, but I can't see one available in the TH
>> > libraries, or in the haskell-src(-exts) libraries.
>>
>> My strategy is to use the existing haskell-src-exts parser, then
>> translate that AST to the TH AST.
>>
>> Once I've got settled in one place, I'll follow up with a brain dump :)
>>
>> > Cheers,
>> > Reiner
>>
>> Matt
>> ___
>> Haskell-Cafe mailing list
>> Haskell-Cafe@haskell.org
>> http://www.haskell.org/mailman/listinfo/haskell-cafe
>>
>
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe

Re: [Haskell-cafe] Haskell syntax inside QuasiQuote

[Matt Morrow]

> Is there a simple way to do this, i.e. using existing libraries?

Yes indeed. I'll be traveling over the next two days, and am shooting
for a fully functional hackage release by mid next week.

> What I need is a Haskell expression parser which outputs values of type
> Language.Haskell.TH.Syntax.QExp, but I can't see one available in the TH
> libraries, or in the haskell-src(-exts) libraries.

My strategy is to use the existing haskell-src-exts parser, then
translate that AST to the TH AST.

Once I've got settled in one place, I'll follow up with a brain dump :)

> Cheers,
> Reiner

Matt
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe

[Haskell-cafe] Re: Multi-line string literals are both easy /and/ elegant in Haskell

[Matt Morrow]

> How exactly QuasiQuote behave, and what
> is available to handle them? (Or: can I
> find information already on the web?)

A QuasiQuoter is

data QuasiQuoter
  = QuasiQuoter {quoteExp :: String -> Q Exp,
 quotePat :: String -> Q Pat}
-- Defined in Language.Haskell.TH.Quote

There is a good writeup on the haskell.org wiki, and a link to a paper there.

> Sugestion: what about tex like syntax,
> i.e., change of line is a space, blank
> line is a newline (so that we could
> reformat the string without changing
> content)?

GHC hands you a String, and you can do arbitrary things
with it before you eventually return either an ExpQ or PatQ
(depending on context). I've uploaded a few QQs to hackage

http://hackage.haskell.org/cgi-bin/hackage-scripts/package/regexqq
http://hackage.haskell.org/cgi-bin/hackage-scripts/package/lighttpd-conf-qq

and am working on both one for Haskell itself, as well as as for Javascript.

> Best,
> Maurício

Matt
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe

Re: [Haskell-cafe] Multi-line string literals are both easy /and/elegant in Haskell

[Matt Morrow]

On 10/13/08, Andrew Coppin wrote:
> Cool. Is there any progress on getting GHC to *not* freak out when you
> ask it to compile a CAF containing several hundred KB of string literal? :-}

Yes and no. There's dons' compiled-constants pkg which has a solution:

  http://code.haskell.org/~dons/code/compiled-constants/

And the code below would do all the haskell-side work for importing
the data from C, but I'm not aware of a way to have ghc not freak out
if it has to compile a huge amount of static data.

---
{-# LANGUAGE TemplateHaskell #-}
module FromC (fromC) where
import GHC.Ptr(Ptr(Ptr))
import Foreign.C.Types(CChar)
import System.IO.Unsafe(unsafePerformIO)
import Data.ByteString.Unsafe(unsafePackAddressLen)
import Data.ByteString(ByteString)
import Language.Haskell.TH.Syntax
import Language.Haskell.TH.Lib

-- |
-- If in asdf.c == @unsigned char stuff[1024] = {42,.,19};@, then
--
-- > $(fromC "./asdf.c" "stuff" "dat")
---
-- will produce:
--
-- > foreign import ccall unsafe "&" stuff :: Ptr CChar
-- > dat :: ByteString
-- > dat = unsafePerformIO (case stuff of
-- >   Ptr addr_0 -> unsafePackAddressLen 1024 addr_0)
--
fromC :: FilePath -> String -> Int -> String -> Q [Dec]
fromC cfile cvar bytes hsvar = do
  let hsname = mkName hsvar
  t <- [t|ByteString|]
  e <- [|unsafePerformIO
  (case $(varE . mkName $ cvar) of
Ptr addr -> unsafePackAddressLen bytes addr)
  |]
  return [ ForeignD (ImportF CCall Unsafe "&" (mkName cvar)
(AppT (ConT ''Ptr) (ConT ''CChar)))
 , SigD hsname t , ValD (VarP hsname) (NormalB e) []]
---
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe

[Haskell-cafe] Multi-line string literals are both easy /and/ elegant in Haskell

[Matt Morrow]

The new QuasiQuotes extension arriving with ghc 6.10 is very exciting,
and handling multi-line string literals is like stealing candy from
a baby. ;)

-
-- Here.hs
module Here (here) where

import Language.Haskell.TH.Quote
import Language.Haskell.TH.Syntax
import Language.Haskell.TH.Lib

here :: QuasiQuoter
here = QuasiQuoter (litE . stringL) (litP . stringL)
-

-
-- There.hs
{-# LANGUAGE QuasiQuotes #-}
module Main where
import Here (here)
main = putStr [$here|

Shall I say, I have gone at dusk through narrow streets
And watched the smoke that rises from the pipes
Of lonely men in shirt-sleeves, leaning out of windows?

I should have been a pair of ragged claws
Scuttling across the floors of silent seas.


|]
-

-
[EMAIL PROTECTED] a]$ ghc -O2 --make There.hs
[1 of 2] Compiling Here ( Here.hs, Here.o )
[2 of 2] Compiling Main ( There.hs, There.o )
Loading package ghc-prim ... linking ... done.
Loading package integer ... linking ... done.
Loading package base ... linking ... done.
Loading package syb ... linking ... done.
Loading package array-0.2.0.0 ... linking ... done.
Loading package packedstring-0.1.0.1 ... linking ... done.
Loading package containers-0.2.0.0 ... linking ... done.
Loading package pretty-1.0.1.0 ... linking ... done.
Loading package template-haskell ... linking ... done.
Linking There ...
[EMAIL PROTECTED] a]$ ./There


Shall I say, I have gone at dusk through narrow streets
And watched the smoke that rises from the pipes
Of lonely men in shirt-sleeves, leaning out of windows?

I should have been a pair of ragged claws
Scuttling across the floors of silent seas.


[EMAIL PROTECTED] a]$
-
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe

[Haskell-cafe] Types and Trees

[Matt Morrow]

I really learned a lot from writing the below code,
and thought I'd share it with the group. I'm slightly
at a loss for words, having just spent the last two
hours on this when I most certainly should have
been doing other work, but these are two hours
I won't regret. I'm very interested in hearing
others' thoughts on "this", where "this" is
"whatever comes to mind".

Regards,
Matt

{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}

module TT where

import Data.Tree
import Data.Typeable
 (Typeable(..),TypeRep(..),TyCon(..)
 ,typeRepTyCon,typeRepArgs,tyConString)
import Language.Haskell.TH(Type(..),mkName)



class ToType a where
 toType :: a -> Type

class ToTree a b where
 toTree :: a -> Tree b

{-
   Typeable a
   |
 typeOf | (0)
   |
   v toType
 TypeRep  - - - - - - - - >  Type
   | (4) |
 toTree | (1)   (2) | toTree
   |  |
   v (3)v
   Tree TyCon  --->  Tree Type
 toTree

-}

-- (0)
typeableToTypeRep :: (Typeable a) => a -> TypeRep
typeableToTypeRep = typeOf

-- (1)
instance ToTree TypeRep TyCon where
 toTree ty = Node (typeRepTyCon ty)
   (fmap toTree . typeRepArgs $ ty)

-- (2)
instance ToTree Type Type where
 toTree (AppT t1 t2) =
   let (Node x xs) = toTree t1
   in Node x (xs ++ [toTree t2])
 toTree t = Node t []

-- (3.a)
instance ToType TyCon where
 toType tyC = let tyS = tyConString tyC
   in case tyS of
   "->"-> ArrowT
   "[]"-> ListT
   "()"-> TupleT 0
   ('(':',':rest)  -> let n = length
   (takeWhile (==',') rest)
  in TupleT (n+2)
   _   -> ConT . mkName $ tyS

-- (3.b)
instance ToType (Tree TyCon) where
 toType (Node x xs) =
   foldl AppT (toType x)
   (fmap toType xs)

-- (3)
instance ToTree (Tree TyCon) Type where
 toTree = toTree . toType

-- (4)
instance ToType TypeRep where
 toType = toType . (toTree::TypeRep->Tree TyCon)

-- (0)  typeOf
-- (1)  toTree
-- (2)  toTree
-- (3)  toTree
-- (4)  toType

-- (0) -> (1)
tyConTree :: (Typeable a) => a -> Tree TyCon
tyConTree = toTree . typeOf

-- (0) -> (1) -> (3)
typeTree_a :: (Typeable a) => a -> Tree Type
typeTree_a = (toTree::Tree TyCon->Tree Type)
 . (toTree::TypeRep->Tree TyCon)
   . typeOf

-- (0) -> (4) -> (2)
typeTree_b :: (Typeable a) => a -> Tree Type
typeTree_b = (toTree::Type->Tree Type)
 . (toType::TypeRep->Type)
   . typeOf


diagram_commutes :: (Typeable a) => a -> Bool
diagram_commutes a = typeTree_a a == typeTree_b a

-- ghci> diagram_commutes x0
-- True
x0 :: (Num a) => ((a,(a,((a,a),a))),(a,(a,a)))
x0 = ((0,(0,((0,0),0))),(0,(0,0)))



printTree :: (Show a) => Tree a -> IO ()
printTree = putStr . drawTree . fmap show

printForest :: (Show a) => Forest a -> IO ()
printForest = putStr . drawForest . (fmap . fmap) show


{-

ghci> printTree $ tyConTree  x0
(,)
|
+- (,)
|  |
|  +- Integer
|  |
|  `- (,)
| |
| +- Integer
| |
| `- (,)
||
|+- (,)
||  |
||  +- Integer
||  |
||  `- Integer
||
|`- Integer
|
`- (,)
  |
  +- Integer
  |
  `- (,)
 |
 +- Integer
 |
 `- Integer


ghci> printTree $ typeTree_a x0
TupleT 2
|
+- TupleT 2
|  |
|  +- ConT Integer
|  |
|  `- TupleT 2
| |
| +- ConT Integer
| |
| `- TupleT 2
||
|+- TupleT 2
||  |
||  +- ConT Integer
||  |
||  `- ConT Integer
||
|`- ConT Integer
|
`- TupleT 2
  |
  +- ConT Integer
  |
  `- TupleT 2
 |
 +- ConT Integer
 |
 `- ConT Integer


ghci> printTree $ typeTree_b x0
TupleT 2
|
+- TupleT 2
|  |
|  +- ConT Integer
|  |
|  `- TupleT 2
| |
| +- ConT Integer
| |
| `- TupleT 2
||
|+- TupleT 2
||  |
||  +- ConT Integer
||  |
||  `- ConT Integer
||
|`- ConT Integer
|
`- TupleT 2
  |
  +- ConT Integer
  |
  `- TupleT 2
 |
 +- ConT Integer
 |
 `- ConT Integer

-}

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe