Re: [Haskell-cafe] definition of the term "combinator"

2013-08-24 Thread damodar kulkarni
Thanks. I found the explanation given at the link quite useful in shedding
the confusion I had had.

Thanks and regards,
-Damodar Kulkarni


On Sat, Aug 24, 2013 at 10:57 AM, Jason Dagit  wrote:

>
>
>
> On Fri, Aug 23, 2013 at 9:09 PM, damodar kulkarni 
> wrote:
>
>> Hello,
>> The word "combinator" is used several times in the Haskell community.
>> e.g. parser combinator, combinator library etc.
>>
>> Is it exactly the same term that is used in the "combinatory logic" ?
>> A combinator is a higher-order function that uses *only function
>> application* and earlier defined combinators to define a result from its
>> arguments. [1]
>>
>> It seems, the term combinator as in, say, "parser combinator", doesn't
>> have much to do with the "*only function application*" requirement of the
>> "combinatory logic", per se.
>>
>> If the above observation holds, is the term combinator as used in the
>> Haskell community, properly defined?
>>
>> In other words:
>>
>> Where can I find a formal and precise definition of the term
>> "combinator", as a term used by the Haskell community to describe
>> "something"?
>>
>
> Good question. I believe this article addresses the points you raise:
> http://www.haskell.org/haskellwiki/Combinator
>
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] reasons why Template Haskell does not propose something similar to Python exec() or eval()

2013-08-24 Thread TP
Hi everybody,

I continue to learn and test Template Haskell (one more time thanks to John 
Lato for his post at:

http://www.mail-archive.com/haskell-cafe@haskell.org/msg106696.html

that made me understand a lot of things).

I have a question about the way Template Haskell is working. Why Template 
Haskell does not propose something similar to Python (or bash) exec() or 
eval(), i.e. does not offer the possibility to take a (quoted) string in 
input, to make abstract syntax in output (to be executed later in a splice 
$()).
For example, in Python, to make an affectation 'a="a"' programatically, I 
can simply do (at runtime; even if I am here only concerned with what 
Template Haskell could do, i.e. at compile time):
> def f(s): return '%s = \'%s\'' % (s,s)
> exec(f("a"))
> a
'a'

With Template Haskell, I am compelled to make a function returning the 
abstract syntax corresponding to variable declaration:

ValD (VarP $ mkName s) (NormalB $ LitE $ StringL s)

(see complete example in Post Scriptum).
This works fine, but it is less direct. I am sure that the Template Haskell 
approach has many advantages, but I am unable to list them. I think it is 
important to have the reasons in mind. Could you help me?

Thanks in advance,

TP


PS: the complete Haskell example:

---
module MakeVard where
import Language.Haskell.TH

makeVard :: Monad m => String -> m [Dec]
-- Equivalent to "%s = \"%s\""
makeVard s = return [ ValD (VarP $ mkName s) (NormalB $ LitE $ StringL s) [] 
]
---

tested by

