Re: [Haskell-cafe] Array, Vector, Bytestring

2013-06-04 Thread Artyom Kazak

Oops.

Ben Gamari bgamari.f...@gmail.com писал(а) в своём письме Tue, 04 Jun
2013 04:41:53 +0300:


To be perfectly clear, ByteString and Text target much different
use-cases and are hardly interchangeable. While ByteString is, as the
name suggests, a string of bytes, Text is a string of characters in a
Unicode encoding. When you are talking about unstructured binary data,
you should most certainly be using ByteString.


Why create a special case? Right now you should use ByteString, yes, but I
wish I could just use a generic array of Word8.

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


Re: [Haskell-cafe] Array, Vector, Bytestring

2013-06-04 Thread Peter Simons
Hi Clark,

  How is this a problem?
 
  If you're representing text, use 'text'.
  If you're representing a string of bytes, use 'bytestring'.
  If you want an array of values, think c++ and use 'vector'.

the problem is that all those packages implement the exact same data
type from scratch, instead of re-using an implementation of a
general-purpose array internally. That is hardly desirable, nor is it
necessary.

Take care,
Peter


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


Re: [Haskell-cafe] Array, Vector, Bytestring

2013-06-04 Thread Tom Ellis
On Tue, Jun 04, 2013 at 04:01:37PM +0200, Peter Simons wrote:
   How is this a problem?
  
   If you're representing text, use 'text'.
   If you're representing a string of bytes, use 'bytestring'.
   If you want an array of values, think c++ and use 'vector'.
 
 the problem is that all those packages implement the exact same data
 type from scratch, instead of re-using an implementation of a
 general-purpose array internally. That is hardly desirable, nor is it
 necessary.

Just to clarify for those on the sidelines, the issue is duplication of
implementation details, rather than duplication of functionality?

Tom

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


Re: [Haskell-cafe] Array, Vector, Bytestring

2013-06-04 Thread silvio

Just to clarify for those on the sidelines, the issue is duplication of
implementation details, rather than duplication of functionality?


Well to me, that is not the main issue. The main issue is that you have 
to study all of them and depending on which libraries you want to use 
have to convert between them, which could be expensive and is definitely 
annoying.


I made a few simple benchmarks comparing the three libraries you can 
find the code attached.


this is compiled with -O2

# simple sum of 100 Word8 elements

Unboxed Vector   1.114060 ms
Storable Vector  795.1207 us
Primitive Vector 1.116145 ms

ByteString   9.076256 ms

array library has no fold or sum function

# simple sum of 100 more or less randomly chosen elements

Unboxed Vector (unsafe)33.74364 ms
Storable Vector (unsafe)   50.27273 ms
Storable Vector (safe) 67.01634 ms
Primitive Vector (unsafe)  56.29919 ms

ByteString (unsafe)19.29611 ms
ByteString (safe)  18.29065 ms

UArray (safe)  46.88719 ms
unsafe does not exist for array

So Unboxed can be better than Storable but doesn't need to be.
Also, which implementation is faster depends very much on the problem at 
hand. And array is just missing half the needed features.


Silvio
import Criterion.Main
import Criterion.Config

import Data.Word
import Data.Bits
import System.Random

import qualified Data.Vector.Unboxed as UVec
import qualified Data.Vector.Storable as SVec
import qualified Data.Vector.Primitive as PVec

import qualified Data.ByteString as BStr
import qualified Data.ByteString.Unsafe as BStr

import qualified Data.Array.Unboxed as UArr
import qualified Data.Array.Storable as SArr

num = 100 :: Int
logNum = floor $ logBase 2 (fromIntegral num)
maskNum = 2^logNum-1

gen = mkStdGen 4653

randomList = take num $ randoms gen

