Re: [Haskell-cafe] New slogan for haskell.org

2007-10-06 Thread Don Stewart
bf3:
 For me, a good reason why one should look at Haskell is because you 
 should NOT look at Haskell since it will change your view on programming 
 so much, you don't want to go back... ;-)
 
 But where is the great IDE Haskell deserves??? :-) Seriously, 99% of the 
 programmers I know don't want to look at it because when they see Emacs 
 or VIM, they say what the f*ck, I don't want to go back to the 
 stone age. If you want to attract more people that are inside the 
 imperative-OO-with-nice-IDE-blob, create a great looking and 
 functional IDE. An IDE that integrates the existing tools. That shows 
 you graphical pictures of the graph rewriting process, potential space 
 leaks, profiling bottlenecks, etc. Heck, why not introduce pictures as 
 symbols and values, as in DrScheme. Or UNICODE fonts. or or ... Okay, 
 enough of that, off topic ;-)

It has been suggested we could just sit DrScheme in front of ghc/ghci.
Anyone with experience who'd like to step up for this?

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


[Haskell-cafe] Typed DSL compiler, or converting from an existential to a concrete type

2007-10-06 Thread oleg

The earlier message showed how to implement a typechecker from untyped
AST to wrapped typed terms. The complete code can be found at
http://okmij.org/ftp//Haskell/staged/TypecheckedDSL.hs

The typechecker has the type
typecheck :: Gamma - Exp - Either String TypedTerm
where
data TypedTerm = forall t. TypedTerm (Typ t) (Term t)

Upon success, the typechecker returns the typed term wrapped in an
existential envelope. Although we can evaluate that term, the result
is not truly satisfactory because the existential type is not
`real'. For example, given the parsed AST

 te3 = EApp (EApp (EPrim +) 
(EApp (EPrim inc) (EDouble 10.0)))
(EApp (EPrim inc) (EDouble 20.0))

we might attempt to write

 testr = either (error) (ev) (typecheck env0 te3)
  where ev (TypedTerm t e) = sin (eval e)

We know that it should work. We know that e has the type Term Double,
and so (eval e) has the type Double, and so applying sin is correct. But
the typechecker does not see it this way. To the typechecker
Inferred type is less polymorphic than expected
  Quantified type variable `t' escapes
that is, to the typechecker, the type of (eval e) is some abstract
type t, and that is it.

As it turns out, we can use TH to convert from an existential to a
concrete type. This is equivalent to implementing an embedded
*compiler* for our DSL. 