---
{-# LANGUAGE TemplateHaskell #-}
import MakeVard

$(makeVard "a")

main = do

print a
---

resulting in
$ runghc -ddump-splices test.hs 
test_makeVar.hs:1:1: Splicing declarations
makeVard "a"
  ==>
test_makeVar.hs:4:3-14
a = "a"
"a"


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


Re: [Haskell-cafe] reasons why Template Haskell does not propose something similar to Python exec() or eval()

2013-08-24 Thread jean-christophe mincke
Hello,

Maybe you could have a look at Quasi
Quotation
.

Regards

J-C


On Sat, Aug 24, 2013 at 11:36 AM, TP  wrote:

> Hi everybody,
>
> I continue to learn and test Template Haskell (one more time thanks to John
> Lato for his post at:
>
> http://www.mail-archive.com/haskell-cafe@haskell.org/msg106696.html
>
> that made me understand a lot of things).
>
> I have a question about the way Template Haskell is working. Why Template
> Haskell does not propose something similar to Python (or bash) exec() or
> eval(), i.e. does not offer the possibility to take a (quoted) string in
> input, to make abstract syntax in output (to be executed later in a splice
> $()).
> For example, in Python, to make an affectation 'a="a"' programatically, I
> can simply do (at runtime; even if I am here only concerned with what
> Template Haskell could do, i.e. at compile time):
> > def f(s): return '%s = \'%s\'' % (s,s)
> > exec(f("a"))
> > a
> 'a'
>
> With Template Haskell, I am compelled to make a function returning the
> abstract syntax corresponding to variable declaration:
>
> ValD (VarP $ mkName s) (NormalB $ LitE $ StringL s)
>
> (see complete example in Post Scriptum).
> This works fine, but it is less direct. I am sure that the Template Haskell
> approach has many advantages, but I am unable to list them. I think it is
> important to have the reasons in mind. Could you help me?
>
> Thanks in advance,
>
> TP
>
>
> PS: the complete Haskell example:
>
> ---
> module MakeVard where
> import Language.Haskell.TH
>
> makeVard :: Monad m => String -> m [Dec]
> -- Equivalent to "%s = \"%s\""
> makeVard s = return [ ValD (VarP $ mkName s) (NormalB $ LitE $ StringL s)
> []
> ]
> ---
>
> tested by
>
> ---
> {-# LANGUAGE TemplateHaskell #-}
> import MakeVard
>
> $(makeVard "a")
>
> main = do
>
> print a
> ---
>
> resulting in
> $ runghc -ddump-splices test.hs
> test_makeVar.hs:1:1: Splicing declarations
> makeVard "a"
>   ==>
> test_makeVar.hs:4:3-14
> a = "a"
> "a"
>
>
> ___
> 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] reasons why Template Haskell does not propose something similar to Python exec() or eval()

2013-08-24 Thread Tobias Dammers
IIRC you can use haskell-src-exts to parse a string into TH AST structures.
There might even be a quasi-quoter for that; I don't have a real computer
at hand right more, so you'll need to do some research of your own.
On Aug 24, 2013 11:37 AM, "TP"  wrote:

> Hi everybody,
>
> I continue to learn and test Template Haskell (one more time thanks to John
> Lato for his post at:
>
> http://www.mail-archive.com/haskell-cafe@haskell.org/msg106696.html
>
> that made me understand a lot of things).
>
> I have a question about the way Template Haskell is working. Why Template
> Haskell does not propose something similar to Python (or bash) exec() or
> eval(), i.e. does not offer the possibility to take a (quoted) string in
> input, to make abstract syntax in output (to be executed later in a splice
> $()).
> For example, in Python, to make an affectation 'a="a"' programatically, I
> can simply do (at runtime; even if I am here only concerned with what
> Template Haskell could do, i.e. at compile time):
> > def f(s): return '%s = \'%s\'' % (s,s)
> > exec(f("a"))
> > a
> 'a'
>
> With Template Haskell, I am compelled to make a function returning the
> abstract syntax corresponding to variable declaration:
>
> ValD (VarP $ mkName s) (NormalB $ LitE $ StringL s)
>
> (see complete example in Post Scriptum).
> This works fine, but it is less direct. I am sure that the Template Haskell
> approach has many advantages, but I am unable to list them. I think it is
> important to have the reasons in mind. Could you help me?
>
> Thanks in advance,
>
> TP
>
>
> PS: the complete Haskell example:
>
> ---
> module MakeVard where
> import Language.Haskell.TH
>
> makeVard :: Monad m => String -> m [Dec]
> -- Equivalent to "%s = \"%s\""
> makeVard s = return [ ValD (VarP $ mkName s) (NormalB $ LitE $ StringL s)
> []
> ]
> ---
>
> tested by
>
> ---
> {-# LANGUAGE TemplateHaskell #-}
> import MakeVard
>
> $(makeVard "a")
>
> main = do
>
> print a
> ---
>
> resulting in
> $ runghc -ddump-splices test.hs
> test_makeVar.hs:1:1: Splicing declarations
> makeVard "a"
>   ==>
> test_makeVar.hs:4:3-14
> a = "a"
> "a"
>
>
> ___
> 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] reasons why Template Haskell does not propose something similar to Python exec() or eval()

2013-08-24 Thread Marc Weber
Excerpts from TP's message of Sat Aug 24 11:36:04 +0200 2013:
> Haskell does not propose something similar to Python (or bash) exec() or 
> eval(), i.e. does not offer the possibility to take a (quoted) string in 

You actually have eval/exec like features. You can run "ghc" modules in a
haskell application to compile a module, then run that code.

Eg see this example to get started
http://mawercer.de/tmp/haskell-dyn-loading-example.zip

Origin of most ideas was this site:
http://codeutopia.net/blog/2011/08/20/adventures-in-haskell-dynamic-loading-and-compiling-of-modules/

Marc Weber

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


Re: [Haskell-cafe] GHC flags: optghc

2013-08-24 Thread Ben Doyle
That's not a GHC flag; it's a haddock flag. Haddock (which, in case you're
not familiar with it, is a program to generate documentation from Haskell
source code) uses GHC, and the `optghc` flag lets you pass options to GHC
when you invoke Haddock. See [the Haddock docs of the 6.12 era][1], on page
3.

It's also entirely possible that some program besides Haddock uses a flag
of the same name (for the same purpose, one would hope).

[1]: http://www.haskell.org/ghc/docs/6.12.3/haddock.pdf




2013/8/23 

> Hi,
>
> I am using GHC version 6.12.1.
> What is optghc ?
>
> I can't find that information anywhere...
>
> Thanks,
> Jose
>
> --
> Jose Antonio Lopes
> Ganeti Engineering
> Google Germany GmbH
> Dienerstr. 12, 80331, München
>
> Registergericht und -nummer: Hamburg, HRB 86891
> Sitz der Gesellschaft: Hamburg
> Geschäftsführer: Graham Law, Christine Elizabeth Flores
> Steuernummer: 48/725/00206
> Umsatzsteueridentifikationsnummer: DE813741370
>
> ___
> 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] TypeLits & Typeable