-- PREPARE ARRAYS
uvec = UVec.fromList randomList :: UVec.Vector Word8
svec = SVec.fromList randomList :: SVec.Vector Word8
pvec = PVec.fromList randomList :: PVec.Vector Word8
bstr = BStr.pack randomList :: BStr.ByteString
uarr = UArr.listArray (0,num-1) randomList :: UArr.UArray Int Word8

-- FOR SECOND TEST
randomAccessSum :: (Int - Word8) - Word8
randomAccessSum f = go (num-1) 0 0 where
go 0 _ result = result
go n index oldResult = let result = f index + oldResult in
seq result go (n-1) ((index + 38634329) .. maskNum) result

-- myConfig = defaultConfig { cfgVerbosity = ljust Quiet }
myConfig = defaultConfig

main = do
uvec `seq` svec `seq` pvec `seq` bstr `seq` return ()
defaultMainWith myConfig (return ())
[ bgroup sum
[ bench Unboxed Vector: sum   $ whnf UVec.sum uvec
--, bench Unboxed Vector: foldl1' (+)   $ whnf (UVec.foldl1' (+)) uvec
, bench Storable Vector: sum  $ whnf SVec.sum svec
, bench Storable Vector: foldl1' (+)  $ whnf (SVec.foldl1' (+)) svec
--, bench Storable Vector: sum . toList $ whnf (sum . SVec.toList) svec
, bench Primitive Vector: sum $ whnf PVec.sum pvec
, bench ByteString: foldl1' (+)   $ whnf (BStr.foldl1' (+)) bstr
, bench ByteString: foldl1 (+)  $ whnf (BStr.foldl1 (+)) bstr
]
, bgroup random access sum
[ bench Unboxed Vector: unsafeIndex   $ whnf randomAccessSum (UVec.unsafeIndex uvec)
, bench Storable Vector: unsafeIndex  $ whnf randomAccessSum (SVec.unsafeIndex svec)
, bench Storable Vector: safe (!) $ whnf randomAccessSum ((SVec.!) svec)
, bench Primitive Vector: unsafeIndex $ whnf randomAccessSum (PVec.unsafeIndex pvec)
, bench ByteString: unsafeIndex   $ whnf randomAccessSum (BStr.unsafeIndex bstr)
, bench ByteString: safe index$ whnf randomAccessSum ((BStr.index) bstr)
, bench UArray: safe (!)  $ whnf randomAccessSum ((UVec.!) uvec)
]
]

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


[Haskell-cafe] Frankfurt Haskell User Group meets 19.6.13, topics: Netwire, Hackathon planning

2013-06-04 Thread Peter Althainz
Dear All,

all interested Haskellers are inivted to our Meetup on 19.6.13:
http://www.meetup.com/Frankfurt-Haskell-User-Group/events/122879122/.

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


Re: [Haskell-cafe] Array, Vector, Bytestring

2013-06-04 Thread Carter Schonwald
I really don't understand this concern.

These libraries are tuned for wildly different workloads and use cases, so
these sorts of micro benchmarks are an Apples to Frogs comparisons.
(even aside from the fact that you'll get very different perf if you used
-fllvm and set things up so the array indexing and associated loop code get
inlined and fused together!)

what is the actual concern? Strawman micro benchmarks that don't even
compare the respective libraries for their intended use cases seeems
weird.






On Tue, Jun 4, 2013 at 12:49 PM, silvio silvio.fris...@gmail.com wrote:

 Just to clarify for those on the sidelines, the issue is duplication of
 implementation details, rather than duplication of functionality?


 Well to me, that is not the main issue. The main issue is that you have to
 study all of them and depending on which libraries you want to use have to
 convert between them, which could be expensive and is definitely annoying.

 I made a few simple benchmarks comparing the three libraries you can find
 the code attached.

 this is compiled with -O2

 # simple sum of 100 Word8 elements

 Unboxed Vector   1.114060 ms
 Storable Vector  795.1207 us
 Primitive Vector 1.116145 ms

 ByteString   9.076256 ms

 array library has no fold or sum function

 # simple sum of 100 more or less randomly chosen elements

 Unboxed Vector (unsafe)33.74364 ms
 Storable Vector (unsafe)   50.27273 ms
 Storable Vector (safe) 67.01634 ms
 Primitive Vector (unsafe)  56.29919 ms

 ByteString (unsafe)19.29611 ms
 ByteString (safe)  18.29065 ms

 UArray (safe)  46.88719 ms
 unsafe does not exist for array

 So Unboxed can be better than Storable but doesn't need to be.
 Also, which implementation is faster depends very much on the problem at
 hand. And array is just missing half the needed features.

 Silvio

 ___
 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] Array, Vector, Bytestring

