Two Times [was Re: Happy and Macros (was Re: ANNOUNCE: Happy 1.10 released)]

2001-05-11 Thread Marc van Dongen

Manuel M. T. Chakravarty ([EMAIL PROTECTED]) wrote:

[received message twice]

Am I just the only one or does everybody receive
messages posted to [EMAIL PROTECTED] and
[EMAIL PROTECTED] twice? I find
it a bit (I know I am exaggerating) annoying.
Is there a way to avoid this?


Regards,


Marc

___
Glasgow-haskell-users mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users



Re: MonadError and fundeps

2001-05-11 Thread Marcin 'Qrczak' Kowalczyk

On Fri, 11 May 2001, Lauri Alanko wrote:

 Why? This makes composing and subtyping impossible:
 
 instance (MonadTrans t, MonadState s m, Monad (t m)) 
= MonadState s (t m) where
 get = lift get
 put = lift . put

This instance is illegal anyway. One of types in the instance head must be
a type constructor applied to something (type variables in Haskell 98,
anything with -fglasgow-exts).

Even if it was legal, it would overlap with
instance Monad m = MonadState s (StateT s m)

Also MonadReader and MonadWriter can't have such generic instances anyway
because their methods have values of type 'm a' as arguments.


OTOH without the fundep there are ambiguities. For example:

class ParsingState s where
stateInput :: s - String
stateSkip  :: Int - s - s

instance ParsingState String where ...
instance ParsingState s = ParsingState (s, Pos) where ...

input :: (ParsingState s, MonadState s m) = m String
 -- Ambiguous without the fundep.
input = gets stateInput

-- 
Marcin 'Qrczak' Kowalczyk


___
Glasgow-haskell-users mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users



Re: MonadError and fundeps

2001-05-11 Thread Lauri Alanko

On Fri, May 11, 2001 at 02:14:24PM +0200, Marcin 'Qrczak' Kowalczyk wrote:
 On Fri, 11 May 2001, Lauri Alanko wrote:
 
  Why? This makes composing and subtyping impossible:
  
  instance (MonadTrans t, MonadState s m, Monad (t m)) 
   = MonadState s (t m) where
  get = lift get
  put = lift . put
 
 This instance is illegal anyway. One of types in the instance head must be
 a type constructor applied to something (type variables in Haskell 98,
 anything with -fglasgow-exts).

Ah. So it seems. Pardon. It works in Hugs, though.

 Even if it was legal, it would overlap with
 instance Monad m = MonadState s (StateT s m)

Yep, but in hugs +o the latter overrides the first one. Which is quite
convenient.

 Also MonadReader and MonadWriter can't have such generic instances anyway
 because their methods have values of type 'm a' as arguments.

Oh?

translift :: (MonadTrans t, Monad m, Monad (t m)) 
   = (m a - m b) - t m a - t m b
   
translift f m = m = lift . f . return

instance (MonadTrans t, MonadReader r m, Monad (t m)) 
= MonadReader r (t m) where
ask = lift ask
local = translift . local

instance (MonadTrans t, MonadWriter w m, Monad (t m), Monoid w) =
MonadWriter w (t m) where
tell = lift . tell
listen = translift listen
pass = translift pass


 OTOH without the fundep there are ambiguities. For example:
 
 class ParsingState s where
 stateInput :: s - String
 stateSkip  :: Int - s - s
 
 instance ParsingState String where ...
 instance ParsingState s = ParsingState (s, Pos) where ...
 
 input :: (ParsingState s, MonadState s m) = m String
  -- Ambiguous without the fundep.
 input = gets stateInput

So it is, and why not? Is it inconceivable that m might actually have
multiple ParsingStates, and thus you really have to specify which one you
want to use to get the input?


Lauri Alanko
[EMAIL PROTECTED]

___
Glasgow-haskell-users mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users



GHCi turned upside down?

2001-05-11 Thread George Russell

GHCi allows us to mix fixed compiled and dynamic interpreted code to 
be run from what I presume is dynamic interpreted code - the command
prompt.  Would it be possible to run dynamic interpreted code from
a compiled program?  I'm hoping the answer is Yes, because this is what
GHCi does, the only problem being to clean up the syntax and document
it.

I'm afraid I haven't been following the FFI debate lately but perhaps we
could steal some of the FFI's syntax for declaring types of imported
entities.  The difference (I'm not sure if this is a difference with
the latest with the latest FFI version) would be that the source file/string
(and perhaps function name) need to vary dynamically, which means also that
of course it needs to be done below top level, and invoke an IO action.  So
we might try something like

runMain :: FilePath - IO ()
runMain sourcePath =
   do
  source - readFile sourcePath
  foreign import ghci source main main :: IO ()
  main

which would read the file sourcePath, interpret it as Haskell,
and run the main action therein.

This isn't meant to be a polished proposal, just an idea for something
which might be nice to have around in the future.

___
Glasgow-haskell-users mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users



Re: MonadError and fundeps

2001-05-11 Thread Marcin 'Qrczak' Kowalczyk

On Fri, 11 May 2001, Lauri Alanko wrote:

 Yep, but in hugs +o the latter overrides the first one. Which is quite
 convenient.

I doubt that it works predictably in all cases (when state types are not
known statically). I can try to construct an example if you wish.

 translift :: (MonadTrans t, Monad m, Monad (t m)) 
  = (m a - m b) - t m a - t m b
  
 translift f m = m = lift . f . return
 
 instance (MonadTrans t, MonadReader r m, Monad (t m)) 
 = MonadReader r (t m) where
 ask = lift ask
   local = translift . local
 
 instance (MonadTrans t, MonadWriter w m, Monad (t m), Monoid w) =
 MonadWriter w (t m) where
 tell = lift . tell
   listen = translift listen
   pass = translift pass