2013-08-24 Thread Nicolas Trangez
Hello Cafe,

I was playing around with TypeLits in combination with Typeable (using
GHC 7.7.7.20130812 FWIW), but was surprised to find Symbols aren't
Typeable, and as such the following doesn't work. Is this intentional,
or am I missing something?

Thanks,

Nicolas

{-# LANGUAGE DataKinds,
 KindSignatures,
 DeriveFunctor,
 DeriveDataTypeable #-}
module Main where

import Data.Typeable
import GHC.TypeLits

data NoSymbol n a b = NoSymbol a b
  deriving (Typeable)

data WithSymbol (n :: Symbol) a b = WithSymbol a b
  deriving (Typeable)

data Sym
  deriving (Typeable)

main :: IO ()
main = do
print $ typeOf (undefined :: NoSymbol Sym Int Int)

let d = undefined :: WithSymbol "sym" Int Int
{-
print $ typeOf d

No instance for (Typeable Symbol "sym")
  arising from a use of ‛typeOf’
-}

return ()


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


Re: [Haskell-cafe] Yet Another Forkable Class

2013-08-24 Thread Ozgur Akgun
Hi.

On 23 August 2013 13:29, Nicolas Trangez  wrote:

> Did anyone ever consider using type-level literals (strings) to 'name'
> effects (or transformer layers when using monad stacks)?
>

Edwin Brady had this in his effects library in Idris.
http://www.idris-lang.org/documentation/effects/

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


[Haskell-cafe] Template Haskell: let statement in a splice put in the "main = do" part of a program?

2013-08-24 Thread TP
Hi,

I continue to test Template Haskell, and I have some difficulties to use a 
splice $() in a "do" contained in the "main" part of a program. Here is an 
example. I want to make a splice that does `let a="a"` in my code.


$ cat MakeLetStatement.hs

{-# LANGUAGE TemplateHaskell #-}

module MakeLetStatement where

import Language.Haskell.TH

makeLetStatement :: String -> ExpQ
makeLetStatement s = return $ DoE $ [ LetS $ [ ValD (VarP $ mkName s)
(NormalB $ LitE $ StringL s) [] ]]


$ cat test_MakeLetStatement.hs

{-# LANGUAGE TemplateHaskell #-}

import MakeLetStatement

main = do

$(makeLetStatement "a")
-- print a


Note I have commented "print a" because otherwise I obtain "Not in scope: 
`a'" that shows that `a` has not been defined correctly, but does not show 
whether my splice has been correctly expanded (I use --dump-splices GHC 
option, but it seems it is not working for splices in the "main = do" part).

I obtain:
$ runghc -ddump-splices test_MakeLetStatement.hs 

test_MakeLetStatement.hs:7:3:
Illegal last statement of a 'do' block:
  let a = "a"
(It should be an expression.)
When splicing a TH expression: do let a = "a"
In a stmt of a 'do' block: $(makeLetStatement "a")
In the expression: do { $(makeLetStatement "a") }
In an equation for `main': main = do { $(makeLetStatement "a") }

That shows that my splice has been correctly expanded: we have `let a = 
"a"`. However, what happens is the same as in the following dummy script, we 
have in fact defined a "do" inside the first "do" (with DoE), and so we 
obtain an error because the last statement in a do block should be an 
expression.

main = do
do let a = "a"
print a


So my code does not work, without surprise, but in fact my problem is to 
transform a LetS statement:

http://www.haskell.org/ghc/docs/latest/html/libraries/template-haskell-2.8.0.0/Language-Haskell-TH.html#v:LetS

that has type Stmt, in an ExpQ that seems to be the only thing that we can 
put in a splice. I have found that it can only be done by doE (or DoE) and 
compE (or CompE) according to 

http://www.haskell.org/ghc/docs/latest/html/libraries/template-haskell-2.8.0.0/Language-Haskell-TH.html#v:doE

But doE is not a solution as we have seen above, and compE is to construct 
list comprehensions, which is a different thing.

So, is there any solution to my problem?

Thanks in advance,

TP



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


Re: [Haskell-cafe] Template Haskell: let statement in a splice put in the "main = do" part of a program?

2013-08-24 Thread Brandon Allbery
On Sat, Aug 24, 2013 at 11:00 AM, TP  wrote:

> main = do
>
> $(makeLetStatement "a")
> -- print a
>

Is that the actual indentation you used? Because it's wrong if so, and the
error you would get is the one you're reporting. Indentation matters in
Haskell.

In an equation for `main': main = do { $(makeLetStatement "a") }
>

You cannot *end* a do with a let-statement; it requires something else
following it. You have nothing following it, as shown by the above fragment
from the error message.

-- 
brandon s allbery kf8nh   sine nomine associates
allber...@gmail.com  ballb...@sinenomine.net
unix, openafs, kerberos, infrastructure, xmonadhttp://sinenomine.net
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Template Haskell: let statement in a splice put in the "main = do" part of a program?

2013-08-24 Thread TP
Brandon Allbery wrote:

>> main = do
>>
>> $(makeLetStatement "a")
>> -- print a
>>
> 
> Is that the actual indentation you used? Because it's wrong if so, and the
> error you would get is the one you're reporting. Indentation matters in
> Haskell.

Yes, it matters, but not after "main = do": all the lines can start at the 
beginning of the line. Am I wrong? Or do I not understand what you say?

> In an equation for `main': main = do { $(makeLetStatement "a") }
>>
> 
> You cannot *end* a do with a let-statement; it requires something else
> following it. You have nothing following it, as shown by the above
> fragment from the error message.

Yes, I have explained why: to be able to see the evaluation of the splice; 
otherwise I obtain "Not in scope: `a'" if I uncomment "-- print a" at the 
end of my code; I have explained everything in my initial post.

TP



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