2013-06-04 Thread Mike Ledger

On 05/06/13 02:49, silvio wrote:

Just to clarify for those on the sidelines, the issue is duplication of
implementation details, rather than duplication of functionality?


Well to me, that is not the main issue. The main issue is that you 
have to study all of them and depending on which libraries you want to 
use have to convert between them, which could be expensive and is 
definitely annoying.


I made a few simple benchmarks comparing the three libraries you can 
find the code attached.


this is compiled with -O2

# simple sum of 100 Word8 elements

Unboxed Vector   1.114060 ms
Storable Vector  795.1207 us
Primitive Vector 1.116145 ms

ByteString   9.076256 ms

array library has no fold or sum function

# simple sum of 100 more or less randomly chosen elements

Unboxed Vector (unsafe)33.74364 ms
Storable Vector (unsafe)   50.27273 ms
Storable Vector (safe) 67.01634 ms
Primitive Vector (unsafe)  56.29919 ms

ByteString (unsafe)19.29611 ms
ByteString (safe)  18.29065 ms

UArray (safe)  46.88719 ms
unsafe does not exist for array

So Unboxed can be better than Storable but doesn't need to be.
Also, which implementation is faster depends very much on the problem 
at hand. And array is just missing half the needed features.


Silvio


___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe
array does provide folding functions, found in its Foldable and 
Traversable instances.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Array, Vector, Bytestring

2013-06-04 Thread silvio

array does provide folding functions, found in its Foldable and
Traversable instances.


Where can I find this? I can neither in the array package nor with 
google nor with hoogle.


Silvio

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


Re: [Haskell-cafe] Array, Vector, Bytestring

2013-06-04 Thread Mike Ledger

On 05/06/13 07:01, silvio wrote:

array does provide folding functions, found in its Foldable and
Traversable instances.


Where can I find this? I can neither in the array package nor with 
google nor with hoogle.


Silvio

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe
Data.Foldable and Data.Traversable, if you hoogle Foldable or 
Traversable you'll find their modules' docs.


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


Re: [Haskell-cafe] Array, Vector, Bytestring

2013-06-04 Thread silvio

These libraries are tuned for wildly different workloads and use cases,
so these sorts of micro benchmarks are an Apples to Frogs comparisons.


You can argue that for any benchmark, but sometimes the choice is 
between Apples and Frogs. If you have some more extensive benchmarks I'm 
happy to have a look at them.



(even aside from the fact that you'll get very different perf if you
used -fllvm and set things up so the array indexing and associated loop
code get inlined and fused together!)


I think llvm should be default by now. In any case, if you write code, 
it is important to know how well something works out of box without you 
having to spend hours optimizing it.



what is the actual concern? Strawman micro benchmarks that don't even
compare the respective libraries for their intended use cases seeems
weird.


Perhaps i should have explained that better.

If one library was clearly superior to the others, that would have made 
it easier to choose.