The trick is the magic function
lift'self :: Term a - ExpQ
that takes a term and converts it to the code of itself. Running the
resulting code recovers the original term:
$(lift'self term) === term

There is actually little magic to lift'self. It takes only
four lines of code to define this function.

We can now see the output of the compiler, the generated code

*TypedTermLiftTest show_code $ tevall te3
TypecheckedDSLTH.App (TypecheckedDSLTH.App (TypecheckedDSLTH.Fun 
(Language.Haskell.TH.Syntax.mkNameG_v base GHC.Num +) (GHC.Num.+)) 
(TypecheckedDSLTH.App (TypecheckedDSLTH.Fun 
(Language.Haskell.TH.Syntax.mkNameG_v main TypecheckedDSLTH inc) 
TypecheckedDSLTH.inc) (TypecheckedDSLTH.Num (10%1 (TypecheckedDSLTH.App 
(TypecheckedDSLTH.Fun (Language.Haskell.TH.Syntax.mkNameG_v main 
TypecheckedDSLTH inc) TypecheckedDSLTH.inc) (TypecheckedDSLTH.Num (20%1)))

[we should be glad this is not the machine code]

Mainly, we can now do the following (in a different module: TH
requires splices to be used in a different module)

 tte3 = $(tevall te3)

:t tte3
tte3 :: Term Double
This is the real Double type, rather some abstract type

 ev_tte3 = eval tte3
 -- 32.0

 testr = sin (eval tte3)

 testr = sin (eval tte3)
 -- 0.5514266812416906

The complete code for the DSL compiler is available at

http://okmij.org/ftp//Haskell/staged/TypecheckedDSLTH.hs
http://okmij.org/ftp//Haskell/staged/TypedTermLiftTest.hs

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


Re: [Haskell-cafe] Puzzled

2007-10-06 Thread Peter Verswyvelen
Ouch, now I really feel stupid, because I *knew* about the stricter 
foldl' version.


But great to know about the new strictness on vars! I really should get 
GHC 6.8 RC1 for Windows...


I just got puzzled why mysum worked better than sum for some reason... 
mysym looks like an identical unfolded version of sum to me, yet it 
behaved differently. mysum, also being non-strict, did *not* stack 
overflow. Maybe because it is a simpler / more unfolded version, so it 
needs to keep less euh unevaluated thunks (how are these called?) on 
the stack? So I would also have gotten a stack overflow with mysum, it 
just needed more iterations?


Many thanks,
Peter


Bertram Felgenhauer wrote:

Peter Verswyvelen wrote:
  
The following code, when compiled with GHC 6.6.1 --make -O gives a stack 
overflow when I enter 100 as a command line argument:


(please don't look at the efficiency of the code, it can of course be 
improved a lot both in time performance and numeric precision...)


import System

leibnizPI :: Integer - Double
leibnizPI n = sum (map leibnizTerm [0..n]) where
   leibnizTerm n = let i = fromIntegral n
   in 4 * (((-1) ** i) / (2*i+1))
main = do
 args - getArgs
 let n = read (head args)
 print (leibnizPI n)

However, if I replace

main = print (leibnizPI 100)

is does not stack overflow.

Now, if I leave the original main, but replace sum in leibnizPI by

mysum xs = aux 0 xs
   where
 aux s (x:xs) = aux (s+x) xs
 aux s [] = s

Then I don't get a stack overflow.

However, I do get a stack overflow when I compile it without -O, in all 
cases.


This puzzles me. I don't see any non-tail calls in my code...

I guess it has to do with strictness? 
http://www.haskell.org/haskellwiki/Performance/Strictness



Yes.

The problem is that without optimizations, both  sum  and  mysum
build a large unevaluated expression of the form

((..((0+x1)+x2)+...)+xn)

The stack overflow happens when this expression gets evaluated. At that
point, the outermost (+) demands the result of the (+) on the next level,
and so on.

To prevent this you need a stricter version of sum. You can build one
with foldl':

  

import Data.List

sum' :: Num a = [a] - a
sum' = foldl' (+) 0



Arguably this is the correct definition of sum. The problem you
had is fairly common.

  
Why isn't it possible to annotate strictness on the type signature in 
Haskell as in Clean? Is this on the TODO list?



Strictness is independent from the type in Haskell (but see the fourth
solution presented below). You can explicitely make one value at least
as strict as another using  seq:

  

mysum' xs = aux 0 xs
   where
 aux s (x:xs) = let s' = s+x in s' `seq` aux s' xs
 aux s [] = s



In ghc, you can mark arguments as strict

  

mysum'' xs = aux 0 xs
   where
 aux !s (x:xs) = aux (s+x) xs
 aux !s [] = s



This is a language extension, you need -fbang-patterns
to allow it, or with a recent ghc (6.7, 6.9 or a 6.8 rc)
a {-# LANGUAGE BangPatterns #-} pragma, or -XBangPatterns.

A fourth possibility, which is Haskell 98 again, is to declare an
auxiliary data type with a strict field:

  

data Strict a = Strict !a

mysum''' xs = aux (Strict 0) xs
  where
aux (Strict s) (x:xs) = aux (Strict (s+x)) xs
aux (Strict s) [] = s



Hope that helps,

Bertram
___
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] Puzzled

2007-10-06 Thread Chaddaï Fouché
2007/10/6, Peter Verswyvelen [EMAIL PROTECTED]:
  But great to know about the new strictness on vars! I really should get GHC
 6.8 RC1 for Windows...

Just in case you misunderstood : this functionality was already there
in GHC 6.4, it's just the new syntax to active it that is available
only in recent versions of GHC : this new syntax will hopefully be
adopted by others Haskell compilers and thus become a
compiler-agnostic way of specifying extensions to Haskell98 (so that
others compiler than GHC can tell you why they won't compile this
wonderful code that use all the latest extensions that have been
included into your release candidate of GHC, much better than the old
way where they just told you the syntax was wrong, isn't it ?).

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


Re: [Haskell-cafe] Puzzled

2007-10-06 Thread Stuart Cook
On 10/6/07, Bertram Felgenhauer [EMAIL PROTECTED] wrote:
 This is a language extension, you need -fbang-patterns
 to allow it, or with a recent ghc (6.7, 6.9 or a 6.8 rc)
 a {-# LANGUAGE BangPatterns #-} pragma, or -XBangPatterns.

LANGUAGE pragmas (including BangPatterns) work just fine in 6.6, by the way.


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


[Haskell-cafe] Re: Typed DSL compiler, or converting from an existential to a concrete type

2007-10-06 Thread Pasqualino 'Titto' Assini
Hi Oleg,

Many thanks for this, it is really brilliant stuff.

It is a pity that it cannot be used in an interpreter but it is a great trick 
to know for static compilation of DSLs.

All the best,

   titto


On Saturday 06 October 2007 08:55:36 [EMAIL PROTECTED] wrote:
 The earlier message showed how to implement a typechecker from untyped
 AST to wrapped typed terms. The complete code can be found at
   http://okmij.org/ftp//Haskell/staged/TypecheckedDSL.hs

 The typechecker has the type
   typecheck :: Gamma - Exp - Either String TypedTerm
 where
   data TypedTerm = forall t. TypedTerm (Typ t) (Term t)

 Upon success, the typechecker returns the typed term wrapped in an
 existential envelope. Although we can evaluate that term, the result
 is not truly satisfactory because the existential type is not
 `real'. For example, given the parsed AST

  te3 = EApp (EApp (EPrim +)
   (EApp (EPrim inc) (EDouble 10.0)))
 (EApp (EPrim inc) (EDouble 20.0))

 we might attempt to write

  testr = either (error) (ev) (typecheck env0 te3)
   where ev (TypedTerm t e) = sin (eval e)

 We know that it should work. We know that e has the type Term Double,
 and so (eval e) has the type Double, and so applying sin is correct. But
 the typechecker does not see it this way. To the typechecker
 Inferred type is less polymorphic than expected
   Quantified type variable `t' escapes
 that is, to the typechecker, the type of (eval e) is some abstract
 type t, and that is it.

 As it turns out, we can use TH to convert from an existential to a
 concrete type. This is equivalent to implementing an embedded
 *compiler* for our DSL.

 The trick is the magic function
   lift'self :: Term a - ExpQ
 that takes a term and converts it to the code of itself. Running the
 resulting code recovers the original term:
   $(lift'self term) === term

 There is actually little magic to lift'self. It takes only
 four lines of code to define this function.

 We can now see the output of the compiler, the generated code

 *TypedTermLiftTest show_code $ tevall te3
 TypecheckedDSLTH.App (TypecheckedDSLTH.App (TypecheckedDSLTH.Fun
 (Language.Haskell.TH.Syntax.mkNameG_v base GHC.Num +) (GHC.Num.+))
 (TypecheckedDSLTH.App (TypecheckedDSLTH.Fun
 (Language.Haskell.TH.Syntax.mkNameG_v main TypecheckedDSLTH inc)
 TypecheckedDSLTH.inc) (TypecheckedDSLTH.Num (10%1 (TypecheckedDSLTH.App
 (TypecheckedDSLTH.Fun (Language.Haskell.TH.Syntax.mkNameG_v main
 TypecheckedDSLTH inc) TypecheckedDSLTH.inc) (TypecheckedDSLTH.Num
 (20%1)))

 [we should be glad this is not the machine code]

 Mainly, we can now do the following (in a different module: TH
 requires splices to be used in a different module)

  tte3 = $(tevall te3)
 
   :t tte3

   tte3 :: Term Double
 This is the real Double type, rather some abstract type

  ev_tte3 = eval tte3
  -- 32.0
 
  testr = sin (eval tte3)
 
  testr = sin (eval tte3)
  -- 0.5514266812416906

 The complete code for the DSL compiler is available at

   http://okmij.org/ftp//Haskell/staged/TypecheckedDSLTH.hs
   http://okmij.org/ftp//Haskell/staged/TypedTermLiftTest.hs


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


Re: [Haskell-cafe] Puzzled

2007-10-06 Thread Brent Yorgey
Just to be clear, I doubt the difference had anything to do with
tail-recursion per se.   My guess is that with the mysum version, ghc was
able to do some strictness analysis/optimization that it wasn't able to do
(for whatever reason) with the first version.  The best solution (as others
have pointed out) is to create a strict version of sum with foldl'.

On 10/6/07, Peter Verswyvelen [EMAIL PROTECTED] wrote:

  Ouch, now I really feel stupid, because I *knew* about the stricter
 foldl' version.

 But great to know about the new strictness on vars! I really should get
 GHC 6.8 RC1 for Windows...

 I just got puzzled why mysum worked better than sum for some reason...
 mysym looks like an identical unfolded version of sum to me, yet it behaved
 differently. mysum, also being non-strict, did *not* stack overflow. Maybe
 because it is a simpler / more unfolded version, so it needs to keep less
 euh unevaluated thunks (how are these called?) on the stack? So I would
 also have gotten a stack overflow with mysum, it just needed more
 iterations?

 Many thanks,
 Peter


 Bertram Felgenhauer wrote:

 Peter Verswyvelen wrote:

  The following code, when compiled with GHC 6.6.1 --make -O gives a stack
 overflow when I enter 100 as a command line argument:

 (please don't look at the efficiency of the code, it can of course be
 improved a lot both in time performance and numeric precision...)

 import System

 leibnizPI :: Integer - Double
 leibnizPI n = sum (map leibnizTerm [0..n]) where
leibnizTerm n = let i = fromIntegral n
in 4 * (((-1) ** i) / (2*i+1))
 main = do
  args - getArgs
  let n = read (head args)
  print (leibnizPI n)

 However, if I replace

 main = print (leibnizPI 100)

 is does not stack overflow.

 Now, if I leave the original main, but replace sum in leibnizPI by

 mysum xs = aux 0 xs
where
  aux s (x:xs) = aux (s+x) xs
  aux s [] = s

 Then I don't get a stack overflow.

 However, I do get a stack overflow when I compile it without -O, in all
 cases.

 This puzzles me. I don't see any non-tail calls in my code...

 I guess it has to do with strictness?
 http://www.haskell.org/haskellwiki/Performance/Strictness

  Yes.

 The problem is that without optimizations, both  sum  and  mysum
 build a large unevaluated expression of the form

 ((..((0+x1)+x2)+...)+xn)

 The stack overflow happens when this expression gets evaluated. At that
 point, the outermost (+) demands the result of the (+) on the next level,
 and so on.

 To prevent this you need a stricter version of sum. You can build one
 with foldl':

import Data.List

 sum' :: Num a = [a] - a
 sum' = foldl' (+) 0

  Arguably this is the correct definition of sum. The problem you
 had is fairly common.

Why isn't it possible to annotate strictness on the type signature in
 Haskell as in Clean? Is this on the TODO list?

  Strictness is independent from the type in Haskell (but see the fourth
 solution presented below). You can explicitely make one value at least
 as strict as another using  seq:

mysum' xs = aux 0 xs
where
  aux s (x:xs) = let s' = s+x in s' `seq` aux s' xs
  aux s [] = s

  In ghc, you can mark arguments as strict

mysum'' xs = aux 0 xs
where
  aux !s (x:xs) = aux (s+x) xs
  aux !s [] = s

  This is a language extension, you need -fbang-patterns
 to allow it, or with a recent ghc (6.7, 6.9 or a 6.8 rc)
 a {-# LANGUAGE BangPatterns #-} pragma, or -XBangPatterns.

 A fourth possibility, which is Haskell 98 again, is to declare an
 auxiliary data type with a strict field:

data Strict a = Strict !a

 mysum''' xs = aux (Strict 0) xs
   where
 aux (Strict s) (x:xs) = aux (Strict (s+x)) xs
 aux (Strict s) [] = s

  Hope that helps,

 Bertram
 ___
 Haskell-Cafe mailing list
 [EMAIL PROTECTED]://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 mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] ANNOUNCE: binary 0.4: high performance, pure binary parsing and serialisation

2007-10-06 Thread Don Stewart

Binary: high performance, pure binary encoding, decoding and serialisation for 
Haskell
 -- 

The Binary Strike Team is pleased to announce release 0.4 of Data.Binary, the
pure, efficient binary serialisation library for Haskell, now available from
Hackage:

 tarball:
http://hackage.haskell.org/cgi-bin/hackage-scripts/package/binary/0.4
 darcs:  darcs get http://darcs.haskell.org/binary

The 'binary' package provides efficient serialisation of Haskell values
to and from lazy ByteStrings, and a low level layer for high performance
decoding and decoding binary data. ByteStrings constructed this way may then be
written to disk, written to the network, or further processed (e.g.  stored in
memory directly, or compressed in memory with zlib or bzlib).

*Very* high performance can be expected, with throughput over 1G/sec observed
in practice (good enough for most networking scenarios, we suspect).

Encoding and decoding are achieved by the functions:

encode :: Binary a = a - ByteString
decode :: Binary a = ByteString - a

which mirror the read/show functions. Convenience functions for serialising to
disk are also provided:

encodeFile :: Binary a = FilePath - a - IO ()
decodeFile :: Binary a = FilePath - IO a

To serialise your Haskell data, all you need do is write an instance of
Binary for your type. For example, suppose in an interpreter we had the
data type:

import Data.Binary
import Control.Monad

data Exp = IntE Int
 | OpE  String Exp Exp

We can serialise this to bytestring form with the following instance:

instance Binary Exp where
put (IntE i)  = putWord8 0  put i
put (OpE s e1 e2) = putWord8 1  put s  put e1  put e2
get = do tag - getWord8
 case tag of
0 - liftM  IntE get
1 - liftM3 OpE  get get get

The binary library has been heavily tuned for performance, particularly for
writing speed.  On average, Data.Binary is 10x faster than NewBinary, and 
has the advantage of a pure interface, and bytestring return values.

Binary was developed by a team of 8 during the Haskell Hackathon, Hac
07, in January 2007, and this maintainence release has taken place during the
second hackathon.

Binary is portable, using the foreign function interface and cpp, and has
been tested with Hugs and GHC.

Happy hacking!

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


Re: [Haskell-cafe] ANNOUNCE: binary 0.4: high performance, pure binary parsing and serialisation

2007-10-06 Thread Felipe Almeida Lessa
On 10/6/07, Don Stewart [EMAIL PROTECTED] wrote:
 The Binary Strike Team is pleased to announce release 0.4 of Data.Binary, the
 pure, efficient binary serialisation library for Haskell, now available from
 Hackage:

May I ask what are the changes? I didn't find some sort of changelog anywhere.

  tarball:
 http://hackage.haskell.org/cgi-bin/hackage-scripts/package/binary/0.4

...and this links gives a four-oh-four, not found.

Thanks for this fine library,

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


Re: [Haskell-cafe] Typed DSL compiler, or converting from an existential to a concrete type

2007-10-06 Thread Roberto Zunino
[EMAIL PROTECTED] wrote:
 we might attempt to write
 
 testr = either (error) (ev) (typecheck env0 te3)
  where ev (TypedTerm t e) = sin (eval e)
 
 We know that it should work.

If we know it has to be a Double, we can express that:

 testr = either (error) (ev) (typecheck env0 te3)
  where ev (TypedTerm TDouble e) = sin (eval e)

and this compiles. Of course, we can consider the other types as well:

 testr = either (error) (ev) (typecheck env0 te3)
   where ev (TypedTerm TDouble e) = Right $ sin (eval e)
 ev _ = Left not a Double

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


Re: [Haskell-cafe] Extract source code from literate Haskell (LHS) files

2007-10-06 Thread Neil Mitchell
Hi Peter,

  This is of course very easy to do manually, but does a command line tool
 exist for extracting source code from literate Haskell files?

Cpphs is the perfect tool to do this.

Thanks

Neil


On 9/30/07, Peter Verswyvelen [EMAIL PROTECTED] wrote:


  Thanks,
  Peter


 ___
 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] GLFW for WinHugs

2007-10-06 Thread Neil Mitchell
Hi Peter,

It sounds like the problem is that you need to convert it to Hugs,
rather than WinHugs specific (which might put a few people off looking
to see if they can help). Perhaps an email to the author of the
library might help you find if they would be interested in doing a
port to Hugs.

From my very limited knowledge, RTS.h defines various constants and
links into the GHC runtime, but I don't think Hugs has any equivalent.
Depending on what they are using RTS.h for, they might be able to use
alternatives on Hugs. However, my knowledge of this side is even less
than my knowledge of football, so if you can find a second opinion,
take it!

Thanks

Neil

On 10/3/07, Peter Verswyvelen [EMAIL PROTECTED] wrote:




 The latest version of SOE comes with a wrapper for a nice GLFW library. This
 library comes with a demo of a 3D bouncing Amiga ball so it must be the
 best library in the world ;-) ;-)



 Since I'm letting my students play with WinHugs, I would prefer to have a
 WinHugs compatible version of that library. I tried to convert it, but I got
 stuck when ffihugs complained about not finding RTS.h, which seems to be a
 GHC-only include file.



 Would it be possible to convert this library to WinHugs? I guess similar
 work has been done for other libraries, so any hints are welcome.



 Thanks,

 Peter


 ___
 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] Type-level arithmetic

2007-10-06 Thread Andrew Coppin
I've seen quite a few people do crazy things to abuse the Haskell type 
system in order to perform arithmetic in types. Stuff the type system 
was never ever intended to do.


Well I was just wondering... did anybody ever sit down and come up with 
a type system that *is* designed for this kind of thing? What would that 
look like? (I'm guessing rather complex!)


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


Re: [Haskell-cafe] Type-level arithmetic

2007-10-06 Thread Dan Piponi
On 10/6/07, Andrew Coppin [EMAIL PROTECTED] wrote:
 I've seen quite a few people do crazy things to abuse the Haskell type
 system in order to perform arithmetic in types.

How did you know precisely what I was doing at this moment in time?

 Stuff the type system
 was never ever intended to do.

There's didn't intended that it be possible to and there's intend
that it be impossible to. Hmmm...maybe one of these should be called
cointend.

 Well I was just wondering... did anybody ever sit down and come up with
 a type system that *is* designed for this kind of thing? What would that
 look like? (I'm guessing rather complex!)

Well there are always languages with dependent type systems which
allow you to have the type depend on a value. In such a language it's
easier to make types that correspond to some mathematical
constructions, like a separate type for each n-dimensional vector.
(See http://www.haskell.org/haskellwiki/Dependent_type.) But that's
kind of cheating. I'm guessing you're talking about a language that
makes it easier to fake your own dependent types without properly
implementing dependent types. If you find one, I could use it right
now - the details of embedding the gaussian integers in Haskell types
are getting a bit complicated right now...
--
Dan
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: New slogan for haskell.org

2007-10-06 Thread Will Thompson
On Sat, Oct 06, 2007 at 01:26:18PM -0500, Alex Tarkovsky wrote:
 ...and the silliness continues:

In which case:

http://pics.livejournal.com/resiak/pic/00019kx6/

Will


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


[Haskell-cafe] Re: New slogan for haskell.org

2007-10-06 Thread Alex Tarkovsky
Will Thompson wrote:
 http://pics.livejournal.com/resiak/pic/00019kx6/

Bravo. ;)

And here's what happens when you substitute your cat for GHCi:

http://arcanux.org/lambdacats3.html

-- 
Alex Tarkovsky

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


Re: [Haskell-cafe] Extract source code from literate Haskell (LHS) files

2007-10-06 Thread Malcolm Wallace
   This is of course very easy to do manually, but does a command line tool
  exist for extracting source code from literate Haskell files?
 
 Cpphs is the perfect tool to do this.

In case the link is not immediately obvious, cpphs has the -unlit flag
to remove the literate parts of the file, leaving pure code.

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


Re: [Haskell-cafe] ANNOUNCE: binary 0.4: high performance, pure binary parsing and serialisation

2007-10-06 Thread Andrew Coppin

Don Stewart wrote:

*Very* high performance can be expected, with throughput over 1G/sec observed
in practice (good enough for most networking scenarios, we suspect).
  


Um... I wasn't aware that there was any harddrive or networking 
technology that goes this fast?


Anyway, I'll have to take a look at the package and see if I can figure 
out how to work it. It is likely to prove quite useful...


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


Re: [Haskell-cafe] ANNOUNCE: binary 0.4: high performance, pure binary parsing and serialisation

2007-10-06 Thread Don Stewart
agl:
 On 10/6/07, Felipe Almeida Lessa [EMAIL PROTECTED] wrote:
  May I ask what are the changes? I didn't find some sort of changelog 
  anywhere.
 
 There's the darcs changes list. The descriptions there in are .. terse :)
 
 But here's a selection:
   * Add getLazyByteStringNul.
 
 -- | Get a lazy ByteString that is terminated with a NUL byte. Fails
 -- if it reaches the end of input without hitting a NUL.
 getLazyByteStringNul :: Get L.ByteString
 
   * Fix strictness bug in runGetState that led to runtime errors.
 
   * Port binary to ghc 6.8
 
   * add parallel driver  (appears to be a parallel quicktest - which
 is cool because the tests took quite a while previously).

The main thing is porting to ghc 6.8 -- which means the new (*faster*)
lazy bytestring representation, and the smp parallel quickcheck driver
for the testsuite (it'll use N cores, watch the jobs migrate around).

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


Re: [Haskell-cafe] ANNOUNCE: binary 0.4: high performance, pure binary parsing and serialisation

2007-10-06 Thread Stefan O'Rear
On Sat, Oct 06, 2007 at 10:16:37PM +0100, Andrew Coppin wrote:
 Don Stewart wrote:
 *Very* high performance can be expected, with throughput over 1G/sec 
 observed
 in practice (good enough for most networking scenarios, we suspect).
   

 Um... I wasn't aware that there was any harddrive or networking technology 
 that goes this fast?

 Anyway, I'll have to take a look at the package and see if I can figure out 
 how to work it. It is likely to prove quite useful...

It's what we call ironic understatement, I suspect.

Anyways, a single-mode optical fiber (as thin as a human hair), can
transmit data at around 1,000,000 Gbit/s.  Good luck finding a
sufficiently advanced line driver; the last time I ran the Linux
configuation program, it prompted up to 10,000 Mbit/s, so we're probably
at least that far...

Stefan


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


Re: [Haskell-cafe] ANNOUNCE: binary 0.4: high performance, pure binary parsing and serialisation

2007-10-06 Thread Don Stewart
andrewcoppin:
 Don Stewart wrote:
 *Very* high performance can be expected, with throughput over 1G/sec 
 observed
 in practice (good enough for most networking scenarios, we suspect).
   
 
 Um... I wasn't aware that there was any harddrive or networking 
 technology that goes this fast?

My bus is that fast. The point to take home is that serialising values
(and possibly parsing stuff off the network) won't be a bottleneck in
your Haskell code, for a while to come.

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


Re: [Haskell-cafe] Type-level arithmetic

2007-10-06 Thread Lennart Augustsson
Yes, that web page is a terrible introduction to dependent types. :)

On 10/6/07, Andrew Coppin [EMAIL PROTECTED] wrote:

 Dan Piponi wrote:
  On 10/6/07, Andrew Coppin [EMAIL PROTECTED] wrote:
 
  I've seen quite a few people do crazy things to abuse the Haskell type
  system in order to perform arithmetic in types.
 
 
  How did you know precisely what I was doing at this moment in time?
 

 Birthday paradox?

  Stuff the type system
  was never ever intended to do.
 
 
  There's didn't intended that it be possible to and there's intend
  that it be impossible to. Hmmm...maybe one of these should be called
  cointend.
 

 Ouch. You're making my head hurt...

  Well I was just wondering... did anybody ever sit down and come up with
  a type system that *is* designed for this kind of thing? What would
 that
  look like? (I'm guessing rather complex!)
 
 
  Well there are always languages with dependent type systems which
  allow you to have the type depend on a value. In such a language it's
  easier to make types that correspond to some mathematical
  constructions, like a separate type for each n-dimensional vector.
  (See http://www.haskell.org/haskellwiki/Dependent_type.) But that's
  kind of cheating. I'm guessing you're talking about a language that
  makes it easier to fake your own dependent types without properly
  implementing dependent types. If you find one, I could use it right
  now - the details of embedding the gaussian integers in Haskell types
  are getting a bit complicated right now...
 

 ...I have no idea what you just said.

 (The wiki article is pretty special though. An entire raft of dense
 equations with no attempt to provide any background or describe what any
 of this gibberish *is*. Clearly it made sense to the author, but...)

 ___
 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] ANNOUNCE: binary 0.4: high performance, pure binary parsing and serialisation

2007-10-06 Thread Don Stewart
felipe.lessa:
 On 10/6/07, Don Stewart [EMAIL PROTECTED] wrote:
  The Binary Strike Team is pleased to announce release 0.4 of Data.Binary, 
  the
  pure, efficient binary serialisation library for Haskell, now available from
  Hackage:
 
 May I ask what are the changes? I didn't find some sort of changelog anywhere.
 
   tarball:
  http://hackage.haskell.org/cgi-bin/hackage-scripts/package/binary/0.4
 
 ...and this links gives a four-oh-four, not found.
 
 Thanks for this fine library,
 

Ah, hackages format changed, but my email template didn't:

http://hackage.haskell.org/cgi-bin/hackage-scripts/package/binary
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Type-level arithmetic

2007-10-06 Thread David Menendez
On 10/6/07, Dan Piponi [EMAIL PROTECTED] wrote:
 I'm guessing you're talking about a language that
 makes it easier to fake your own dependent types without properly
 implementing dependent types. If you find one, I could use it right
 now - the details of embedding the gaussian integers in Haskell types
 are getting a bit complicated right now...

I think Ωmega was designed along those lines.

http://web.cecs.pdx.edu/~sheard/


-- 
Dave Menendez [EMAIL PROTECTED]
http://www.eyrie.org/~zednenem/
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] New slogan for haskell.org

2007-10-06 Thread Martin DeMello
On 10/5/07, Don Stewart [EMAIL PROTECTED] wrote:

 It has been suggested we could just sit DrScheme in front of ghc/ghci.
 Anyone with experience who'd like to step up for this?

Note that there's a DrOCaml, which might be a good starting point.

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