Re: [Haskell-cafe] Name overloading

2010-01-14 Thread Cristiano Paris
I wish to thank all of you for your comments.

In fact, the solutions you proposed mostly coincided with mine
(including the one using type families) but, in my opinion, they are
more cumbersome than the prefixed names solution.

Going back to my example:

f x = open $ open x

where:

data Foo = { open :: Bar }
data Bar = { open :: String }

there are basically two possibilities to assign types to the open
functions, either the first is open :: Foo - Bar and the second is
open :: Bar - String or the converse.

It's clear that the type checker might explore these two possibilities
until one of them typechecks. Hence, the possible outcomes of this
search would be:

1 - No possible assignment works so the typechecking phase fail.
2 - One possibility matches, then it's undertaken.
3 - Two or more possibilities match so an ambiguity is found which can
be solved only by the programmer specifying the type of the open
function explicitly, which is just like using the prefix based
solution.

Would you trust a type checker behaving like this? My answer is no, as
the type checker would be making assumptions about my intentions when
I wrote the expression open $ open x. I would rather prefer the
compiler to signal this as an error, forcing me to be more explicit
about my real intentions that I could actually find to be wrong (i.e.
a bug would be accepted silently).

Concerning TDNR, I read about it just a while ago but, as far as I can
remember, it's just a syntactic dissertation on the subject while the
type checking matter is not touched.

Thank you again.

C.

On Wed, Jan 13, 2010 at 8:28 PM, Evan Laforge qdun...@gmail.com wrote:
 Now, in Haskell we have type inference, which is The Good Thing as
 it allows to validate your program at compile time. Hence, the idea
 coming up to my mind is that type inference actually forbids a
 type-directed resolution of names as in C++ or Java.

 Is this correct?

 There is a proposed extension which is not implemented but was
 discussed on the list a while back, maybe you'd find this interesting:

 http://hackage.haskell.org/trac/haskell-prime/wiki/TypeDirectedNameResolution

 Search back in the archives for TDNR and you should turn up some threads.

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


Re: [Haskell-cafe] Language simplicity

2010-01-14 Thread Evan Laforge
Wow, that's kind of cute:

{-# LANGUAGE UnicodeSyntax #-}
(*) = (*)
(/) = (/)
公式 高 中 低=高*中*低/整數
整數 = 123

Oddly, if I change the order of these definitions I get syntax errors.
 Very mysterious.  Nice how it knows that * is a symbol, but I'm not
sure how I'm supposed to name a type.  It certainly spells the end of
of camelCase arguments though, and can take single-character variable
names to dizzying new heights :)

I suppose number literals can't be overridden though.  Not to mention = and ().

 It's not just one's editor (I use emacs, and it's actually not that
 hard to type a decent subset of interesting Unicode characters in
 emacs with the tex input mode), but readability.  The ASCII characters
 are universal and easily recognized (assuming you have a decent
 monochrome font); having to notice potentially significant differences
 involving diacritics alone (not to mention all the various
 mathematical symbols) in identifiers would drive me mad.  It's the
 same reason we try to limit lines of code to ~80 characters -- our
 editors are *capable* of more, sure, but are we?

Unicode identifiers are fun but this is a good point.  The line has to
be somewhere, so it might as well be in the historical position unless
there are widely agreed on benefits to moving it.

On Wed, Jan 13, 2010 at 10:45 PM, Colin Paul Adams
co...@colina.demon.co.uk wrote:
 My wife is Chinese. When she was learning pinyin as a child, she
 asked her father for help with some homework. He replied that he didn't
 understand them.

But that's all kind of beside the point because you already need to
learn quite a bit of specialized knowledge to be writing in haskell in
the first place.  It's real hard to get to that stage without already
recognizing ascii.

If the problem was just pinyin and not latin letters in general, then
most Taiwanese wouldn't understand it either.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Web application interface

2010-01-14 Thread Nicolas Pouillard
Excerpts from Jinjing Wang's message of Thu Jan 14 01:28:31 +0100 2010:
| The hyena backend is essentially just a translator between hack and
| wai, i failed to finished it since I can't understand iteratee
| (seriously) and eventually got distracted  ...

If I have well understood you miss a function to convert an enumerator
to a list.

What about this code?

 import qualified Data.ByteString.Lazy.Char8 as S
 import Control.Concurrent (forkIO)
 import Control.Concurrent.Chan (newChan,writeChan,getChanContents)

 type Enumerator = forall a. (a - S.ByteString - IO (Either a a)) - a - IO 
 a

 enumToList :: Enumerator - IO [S.ByteString]
 enumToList e = do ch - newChan
   _  - forkIO $ e (writer ch) ()
   getChanContents ch
   where writer ch () chunk = do writeChan ch chunk
 return (Right ())

Best regards,

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


Re: [Haskell-cafe] Web application interface

2010-01-14 Thread Pasqualino Titto Assini
Hi Michael,

no, the message was not meant to be off-list, that was just me
pressing the wrong button :-)

Regarding happstack, I do not believe that there is a contrast with
your effort, the core of happstack is in its persistency mechanism not
in its http interface so I think it would be great to engage the
happstack community in this effort.

We have so many half-baked and dispersed attempts in the web area that
any attempt at consolidation can only be welcome.

Personally I have been using happstack for a few years though now I am
running it behind a nginx server because of its known deficiencies (no
HTTPS etc).

   titto

P.S.
I will be away for a few days and unable to answer my email



2010/1/13 Michael Snoyman mich...@snoyman.com:
 Not sure if you replied off-list on purpose or not, but I'll continue this
 off list for the moment. I think we have a bit of a problem in the Haskell
 web community: you've got the Happstack camp and then the rest of us. The
 rest of us need to rally around *something*, and it seems that Hack didn't
 get people's attention for some reason.

 I'm happy to write WAI, but I'd like more to make it a community effort. You
 have any thoughts on this? My first stab at the idea is to create a github
 repo, write the code, and then try to get people to comment on it. However,
 I also want to give it at least a day so I can get people's feedback on this
 e-mail.

 What have you been using for Haskell web development until now? It seems
 like each non-Happstack person has a totally different approach, and I'd
 like to try and consolidate this together somehow.

 Michael

 On Wed, Jan 13, 2010 at 11:12 PM, Pasqualino Titto Assini
 tittoass...@gmail.com wrote:

 A unified web app interface would be a God-sent, please please go ahead.

 Regarding point 1, I find hack interface nice and clean and would like
 to see something similar.

 Regarding point 2 I vote for correctness/performance vs convenience.

     titto

 2010/1/13 Michael Snoyman mich...@snoyman.com:
  Hi,
 
  I recently read (again) the wiki page on a web application interface[1]
  for
  Haskell. It seems like this basically works out to Hack[2], but using an
  enumerator instead of lazy bytestring in the response type. Is anyone
  working on implementing this? If not, I would like to create the
  package,
  though I wouldn't mind some community input on some design decisions:
 
  * Hack has been fairly well-tested in the past year and I think it
  provides
  the features that people want. Therefore, I would want to model the
  Environment variable for WAI from Hack. I *could* just import Hack in
  WAI
  and use the exact same Environment data type. Thoughts?
 
  * If using a different data type for Environment, should I replace the
  String parts with ByteStrings? On the one hand, ByteStrings are the
  correct data type since the HTTP protocol does not specify a character
  encoding; on the other hand, Strings are easier to deal with.
 
  * It's simple to write a function to convert between a lazy bytestring
  and
  an enumerator, meaning it would be very easy to write conversion
  functions
  between Hack and WAI applications. This would make it simpler for people
  to
  use either backend.
 
  If someone else is already working on WAI, please let me know, I don't
  want
  to have duplicate implementations. The idea here is to consolidate, not
  split the community. I have a few Hack handlers (simpleserver, cgi,
  fastcgi)
  that I would happily convert to WAI handlers as well.
 
  Michael
 
  [1] http://www.haskell.org/haskellwiki/WebApplicationInterface
  [2] http://hackage.haskell.org/cgi-bin/hackage-scripts/package/hack
 
  ___
  Haskell-Cafe mailing list
  Haskell-Cafe@haskell.org
  http://www.haskell.org/mailman/listinfo/haskell-cafe
 
 



 --
 Pasqualino Titto Assini, Ph.D.
 http://quicquid.org/





-- 
Pasqualino Titto Assini, Ph.D.
http://quicquid.org/
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Language simplicity

2010-01-14 Thread Roel van Dijk
2010/1/14 Evan Laforge qdun...@gmail.com:
 Wow, that's kind of cute:

 {-# LANGUAGE UnicodeSyntax #-}
 (*) = (*)
 (/) = (/)
 公式 高 中 低 = 高 * 中 * 低 / 整數
 整數 = 123

That code snippet is also perfectly legal Haskell without the
UnicodeSyntax language extension. You use UnicodeSyntax if you want to
write code like this:

{-# LANGUAGE UnicodeSyntax, ScopedTypeVariables #-}
swap ∷ ∀ α β. (α, β) → (β, α)
swap = uncurry $ flip (,)

 Oddly, if I change the order of these definitions I get syntax
 errors.  Very mysterious.  Nice how it knows that * is a symbol,
 but I'm not sure how I'm supposed to name a type.

I was a bit surprised that you could use * as an operator since it is
a punctuation character. Maybe there are some corner cases with
fullwidth characters or with composition of characters.

 Unicode identifiers are fun but this is a good point.  The line has
 to be somewhere, so it might as well be in the historical position
 unless there are widely agreed on benefits to moving it.

I have already crossed that line:

http://hackage.haskell.org/package/base-unicode-symbols
http://hackage.haskell.org/package/containers-unicode-symbols

But I am aware that there is a point beyond which unicode symbols only
make your code harder to understand. So I try to be conservative in my
use of them. Still, there are a lot of useful and acceptable symbols
which are not part of the historic ASCII set: ∈, ≤, ∪, ∧, ¬, ∘ to name
a few.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Web application interface

2010-01-14 Thread Alberto G. Corona
2010/1/14 Jinjing Wang nfjinj...@gmail.com



 Hyena is especially tuned for streaming and that's exactly what hack
 can't do (in practice).


Isn't possible to stream an (almost) infinite bytestring trough hack?. I
ever trough that the laziness of haskell is a great advantage in Web
applications. This is very important because the size of the block
transferred vary widely. In my applications I don´t care whether I have to
stream a hello world page or a video.  The first block of my application
goes trough the internet as soon as my  procedure start without concern
about if the processing is composed of a complicated chain of steps or not.
And with no especial coding; Neither my web server interface nor my user
responsiveness requirements force me to code iterations everywhere in my
code.  I know the chuncked mode in web server but I think that just this
mode of web streaming is the right mode for serving lazy haskell
applications.

 My question is why whatever performance advantage the iteratee may have,
can not be coded under the clean interface of a lazy bytestring or whatever
lazy stream.


 http://github.com/nfjinjing/hack-handler-hyena


 --
 jinjing
 ___
 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] Web application interface

2010-01-14 Thread Michael Snoyman
On Thu, Jan 14, 2010 at 12:50 PM, Alberto G. Corona agocor...@gmail.comwrote:



 2010/1/14 Jinjing Wang nfjinj...@gmail.com



 Hyena is especially tuned for streaming and that's exactly what hack
 can't do (in practice).


 Isn't possible to stream an (almost) infinite bytestring trough hack?. I
 ever trough that the laziness of haskell is a great advantage in Web
 applications. This is very important because the size of the block
 transferred vary widely. In my applications I don´t care whether I have to
 stream a hello world page or a video.  The first block of my application
 goes trough the internet as soon as my  procedure start without concern
 about if the processing is composed of a complicated chain of steps or not.
 And with no especial coding; Neither my web server interface nor my user
 responsiveness requirements force me to code iterations everywhere in my
 code.  I know the chuncked mode in web server but I think that just this
 mode of web streaming is the right mode for serving lazy haskell
 applications.

  My question is why whatever performance advantage the iteratee may have,
 can not be coded under the clean interface of a lazy bytestring or whatever
 lazy stream.


Well, for one thing, you'd need to use lazy IO to achieve your goal, which
has some safety issues. As things get more and more complex, the
requirements of lazy IO will continue to grow. This also has implications
for number of open file handles and deterministic space usage. Given the
fact that a lazy bytestring and easily be converted to an enumerator, I
think it makes sense to start a new package using this approach.

As a side point, would anyone be interested in having a central location for
web-specific Haskell development discussions? I know we have the mailing
list, but it's never used. I'm thinking more of a place to post articles and
links to packages. In particular, I think it would be great to have a site
with multiple sections (model, view, controller, authentication,
authorization, etc) and articles, forums and packages specific for each.
Also a great place to post what the community is missing.

Michael


 http://github.com/nfjinjing/hack-handler-hyena


 --
 jinjing

 ___
 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: FASTER primes

2010-01-14 Thread Daniel Fischer
Am Donnerstag 14 Januar 2010 08:25:48 schrieb Will Ness:
 Daniel Fischer daniel.is.fischer at web.de writes:
  Am Mittwoch 13 Januar 2010 10:43:42 schrieb Heinrich Apfelmus:
   I wonder whether it's really the liveness of  pair  in
  
     mergeSP (a,b) pair
        = let sm = spMerge b (fst pair)
          in (a ++ fst sm, merge (snd sm) (snd pair))
  
   that is responsible for the space leak, for chances are that
   Sparud's technique applies and  pair  is properly disposed of.
   Rather, it could be that we need the stronger property that forcing
   the second component will evaluate the first to NF.
 
  I think that is responsible. At least that's how I understand the
  core:
 
  mergeSP (a,b) ~(c,d) = (a ++ bc, merge b' d)
 where
(bc, b') = spMerge b c
spMerge ...

 That is equivalent to

   first (a++) . second (`merge`d) $ spMerge b c

 and Daniel's fix is equivalent to

   first (a++) $ spMerge b c d


 Now, when compiler sees the first variant, it probably treats spMerge as
 opaque. I.e. although in reality spMerge only contributes to the
 first channel while it is progressively instantiated, and (`merge`d)
 will only be called upon when spMerge's final clause is reached, that is
 (most likely) not known to the compiler at this stage. When looking at
 just the first expression itself, it has to assume that spMerge may
 contribute to both channels (parts of a pair) while working, and so
 can't know _when_ /d/ will get called upon to contribute to the data, as
 it is consumed finally at access.

 So /d/ is gotten hold of prematurely, _before_ going into spMerge.

No, the problem is that d itself is  gotten hold of too late, it is 
accessed only indirectly via the pair, so we keep an unnecessary reference 
to c via d.


 The second variant passes the responsibility for actually accessing its
 inputs to spMerge itself, and _it_ is clear about needing /d/ only in
 the very end.

The second variant is clear about not needing the _pair_ anymore once 
spMerge is entered. Thus d doesn't reference c anymore.


 Just a theory. :)

 Does that make sense?



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


Re: [Haskell-cafe] FFI, C/C++ and undefined references

2010-01-14 Thread Malcolm Wallace

I still get the undefined reference errors.


It is likely there is some combination of other mistakes as well  
then.  Other responses have made suggestions of fixes you require in  
the C++ code for instance.  You will need those as well.



 I did eventually get ghc to compile
Main.hs by putting the -c and -cpp flags after --make Main.hs.

Then it produces a Main.o file which (even with +x permissions on my  
Linux
box) will not run. I just get the message cannot run binary file,  
or some

such message.


The file Main.o is just an object file, not a complete executable.  It  
still needs to be linked against some other (Haskell or C/C++) object  
files and libraries, and the Haskell runtime system, to form an  
executable that can be run.  ghc is capable of doing all the linking,  
e.g.

ghc -o myProg Main.o slirm.o -package base -package foo

However, if you are unsure of which Haskell packages are needed, it is  
wise to let ghc work out the dependencies for you, e.g. with

ghc --make Main.hs slirm.o

It cannot work out the C/C++ dependencies though, so every time you  
get undefined reference linking errors, you must discover which C  
code provides those symbols, and add its object file to the  
commandline by hand.


Regards,
Malcolm

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


Re: [Haskell-cafe] Language simplicity

2010-01-14 Thread Daniel Fischer
Am Donnerstag 14 Januar 2010 11:38:57 schrieb Roel van Dijk:

 I was a bit surprised that you could use * as an operator since it is
 a punctuation character. Maybe there are some corner cases with
 fullwidth characters or with composition of characters.


Thus speaketh the report (http://haskell.org/onlinereport/lexemes.html):

symbol   -  ascSymbol | uniSymbolspecial | _ | : |  | '
ascSymbol   -  ! | # | $ | % |  | * | + | . | / |  | = |  | ? | @
|   \ | ^ | | | - | ~ 
uniSymbol-  any Unicode symbol or punctuation

Punctuation characters are legitimate for operators.

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


Re: [Haskell-cafe] Web application interface

2010-01-14 Thread Alberto G. Corona
2010/1/14 Michael Snoyman mich...@snoyman.com



 Well, for one thing, you'd need to use lazy IO to achieve your goal, which
 has some safety issues. As things get more and more complex, the
 requirements of lazy IO will continue to grow. This also has implications
 for number of open file handles and deterministic space usage. Given the
 fact that a lazy bytestring and easily be converted to an enumerator, I
 think it makes sense to start a new package using this approach.

 These must be issues of base library developers, not application
developpers. TIme ago a guy said me that using an standard library like
malloc for memory allocation where not the optimum. And he was right.
Fortunately things went in the non-optimum direction.  You can make the
application faster by using your own plumbing code instead of standard
libraries provided that you have enough time and knowledge. Because I don´t
have neither of the two  :-) (nor have the people that read my code and
maintain the application), I really like the laziness of haskell and the
lazy bytestring interface.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Web application interface

2010-01-14 Thread Michael Snoyman
On Thu, Jan 14, 2010 at 1:20 PM, Alberto G. Corona agocor...@gmail.comwrote:



 2010/1/14 Michael Snoyman mich...@snoyman.com



 Well, for one thing, you'd need to use lazy IO to achieve your goal, which
 has some safety issues. As things get more and more complex, the
 requirements of lazy IO will continue to grow. This also has implications
 for number of open file handles and deterministic space usage. Given the
 fact that a lazy bytestring and easily be converted to an enumerator, I
 think it makes sense to start a new package using this approach.

 These must be issues of base library developers, not application
 developpers. TIme ago a guy said me that using an standard library like
 malloc for memory allocation where not the optimum. And he was right.
 Fortunately things went in the non-optimum direction.  You can make the
 application faster by using your own plumbing code instead of standard
 libraries provided that you have enough time and knowledge. Because I don´t
 have neither of the two  :-) (nor have the people that read my code and
 maintain the application), I really like the laziness of haskell and the
 lazy bytestring interface.

 Lazy bytestring interface is one thing; lazy IO is another. If you have
pure code generating a lazy bytestring, Hack will work fine for you. Try
this one however: take a 10MB YAML file, reformat it using something in the
IO monad (for example, look up values from a database) and produce HTML
output. Hack will *not* allow you to run in constant space without
significant usageof unsafe functions.

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


Re: [Haskell-cafe] Language simplicity

2010-01-14 Thread Roel van Dijk
 Thus speaketh the report (http://haskell.org/onlinereport/lexemes.html):

 symbol   -      ascSymbol | uniSymbolspecial | _ | : |  | '
 ascSymbol       -      ! | # | $ | % |  | * | + | . | / |  | = |  | ? | @
        |       \ | ^ | | | - | ~
 uniSymbol        -      any Unicode symbol or punctuation

 Punctuation characters are legitimate for operators.

Aha, didn't know that (or forgot it). Also kind of obvious when you
consider that '.' and ':' are punctuation characters.

I think it is time for an Obfuscated Haskell Contest :-)
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Language simplicity

2010-01-14 Thread Colin Paul Adams
 Roel == Roel van Dijk vandijk.r...@gmail.com writes:

Roel I think it is time for an Obfuscated Haskell Contest :-)