Also I wanted to check if Unboxed was usually better than Storable as 
they are semantically the same (correct me if i'm wrong). Which it is in 
one example. Still I think Storable could be done so we don't need 
Unboxed, too.


I would have said that sum/fold (i.e. consecutive access of the 
elements) is a reasonable use case for how we typically use bytestring 
and the random access sum is a reasonable you use case for how we 
typically use array/vector. Interestingly enough the performance was 
exactly opposed to these reasonable use cases.


Silvio

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


Re: [Haskell-cafe] Array, Vector, Bytestring

2013-06-04 Thread Peter Simons
Hi Tom,

  On Tue, Jun 04, 2013 at 04:01:37PM +0200, Peter Simons wrote:
How is this a problem?
   
If you're representing text, use 'text'.
If you're representing a string of bytes, use 'bytestring'.
If you want an array of values, think c++ and use 'vector'.
 
  the problem is that all those packages implement the exact same data
  type from scratch, instead of re-using an implementation of a
  general-purpose array internally. That is hardly desirable, nor is it
  necessary.
 
  Just to clarify for those on the sidelines, the issue is duplication of
  implementation details, rather than duplication of functionality?

I am not sure what the terms duplication of implementation details and
duplication of functionality mean in this context. Could you please
explain how these two concepts differ in your opinion?

Take care,
Peter


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


Re: [Haskell-cafe] Array, Vector, Bytestring

2013-06-04 Thread Tom Ellis
On Tue, Jun 04, 2013 at 11:23:16PM +0200, Peter Simons wrote:
   On Tue, Jun 04, 2013 at 04:01:37PM +0200, Peter Simons wrote:
 If you're representing text, use 'text'.
 If you're representing a string of bytes, use 'bytestring'.
 If you want an array of values, think c++ and use 'vector'.
  
   the problem is that all those packages implement the exact same data
   type from scratch, instead of re-using an implementation of a
   general-purpose array internally. That is hardly desirable, nor is it
   necessary.
  
   Just to clarify for those on the sidelines, the issue is duplication of
   implementation details, rather than duplication of functionality?
 
 I am not sure what the terms duplication of implementation details and
 duplication of functionality mean in this context. Could you please
 explain how these two concepts differ in your opinion?

Hi Peter,

When I say duplication of implementation details I believe I mean
something like your implementing the exact same data type from scratch.

By duplication of functionality, on the other hand, I mean providing two
libraries with similar APIs which essentially serve the same purpose.

I believe you are suggesting that there is redundancy in the implementation
details of these libraries, not in the APIs they expose.  Then again, I was
just trying to understand the discussion at hand.  I don't have an opinion
on it.

Tom

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


Re: [Haskell-cafe] Typeable typeclass and type-level naturals

2013-06-04 Thread TP
Roman Cheplyaka wrote:

 Try adding
 
   deriving instance Typeable 'Zero
   deriving instance Typeable a = Typeable ('Succ a)
 
 to your module.
 
 (I haven't tested it — you might need to tweak it a bit.)

Thanks Roman.
Unfortunately, I already tried that (without the constraint Typeable a =, 
what a fool), but it did not work. The error is the same with the 
constraint:

Derived typeable instance must be of form (Typeable 'Succ)
In the stand-alone deriving instance for
  ‛Typeable a = Typeable (Succ a)’

What is the problem?

Is it possible that it is a bug in GHC? Indeed, we had unwanted similar 
error messages recently:

http://hackage.haskell.org/trac/ghc/ticket/7704

Thanks,

TP

PS: the complete program for a test that shows the error:
--
{-# LANGUAGE GADTs #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE StandaloneDeriving #-}

import Data.Typeable

data Nat = Zero | Succ Nat
deriving ( Show, Eq, Ord, Typeable )

deriving instance Typeable 'Zero
deriving instance Typeable a = Typeable ('Succ a)

data Box where
Box :: (Typeable s, Show s, Eq s) = s - Box
deriving Typeable

data Proxy a = P deriving Typeable

deriving instance Show Box
instance Eq Box where

(Box s1) == (Box s2) = Just s1 == cast s2

main = do

let one = undefined :: Main.Proxy ('Succ 'Zero)
let foo = Box one
print foo


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


[Haskell-cafe] Why isn't hsc2hs functionality provided by ghc?

2013-06-04 Thread silly8888
I was wondering today, why hasn't hsc2hs been merged with ghc so that
it would be possible to add a

{-# LANGUAGE ForeignFunctionInterface #-}

at the top of a source file and then load it with ghci or compile it,
without the intermediate step of calling hsc2hs? This would be exactly
like the CPP extension. I don't have to call cpp manually. All I have
to do is to add {-# LANGUAGE CPP #-} and then ghc will take care of
the rest. This would also mean that there would be no need to have a
separate file extension. Surely I must not be the first person to have
that thought, so there must be a good reason why this hasn't happen
yet, but what is it?

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


Re: [Haskell-cafe] How to write a pure String to String function in Haskell FFI to C++

2013-06-04 Thread adam vogt
On Sun, Jun 2, 2013 at 10:19 PM, Ting Lei tin...@gmail.com wrote:
 Thanks for your answers so far.

 It seems that the laziness of String or [char] is the problem.

 My question boils then down to this. There are plenty of Haskell FFI
 examples where simple things like sin/cos in math.h can be imported into
 Haskell as pure functions. Is there a way to extend that to String without
 introducing an IO (), but maybe sacrificing laziness?
 If String has to be lazy, is there another Haskell data type convertible to
 String that can do the job?

 The C++/C function (e.g. toUppers) is computation-only and as pure as cos
 and tan. The fact that marshaling string incurs an IO monad in current
 examples is kind of unintuitive and like a bug in design. I don't mind
 making redundant copies under the hood from one type to another..

Hi Ting,

In the Foreign.C.String there is a function that converts String to an
array (CString = Ptr CChar) which can be handled on the C side:

withCString :: String - (CString - IO a) - IO a

peekCString :: CString - IO String

It's slightly more convenient to use these functions through the
preprocessor c2hs, as in the following example
http://code.haskell.org/~aavogt/c_toUpper_ffi_ex/. c2hs also has a
'pure' keyword which makes it add the unsafePerformIO, but for
whatever reason the side-effects were not done in the right order (the
peekCString happened before the foreign function was called).

Regards,
Adam

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


Re: [Haskell-cafe] Why isn't hsc2hs functionality provided by ghc?

2013-06-04 Thread Ivan Lazar Miljenovic
On 5 June 2013 12:02, silly silly8...@gmail.com wrote:
 I was wondering today, why hasn't hsc2hs been merged with ghc so that
 it would be possible to add a

 {-# LANGUAGE ForeignFunctionInterface #-}

 at the top of a source file and then load it with ghci or compile it,
 without the intermediate step of calling hsc2hs? This would be exactly
 like the CPP extension. I don't have to call cpp manually. All I have
 to do is to add {-# LANGUAGE CPP #-} and then ghc will take care of
 the rest. This would also mean that there would be no need to have a
 separate file extension. Surely I must not be the first person to have
 that thought, so there must be a good reason why this hasn't happen
 yet, but what is it?

Isn't this done automatically when you have files with the .hsc extension?

-- 
Ivan Lazar Miljenovic
ivan.miljeno...@gmail.com
http://IvanMiljenovic.wordpress.com

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


Re: [Haskell-cafe] Why isn't hsc2hs functionality provided by ghc?

2013-06-04 Thread silly8888
On Tue, Jun 4, 2013 at 10:15 PM, Ivan Lazar Miljenovic
ivan.miljeno...@gmail.com wrote:

 Isn't this done automatically when you have files with the .hsc extension?


No, it is not.

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


Re: [Haskell-cafe] Why isn't hsc2hs functionality provided by ghc?

2013-06-04 Thread John Lato
On Wed, Jun 5, 2013 at 10:15 AM, Ivan Lazar Miljenovic 
ivan.miljeno...@gmail.com wrote:

 On 5 June 2013 12:02, silly silly8...@gmail.com wrote:
  I was wondering today, why hasn't hsc2hs been merged with ghc so that
  it would be possible to add a
 
  {-# LANGUAGE ForeignFunctionInterface #-}
 
  at the top of a source file and then load it with ghci or compile it,
  without the intermediate step of calling hsc2hs? This would be exactly
  like the CPP extension. I don't have to call cpp manually. All I have
  to do is to add {-# LANGUAGE CPP #-} and then ghc will take care of
  the rest. This would also mean that there would be no need to have a
  separate file extension. Surely I must not be the first person to have
  that thought, so there must be a good reason why this hasn't happen
  yet, but what is it?

 Isn't this done automatically when you have files with the .hsc extension?


cabal handles this transparently, but not ghc.  It's frustrating when you
want to develop a project with ghci.

I don't think it's a good idea to merge hsc2hs syntax into Haskell files.
 In particular, it's often useful to inspect the intermediate .hs file
produced by hsc2hs during development or debugging.  Also it would
complicate ghc's parser, etc...

My preferred solution would be to have ghc/ghci automatically run hsc2hs
(support c2hs also?) when necessary.  But so long as it's handled
automatically, I wouldn't be particularly bothered by the implementation.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Why isn't hsc2hs functionality provided by ghc?

2013-06-04 Thread Jason Dagit
On Tue, Jun 4, 2013 at 8:45 PM, John Lato jwl...@gmail.com wrote:
 On Wed, Jun 5, 2013 at 10:15 AM, Ivan Lazar Miljenovic
 ivan.miljeno...@gmail.com wrote:

 On 5 June 2013 12:02, silly silly8...@gmail.com wrote:
  I was wondering today, why hasn't hsc2hs been merged with ghc so that
  it would be possible to add a
 
  {-# LANGUAGE ForeignFunctionInterface #-}
 
  at the top of a source file and then load it with ghci or compile it,
  without the intermediate step of calling hsc2hs? This would be exactly
  like the CPP extension. I don't have to call cpp manually. All I have
  to do is to add {-# LANGUAGE CPP #-} and then ghc will take care of
  the rest. This would also mean that there would be no need to have a
  separate file extension. Surely I must not be the first person to have
  that thought, so there must be a good reason why this hasn't happen
  yet, but what is it?

 Isn't this done automatically when you have files with the .hsc extension?


 cabal handles this transparently, but not ghc.  It's frustrating when you
 want to develop a project with ghci.

 I don't think it's a good idea to merge hsc2hs syntax into Haskell files.
 In particular, it's often useful to inspect the intermediate .hs file
 produced by hsc2hs during development or debugging.  Also it would
 complicate ghc's parser, etc...

 My preferred solution would be to have ghc/ghci automatically run hsc2hs
 (support c2hs also?) when necessary.  But so long as it's handled
 automatically, I wouldn't be particularly bothered by the implementation.

How about having a `ghci` command for cabal? Or does the automatic
requirement really need to be part of ghc to work the way you want?

(BTW, cabal-dev does have a `ghci` command, but I haven't tested to
see if it does the hsc - hs conversion.)

Jason

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


Re: [Haskell-cafe] Int is broken [Was: Different answers on different machines]

2013-06-04 Thread Richard A. O'Keefe

On 4/06/2013, at 4:22 PM, Rustom Mody wrote:

 
 
 On Tue, Jun 4, 2013 at 7:35 AM, Richard A. O'Keefe o...@cs.otago.ac.nz 
 wrote:
 
 On 3/06/2013, at 6:58 PM, Carter Schonwald wrote:
  If the Int type had either of these semantics by default, many many 
  performance sensitive libraries would suddenly have substantially less 
  compelling performance.  Every single operation that was branchless before 
  would have a branch *every* operation. this would be BAD.
 
 Actually, the x86 can be configured to trap integer overflows,
 so on that not entirely unpopular platform, there need be NO
 extra branches.
 
 Well yes and no. See http://software.intel.com/en-us/forums/topic/306156

I made a mistake, for which I apologise.
There were two things I wanted the x86 to trap, several years ago,
and I found that one of them *could* be trapped and the other could
not.  The one that couldn't was integer overflow.

I do note that the page cited answers a *different* question
which is does the Intel COMPILER support integer overflow trapping.
The question I answered wrongly was does the Intel HARDWARE support
integer overflow trapping (by raising an exception on integer
overflow if a bit is set in a certain control register).

Having apologised for my error, I close with the observation that
Jacob Navia, developer of lcc-win32 (he started with the LCC compiler
but added serious x86-specific optimisation and other Windows goodness),
claims that sticking JO after signed integer operations adds very little
to run time because it is predicted very well by the branch prediction
hardware, since it is almost never taken.

 In Discipline of Programming (in 1976!) Dijkstra exactly described this 
 problem, and squarely put the blame on poorly engineered machines.
 He introduced 3 concepts/terms:
 UM : unbounded machine
 SLM : sufficiently large machine
 HSLM : hopefully sufficiently large machine

Dijkstra was a Burroughs Research Fellow, and the B6700 was a textbook
example of an HSLM.  I couldn't believe how primitive other systems
were after using that.  The signed-integer-overflow-trapping C compiler
I mentioned was a MIPS one (MIPS distinguishing between ADD and ADDU, c).


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


Re: [Haskell-cafe] Why isn't hsc2hs functionality provided by ghc?

2013-06-04 Thread John Lato
cabal-dev ghci does work with hsc2hs, but only because it doesn't interpret
your source.  Rather, cabal-dev ghci loads ghci using the sandbox install
of your package, which is less useful for a variety of reasons.

Aside from that detail, I wouldn't gain any benefit from having this
feature built in to ghci instead of accessing ghci via cabal (or
cabal-dev).  cabal seems like a better location, and it's aware of several
preprocessors already.



On Wed, Jun 5, 2013 at 12:00 PM, Jason Dagit dag...@gmail.com wrote:

 On Tue, Jun 4, 2013 at 8:45 PM, John Lato jwl...@gmail.com wrote:
  On Wed, Jun 5, 2013 at 10:15 AM, Ivan Lazar Miljenovic
  ivan.miljeno...@gmail.com wrote:
 
  On 5 June 2013 12:02, silly silly8...@gmail.com wrote:
   I was wondering today, why hasn't hsc2hs been merged with ghc so that
   it would be possible to add a
  
   {-# LANGUAGE ForeignFunctionInterface #-}
  
   at the top of a source file and then load it with ghci or compile it,
   without the intermediate step of calling hsc2hs? This would be exactly
   like the CPP extension. I don't have to call cpp manually. All I have
   to do is to add {-# LANGUAGE CPP #-} and then ghc will take care of
   the rest. This would also mean that there would be no need to have a
   separate file extension. Surely I must not be the first person to have
   that thought, so there must be a good reason why this hasn't happen
   yet, but what is it?
 
  Isn't this done automatically when you have files with the .hsc
 extension?
 
 
  cabal handles this transparently, but not ghc.  It's frustrating when you
  want to develop a project with ghci.
 
  I don't think it's a good idea to merge hsc2hs syntax into Haskell files.
  In particular, it's often useful to inspect the intermediate .hs file
  produced by hsc2hs during development or debugging.  Also it would
  complicate ghc's parser, etc...
 
  My preferred solution would be to have ghc/ghci automatically run hsc2hs
  (support c2hs also?) when necessary.  But so long as it's handled
  automatically, I wouldn't be particularly bothered by the implementation.

 How about having a `ghci` command for cabal? Or does the automatic
 requirement really need to be part of ghc to work the way you want?

 (BTW, cabal-dev does have a `ghci` command, but I haven't tested to
 see if it does the hsc - hs conversion.)

 Jason

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