This gives wrong results (but I haven't checked). For example
listen :: Monoid w
   = ReaderT r (Writer w) a - ReaderT r (Writer w) (a, w)
doesn't listen what the action tells, but listens to 'return' which always
tells mempty. Similarly 'local' first runs the action in the original
environment and then provides a new environment to 'return' which doesn't
look at it.

I did most monad transformer forwarding instances in ghc-5.00 and hope
that I got them right, but I haven't tested them much. It's not that
mechanical (except MonadState), and some combinations can't be done at
all.

It could be advantageous to put something like translift in an extension
of MonadTrans. AFAIR many liftings of this type are similar (but the
function must be provided separately for each state transformer), so it
would simplify making forwarding instances.

 Is it inconceivable that m might actually have multiple ParsingStates,
 and thus you really have to specify which one you want to use to get
 the input?

The idea is to use a single state and abstract over the way in which
interesting components are contained in it. It has these advantages:
* It works. I doubt that automatic recognition of the state type would work.
* It allows to have multiple components of the same type in the state.

Now I see that my simulation of a fundep without the fundep (an extra
class which generates the dependency, instantiated separately for each
monad transformer, with MonadError as a superclass) doesn't work that
well: throwError would still be ambiguous so it needs a wrapper with a
type which tells how to determine the error type using the new class.
So I'm now convinced that MonadError should have the fundep too.

Some other mechanism could be invented to make it easier to embed various
components in the same type (for MonadReader  MonadState) or various
alternatives (for MonadError). I have a rather heavy proposal for the
first case (a language extension which redesigns records). OCaml has
a dual mechanism for the second (polymorphic variants). If my records
succeed, I will try to cover variants too.

-- 
Marcin 'Qrczak' Kowalczyk




___
Glasgow-haskell-users mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users



RE: GHCi turned upside down?

2001-05-11 Thread Simon Marlow

 GHCi allows us to mix fixed compiled and dynamic interpreted code to 
 be run from what I presume is dynamic interpreted code - the command
 prompt.  Would it be possible to run dynamic interpreted code from
 a compiled program?  I'm hoping the answer is Yes, because 
 this is what
 GHCi does, the only problem being to clean up the syntax and document
 it.

It's certainly possible, but bear in mind that you'd have to link in
essentially the whole of GHCi into your program in order to do it!  But
one of the things on our wish list is to have a clearly defined
interface to the underlying compilation/session manager, (i.e. what
we've been calling the HEP, or Haskell Execution Platform).  This would
allow you to plug in new user interfaces, make interpreted COM objects,
and in general have Haskell compilation/execution services available
from a Haskell API.  There's still work to do in deciding exactly what
this API should look like, though.

Cheers,
Simon

___
Glasgow-haskell-users mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users



Re: Happy and Macros (was Re: ANNOUNCE: Happy 1.10 released)

2001-05-11 Thread Carl R. Witty

Manuel M. T. Chakravarty [EMAIL PROTECTED] writes:

 I don't think, the point is the test for non-ambiguity.  At
 least, Doitse's and my self-optimising parser combinator
 library will detect that a grammar is ambigious when you
 parse a sentence involving the ambiguous productions.  So,
 you can check that by parsing a file involving all grammar
 constructs of the language.

Sorry, doesn't work.  Where do you get this file involving all
grammar constructs of the language?

If such an approach worked, you could use it to determine whether an
arbitrary context-free grammar was ambiguous; but this problem is
undecidable.

Carl Witty

___
Glasgow-haskell-users mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users



Re: Happy and Macros (was Re: ANNOUNCE: Happy 1.10 released)

2001-05-11 Thread Brian Boutel

Carl R. Witty wrote:
 
 Manuel M. T. Chakravarty [EMAIL PROTECTED] writes:
 
  I don't think, the point is the test for non-ambiguity.  At
  least, Doitse's and my self-optimising parser combinator
  library will detect that a grammar is ambigious when you
  parse a sentence involving the ambiguous productions.  So,
  you can check that by parsing a file involving all grammar
  constructs of the language.
 
 Sorry, doesn't work.  Where do you get this file involving all
 grammar constructs of the language?
 
 If such an approach worked, you could use it to determine whether an
 arbitrary context-free grammar was ambiguous; but this problem is
 undecidable.
 

This illustrates the difference between generality and usefulness.

Often, one is less interested in learning that a grammar is ambiguous
than learning that it is not. 

If you have a parser generator for a class of grammars, it will tell you
if (and probably why) a candidate grammar you feed to it is not a member
of that class. If it is accepted by, for example, a parser generator for
LR(1) grammars, then it is a DCFG and therefore unambiguous.

If you start with a natural grammar for the language, i.e. one that
corresponds to the abstract syntax, and use a generator for a broad
class of grammars (e.g LR(1)) then failure will give a good hint that
the only way to get an unambiguous grammar in that class is to restrict
the language, and you can use that information to make design decisions.

For example, although Haskell has both 'let' and 'where' for introducing
local definitions, thereby reflecting the typical committee decision
when there are varying stylistic preferences, 'where' is not part of the
expression syntax. If you write a grammar which includes the natural
productions

exp - let defs in exp
exp - exp where defs

and put this through a suitable generator, you will see why not.

Of course, it is possible that an unambiguous grammar will fail to be
LR(1) - by being non-deterministic, so the proper conclusion is that G
is ambiguous or non-deterministic. But that is close enough for most
purposes.

Early versions of Hope had both 'let' and 'where' as expressions, and
had three different forms of condtional. Most combinations of these
constructs would interract to create ambiguity. The hand-coded parsers
in use had not picked this up. That shows the advantage of using a
generator - you get a constructive proof that the grammar is in the
desired class.

--brian

___
Glasgow-haskell-users mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users