Are you allowed to use obsolete scripts for your identifiers? :-)
-- 
Colin Adams
Preston Lancashire
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Language simplicity

2010-01-14 Thread Roel van Dijk
On Thu, Jan 14, 2010 at 12:47 PM, Colin Paul Adams
co...@colina.demon.co.uk wrote:
 Roel == Roel van Dijk vandijk.r...@gmail.com writes:

    Roel I think it is time for an Obfuscated Haskell Contest :-)

 Are you allowed to use obsolete scripts for your identifiers? :-)

Sure, I'll consider bonus points if you write your program entirely in
cuneiform.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Typed Configuration Files

2010-01-14 Thread Ketil Malde
Magnus Therning mag...@therning.org writes:

 Seriously, cmdargs is *brilliant*.  It's also magic (to me).

On this list, I'm uncertain whether brilliant is a warning or a
recommendation, but magic is clearly irresistible, so I had a go at
using cmdargs. 

And I agree, it is really nice in quickly and succintly getting command
parsing up and working, and in that it most Works As Expected (tm).
Some snags I ran into, which may (or may not) serve to improve
documentation, and which may (or may not) result in some gentle guidande
as to preferred solutions rising to the surface: 

- The examples use 'def' a lot, and I mistakenly thought 'empty' would
  supply default values. Not so, replace 'def' with the default value
  and off you go.  'def' seems to be the minimum value for that
  particular type.

- As I wanted a single file argument, I tried to use 'args' in
  combination with a parameter of type FilePath.  Apparently 'args'
  wants [FilePath] and appends command line arguments to the default
  value.  I used 'error no file bla bla' as the default value, and 
  appending to this didn't do much good, as you can imagine.  So: use
  [FilePath] and check the length manually.

- CmdArgs helpfully provides default --help, --version as well as
  --quite and --verbose.  For the two former, there's also a nice
  default implementation, but presumably the latter two are for use in
  the program proper.  Unfortunately, I don't know how to get at their
  values.

-k
-- 
If I haven't seen further, it is by standing in the footprints of giants
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Web application interface

2010-01-14 Thread Michael Snoyman
On Thu, Jan 14, 2010 at 1:58 PM, Alberto G. Corona agocor...@gmail.comwrote:



 2010/1/14 Michael Snoyman mich...@snoyman.com



 On Thu, Jan 14, 2010 at 1:20 PM, Alberto G. Corona 
 agocor...@gmail.comwrote:



 2010/1/14 Michael Snoyman mich...@snoyman.com



 Well, for one thing, you'd need to use lazy IO to achieve your goal,
 which has some safety issues. As things get more and more complex, the
 requirements of lazy IO will continue to grow. This also has implications
 for number of open file handles and deterministic space usage. Given the
 fact that a lazy bytestring and easily be converted to an enumerator, I
 think it makes sense to start a new package using this approach.

 These must be issues of base library developers, not application
 developpers. TIme ago a guy said me that using an standard library like
 malloc for memory allocation where not the optimum. And he was right.
 Fortunately things went in the non-optimum direction.  You can make the
 application faster by using your own plumbing code instead of standard
 libraries provided that you have enough time and knowledge. Because I don´t
 have neither of the two  :-) (nor have the people that read my code and
 maintain the application), I really like the laziness of haskell and the
 lazy bytestring interface.

 Lazy bytestring interface is one thing; lazy IO is another. If you have
 pure code generating a lazy bytestring, Hack will work fine for you. Try
 this one however: take a 10MB YAML file, reformat it using something in the
 IO monad (for example, look up values from a database) and produce HTML
 output. Hack will *not* allow you to run in constant space without
 significant usageof unsafe functions.

 Michael


 So there are memory leaks somewhere in the lazy bytestring IO libraries
 (not in hack neither is an inherent problem in the lazy bytestring design,
 the lazy IO concept or laziness as such).

 I did''t take a look, but surely a lazy bytestring IO read is composed of
 an iteration of strict block reads that present a lazy bytestring interface.
 It must be  essentially the same than a iteratee IO, but with a higher level
 interface (at least higher from my point of view).

 I like haskell for Internet applications because streaming is the essence
 of communications and function call is the building block of programming.
 Haskell deals with both with zero impedance because its laziness. Don't
 break this!!


 No, that's not the way it works. Lazy IO requires the use of
unsafeInterleaveIO, which is, well, unsafe. Pure functions in Haskell can
safely be lazy, not so with IO. If you don't believe me, you can read more
about it here: http://okmij.org/ftp/Streams.html#iteratee

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


[Haskell-cafe] ANN: hakyll-1.0

2010-01-14 Thread Jasper Van der Jeugt
Hello,

I have just released hakyll[1] 1.0. It is now available on hackage[2].
This is considered a first stable release (hence 1.0), and pretty it
is functional.

Hakyll is a Haskell library for generating static sites. It is written
in a very configurable way and uses an xmonad-like DSL for
configuration.

Important changes:
- Switched from the template library to a custom template system,
because we needed some more flexibility, but not quite as much as
something like HStringTemplate would give.
- Switched from inconsistent String/ByteString usage to String only
for the external API.
- Added a $root system so it is easy to work with relative/absolute URL's.
- Many bugfixes.
- More documentation and a reference are online now.

All feedback and questions are welcome.

Kind regards,
Jasper Van der Jeugt

[1]: http://jaspervdj.be/hakyll
[2]: http://hackage.haskell.org/package/hakyll
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Language simplicity

2010-01-14 Thread Martijn van Steenbergen

Niklas Broberg wrote:

Haskell '98 apparently features 25 reserved words. (Not counting forall
and mdo and so on, which AFAIK are not in Haskell '98.)


21 actually. case, class, data, default, deriving, do, else, if,
import, in, infix, infixl, infixr, instance, let, module, newtype, of,
then, type, where. There's also three special words that can still be
used as identifiers, so aren't reserved: as, qualified, hiding.


Since you can define operators in Haskell, would it make sense to 
include '=', '--', ':', ',' etc. as reserved names since those can't 
be used as operator names?



Illegal binding of built-in syntax: :
Illegal binding of built-in syntax: (,)
parse error (possibly incorrect indentation)


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


Re: [Haskell-cafe] wildcards for type variables?

2010-01-14 Thread Ozgur Akgun
Can someone give an example of a reasonable function that never uses one
of its parameters, and justify the existence of that parameter in this case,
please?

Because for this example,
f :: _unused - A - B
f _ a = b
I think what I'd do is to write the function f without that first parameter,
and call the funcrtion accordingly.

Best,


2010/1/13 Sebastian Fischer s...@informatik.uni-kiel.de


 On Jan 13, 2010, at 6:54 PM, Evan Laforge wrote:

  It's not a big issue, but it seemed like a nice symmetry with pattern
 matching syntax.


 And I don't think it's a weird idea. The Haskell dialect Curry [1]
 supports this syntax. Maybe the hurdle for Haskell is the competition with
 more complex, conflicting proposals like [2].

 Sebastian

 [1] http://curry-language.org
 [2] http://hackage.haskell.org/trac/haskell-prime/wiki/PartialTypeSigs


 --
 Underestimating the novelty of the future is a time-honored tradition.
 (D.G.)



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




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


Re: [Haskell-cafe] wildcards for type variables?

2010-01-14 Thread Ivan Lazar Miljenovic
Ozgur Akgun ozgurak...@gmail.com writes:

 Can someone give an example of a reasonable function that never uses one
 of its parameters, and justify the existence of that parameter in this case,
 please?

I would like to bring your attention to the const function:

,
| const :: a - b - a
| const a _ = a
`

For justification, I often use this function when I need to provide a
function that takes two arguments by the function I want to use only
needs one; as such either const of (flip const) can let me absorb and
ignore the unneeded argument.

Satisfied? ;-)

-- 
Ivan Lazar Miljenovic
ivan.miljeno...@gmail.com
IvanMiljenovic.wordpress.com
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] wildcards for type variables?

2010-01-14 Thread Ketil Malde
Ozgur Akgun ozgurak...@gmail.com writes:

 Can someone give an example of a reasonable function that never uses one
 of its parameters, and justify the existence of that parameter in this case,
 please?

E.g, 'const' is useful when you need something to feed to a higher order
function:

  -- an element =3 starts a new group
  *Main groupBy (const (3)) [1,2,3,4,1,5,6]
  [[1],[2],[3,4],[1,5,6]]

Not the best example, perhaps, but the existence of const allows you to
easily reuse existing framework.

There's also 'par', although it's raison d'être is to have an effect on
the second parameter, so it is arguably using it.

-k
-- 
If I haven't seen further, it is by standing in the footprints of giants
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] deleteBy type too restrictive

2010-01-14 Thread Dan Rosén
Hello,

I realized today that the type for deleteBy in Data.List is too restrictive.
The code is:

deleteBy:: (a - a - Bool) - a - [a] - [a]
deleteBy _  _ []= []
deleteBy eq x (y:ys)= if x `eq` y then ys else y : deleteBy eq x ys

though the type deleteBy :: (b - a - Bool) - b - [a] - [a] will do good
as well.

Is there a particular reason that the type has this restriction? Otherwise,
where can I post a suggestion to have it untightened?

Best regards,
Dan Rosén

references:
http://haskell.org/ghc/docs/latest/html/libraries/base-4.2.0.0/Data-List.html#v:deleteBy
http://www.haskell.org/ghc/docs/latest/html/libraries/base-4.2.0.0/src/Data-List.html#deleteBy
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] General Advice Needed ..

2010-01-14 Thread Ian675

Hi,

First of all, sorry if its in the wrong section..

But I'm just having trouble getting to grips with Haskell. I have my
functional programming exam tommorow and I'm struggling to understand any of
this.

We worked through the book The Craft Of Functional Programming and Im trying
to work my way through it but still no luck.. I find it really hard to put
down code onto paper. I can understand the code in the book

I can do the simple simple functions like cube..

cube :: Int - Int
cube n = n*n*n

But after that im lost :(

Is there any general advice? Just keep reading the book till it drills into
my big head?

You can make sarcastic n00b jokes if you like.. I'm just a very frustrated
student right now!
-- 
View this message in context: 
http://old.nabble.com/General-Advice-Needed-..-tp27161410p27161410.html
Sent from the Haskell - Haskell-Cafe mailing list archive at Nabble.com.

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


Re: [Haskell-cafe] Language simplicity

2010-01-14 Thread Niklas Broberg
 Since you can define operators in Haskell, would it make sense to include
 '=', '--', ':', ',' etc. as reserved names since those can't be used as
 operator names?

They are indeed reserved operators in the report. 11 of those:

.. : :: = \ | - - @ ~ =

To be fair, _ is also a reserved identifier, so 22 and not 21 as I
said previously. So a total of 33 reserved names.

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


Re: [Haskell-cafe] Language simplicity

2010-01-14 Thread Tom Tobin
On Thu, Jan 14, 2010 at 12:45 AM, Colin Paul Adams
co...@colina.demon.co.uk wrote:
 Tom == Tom Tobin korp...@korpios.com writes:

    Tom readability.  The ASCII characters are universal and easily
    Tom recognized

 No they are not.
 My wife is Chinese. When she was learning pinyin as a child, she asked
 her father for help with some homework. He replied that he didn't
 understand them.

I should have said The ASCII characters are universal and easily
recognized *for programmers*.  Of course someone who hasn't come in
contact with the Latin alphabet, let alone programming, isn't going to
recognize ASCII — but I think we'd have an amazingly hard time finding
a programmer who wasn't familiar with it, regardless of their native
language.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] General Advice Needed ..

2010-01-14 Thread Martin Coxall
 
 But after that im lost :(
 
 Is there any general advice? Just keep reading the book till it drills into
 my big head?

Is it that you're having difficulty knowing how you'd solve certain classes of 
problems using Haskell? You're stuck in an imperative rut?

The O'Reilly book Real World Haskell is very good for this, because as the 
name implies, it uses Haskell to solve actual engineering problems, rather than 
approach it from the theoretical angle.

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


Re: [Haskell-cafe] General Advice Needed ..

2010-01-14 Thread Matthias Görgens
Hi,

it may be a bit too late for you, but in general working through
Smullyan's To Mock a Mockingbird
(http://en.wikipedia.org/wiki/To_Mock_a_Mockingbird) may help in
coming to grips with some of the theory (and intuition) behind
functional programming.

The Real World Haskell book is also a good choice, completely
orthogonal to Smullyan's book, and much more practical.

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


Re: [Haskell-cafe] General Advice Needed ..

2010-01-14 Thread Ian675

Pretty much yeah.. Im going through the book and things like :

Define a function rangeProduct which when given natural numbers m and n,
returns the product m*(m+1)**(n-1)*n

I got the solution from my lecture notes but I still dont understand it..

rangeProduct :: Int - Int - Int
rangeProduct m n
  | m  n = 0
  | m == n = m
  | otherwise = m * rangeProduct (m+1) n

Totally lost! Haha..

But thanks for the book suggestion, My exam is tommorow so I'm hoping theres
an online version of this book that I can read through!

And maybe by some divine miracle I'll understand it :-)

Martin Coxall-2 wrote:
 
 
 But after that im lost :(
 
 Is there any general advice? Just keep reading the book till it drills
 into
 my big head?
 
 Is it that you're having difficulty knowing how you'd solve certain
 classes of problems using Haskell? You're stuck in an imperative rut?
 
 The O'Reilly book Real World Haskell is very good for this, because as
 the name implies, it uses Haskell to solve actual engineering problems,
 rather than approach it from the theoretical angle.
 
 Martin
 ___
 Haskell-Cafe mailing list
 Haskell-Cafe@haskell.org
 http://www.haskell.org/mailman/listinfo/haskell-cafe
 
 

-- 
View this message in context: 
http://old.nabble.com/General-Advice-Needed-..-tp27161410p27162216.html
Sent from the Haskell - Haskell-Cafe mailing list archive at Nabble.com.

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


Re: [Haskell-cafe] General Advice Needed ..

2010-01-14 Thread Ian675

It may be a bit late but I'll try anything

Thankyou, I'll have a read :-)


Matthias Görgens-2 wrote:
 
 Hi,
 
 it may be a bit too late for you, but in general working through
 Smullyan's To Mock a Mockingbird
 (http://en.wikipedia.org/wiki/To_Mock_a_Mockingbird) may help in
 coming to grips with some of the theory (and intuition) behind
 functional programming.
 
 The Real World Haskell book is also a good choice, completely
 orthogonal to Smullyan's book, and much more practical.
 
 Matthias.
 ___
 Haskell-Cafe mailing list
 Haskell-Cafe@haskell.org
 http://www.haskell.org/mailman/listinfo/haskell-cafe
 
 

-- 
View this message in context: 
http://old.nabble.com/General-Advice-Needed-..-tp27161410p27162253.html
Sent from the Haskell - Haskell-Cafe mailing list archive at Nabble.com.

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


Re: [Haskell-cafe] General Advice Needed ..

2010-01-14 Thread Tom Tobin
On Thu, Jan 14, 2010 at 7:52 AM, Ian675 adam_khan_...@hotmail.com wrote:
 Is there any general advice? Just keep reading the book till it drills into
 my big head?

Also don't be afraid to ask specific questions on the Beginners
mailing list; while Cafe is a good general resource, Beginners is
specifically there for those still learning the language (like me).
:-)
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Language simplicity

2010-01-14 Thread Matthias Görgens
 All Lisps have special forms which are evaluated uniquely and differently 
 from function application and are therefore reserved words by another name. 
 For example, Clojure has def, if, do, let, var, quote, fn, loop, recur, 
 throw, try, monitor-enter, monitor-exit, dot, new and set!.

Yes, but the special forms are not distinguishable from user defined
macros --- and some Lisp-implemantations special forms are another
implementations macros.  E.g. you can choose to make `if' a macro that
expands to `cond' or vice versa.  I do not know whether you are
allowed to shadow the name of special-forms.

 If you count reserved tokens, I guess Lisp reserves parentheses and 
 whitespace?

Not if you are using Common Lisp.  There you can install reader-macros
that act on characters in the input-stream.  (Most macros act on stuff
in the already parsed syntrax tree.)

Forth is also a remarkably flexible language in this regard.

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


Re: [Haskell-cafe] Language simplicity

2010-01-14 Thread Martin Coxall

On 14 Jan 2010, at 14:42, Matthias Görgens wrote:

 All Lisps have special forms which are evaluated uniquely and differently 
 from function application and are therefore reserved words by another name. 
 For example, Clojure has def, if, do, let, var, quote, fn, loop, recur, 
 throw, try, monitor-enter, monitor-exit, dot, new and set!.
 
 Yes, but the special forms are not distinguishable from user defined
 macros --- and some Lisp-implemantations special forms are another
 implementations macros.  E.g. you can choose to make `if' a macro that
 expands to `cond' or vice versa.  I do not know whether you are
 allowed to shadow the name of special-forms.
 

Clojure's a lot more 'syntaxy' than most Lisps. It has literals for large 
classes of entities that get represented as lists in most other Lisps. Which I 
guess is clearly a pragmatic design decision: be as syntax-heavy as is 
reasonably practicable without sacrificing homoiconicity and ending up like 
Dylan.

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


Re: [Haskell-cafe] Typed Configuration Files

2010-01-14 Thread Ketil Malde
Ketil Malde ke...@malde.org writes:

 - CmdArgs helpfully provides default --help, --version as well as
   --quite and --verbose.  For the two former, there's also a nice
   default implementation, but presumably the latter two are for use in
   the program proper.  Unfortunately, I don't know how to get at their
   values.

I couldn't find it in an example, but apparently it is done through
global functions 'isLoud', 'isNormal', and 'isQuiet'.

-k
-- 
If I haven't seen further, it is by standing in the footprints of giants
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: looking for origin of quote on preprocessors and language design

2010-01-14 Thread Henning Thielemann
Maciej Piechotka schrieb:

 
 Hmm. May I ask how to do for example something depending on POSIX or
 WinAPI? I am sorry but I cannot see how any of the above problems could
 be solved.

Sure, I choose different Hs-Source-Dirs for the different platforms.
Multiple Hs-Source-Dirs are merged.

Example:
   http://hackage.haskell.org/packages/archive/sox/0.1/sox.cabal

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


Re: [Haskell-cafe] Language simplicity

2010-01-14 Thread Steve Schafer
On Thu, 14 Jan 2010 14:42:06 +, you wrote:

 All Lisps have special forms which are evaluated uniquely and differently 
 from function application and are therefore reserved words by another name. 
 For example, Clojure has def, if, do, let, var, quote, fn, loop, recur, 
 throw, try, monitor-enter, monitor-exit, dot, new and set!.

Yes, but the special forms are not distinguishable from user defined
macros --- and some Lisp-implemantations special forms are another
implementations macros.  E.g. you can choose to make `if' a macro that
expands to `cond' or vice versa.  I do not know whether you are
allowed to shadow the name of special-forms.

You can in Scheme; syntactic-keyword bindings can shadow variable
bindings, and vice versa:

The following is given as an example in R5RS:

 (let-syntax ((when (syntax-rules ()
  ((when test stmt1 stmt2 ...)
   (if test
   (begin stmt1
  stmt2 ...))

   (let ((if #t))
 (when if (set! if 'now))
 if))

Evaluating the above returns now.

Steve Schafer
Fenestra Technologies Corp.
http://www.fenestra.com/
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Quick, somebody do something!

2010-01-14 Thread Henk-Jan van Tuyl


Haskell has dropped out of the top 50 at Tiobe [1]; how could this hapen?  
Let's start selling mobile phones that can only be programmed in Haskell  
:-)



[1] http://www.tiobe.com/content/paperinfo/tpci/index.html


--
Met vriendelijke groet,
Henk-Jan van Tuyl


--
http://Van.Tuyl.eu/
http://members.chello.nl/hjgtuyl/tourdemonad.html
--
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Quick, somebody do something!

2010-01-14 Thread Deniz Dogan
2010/1/14 Henk-Jan van Tuyl hjgt...@chello.nl:

 Haskell has dropped out of the top 50 at Tiobe [1]; how could this hapen?
 Let's start selling mobile phones that can only be programmed in Haskell :-)


 [1] http://www.tiobe.com/content/paperinfo/tpci/index.html


 --
 Met vriendelijke groet,
 Henk-Jan van Tuyl



So then we lived up to Peyton-Jones' Haskell slogan: avoid success at all costs.

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


Re: [Haskell-cafe] Web application interface

2010-01-14 Thread Jeremy Shaw

Hello,

Happstack is currently bundled with it's own lazy I/O based HTTP  
backend. Ideally, we would like to split that out, and allow happstack  
to be used with that backend, hyena, or other options.


A primary using for using hyena would be for the benefits of  
predictability and constant space usage that iterators bring. People  
do actually running into the issues that come with lazy I/O, such as  
running out of file descriptors, etc.  So, I feel like I would want to  
stick with using iterators the whole way when using hyena, and not  
convert back to a lazy ByteString?


Happstack now includes support for sendfile(). This is done by adding  
another constructor to the Response type:


(line 94):
http://patch-tag.com/r/mae/happstack/snapshot/current/content/pretty/happstack-server/src/Happstack/Server/HTTP/Types.hs

Then here on line 197, we match on that case and use sendfile to send  
the data:


http://patch-tag.com/r/mae/happstack/snapshot/current/content/pretty/happstack-server/src/Happstack/Server/HTTP/Handler.hs

This makes it difficult for use to be compatible with WAI. We can  
write a wrapper that converts the sendfile case to use lazy  
bytestrings instead, but then we lose the advantages of using sendfile.


I wonder if the 'Response' portion of WAI should support all three  
currently used methods:

  - lazy I/O
  - Enumerator
  - sendFile

I haven't really thought about how that would work..

hyena currently includes a Network.WAI which uses ByteString:

http://hackage.haskell.org/packages/archive/hyena/0.1/doc/html/Network-Wai.html

gotta run, sorry about any typos!
- jeremy


On Jan 13, 2010, at 8:46 AM, Michael Snoyman wrote:


Hi,

I recently read (again) the wiki page on a web application  
interface[1] for Haskell. It seems like this basically works out to  
Hack[2], but using an enumerator instead of lazy bytestring in the  
response type. Is anyone working on implementing this? If not, I  
would like to create the package, though I wouldn't mind some  
community input on some design decisions:


* Hack has been fairly well-tested in the past year and I think it  
provides the features that people want. Therefore, I would want to  
model the Environment variable for WAI from Hack. I *could* just  
import Hack in WAI and use the exact same Environment data type.  
Thoughts?


* If using a different data type for Environment, should I replace  
the String parts with ByteStrings? On the one hand, ByteStrings are  
the correct data type since the HTTP protocol does not specify a  
character encoding; on the other hand, Strings are easier to deal  
with.


* It's simple to write a function to convert between a lazy  
bytestring and an enumerator, meaning it would be very easy to write  
conversion functions between Hack and WAI applications. This would  
make it simpler for people to use either backend.


If someone else is already working on WAI, please let me know, I  
don't want to have duplicate implementations. The idea here is to  
consolidate, not split the community. I have a few Hack handlers  
(simpleserver, cgi, fastcgi) that I would happily convert to WAI  
handlers as well.


Michael

[1] http://www.haskell.org/haskellwiki/WebApplicationInterface
[2] http://hackage.haskell.org/cgi-bin/hackage-scripts/package/hack
___
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] FFI, C/C++ and undefined references

2010-01-14 Thread DNM

OK. Before anyone expends any e-ink replying to my reply below -- the one
where I
demonstrate that I don't understand what -c, -cpp mean to 'ghc' (not that
you can
blame me, since there isn't any documentation in the 'ghc' man page) -- I
see why
the Main.o file doesn't run.  It's an object file, not an executable (not
being from
the C/C++ world, being a distinction I did not have at the forefront of my
mind).

Anyhow, still no dice.  Even when cleaning up my Haskell code, I can't get
this
to compile.

--D.N.


DNM wrote:
 
 Note: I'm relatively new to Haskell, and my knowledge of C and C++ is
 basically pretty
 minimal -- I can read, modify and compile C/C++ programs (usually).
 
 I'm trying to interface with some C++ code by writing a little bit of C
 code that uses that C++ code,
 and I'm getting undefined reference errors when I try to 'ghc --make' a
 client application to test
 it.
 
 Actually, I'm modifying Nitin Madnani's (freely available) Python SRILM
 toolkit wrapper code.  (SRILM, 
 by the bye, is a C++-based toolkit for training and using statistical
 n-gram language models.  I was 
 surprised that no-one has tried to do this yet -- or at least not that
 they have shared with the rest of us.)  
 Anyhow, I've verified that my modification of Madnani's C code works by
 compiling it and running it 
 through a SWIG interface in Madnani's Python code, so I'm pretty confident
 the C client of SRILM 
 is solid.   The culprit is either my Haskell FFI code or the client of
 that code.
 
 Without cooking up a microcosm of my problem with little Foo's and Bar's,
 I'll just give my
 actual C, header file and Haskell code (or at least the relevant bits),
 and then the error.
 
 - srilm.h 
 #ifdef __cplusplus
   extern C {
 #else
 typedef struct Ngram Ngram; /* dummy type to stand in for class */
 #endif
 
 Ngram* bldLM(int order, const char* filename);
 void deleteLM(Ngram* ngram);
 float getSeqProb(Ngram* ngram, const char* ngramstr, unsigned order,
 unsigned length);
 
 #ifdef __cplusplus
   }
 #endif
 -
 
 - srilm.c 
 // Initialize and read in the ngram model
 Ngram* bldLM(int order, const char* filename) { ... }
 ...
 // Delete the ngram model
 void deleteLM(Ngram* ngram) {
   delete srilm_vocab;
   delete ngram;
 }
 ...
 // Get the ngram probability of the given string, given n-gram order
 'order' and string length
 // 'length'.
 float getSeqProb(Ngram* ngram, const char* ngramstr, unsigned order,
 unsigned length) { ...}
 -
 
 Next, the Haskell FFI specs and code that marshals data between Haskell
 and C.
 
  LM.hs --
 {-# INCLUDE srilm.h #-}
 {-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls #-}
 ... module decl's, imports, etc.
 {- | A dummy placeholder for SRILM n-gram model thingies. -}
 data Ngram
 
 data NGModel = NGModel {ng :: !(ForeignPtr Ngram)}
 
 foreign import ccall srilm.h bldLM
 c_blm :: CInt - CString - Ptr Ngram
 
 foreign import ccall srilm.h deleteLM
 c_dlm :: FunPtr ((Ptr Ngram) - IO ())
 
 foreign import ccall srilm.h getSeqProb 
 c_ngramProb :: Ptr Ngram - CString - CUInt - CUInt - CFloat
 
 {- 
| Given an n-gram model, an Int representing the n-gram order
  and a list of strings (word sequence), compute the 
  n-gram probability of the sequence.
 -}
 scoreSequence :: NGModel - Int - [String] - Float
 scoreSequence ngram order seq = 
 unsafePerformIO $ do
   stringSeq - newCString (unwords seq)
   let sc = c_ngramProb (unsafeForeignPtrToPtr $ ng ngram) stringSeq
 (fromIntegral order) (fromIntegral $ length seq)
   return (realToFrac sc)
 ...
 buildLM :: Int - String - NGModel
 buildLM order fname = 
 NGModel $ 
 unsafePerformIO $ do
   cFName - newCString fname
   let ng = c_blm (fromIntegral order) cFName
   return $ unsafePerformIO $ newForeignPtr c_dlm ng
 
 
 Now, I've defined a simple app that tries to use this:
 
 --- Main.hs -
 module Main where
 import SRILM.LM(scoreSequence, buildLM)
 
 main :: IO ()
 main = do
   let lm = buildLM 5 eng.kn.5g.lm
   putStrLn $ show $ scoreSequence lm 5 [the, prime, minister,
 gave, a, speech, .]
 ---
 
 But when I try to compile it (after having successfully compiled the C
 code with g++), I get:
 
 $ ghc --make Main.hs
 Linking Main ...
 LM.o: In function `r18k_info':
 (.text+0x122): undefined reference to `bldLM'
 LM.o: In function `r18m_info':
 (.text+0x14e): undefined reference to `deleteLM'
 LM.o: In function `r18o_info':
 (.text+0x28b): undefined reference to `getSeqProb'
 collect2: ld returned 1 exit status
 
 Any ideas?
 
 Note that I'm not confident that everything on the Haskell side is
 correct, but it seems
 that ghc can't find my C 

Re: [Haskell-cafe] General Advice Needed ..

2010-01-14 Thread Henk-Jan van Tuyl
On Thu, 14 Jan 2010 15:38:26 +0100, Ian675 adam_khan_...@hotmail.com  
wrote:




Pretty much yeah.. Im going through the book and things like :

Define a function rangeProduct which when given natural numbers m and n,
returns the product m*(m+1)**(n-1)*n

I got the solution from my lecture notes but I still dont understand it..

rangeProduct :: Int - Int - Int
rangeProduct m n
  | m  n = 0
  | m == n = m
  | otherwise = m * rangeProduct (m+1) n



I'll try to give a clear explanation of this function:


rangeProduct :: Int - Int - Int
rangeProduct m n
A function is defined with parameters m and n, both Int; the result of the  
function is also an Int



  | m  n = 0
If m  n, the result is 0; the rest of the function definition will be  
skipped



  | m == n = m
If m is not larger then n, evalution continues here; if m == n, the result  
of the function is m




  | otherwise = m * rangeProduct (m+1) n
If previous predicates were False, this branch is evaluated (otherwise  
is always True); the function calls itself with (m+1) as first parameter


The boolean expressions in this function are called guards; the right  
hand side after the first guard that evaluates to True, will give the  
result of the function.


Regards,
Henk-Jan van Tuyl


--
http://Van.Tuyl.eu/
http://members.chello.nl/hjgtuyl/tourdemonad.html
--
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] General Advice Needed ..

2010-01-14 Thread Stephen Tetley
Hello

Does you find this version easier to understand?

rangeProduct :: Int - Int - Int
rangeProduct m n = if m  n then 0
else if m == n then m
   else m * rangeProduct (m+1) n



I would suspect the main point of the example is to make you think
recursively - note how rangeProduct is called from within its own
definition (on the last line of code).

Before it, there are two stopping conditions that will halt recursion
if m  n  or if m == n - stopping conditions are crucial for
recursive thinking and programming - without them you will recur
endlessly and never produce an answer.

If you exam is 'on paper' - that's to say code you can have some
syntax errors because it isn't actually run - you want to be
demonstrating that you can think recursively.


Good luck

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


Re: [Haskell-cafe] Web application interface

2010-01-14 Thread Michael Snoyman
On Thu, Jan 14, 2010 at 5:42 PM, Jeremy Shaw jer...@n-heptane.com wrote:

 Hello,

 Happstack is currently bundled with it's own lazy I/O based HTTP backend.
 Ideally, we would like to split that out, and allow happstack to be used
 with that backend, hyena, or other options.

 A primary using for using hyena would be for the benefits of predictability
 and constant space usage that iterators bring. People do actually running
 into the issues that come with lazy I/O, such as running out of file
 descriptors, etc.  So, I feel like I would want to stick with using
 iterators the whole way when using hyena, and not convert back to a lazy
 ByteString?

 Happstack now includes support for sendfile(). This is done by adding
 another constructor to the Response type:

 (line 94):

 http://patch-tag.com/r/mae/happstack/snapshot/current/content/pretty/happstack-server/src/Happstack/Server/HTTP/Types.hs

 Then here on line 197, we match on that case and use sendfile to send the
 data:


 http://patch-tag.com/r/mae/happstack/snapshot/current/content/pretty/happstack-server/src/Happstack/Server/HTTP/Handler.hs

 This makes it difficult for use to be compatible with WAI. We can write a
 wrapper that converts the sendfile case to use lazy bytestrings instead, but
 then we lose the advantages of using sendfile.

 I wonder if the 'Response' portion of WAI should support all three
 currently used methods:
  - lazy I/O
  - Enumerator
  - sendFile

 I haven't really thought about how that would work..

 hyena currently includes a Network.WAI which uses ByteString:


 http://hackage.haskell.org/packages/archive/hyena/0.1/doc/html/Network-Wai.html

 gotta run, sorry about any typos!
 - jeremy

 Firstly, thanks for the Heyna Network.Wai link, I wasn't aware of it.
Definitely something to take into consideration here.

As for your proposal of three methods, I'm not sure if it's necesary. I
understand that we would want sendfile for speedy serving of files straight
from the filesystem, but it's fairly straight-forward to convert a lazy
bytestring into an enumerator, and I don't think we get a performance
penalty for doing so (if there's a benchmark otherwise, I'd be happy to see
it).

So if this were a changeset to Network.Wai in Hyena, I would see redefining
Application as:

type Application = Environment - IO (Int, ByteString, Headers, Either
FilePath Enumerator)

Implementations that wish to go for efficiency could use sendfile directly.
We could even include a helper function for making this easy. We could also
provide a lazy bytestring - enumerator function while we're at it (although
those features might be more appropriate for a wai-helpers package, I'm not
certain).

I think it would be great if we could get Happstack involved in the WAI
project.

Michael



 On Jan 13, 2010, at 8:46 AM, Michael Snoyman wrote:

  Hi,

 I recently read (again) the wiki page on a web application interface[1]
 for Haskell. It seems like this basically works out to Hack[2], but using an
 enumerator instead of lazy bytestring in the response type. Is anyone
 working on implementing this? If not, I would like to create the package,
 though I wouldn't mind some community input on some design decisions:

 * Hack has been fairly well-tested in the past year and I think it
 provides the features that people want. Therefore, I would want to model the
 Environment variable for WAI from Hack. I *could* just import Hack in WAI
 and use the exact same Environment data type. Thoughts?

 * If using a different data type for Environment, should I replace the
 String parts with ByteStrings? On the one hand, ByteStrings are the
 correct data type since the HTTP protocol does not specify a character
 encoding; on the other hand, Strings are easier to deal with.

 * It's simple to write a function to convert between a lazy bytestring and
 an enumerator, meaning it would be very easy to write conversion functions
 between Hack and WAI applications. This would make it simpler for people to
 use either backend.

 If someone else is already working on WAI, please let me know, I don't
 want to have duplicate implementations. The idea here is to consolidate, not
 split the community. I have a few Hack handlers (simpleserver, cgi, fastcgi)
 that I would happily convert to WAI handlers as well.

 Michael

 [1] http://www.haskell.org/haskellwiki/WebApplicationInterface
 [2] http://hackage.haskell.org/cgi-bin/hackage-scripts/package/hack
 ___
 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] Language simplicity

2010-01-14 Thread Evan Laforge
 Unicode identifiers are fun but this is a good point.  The line has
 to be somewhere, so it might as well be in the historical position
 unless there are widely agreed on benefits to moving it.

 I have already crossed that line:

Ha, well haskell programmers wouldn't be haskell programmers if they
weren't already a bunch of line crossers :)
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] General Advice Needed ..

2010-01-14 Thread Ian675

thankyou.. that made more sense to me :)

What im doing now is.. 
Im still working through the Craft of Functional Programming book but I've
found a site that has solutions to some of the excercise questions. So i'm
noting them down and trying to make sense of them

Is that a good approach?


Henk-Jan van Tuyl wrote:
 
 On Thu, 14 Jan 2010 15:38:26 +0100, Ian675 adam_khan_...@hotmail.com  
 wrote:
 

 Pretty much yeah.. Im going through the book and things like :

 Define a function rangeProduct which when given natural numbers m and n,
 returns the product m*(m+1)**(n-1)*n

 I got the solution from my lecture notes but I still dont understand it..

 rangeProduct :: Int - Int - Int
 rangeProduct m n
   | m  n = 0
   | m == n = m
   | otherwise = m * rangeProduct (m+1) n

 
 I'll try to give a clear explanation of this function:
 
 rangeProduct :: Int - Int - Int
 rangeProduct m n
 A function is defined with parameters m and n, both Int; the result of the  
 function is also an Int
 
   | m  n = 0
 If m  n, the result is 0; the rest of the function definition will be  
 skipped
 
   | m == n = m
 If m is not larger then n, evalution continues here; if m == n, the result  
 of the function is m
 
 
   | otherwise = m * rangeProduct (m+1) n
 If previous predicates were False, this branch is evaluated (otherwise  
 is always True); the function calls itself with (m+1) as first parameter
 
 The boolean expressions in this function are called guards; the right  
 hand side after the first guard that evaluates to True, will give the  
 result of the function.
 
 Regards,
 Henk-Jan van Tuyl
 
 
 --
 http://Van.Tuyl.eu/
 http://members.chello.nl/hjgtuyl/tourdemonad.html
 --
 ___
 Haskell-Cafe mailing list
 Haskell-Cafe@haskell.org
 http://www.haskell.org/mailman/listinfo/haskell-cafe
 
 

-- 
View this message in context: 
http://old.nabble.com/General-Advice-Needed-..-tp27161410p27164433.html
Sent from the Haskell - Haskell-Cafe mailing list archive at Nabble.com.

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


[Haskell-cafe] Haskell implementation of ideas from StandardML as a Metaprogramming language

2010-01-14 Thread CK Kashyap
Hi All,
I was just going over the paper titled - Standard ML as a meta programming 
language by Samuel Kamin - It has a few ideas of generating C++ code from ML. 
The first one being generating C++ top down parser. I wanted to try out the 
sample in Haskell - I was wondering if anyone's already done that - I could 
just look at that implementation for reference.
Regards,
Kashyap


  

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


Re: [Haskell-cafe] Re: looking for origin of quote on preprocessors and language design

2010-01-14 Thread Jason Dusek
2010/01/07 Maciej Piechotka uzytkown...@gmail.com:
 On Thu, 2010-01-07 at 13:32 +0100, Johannes Waldmann wrote:
  Dear all,
 
  It's not exactly Haskell-specific, but ...
  I am trying to track down the origin of the proverb
 
  the existence (or: need for) a preprocessor
  shows omissions in (the design of) a language.
 
  I like to think that in Haskell, we don't need
  preprocessors since we can manipulate programs
  programmatically, because they are data.
 
  In other words, a preprocessor realizes higher order
  functions, and you only need this if your base language
  is first-order.
 
  Yes, that's vastly simplified, and it does not cover
  all cases, what about generic programming
  (but this can be done via Data.Data)
  and alex/happy (but we have parsec) etc etc.

 Not quite. While I agree that the *frequent* need for a preprocessor
 shows omissions in (the design of) a language. it is not necessary the
 case. Preprocessor may be useful if:

 - there is a new beatyful feature in newer version of compiler but you
 still want to have backward compatibility.
 - there are compiler or platform dependant elements. For example if you
 write a driver in Haskell you may want to share code as much as possible
 but you need to know 1) the size of registers and 2) the platform you're
 writing as Windows have quite different API then Linux or BSD.
 - You need to enable/disable features at build-time. It is not frequent
 at closed-source system but it is frequent on OpenSource systems. For
 example I might need to have minimal program for embedded system but
 with full feature set it likly conquer the desktops

 in such cases it is easier/more efficient to just write
 #if (defined WINDOWS  BITS = 64) || defined ALSA
 ...
 #elseif GHC_VERSION = 061004

 #endif

  I think that pre-processing is an inevitable result of poor
  support for DSLs. When looking into embedded programming for
  the AVR family recently, I was surprised at the degree to
  which programmers rely on C macros; they're the only way they
  can get the expressiveness they want at a price they can
  accept.

  Haskell has strong support for embedded DSLs and the
  abstraction penalty is low so it's not hard to get away with
  just writing Haskell for things. Just the same, there are some
  aspects of Haskell syntax that make it horribly awkward for
  some applications. I would like to write all my shell scripts
  in Haskell -- especially those scripts that drive SSH
  connections or multiple external processes -- but the line
  noise penalty is pretty high right now. Using quasi-quotation
  -- a kind of pre-processor -- with a more shell-like set of
  shortcuts might be just the right thing.

  It's nice to reflect on the fact that Haskell offers a lot of
  flexibility for program transformation but is relatively safe
  from the incomprehensibility that results from the use of
  monkey patching in Ruby or macros in general.

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


Re: [Haskell-cafe] Typed Configuration Files

2010-01-14 Thread Matthias Görgens
Hi Sebastian,

You might also want to look at how xmonad handles it's configuration.
Basically the configuration file is the main-file that produces the
executable and takes in the rest of xmonad as a library.  This works
out quite well, but you need a compiler to update the configuration.

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


Re: [Haskell-cafe] Typed Configuration Files

2010-01-14 Thread Neil Mitchell
Hi

The CmdArgs manual might help:
http://community.haskell.org/~ndm/darcs/cmdargs/cmdargs.htm

 Seriously, cmdargs is *brilliant*.  It's also magic (to me).

 On this list, I'm uncertain whether brilliant is a warning or a
 recommendation, but magic is clearly irresistible, so I had a go at
 using cmdargs.

I'd describe cmdargs as referentially impure, but really concise.

 And I agree, it is really nice in quickly and succintly getting command
 parsing up and working, and in that it most Works As Expected (tm).
 Some snags I ran into, which may (or may not) serve to improve
 documentation, and which may (or may not) result in some gentle guidande
 as to preferred solutions rising to the surface:

 - The examples use 'def' a lot, and I mistakenly thought 'empty' would
  supply default values. Not so, replace 'def' with the default value
  and off you go.  'def' seems to be the minimum value for that
  particular type.

'def' is the default value, empty has a particular semantic meaning
and serves to change the options. I should document this more
carefully. Perhaps empty should be renamed 'optional', since that's
what it does.

 - As I wanted a single file argument, I tried to use 'args' in
  combination with a parameter of type FilePath.  Apparently 'args'
  wants [FilePath] and appends command line arguments to the default
  value.  I used 'error no file bla bla' as the default value, and
  appending to this didn't do much good, as you can imagine.  So: use
  [FilePath] and check the length manually.

argPos 0 should do the trick.

 - CmdArgs helpfully provides default --help, --version as well as
  --quite and --verbose.  For the two former, there's also a nice
  default implementation, but presumably the latter two are for use in
  the program proper.  Unfortunately, I don't know how to get at their
  values.

As you found later, isLoud etc do the job.

CmdArgs is very much a 0.1 release. The documentation isn't polished,
it does simple arguments nicely, but has flaws when you try and go
more advanced. I want to spend some more time on it at some point.

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


Re: [Haskell-cafe] General Advice Needed ..

2010-01-14 Thread Gregory Crosswhite
Yes.  An approach that I have always used that has worked well for me is to 
keep a list of tricks while I am studying.  Whenever I get stuck on a 
practice problem but eventually figure it out (either by simply thinking 
harder, looking it up, or asking someone for help), I try to identify the 
missing link that had prevented me from seeing how to do it immediately, and 
then write it down on my tricks list so that I know that I need to keep that 
trick in mind while I am taking the test.

Cheers,
Greg


On Jan 14, 2010, at 8:53 AM, Ian675 wrote:

 
 thankyou.. that made more sense to me :)
 
 What im doing now is.. 
 Im still working through the Craft of Functional Programming book but I've
 found a site that has solutions to some of the excercise questions. So i'm
 noting them down and trying to make sense of them
 
 Is that a good approach?
 
 
 Henk-Jan van Tuyl wrote:
 
 On Thu, 14 Jan 2010 15:38:26 +0100, Ian675 adam_khan_...@hotmail.com  
 wrote:
 
 
 Pretty much yeah.. Im going through the book and things like :
 
 Define a function rangeProduct which when given natural numbers m and n,
 returns the product m*(m+1)**(n-1)*n
 
 I got the solution from my lecture notes but I still dont understand it..
 
 rangeProduct :: Int - Int - Int
 rangeProduct m n
  | m  n = 0
  | m == n = m
  | otherwise = m * rangeProduct (m+1) n
 
 
 I'll try to give a clear explanation of this function:
 
 rangeProduct :: Int - Int - Int
 rangeProduct m n
 A function is defined with parameters m and n, both Int; the result of the  
 function is also an Int
 
  | m  n = 0
 If m  n, the result is 0; the rest of the function definition will be  
 skipped
 
  | m == n = m
 If m is not larger then n, evalution continues here; if m == n, the result  
 of the function is m
 
 
  | otherwise = m * rangeProduct (m+1) n
 If previous predicates were False, this branch is evaluated (otherwise  
 is always True); the function calls itself with (m+1) as first parameter
 
 The boolean expressions in this function are called guards; the right  
 hand side after the first guard that evaluates to True, will give the  
 result of the function.
 
 Regards,
 Henk-Jan van Tuyl
 
 
 --
 http://Van.Tuyl.eu/
 http://members.chello.nl/hjgtuyl/tourdemonad.html
 --
 ___
 Haskell-Cafe mailing list
 Haskell-Cafe@haskell.org
 http://www.haskell.org/mailman/listinfo/haskell-cafe
 
 
 
 -- 
 View this message in context: 
 http://old.nabble.com/General-Advice-Needed-..-tp27161410p27164433.html
 Sent from the Haskell - Haskell-Cafe mailing list archive at Nabble.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] sizeOf on a type

2010-01-14 Thread Henning Thielemann


On Fri, 25 Dec 2009, Lennart Augustsson wrote:


sizeOfPtr :: Ptr a - Int
sizeOfPtr = sizeOf . (undefined :: Ptr a - a)

No need for scoped type variables.  But it does assume sizeOf does not
use its argument.


That's even better. I'll add that to the Wiki.

  
http://www.haskell.org/haskellwiki/Scoped_type_variables#Avoiding_Scoped_Type_Variables___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] wildcards for type variables?

2010-01-14 Thread Evan Laforge
On Thu, Jan 14, 2010 at 5:19 AM, Ozgur Akgun ozgurak...@gmail.com wrote:
 Can someone give an example of a reasonable function that never uses one
 of its parameters, and justify the existence of that parameter in this case,
 please?

As I mentioned, this is not only about parameters, but about type
variables.  From my own code:

data Signal y = doesn't depend on y
data ControlY -- phantom type
type Control = Signal ControlY
-- other phantom types follow

takes_specific_signal :: Control - ...
takes_generic_signal :: Signal _y - ...

 Because for this example,
 f :: _unused - A - B
 f _ a = b
 I think what I'd do is to write the function f without that first parameter,
 and call the funcrtion accordingly.

It's common (for me at least) to write 'modify' functions that look
like modify_x :: (X - X) - SomeMonad ().  You don't need to write
the 'set' variant if you have const.

That said, 'const' is already in the Prelude.  But ignored args also
turn up when you need a common signature, this also occurs a number of
times in my own code:

this_way :: X - Y - Z
that_way :: X - _y - Z -- doesn't need Ys
testing_way :: _x - _y - Z

...
modify_rec $ const $ rec { rec_doit = if do_this_way then this_way
else that_way }
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Haskell implementation of ideas from StandardML as a Metaprogramming language

2010-01-14 Thread Stephen Tetley
Hello Kashyap

I can do MSL and Region, maybe I did the parser combinators but I
can't find them at the moment.

I tried to keep the code close to the original SML, so as Haskell code
its not pretty. Not having quasiquote was a problem.

Best wishes

Stephen



-- MSL


module MSL where


type Expr = String
type Predicate = Expr
type Statement = String
type Fieldname = String

data Bitsource = Source Expr Expr
  deriving Show


newbitsource a i  = Source a i

initbs (Source _ i) =  i ++  = 0;

getByte (Source a i)  =  a ++ [ ++  i ++ /8]

getNthByte :: Bitsource - Int - Expr
getNthByte (Source a i) n
| n == 0= a ++ [ ++  i ++ /8]
| otherwise = a ++ [ ++  i ++ /8+ ++ show n ++ ]

advanceByte (Source a i) = i ++  =  ++ i ++ -( ++ i ++ %8)+8;

advanceNBytes (Source a i) n
| n == 0= 
| otherwise = i ++  =  ++ i ++ -( ++ i ++ %8)+(8* ++ show n++);


data Recordfield = Field Expr [Fieldname]
  deriving Show

recordptr :: Expr - Recordfield
recordptr e  = Field e []

subfield :: Recordfield - Fieldname - Recordfield
subfield (Field e fl) f  = Field e (f:fl)

deref :: Recordfield - Expr
deref (Field e fl)
= (* ++e++ ) ++ concat ( map cojoin (reverse fl) )
  where
cojoin :: Fieldname - String
cojoin s = . ++ s 



type Message = Bitsource - Recordfield - Statement - Statement   

infield :: Fieldname - Message - Message
infield f m src tgt
= m src (subfield tgt f)


c_if :: Expr - Statement - Statement - Statement
c_if e s1 s2
= if e==1 || e==(1)
 then s1
 else if(++e++){
++ s1
++ } ++ if s2 /=  then else { ++ s2 ++ } else 


seqmsg :: [Message] - Message
seqmsg (m:ml) src tgt s
  = (m src tgt error_action();) ++  (seqmsg ml src tgt s)
seqmsg [] _ _ _ = 

asc2Int :: Int - (Int,Int) - Message
asc2Int w (lo,hi) src tgt s
 = c_if (inrange( ++ (getByte src) ++ , 
++ (ms w) ++ ,  ++ (ms lo)
++ ,  ++ (ms hi))

s
  where
  ms n = show n 


alt :: [Message] - Message
alt (m:ml) src tgt s
  = m src tgt (alt ml src tgt s)


delim :: Expr - Message
delim e src tgt s
  = if ( ++ getByte src ++  ==  ++ e ++)
   ++ advanceByte src

rangex :: Int - Int - [Int]
rangex i j
| i  j = []
| otherwise = (i:(rangex (i+1) j))


c_and [] =  
c_and [pred] = ( ++ pred ++ )   
c_and (pred1:pred2:preds) = ( ++ pred1 ++++ c_and (pred2:preds) ++ )

asc :: String - String - Message
asc chars value src tgt s
  = c_if 
 (deref tgt ++  ==  ++ value ++ ; )
 s

skip :: Int - Message
skip n src tgt s
  = (deref tgt) ++ = 1;
++ (advanceNBytes src n)



bs = newbitsource A bit
f = recordptr target


main = delim 6 bs f abort();


to_confidence = alt [ asc HH High
, asc MM Medium
, asc LL Low
, asc NN None
]   



-- Region

-- This one doesn't work properly -
-- CPoints are difficult to manipulate as strings, hence the `hasVar`
-- problems, it gives some idea of the method though.



module Region where

import Data.Char ( isAlpha )
import Data.List ( foldl' )


-- Prolog
type CExpr = String
type CPred = String
type CFloat = Float

infixr 6 ++
(++) :: Show a = String - a - String
s ++ a = s ++ show a


sqrdist _ = 

add :: CPoint - CPoint - CPoint
add a b = a ++ + ++ b

sub :: CPoint - CPoint - CPoint
sub a b = a ++ - ++ b

hasVar :: CExpr - Bool
hasVar = any isAlpha

cfst :: CPoint - CExpr
cfst a | hasVar a   = a ++ .x
   | otherwise  = 1.1

csnd :: CPoint - CExpr
csnd a | hasVar a   = a ++.y
   | otherwise  = 2.2

pt :: (CFloat,CFloat) - CPoint
pt = show

intersect :: [Region] - Region
intersect (r:rs) = foldl' (/\) r rs
intersect [] = error $ intersect on empty list



-- presentation

type CPoint = CExpr
type Region = CPoint - CPred


circle :: CFloat - Region
circle n = \p - ( ++ sqrdist p ++  ++ n ++ * ++ n ++ )

halfplane :: CPoint - CPoint - Region
halfplane a b = \p - ( ++ zcross (a `sub` p) (b `sub` a) ++   0.0)
  where
zcross e1 e2 =
  ( ++ cfst e1 ++ * ++ csnd e2 ++ - ++ csnd e2 ++ * ++
cfst e1 ++ )


(/\) :: Region - Region - Region
r1 /\ r2 = \p - ( ++ r1 p ++++ r2 p ++ )

(\/) :: Region - Region - Region
r1 \/ r2 = \p - ( ++ r1 p ++  ||  ++ r2 p ++ )

at :: Region - CPoint - Region
r `at` p0 = \p - r (p `sub` p0)

convexPoly :: [CPoint] - Region
convexPoly (p:ps) =
  intersect (zipWith halfplane ([p] ++ ps) (ps ++ [p]))


tightZone :: CPoint - CPred
tightZone =
  (convexPoly [pt (0.0,5.0), pt (118.0,32.0),
   pt (118.0,62.0), pt (0.0,25.0) ])
\/
  (convexPoly [pt 

Re: [Haskell-cafe] Language simplicity

2010-01-14 Thread Andrew Coppin

Martijn van Steenbergen wrote:

Niklas Broberg wrote:

21 actually. case, class, data, default, deriving, do, else, if,
import, in, infix, infixl, infixr, instance, let, module, newtype, of,
then, type, where. There's also three special words that can still be
used as identifiers, so aren't reserved: as, qualified, hiding.


Since you can define operators in Haskell, would it make sense to 
include '=', '--', ':', ',' etc. as reserved names since those can't 
be used as operator names?


Makes sense to me...

It's merely more difficult to catelogue this information for a 
half-dozen different languages. Looking up the reserved word list is 
usually only a Google search away.


Somebody suggested to me that the best metric for how difficult a 
language is to learn is the number of orthogonal concepts you need to 
learn. Of course, measuring THAT is going to be no picknick!


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


Re: [Haskell-cafe] FFI, C/C++ and undefined references

2010-01-14 Thread DNM

Which is weird, because 'srilm.o'/'srilm.h' are the files that define the
mysterious undefined references.  I'll keep plugging away and report
back when (or whether) I make some progress.  In the meanwhile, if anyone
has a clue, I'm all ears.

Best,
D.N.


Malcolm Wallace wrote:
 
 However, if you are unsure of which Haskell packages are needed, it is  
 wise to let ghc work out the dependencies for you, e.g. with
  ghc --make Main.hs slirm.o
 
 It cannot work out the C/C++ dependencies though, so every time you  
 get undefined reference linking errors, you must discover which C  
 code provides those symbols, and add its object file to the  
 commandline by hand.
 

-- 
View this message in context: 
http://old.nabble.com/FFI%2C-C-C%2B%2B-and-undefined-references-tp27139612p27167019.html
Sent from the Haskell - Haskell-Cafe mailing list archive at Nabble.com.

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


Re: [Haskell-cafe] Language simplicity

2010-01-14 Thread jur


On Jan 14, 2010, at 8:38 PM, Andrew Coppin wrote:


Martijn van Steenbergen wrote:

Niklas Broberg wrote:

21 actually. case, class, data, default, deriving, do, else, if,
import, in, infix, infixl, infixr, instance, let, module, newtype,  
of,
then, type, where. There's also three special words that can still  
be

used as identifiers, so aren't reserved: as, qualified, hiding.


Since you can define operators in Haskell, would it make sense to  
include '=', '--', ':', ',' etc. as reserved names since those  
can't be used as operator names?


Makes sense to me...

It's merely more difficult to catelogue this information for a half- 
dozen different languages. Looking up the reserved word list is  
usually only a Google search away.


Somebody suggested to me that the best metric for how difficult a  
language is to learn is the number of orthogonal concepts you need  
to learn. Of course, measuring THAT is going to be no picknick!


I do not think so. More orthogonal concepts may make it more work to  
learn the language, but I think

orthogonality helps to learn a language that has many concepts.

For me, a major problem when learning a language is ad-hocness.
The Java Language Specification part on Generics (parametric  
polymorphism) comes to mind.
It is full of ad-hoc restrictions, and operational details. Haskell's  
polymorphism behaves much

more predictably because it is much less ad-hoc.

Although I do not have any Python programming experience, I got the  
impression that
Python is very un-ad-hoc. Everything behaves in exactly the same way  
at all possible
levels in the language. You need to master only one idea and it  
applies everywhere.

Even if the way it behaves is strange.

Jurriaan


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


Re: [Haskell-cafe] FFI, C/C++ and undefined references

2010-01-14 Thread Daniel Fischer
Am Donnerstag 14 Januar 2010 20:42:42 schrieb DNM:
 Which is weird, because 'srilm.o'/'srilm.h' are the files that define
 the mysterious undefined references.  I'll keep plugging away and
 report back when (or whether) I make some progress.  In the meanwhile,
 if anyone has a clue, I'm all ears.

 Best,
 D.N.

Just an idea. Are you on windows?
If so, then your foreign calls would probably have to be

foreign import stdcall srilm.h whatever ...

instead of 

foreign import ccall ...


 Malcolm Wallace wrote:
  However, if you are unsure of which Haskell packages are needed, it is
  wise to let ghc work out the dependencies for you, e.g. with
   ghc --make Main.hs slirm.o
 
  It cannot work out the C/C++ dependencies though, so every time you
  get undefined reference linking errors, you must discover which C
  code provides those symbols, and add its object file to the
  commandline by hand.

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


Re: [Haskell-cafe] FFI, C/C++ and undefined references

2010-01-14 Thread Paulo Tanimoto
On Thu, Jan 14, 2010 at 2:08 PM, Daniel Fischer
daniel.is.fisc...@web.de wrote:

 Just an idea. Are you on windows?
 If so, then your foreign calls would probably have to be

 foreign import stdcall srilm.h whatever ...

 instead of

 foreign import ccall ...


Yes, I came here to say that too.  I was getting those errors on Windows.

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


Re: [Haskell-cafe] FFI, C/C++ and undefined references

2010-01-14 Thread Stephen Tetley
Hello Daniel

On Windows, isn't stdcall vs ccall still dependent on the actual
library and what compiled it - commonly MSVC (stdcall) or  gcc (ccall)
of course?

I could very easily be wrong...


Best wishes

Stephen



2010/1/14 Daniel Fischer daniel.is.fisc...@web.de:
 Am Donnerstag 14 Januar 2010 20:42:42 schrieb DNM:


 Just an idea. Are you on windows?
 If so, then your foreign calls would probably have to be

 foreign import stdcall srilm.h whatever ...

 instead of

 foreign import ccall ...

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


Re[2]: [Haskell-cafe] FFI, C/C++ and undefined references

2010-01-14 Thread Bulat Ziganshin
Hello Daniel,

Thursday, January 14, 2010, 11:08:24 PM, you wrote:

i think you are wrong. stdcall used for std windows dlls, but gcc by
default generates ccall things. and cl anyway useless here

 Just an idea. Are you on windows?
 If so, then your foreign calls would probably have to be

 foreign import stdcall srilm.h whatever ...

 instead of 

 foreign import ccall ...


 Malcolm Wallace wrote:
  However, if you are unsure of which Haskell packages are needed, it is
  wise to let ghc work out the dependencies for you, e.g. with
   ghc --make Main.hs slirm.o
 
  It cannot work out the C/C++ dependencies though, so every time you
  get undefined reference linking errors, you must discover which C
  code provides those symbols, and add its object file to the
  commandline by hand.

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


-- 
Best regards,
 Bulatmailto:bulat.zigans...@gmail.com

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


Re: [Haskell-cafe] FFI, C/C++ and undefined references

2010-01-14 Thread DNM

Nope. Ubuntu Linux (Intrepid Ibex).  I wish it were that simple.

--D.N.


Daniel Fischer-4 wrote:
 
 Am Donnerstag 14 Januar 2010 20:42:42 schrieb DNM:
 Which is weird, because 'srilm.o'/'srilm.h' are the files that define
 the mysterious undefined references.  I'll keep plugging away and
 report back when (or whether) I make some progress.  In the meanwhile,
 if anyone has a clue, I'm all ears.

 Best,
 D.N.
 
 Just an idea. Are you on windows?
 If so, then your foreign calls would probably have to be
 
 foreign import stdcall srilm.h whatever ...
 
 instead of 
 
 foreign import ccall ...
 

 Malcolm Wallace wrote:
  However, if you are unsure of which Haskell packages are needed, it is
  wise to let ghc work out the dependencies for you, e.g. with
   ghc --make Main.hs slirm.o
 
  It cannot work out the C/C++ dependencies though, so every time you
  get undefined reference linking errors, you must discover which C
  code provides those symbols, and add its object file to the
  commandline by hand.
 
 ___
 Haskell-Cafe mailing list
 Haskell-Cafe@haskell.org
 http://www.haskell.org/mailman/listinfo/haskell-cafe
 
 

-- 
View this message in context: 
http://old.nabble.com/FFI%2C-C-C%2B%2B-and-undefined-references-tp27139612p27167751.html
Sent from the Haskell - Haskell-Cafe mailing list archive at Nabble.com.

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


Re[2]: [Haskell-cafe] FFI, C/C++ and undefined references

2010-01-14 Thread Bulat Ziganshin
Hello DNM,

Thursday, January 14, 2010, 10:42:42 PM, you wrote:

there is better way rather than playing with random bits. just find
tutorial on FFI, and try it. once this example works, start modifying
it to learn various aspects of ffi and add functionality you need

it's one thing i've learned in those 20 years - go forward in small
steps keeping working code instead of jumping at large distance and
then spending days without any clue


 Which is weird, because 'srilm.o'/'srilm.h' are the files that define the
 mysterious undefined references.  I'll keep plugging away and report
 back when (or whether) I make some progress.  In the meanwhile, if anyone
 has a clue, I'm all ears.

 Best,
 D.N.


 Malcolm Wallace wrote:
 
 However, if you are unsure of which Haskell packages are needed, it is  
 wise to let ghc work out the dependencies for you, e.g. with
  ghc --make Main.hs slirm.o
 
 It cannot work out the C/C++ dependencies though, so every time you  
 get undefined reference linking errors, you must discover which C  
 code provides those symbols, and add its object file to the  
 commandline by hand.
 




-- 
Best regards,
 Bulatmailto:bulat.zigans...@gmail.com

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


Re: [Haskell-cafe] FFI, C/C++ and undefined references

2010-01-14 Thread Daniel Fischer
Am Donnerstag 14 Januar 2010 21:39:57 schrieb DNM:
 Nope. Ubuntu Linux (Intrepid Ibex).  I wish it were that simple.

 --D.N.

Okay, so it's not a borken OS 8-)

Can you post ought to be compiling code?
That might help locate the problem.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: Re[2]: [Haskell-cafe] FFI, C/C++ and undefined references

2010-01-14 Thread Stephen Tetley
2010/1/14 Bulat Ziganshin bulat.zigans...@gmail.com:

 there is better way rather than playing with random bits. just find
 tutorial on FFI, and try it. once this example works, start modifying
 it to learn various aspects of ffi and add functionality you need


Also binding to a C library is easier than binding to a C++ one, if
you can think of another library rather than SRILM that will meet your
needs...

Best wishes

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


[Haskell-cafe] ANNOUNCE: Functional Programming Bibliography

2010-01-14 Thread James Russell
I am pleased to announce the Functional Programming Bibliography
at http://www.catamorphism.net/

The functional programming bibliography was created in the hope
that it will be a useful resource to the functional programming
community. The site is still in an early stage of development,
and is pretty raw, and incomplete in a number of ways. Keyword
categorization, in particular, is still fairly spotty.

It currently contains in excess of 1500 references, heavily
slanted toward Haskell-related topics, and contains links to
publicly available versions of many papers, as well as links to
gated versions of some papers.

I am eager for suggestions as to how the site could be made more
useful.

Regards,

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


Re: [Haskell-cafe] ANNOUNCE: Functional Programming Bibliography

2010-01-14 Thread Tim Wawrzynczak
At a quick glance,

+5 Awesome.

Cheers
- Tim

On Thu, Jan 14, 2010 at 3:03 PM, James Russell j.russ...@alum.mit.eduwrote:

 I am pleased to announce the Functional Programming Bibliography
 at http://www.catamorphism.net/

 The functional programming bibliography was created in the hope
 that it will be a useful resource to the functional programming
 community. The site is still in an early stage of development,
 and is pretty raw, and incomplete in a number of ways. Keyword
 categorization, in particular, is still fairly spotty.

 It currently contains in excess of 1500 references, heavily
 slanted toward Haskell-related topics, and contains links to
 publicly available versions of many papers, as well as links to
 gated versions of some papers.

 I am eager for suggestions as to how the site could be made more
 useful.

 Regards,

 James Russell
 ___
 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: Functional Programming Bibliography

2010-01-14 Thread Tim Wawrzynczak
Oh also, I noticed that you say it's powered by Haskell.

Would you mind sharing some of your architectural details as they relate to
Haskell with us?



On Thu, Jan 14, 2010 at 3:11 PM, Tim Wawrzynczak inforichl...@gmail.comwrote:

 At a quick glance,

 +5 Awesome.

 Cheers
 - Tim


 On Thu, Jan 14, 2010 at 3:03 PM, James Russell j.russ...@alum.mit.eduwrote:

 I am pleased to announce the Functional Programming Bibliography
 at http://www.catamorphism.net/

 The functional programming bibliography was created in the hope
 that it will be a useful resource to the functional programming
 community. The site is still in an early stage of development,
 and is pretty raw, and incomplete in a number of ways. Keyword
 categorization, in particular, is still fairly spotty.

 It currently contains in excess of 1500 references, heavily
 slanted toward Haskell-related topics, and contains links to
 publicly available versions of many papers, as well as links to
 gated versions of some papers.

 I am eager for suggestions as to how the site could be made more
 useful.

 Regards,

 James Russell
 ___
 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] FFI, C/C++ and undefined references

2010-01-14 Thread Miguel Mitrofanov

Works fine here (Mac OS X 10.5):

MigMit:ngram MigMit$ ghc --make Main.hs srilm.o
[1 of 2] Compiling LM   ( LM.hs, LM.o )

LM.hs:9:0: Warning: possible missing  in foreign import of FunPtr
[2 of 2] Compiling Main ( Main.hs, Main.o )
Linking Main ...
MigMit:ngram MigMit$ ls Main*
Main* Main.hi   Main.hs   Main.hs~  Main.o
MigMit:ngram MigMit$ cat Main.hs
module Main where
import LM(scoreSequence, buildLM)
main :: IO ()
main = do
 let lm = buildLM 5 eng.kn.5g.lm
 putStrLn $ show $ scoreSequence lm 5 [the, prime, minister,  
gave,a, speech, .]

MigMit:ngram MigMit$ cat LM.hs
{-# INCLUDE srilm.h #-}
{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls #-}
module LM where
import Foreign
import Foreign.C
data Ngram
data NGModel = NGModel {ng :: !(ForeignPtr Ngram)}
foreign import ccall srilm.h bldLM c_blm :: CInt - CString - Ptr  
Ngram
foreign import ccall srilm.h deleteLM c_dlm :: FunPtr ((Ptr Ngram) - 
 IO ())
foreign import ccall srilm.h getSeqProb c_ngramProb :: Ptr Ngram -  
CString - CUInt - CUInt - CFloat

scoreSequence :: NGModel - Int - [String] - Float
scoreSequence ngram order seq =
   unsafePerformIO $ do
 stringSeq - newCString (unwords seq)
 let sc = c_ngramProb (unsafeForeignPtrToPtr $ ng ngram)  
stringSeq (fromIntegral order) (fromIntegral $ length seq)

 return (realToFrac sc)
buildLM :: Int - String - NGModel
buildLM order fname =
   NGModel $
   unsafePerformIO $ do
 cFName - newCString fname
 let ng = c_blm (fromIntegral order) cFName
 return $ unsafePerformIO $ newForeignPtr c_dlm ng
MigMit:ngram MigMit$ cat srilm.h
#ifdef __cplusplus
extern C {
  class Ngram{};
#else
  typedef struct Ngram Ngram;
#endif
  Ngram* bldLM(int order, const char* filename);
  void deleteLM(Ngram* ngram);
  float getSeqProb(Ngram* ngram, const char* ngramstr, unsigned  
order, unsigned length);

#ifdef __cplusplus
}
#endif
MigMit:ngram MigMit$ cat srilm.c
#include srilm.h
Ngram* bldLM(int order, const char* filename) { return 0; }
void deleteLM(Ngram* ngram) {}
float getSeqProb(Ngram* ngram, const char* ngramstr, unsigned order,  
unsigned length) { return 0;}

MigMit:ngram MigMit$

Maybe you just need to recompile srilm.c or something.

On 14 Jan 2010, at 23:39, DNM wrote:



Nope. Ubuntu Linux (Intrepid Ibex).  I wish it were that simple.

--D.N.


Daniel Fischer-4 wrote:


Am Donnerstag 14 Januar 2010 20:42:42 schrieb DNM:
Which is weird, because 'srilm.o'/'srilm.h' are the files that  
define

the mysterious undefined references.  I'll keep plugging away and
report back when (or whether) I make some progress.  In the  
meanwhile,

if anyone has a clue, I'm all ears.

Best,
D.N.


Just an idea. Are you on windows?
If so, then your foreign calls would probably have to be

foreign import stdcall srilm.h whatever ...

instead of

foreign import ccall ...



Malcolm Wallace wrote:
However, if you are unsure of which Haskell packages are needed,  
it is

wise to let ghc work out the dependencies for you, e.g. with
ghc --make Main.hs slirm.o

It cannot work out the C/C++ dependencies though, so every time you
get undefined reference linking errors, you must discover which C
code provides those symbols, and add its object file to the
commandline by hand.


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




--
View this message in context: 
http://old.nabble.com/FFI%2C-C-C%2B%2B-and-undefined-references-tp27139612p27167751.html
Sent from the Haskell - Haskell-Cafe mailing list archive at  
Nabble.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] ANNOUNCE: Functional Programming Bibliography

2010-01-14 Thread Andrew Coppin

James Russell wrote:

I am pleased to announce the Functional Programming Bibliography
at http://www.catamorphism.net/

I am eager for suggestions as to how the site could be made more
useful.
  


As is traditional, my ISP's spam filter ate this email. *sigh*

Anyway, I did a search for Simon Peyton Jones and got... zero results. 
o_O But on further investigation, searching just Peyton Jones delivers 
the expected deluge of hits. Maybe make the searching smarter? (Or just 
make a small note to search by last name only...)


Also, I did a search, changed the sort criteria, and... the previously 
entered information was not presurved. Hopefully that isn't hard to fix.


This resource seems like a nice idea. There are a whole crocload of 
fascinating papers about GHC and program optimisation out there, but it 
tends to be a tad time-consuming to track them all down. Hopefully this 
site will make things significantly easier in that department.

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


Re: [Haskell-cafe] Quick, somebody do something!

2010-01-14 Thread Don Stewart
While the month-old Go language makes the top 15? 

Methods considered unsound.

hjgtuyl:

 Haskell has dropped out of the top 50 at Tiobe [1]; how could this hapen? 
 Let's start selling mobile phones that can only be programmed in Haskell  
 :-)


 [1] http://www.tiobe.com/content/paperinfo/tpci/index.html


 -- 
 Met vriendelijke groet,
 Henk-Jan van Tuyl


 --
 http://Van.Tuyl.eu/
 http://members.chello.nl/hjgtuyl/tourdemonad.html
 --
 ___
 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] FFI, C/C++ and undefined references

2010-01-14 Thread Daniel Fischer
Am Donnerstag 14 Januar 2010 22:19:08 schrieb Miguel Mitrofanov:
 Works fine here (Mac OS X 10.5):

 MigMit:ngram MigMit$ ghc --make Main.hs srilm.o
 [1 of 2] Compiling LM               ( LM.hs, LM.o )

 LM.hs:9:0: Warning: possible missing  in foreign import of FunPtr
 [2 of 2] Compiling Main             ( Main.hs, Main.o )
 Linking Main ...

Thanks Miguel.
Yes, works here (openSuse 11.1), too (kind of):

(move the typedef out of the #else clause in srilm.h, because my g++ 
doesn't know Ngram)

$ g++ -c srilm.c
$ ghc --make Main.hs srilm.o
[1 of 2] Compiling LM   ( LM.hs, LM.o )   

LM.hs:1:11:
Warning: -#include is deprecated: No longer has any effect

LM.hs:13:0: Warning: possible missing  in foreign import of FunPtr
[2 of 2] Compiling Main ( Main.hs, Main.o )
Linking Main ...
$ ./Main 
0.0
Speicherzugriffsfehler

Fixing the two warnings (removing the {-# INCLUDE #-} pragma and changing 
the declaration of deleteLM to
foreign import ccall srilm.h deleteLM 
c_dlm :: FunPtr ((Ptr Ngram) - IO ())
), I get
$ ghc -fforce-recomp --make Main.hs srilm.o
[1 of 2] Compiling LM   ( LM.hs, LM.o )
[2 of 2] Compiling Main ( Main.hs, Main.o )
Linking Main ...
$ ./Main
0.0
$

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


[Haskell-cafe] I/O performance drop in ghc 6.12.1

2010-01-14 Thread Peter Simons
Hi,

I just updated to GHC 6.12.1, and I noticed a significant drop in I/O
performance that I can't explain. The following code is a simple
re-implementation of cat(1), i.e. it just echos all data from standard
input to standard output:

 module Main ( main ) where

 import System.IO
 import Foreign ( allocaBytes )

 bufsize :: Int
 bufsize = 4 * 1024

 catBuf :: Handle - Handle - IO ()
 catBuf hIn hOut = allocaBytes bufsize input
   where
   input ptr= hGetBuf hIn ptr bufsize = output ptr
   output  _  0 = return ()
   output ptr n = hPutBuf hOut ptr n  input ptr

 main :: IO ()
 main = do
   mapM_ (\h - hSetBuffering h NoBuffering) [ stdin, stdout ]
   catBuf stdin stdout

That program used to have exactly the same performance as /bin/cat, but
now it no longer does:

 | $ dd if=/dev/urandom of=test.data bs=1M count=512
 |
 | $ time /bin/cat test.data  /dev/null
 |
 | real0m1.939s
 | user0m0.003s
 | sys 0m1.923s
 |
 | $ time ./cat-hgetbuf test.data  /dev/null
 |
 | real0m4.327s
 | user0m1.967s
 | sys 0m2.317s

I've tested different variants of the program that were built with -O,
-O2, and -O2 -funbox-strict-fields, respectively, but it doesn't seem to
make a difference.

Is there something I'm missing? Any suggestion would be kindly
appreciated.

Take care,
Peter

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


Re: [Haskell-cafe] I/O performance drop in ghc 6.12.1

2010-01-14 Thread Brandon S. Allbery KF8NH

On Jan 14, 2010, at 17:30 , Peter Simons wrote:

I just updated to GHC 6.12.1, and I noticed a significant drop in I/O
performance that I can't explain. The following code is a simple
re-implementation of cat(1), i.e. it just echos all data from standard
input to standard output:



GHC 6.12.1 has the first release of UTF-8 support, so there's  
translation overhead.


--
brandon s. allbery [solaris,freebsd,perl,pugs,haskell] allb...@kf8nh.com
system administrator [openafs,heimdal,too many hats] allb...@ece.cmu.edu
electrical and computer engineering, carnegie mellon universityKF8NH




PGP.sig
Description: This is a digitally signed message part
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] I/O performance drop in ghc 6.12.1

2010-01-14 Thread Bryan O'Sullivan
On Thu, Jan 14, 2010 at 2:30 PM, Peter Simons sim...@cryp.to wrote:


 I just updated to GHC 6.12.1, and I noticed a significant drop in I/O
 performance that I can't explain.


This is probably brought about by the new Unicode I/O support in 6.12. Your
file isn't open in binary mode, so it's probably getting translated from
something like UTF-8 before it reaches you. Might want to compare the two.

I'm a little surprised by the magnitude of the difference; I might have
expected it to be 33%, not 400%.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Force -threaded from a library

2010-01-14 Thread John Van Enk
Hi List,

Is it possible to prevent a library from being used unless -threaded is
enabled? I have a specific case where lots-of-nasty shows up if the library
is linked against an executable built without -threaded.

I suppose this is GHC specific.

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


Re: [Haskell-cafe] I/O performance drop in ghc 6.12.1

2010-01-14 Thread Svein Ove Aas
On Thu, Jan 14, 2010 at 11:38 PM, Bryan O'Sullivan b...@serpentine.com wrote:
 On Thu, Jan 14, 2010 at 2:30 PM, Peter Simons sim...@cryp.to wrote:

 I just updated to GHC 6.12.1, and I noticed a significant drop in I/O
 performance that I can't explain.

 This is probably brought about by the new Unicode I/O support in 6.12. Your
 file isn't open in binary mode, so it's probably getting translated from
 something like UTF-8 before it reaches you. Might want to compare the two.
 I'm a little surprised by the magnitude of the difference; I might have
 expected it to be 33%, not 400%.

Hold on, he's using hGetBuf/hPutBuf.

Although I'd suggest wrapping that in bytestrings.. the point is,
those functions are documented to ignore encoding and always use
binary I/O. There shouldn't be a difference at all.

I wonder if the difference goes away if the handle is explicitly set
to binary? It shouldn't, but then again it shouldn't exist in the
first place.

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


Re: [Haskell-cafe] Quick, somebody do something!

2010-01-14 Thread Alp Mestan
On Thu, Jan 14, 2010 at 11:21 PM, Don Stewart d...@galois.com wrote:

 While the month-old Go language makes the top 15?

 Methods considered unsound.


I fully agree. But anyway, I don't think people either already in the
haskell world or about to enter it will find this relevant.

-- 
Alp Mestan
http://alpmestan.wordpress.com/
http://alp.developpez.com/
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Re: I/O performance drop in ghc 6.12.1

2010-01-14 Thread Peter Simons
Hi Svein,

  Hold on, he's using hGetBuf/hPutBuf.

exactly, that's what I was thinking. When a program requests that 'n'
bytes ought to be read into memory at the location designated by the
given 'Ptr Word8', how could GHC possibly do any encoding or decoding?
That API doesn't allow for multi-byte characters. I would assume that
hGetBuf/hPutBuf are the equivalent to POSIX read() and write()?

  I wonder if the difference goes away if the handle is explicitly set
  to binary?

I added an

   mapM_ (\h - hSetBinaryMode h True) [ stdin, stdout ]

to 'main', and it does seem to improve performance a little, but it's
still quite a bit slower than /bin/cat:

 | $ time /bin/cat test.data  /dev/null
 |
 | real0m2.119s
 | user0m0.003s
 | sys 0m1.967s
 |
 | $ time ./cat-hgetbuf test.data  /dev/null
 |
 | real0m3.449s
 | user0m1.137s
 | sys 0m2.240s

Take care,
Peter

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


[Haskell-cafe] RFC: Space-leak-free, efficient symbol table implementation.

2010-01-14 Thread Thomas Schilling
Hello Café,

Symbol tables are a very common data structure in compilers but the most common 
implementation uses a hash table as a global variable which results in a space 
leak.  If we decide to use several symbol tables we still cannot join different 
symbol tables.

After some Googling I found the following implementation.  It could still be 
argued that there are some smaller space leaks left, but decide for yourself.

The use case I have in mind is a collection of several long-running compiler 
worker threads, that for the most part write their result to disk but may 
occasionally need to communicate with each other (and agree on symbol 
identities.)

I'd appreciate comments / code review on the following code.  I think it's 
fairly well-commented.

Thanks,

 / Thomas


{-# LANGUAGE BangPatterns #-}
{-# OPTIONS_GHC -funbox-strict-fields #-}
-- | 
-- Module  : Data.Atom.UF
-- Copyright   : (c) Thomas Schilling 2010
-- License : BSD-style
--
-- Maintainer  : nomin...@gmail.com
-- Stability   : experimental
-- Portability : portable
--
-- Symbols without a central symbol table.
--
-- Symbols provide the following efficient operations:
--
--  - /O(1)/ equality comparison (in practise)
--  - /O(1)/ ordering comparison (in practise)
--  - /O(n)/ creation
--
-- This can be implemented by using a global variable mapping strings
-- to symbols and a counter assigning ids to symbols.  However, this
-- has two problems:
--
--  1. It has a space leak.  No symbols can ever be removed from this
-- table.  For example, if we add the symbol @\foo\@ the first
-- time it might get assigned id 1, if we then delete it and
-- insert it again it might get assigned id 42.  However, there
-- may still be symbols in memory which got assigned id 1.
-- Instead, symbols should be garbage collected like other data.
-- Using weak pointers has bad effects on performance due to
-- garbage collector overhead.
--
--  2. It is not reliable to compare symbols created using different
-- symbol tables.  They would most likely get assigned different
-- ids.
--
-- This implementation of symbols allows *optional* use of a symbol
-- table.  If a symbol table is used, this implementation will tend to
-- use less memory and its operations will be a little bit faster at
-- the beginning.  For longer runs, it won't make a big difference
-- though, since the representation is self-optimising.
--
-- Inspired by Richard O'Keefe's message to Erlang's eeps mailing list
-- http://www.erlang.org/cgi-bin/ezmlm-cgi/5/057, which in turn was
-- inspired by the Logix implementation of Flat Concurrent Prolog.
--
--
-- * Implementation
--
-- Each symbol is represented a pointer to the symbol info, which
-- consists of:
--
--   * a 'String'
--   * a 'Hash'
--   * a null-able parent pointer to an equivalent symbol info
--
-- Creating the same symbol twice will at first be represented as two
-- different entities.
--
-- @
--.+---+-.
--   A - | 42 | foo | nil |
--'+---+-'
--   B --.
--   '-- .+---+-.
--   C - | 42 | foo | nil |
--'+---+-'
-- @
--
-- (Note that @A@, @B@ and @C@ are @ior...@.)
--
-- When comparing @A@ and @B@ we use the following properties:
--
--  1. If @A@ and @B@ are identical then they must be equal.
--  
--  2. If they point to the same object, they must equal.
--  
--  3. If they have different hashes, they are different.
--
-- Unless there is a hash collision, we can decide equality and
-- ordering for all symbols that have been built with the same hash
-- table.
--
-- If the two objects have no parent, have the same hash, and the same
-- string, we now make one the first the parent of the other and
-- update the pointer of @B@ accordingly.  If there are no references
-- to the second object left it can now be garbage collected.
--
-- If an object already has a parent pointer we follow each object's
-- parents to the roots and compare the roots.  This process might
-- again result in updates to @A@ or @B@ and various parent pointers.
--
-- In the example above, after @A == B@ we have:
--
-- @
--.+---+-.
--   A - | 42 | foo | nil |
--   .-- '+---+-'
--   B --'^
--.+---+--|--.
--   C - | 42 | foo |  *  |
--'+---+-'
-- @
--
-- After @C == A@ or @C == B@ we have.
--
-- @
--   A - .+---+-.
--   .-- | 42 | foo | nil |
--   B --'.- '+---+-'
--|   ^
--|   .+---+--|--.
--   C ---'   | 42 | foo |  *  |
--'+---+-'
-- @
--
-- The second object will now be garbage collected.
--
-- In fact, after the first @A == B@, the remaining updates could use
-- some help from the garbage collector.  This could be done by
-- somehow forcibly (and unsafely) replacing the second object by an
-- update frame and then rely on the 

[Haskell-cafe] IDL - compilers

2010-01-14 Thread Günther Schmidt

Hi,

are there any IDL compilers that can create Haskelk modules from header 
files or type-libs?


Günther


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


Re: [Haskell-cafe] ANNOUNCE: Functional Programming Bibliography

2010-01-14 Thread James Russell
On Thu, Jan 14, 2010 at 4:12 PM, Tim Wawrzynczak inforichl...@gmail.com wrote:
 Oh also, I noticed that you say it's powered by Haskell.

 Would you mind sharing some of your architectural details as they relate to
 Haskell with us?



Not much to it, really.  It's a LAMH thing, if you will.

The Haskell part just runs as a CGI app,
and uses the HDBC, HDBC-mysql, cgi, and xhtml
packages, and is just a few hundred lines, including all
the html templates which I create with the xhtml package.

As for the bibliography stuff,
right now I actually maintain a master .bib file
and use bibTeX along with a set of custom .bst files
to munge everything up to be imported into MySQL.

 On Thu, Jan 14, 2010 at 3:11 PM, Tim Wawrzynczak inforichl...@gmail.com
 wrote:

 At a quick glance,

 +5 Awesome.

 Cheers
 - Tim

 On Thu, Jan 14, 2010 at 3:03 PM, James Russell j.russ...@alum.mit.edu
 wrote:

 I am pleased to announce the Functional Programming Bibliography
 at http://www.catamorphism.net/

 The functional programming bibliography was created in the hope
 that it will be a useful resource to the functional programming
 community. The site is still in an early stage of development,
 and is pretty raw, and incomplete in a number of ways. Keyword
 categorization, in particular, is still fairly spotty.

 It currently contains in excess of 1500 references, heavily
 slanted toward Haskell-related topics, and contains links to
 publicly available versions of many papers, as well as links to
 gated versions of some papers.

 I am eager for suggestions as to how the site could be made more
 useful.

 Regards,

 James Russell
 ___
 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 mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] IDL - compilers

2010-01-14 Thread Don Stewart
gue.schmidt:
 Hi,

 are there any IDL compilers that can create Haskelk modules from header  
 files or type-libs?


The venerable hdirect. http://www.haskell.org/hdirect/

I've recently cabalized the package, which is still in fine condition.
Let me know if you need a copy.

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


Re: [Haskell-cafe] IDL - compilers

2010-01-14 Thread Günther Schmidt

Hi Don,

Am 15.01.10 02:00, schrieb Don Stewart:

gue.schmidt:
   

Hi,

are there any IDL compilers that can create Haskelk modules from header
files or type-libs?

 

The venerable hdirect. http://www.haskell.org/hdirect/

I've recently cabalized the package, which is still in fine condition.
Let me know if you need a copy.
   


Oh yes!, please!, pretty please!


-- Don
   


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


Re: [Haskell-cafe] General Advice Needed ..

2010-01-14 Thread Richard O'Keefe


On Jan 15, 2010, at 3:38 AM, Ian675 wrote:



Pretty much yeah.. Im going through the book and things like :

Define a function rangeProduct which when given natural numbers m  
and n,

returns the product m*(m+1)**(n-1)*n


Case analysis and recursion.

If m  n, the answer is 1 (the product of an empty sequence is 1).
If m = n, the answer is m * the product of m+1 .. n.

range_product m n = if m  n then 1 else m * range_product (m+1) n

Try it in C:
int range_product(int m, int n) {
return m  n ? 1 : m * range_product(m+1, n);
}
Same thing.

Of course the most direct way to express it in Haskell is

range_product m n = product [m..n]


I got the solution from my lecture notes but I still dont understand  
it..


rangeProduct :: Int - Int - Int
rangeProduct m n
 | m  n = 0
 | m == n = m
 | otherwise = m * rangeProduct (m+1) n

Totally lost! Haha..


One reason you're totally lost is that the code in the book is WRONG.
The product of an empty sequence is 1, not 0.

There are two basic ways of thinking functionally, and they are
actually both important in practically every kind of programming.

(1) programming-by-combination:
look for existing functions that are close to what you want and
plug them together.
In this case, looking for product of a sequence of numbers leads
to 'product' and looking for sequence of consecutive numbers
leads to [ .. ] syntax, and plugging them together leads to the
product [m..n] version.

(2) programming-by-case-analysis (including recursion):
look for a way of classifying the problem into alternative cases,
at least some of which are obviously simpler to solve.
Recursion is just the special case where some of the alternatives
can be handled using the function you are trying to define.

By the way, the problem here is ambiguous.
I look at m * (m+1) * ... * (n-1) * n and think
n to the falling n-m+1 (see Concrete Mathematics by Graham,
Knuth, and Patashnik) and this is actually defined (and not identically
1) when m  n.  So there are at least two reasonable definitions of
what the function should do for m  n.  (Returning 0 is NOT reasonable.)


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


Re: [Haskell-cafe] Haskell implementation of ideas from StandardML as a Metaprogramming language

2010-01-14 Thread CK Kashyap
Thank you very much Stephen ... I'll try and work on the doc plus the code 
you've sent to understand it.
If you do find the parser combinators, please do send it to me.

Thanks and Regards,
Kashyap


- Original Message 
 From: Stephen Tetley stephen.tet...@gmail.com
 Cc: haskell-cafe@haskell.org
 Sent: Fri, January 15, 2010 1:08:20 AM
 Subject: Re: [Haskell-cafe] Haskell implementation of ideas from StandardML 
 as a Metaprogramming language
 
 Hello Kashyap
 
 I can do MSL and Region, maybe I did the parser combinators but I
 can't find them at the moment.
 
 I tried to keep the code close to the original SML, so as Haskell code
 its not pretty. Not having quasiquote was a problem.
 
 Best wishes
 
 Stephen
 
 
 
 -- MSL
 
 
 module MSL where
 
 
 type Expr = String
 type Predicate = Expr
 type Statement = String
 type Fieldname = String
 
 data Bitsource = Source Expr Expr
   deriving Show
 
 
 newbitsource a i  = Source a i
 
 initbs (Source _ i) =  i ++  = 0;
 
 getByte (Source a i)  =  a ++ [ ++  i ++ /8]
 
 getNthByte :: Bitsource - Int - Expr
 getNthByte (Source a i) n
 | n == 0= a ++ [ ++  i ++ /8]
 | otherwise = a ++ [ ++  i ++ /8+ ++ show n ++ ]
 
 advanceByte (Source a i) = i ++  =  ++ i ++ -( ++ i ++ %8)+8;
 
 advanceNBytes (Source a i) n
 | n == 0= 
 | otherwise = i ++  =  ++ i ++ -( ++ i ++ %8)+(8* ++ show n++);
 
 
 data Recordfield = Field Expr [Fieldname]
   deriving Show
 
 recordptr :: Expr - Recordfield
 recordptr e  = Field e []
 
 subfield :: Recordfield - Fieldname - Recordfield
 subfield (Field e fl) f  = Field e (f:fl)
 
 deref :: Recordfield - Expr
 deref (Field e fl)
 = (* ++e++ ) ++ concat ( map cojoin (reverse fl) )
   where
 cojoin :: Fieldname - String
 cojoin s = . ++ s
 
 
 
 type Message = Bitsource - Recordfield - Statement - Statement
 
 infield :: Fieldname - Message - Message
 infield f m src tgt
 = m src (subfield tgt f)
 
 
 c_if :: Expr - Statement - Statement - Statement
 c_if e s1 s2
 = if e==1 || e==(1)
  then s1
  else if(++e++){
 ++ s1
 ++ } ++ if s2 /=  then else { ++ s2 ++ } else 
 
 
 
 seqmsg :: [Message] - Message
 seqmsg (m:ml) src tgt s
   = (m src tgt error_action();) ++  (seqmsg ml src tgt s)
 seqmsg [] _ _ _ = 
 
 asc2Int :: Int - (Int,Int) - Message
 asc2Int w (lo,hi) src tgt s
  = c_if (inrange( ++ (getByte src) ++ , 
 ++ (ms w) ++ ,  ++ (ms lo)
 ++ ,  ++ (ms hi))
 
 s
   where
   ms n = show n
 
 
 alt :: [Message] - Message
 alt (m:ml) src tgt s
   = m src tgt (alt ml src tgt s)
 
 
 delim :: Expr - Message
 delim e src tgt s
   = if ( ++ getByte src ++  ==  ++ e ++)
++ advanceByte src
 
 rangex :: Int - Int - [Int]
 rangex i j
 | i  j = []
 | otherwise = (i:(rangex (i+1) j))
 
 
 c_and [] =  
 c_and [pred] = ( ++ pred ++ )
 c_and (pred1:pred2:preds) = ( ++ pred1 ++++ c_and (pred2:preds) ++ 
 )
 
 asc :: String - String - Message
 asc chars value src tgt s
   = c_if 
  (deref tgt ++  ==  ++ value ++ ; )
  s
 
 skip :: Int - Message
 skip n src tgt s
   = (deref tgt) ++ = 1;
 ++ (advanceNBytes src n)
 
 
 
 bs = newbitsource A bit
 f = recordptr target
 
 
 main = delim 6 bs f abort();
 
 
 to_confidence = alt [ asc HH High
 , asc MM Medium
 , asc LL Low
 , asc NN None
 ]
 
 
 
 -- Region
 
 -- This one doesn't work properly -
 -- CPoints are difficult to manipulate as strings, hence the `hasVar`
 -- problems, it gives some idea of the method though.
 
 
 
 module Region where
 
 import Data.Char ( isAlpha )
 import Data.List ( foldl' )
 
 
 -- Prolog
 type CExpr = String
 type CPred = String
 type CFloat = Float
 
 infixr 6 ++
 (++) :: Show a = String - a - String
 s ++ a = s ++ show a
 
 
 sqrdist _ = 
 
 add :: CPoint - CPoint - CPoint
 add a b = a ++ + ++ b
 
 sub :: CPoint - CPoint - CPoint
 sub a b = a ++ - ++ b
 
 hasVar :: CExpr - Bool
 hasVar = any isAlpha
 
 cfst :: CPoint - CExpr
 cfst a | hasVar a   = a ++ .x
| otherwise  = 1.1
 
 csnd :: CPoint - CExpr
 csnd a | hasVar a   = a ++.y
| otherwise  = 2.2
 
 pt :: (CFloat,CFloat) - CPoint
 pt = show
 
 intersect :: [Region] - Region
 intersect (r:rs) = foldl' (/\) r rs
 intersect [] = error $ intersect on empty list
 
 
 
 -- presentation
 
 type CPoint = CExpr
 type Region = CPoint - CPred
 
 
 circle :: CFloat - Region
 circle n = \p - ( ++ sqrdist p ++  ++ n ++ * ++ n ++ )
 
 halfplane :: CPoint - CPoint - Region
 

[Haskell-cafe] ANN: Lite Haskell IDE

2010-01-14 Thread Mambo Banda

Hi

Just started an open source project called Hoodoo. It is meant to be a 
Lite IDE for Haskell. I wrote it to learn Haskell, so if you are a 
beginner (like me) it might interest you. If you're interested follow 
this link (http://hoodoo.kenai.com/), and if you like what you see, grab 
the code and add something:)


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