[ ghc-Bugs-1016120 ] Fails silently if preprocessor not found

2004-08-25 Thread SourceForge.net
Bugs item #1016120, was opened at 2004-08-25 18:35
Message generated for change (Tracker Item Submitted) made by Item Submitter
You can respond by visiting: 
https://sourceforge.net/tracker/?func=detailatid=108032aid=1016120group_id=8032

Category: Compiler
Group: 6.2.1
Status: Open
Resolution: None
Priority: 5
Submitted By: Schoinobates Volans (schoinobates)
Assigned to: Nobody/Anonymous (nobody)
Summary: Fails silently if preprocessor not found

Initial Comment:
When using a package that asks ghc to run a
preprocessor on the source, if the execution of the
preprocessor fails (e.g. because the latter is not
installed on the system or not in the PATH), ghc fails
silently. It should write an error message to stderr,
something like execution of preprocessor 'foo' failed:
No such file or directory.

I encountered this with Wash, version WashNGo-2.0.3:
http://www.informatik.uni-freiburg.de/~thiemann/haskell/WASH/

--

You can respond by visiting: 
https://sourceforge.net/tracker/?func=detailatid=108032aid=1016120group_id=8032
___
Glasgow-haskell-bugs mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs


Is it possible to load bindings into ghci

2004-08-25 Thread Andreas Marth
Hi everybody!

At the moment it happens that I use an unfinished program with ghci.
And each time I start GHCi, I have to introduce the same bindings aka
'cont - readFile myFile' ...
Is there a way to define them once in a File and then point GHCi to
it? (I need somme of the functions in the unfinished program so it has
to be after reading the program file.)

Thanks,
Andreas

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


RE: Is it possible to load bindings into ghci

2004-08-25 Thread Simon Marlow
On 24 August 2004 12:47, Andreas Marth wrote:

 At the moment it happens that I use an unfinished program with ghci.
 And each time I start GHCi, I have to introduce the same bindings aka
 'cont - readFile myFile' ...
 Is there a way to define them once in a File and then point GHCi to
 it? (I need somme of the functions in the unfinished program so it has
 to be after reading the program file.)

Like the '.' command in /bin/sh?  Yes, we ought to have something like
that.  I'll get around to it at some point, unless anyone gets there
first.

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


Re: Is it possible to load bindings into ghci

2004-08-25 Thread Tomasz Zielonka
On Wed, Aug 25, 2004 at 09:09:40AM +0100, Simon Marlow wrote:
 On 24 August 2004 12:47, Andreas Marth wrote:
 
  At the moment it happens that I use an unfinished program with ghci.
  And each time I start GHCi, I have to introduce the same bindings aka
  'cont - readFile myFile' ...
  Is there a way to define them once in a File and then point GHCi to
  it? (I need somme of the functions in the unfinished program so it has
  to be after reading the program file.)
 
 Like the '.' command in /bin/sh?  Yes, we ought to have something like
 that.  I'll get around to it at some point, unless anyone gets there
 first.

Dirty hack - you can put such bindings in ~/.ghci :)

Best regards,
Tom

-- 
.signature: Too many levels of symbolic links
___
Glasgow-haskell-users mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: Is it possible to load bindings into ghci

2004-08-25 Thread Tomasz Zielonka
On Wed, Aug 25, 2004 at 09:09:40AM +0100, Simon Marlow wrote:
 On 24 August 2004 12:47, Andreas Marth wrote:
 
  At the moment it happens that I use an unfinished program with ghci.
  And each time I start GHCi, I have to introduce the same bindings aka
  'cont - readFile myFile' ...
  Is there a way to define them once in a File and then point GHCi to
  it? (I need somme of the functions in the unfinished program so it has
  to be after reading the program file.)
 
 Like the '.' command in /bin/sh?  Yes, we ought to have something like
 that.  I'll get around to it at some point, unless anyone gets there
 first.

How about this:

:def . readFile
:. C.hs

I guess I got there first ;)

Best regards,
Tom

-- 
.signature: Too many levels of symbolic links
___
Glasgow-haskell-users mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Extra parse stage...

2004-08-25 Thread MR K P SCHUPKE

I wish to add some extended syntax to type definitions,
assuming I modify the parser files and associated datatypes
to carry the extra information, is there a convenient place
to insert a pre-parse (before type-checking) to convert the
syntax extensions to regular haskell?

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


Re: Bug in compiling large projects ?

2004-08-25 Thread John Meacham
Just a thought...
but do you have mutually recursive modules with incorrect or
non-existant .hi-boot files? I have encounted similar 'transient'
problems like the ones described when that was the problem.
John
-- 
John Meacham - repetae.netjohn 
___
Glasgow-haskell-users mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


RE: Extra parse stage...

2004-08-25 Thread Simon Marlow
On 25 August 2004 12:28, MR K P SCHUPKE wrote:

 I wish to add some extended syntax to type definitions,
 assuming I modify the parser files and associated datatypes
 to carry the extra information, is there a convenient place
 to insert a pre-parse (before type-checking) to convert the
 syntax extensions to regular haskell?

GHC's strategy is to not do any translation before typechecking, so that
we can generate good error messages.

Nevertheless, it's certainly possible to do what you're suggesting: just
insert an HsSyn-HsSyn pass after parsing (I imagine).  Various things
might complicate matters, such as needing to refer to fixed entities in
other modules in the translation.

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


GHC and MPTCs

2004-08-25 Thread Ketil Malde

Hi,

I recently tried to do the following code:

  class VertexState s v where
  new_point :: s - v - v - v
  next_state :: s - s

  -- interleave :: (VertexState s a) = s - [a] - [a] - [a]
  interleave s (t:ts) (b:bs) = 
  new_point s t b : interleave (next_state s) bs (t:ts)
  interleave _ [] [b] = []

Firstly, GHC doesn't deal all too gracefully with this if the type
signature is uncommented, it tells me:

Could not deduce (VertexState s v)
from the context (VertexState s a)
  arising from use of `next_state' at Grid.lhs:25
Probable fix:
Add (VertexState s v) to the type signature(s) for `interleave'

Unfortunately, doing the probable fix just results in a new request
for (VertexState s v1), and so on.

I suppose the real problem is that GHC can't decide from next_state
that it is supposed to use exactly this instance of VertexState, is
there a good way to do that without adding an explicit dummy parameter
of type v?  

(I really would like to be able to have instances with the same s but
different v's, which I think adding functional deps would make
difficult.)

-kzm
-- 
If I haven't seen further, it is by standing in the footprints of giants
___
Glasgow-haskell-users mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: Is it possible to load bindings into ghci

2004-08-25 Thread Andreas Marth
I answer to 3 different mails here, so don' get confused:

Simon M. wrote:
Like the '.' command in /bin/sh?  Yes, we ought to have something
like
that.  I'll get around to it at some point, unless anyone gets there
first.

I don't know about the '.' command in /bin/sh and I don't have a *nix
machine at hand to find out. It's a pity.

Tomasz Z. wrote:
Dirty hack - you can put such bindings in ~/.ghci :)

I tried that before posting the mail, but it does not work because the
.ghci is read before going to the submitted file which contains the
functions I need. (And ghci discards the bindings.) (I can read the
contents of a file. Even print it, manipulate it (but only with what
is supplied with package base). Quit good already!)

Later Tomasz Z.
 How about this:

 :def . readFile
 :. C.hs

 I guess I got there first ;)

That works great! And you can even put the :def . readFile in the
.ghci File!
So now I start ghci with ghci MyFile wait until it's finished and do
:. all_the_stuff_I_need_in_a_file
and every thing is fine!

Thaks a lot,
Andreas

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


Re: GHC and MPTCs

2004-08-25 Thread MR K P SCHUPKE
Try type annotations:

new_point (s::s) t b : interleave (next_state s::s) bs (t:ts)


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


RE: Is it possible to load bindings into ghci

2004-08-25 Thread Simon Marlow
On 25 August 2004 15:06, Andreas Marth wrote:


 Later Tomasz Z.
 How about this:
 
 def . readFile
 :. C.hs
 
 I guess I got there first ;)
 
 That works great! And you can even put the :def . readFile in the
 .ghci File!
 So now I start ghci with ghci MyFile wait until it's finished and do
 :. all_the_stuff_I_need_in_a_file
 and every thing is fine!

Yes, that's a neat trick.  I'm annoyed I didn't think of it, especially
since I'm the one who invented :def.  Duh :-)

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


Re: Is it possible to load bindings into ghci

2004-08-25 Thread Tomasz Zielonka
On Wed, Aug 25, 2004 at 04:05:39PM +0200, Andreas Marth wrote:
 Tomasz Z. wrote:
 Dirty hack - you can put such bindings in ~/.ghci :)
 
 I tried that before posting the mail, but it does not work because the
 .ghci is read before going to the submitted file which contains the
 functions I need. (And ghci discards the bindings.) (I can read the
 contents of a file. Even print it, manipulate it (but only with what
 is supplied with package base). Quit good already!)

You could :load your modules in .ghci, but that would be inconvenient.

 That works great! And you can even put the :def . readFile in the
 .ghci File!
 
 Thaks a lot,
 Andreas

Thanks to you too. I wanted such functionality many times before, but it
was after your question that I actually tried to do this :)

Best regards,
Tom

-- 
.signature: Too many levels of symbolic links
___
Glasgow-haskell-users mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: GHC and MPTCs

2004-08-25 Thread Ketil Malde
MR K P SCHUPKE [EMAIL PROTECTED] writes:

 Try type annotations:

[slightly edited to keep the different s's differentiated]

 new_point (s0::s) t b : interleave (next_state s0::s) bs (t:ts)

Hmm...I get:

Inferred type is less polymorphic than expected
Quantified type variable `s' escapes
It is mentioned in the environment:
  s0 :: s (bound at Grid.lhs:25)
When checking the type signature of the expression:
  s0 :: forall s. s

-kzm
-- 
If I haven't seen further, it is by standing in the footprints of giants
___
Glasgow-haskell-users mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: [Haskell] XML Serialization and type constraints

2004-08-25 Thread Tomasz Zielonka
On Tue, Aug 24, 2004 at 07:35:46PM +0100, Simon D. Foster wrote:
 I'm trying to implement an extensible XML De/Serializer in Haskell for
 use with SOAP and XML Schema (using the Haskell XML Toolbox). The idea
 is you have a type-class, which is instantiated for each type you want
 to encode/de-encode. This class (atm) takes the form;
 
 class XMLSerializer a where
 encodeElements:: NamespaceTable - Flags - a - [XmlFilter]
 encodeAttributes  :: NamespaceTable - Flags - a - [XmlFilter]
 encodeTree  :: NamespaceTable - String - Flags - a - XmlFilter
 encodeTrees :: NamespaceTable - String - Flags - a - [XmlFilter]
 
 decodeAttribute   :: String - XmlTree - Maybe a
 decodeElement :: XmlTree - Maybe a
 decodeTree:: XmlTree - Maybe a
 decodeTrees   :: XmlTrees - Maybe a
 
 (and a few default instances)
 
 This type-class can then be used recursively to build XML
 representations of Haskell data.
 
 I now want to expand this system to make is more extensible. For
 starters, to make it useful with SOAP, I need to add optional explicit
 typing of data. To this end I have another class; XSDType, which stores
 the XSD equivalent name and name-space for a particular Haskell type.
 This is what is used to add explicit type data to the XML documents.
 Adding this data involves adding an extra attribute to each node in the
 tree. More generally however each Hook, which adds extra data at each
 node has type NamespaceTable - Flags - a - ([XmlFilter],
 [XmlFilter]), where a is the type of the value.
 
 However, this is where the problem comes. How do I go about expressing
 that a has a constraint XSDType a? I don't want to add this constraint
 to the Serializer class itself since an XML tree may not be typed by
 XSD. Somehow I need a way of adding extra constraints to a dynamically.

Here is one possible solution. Below is a working implementation for a
simpler class scheme. You should be able to apply this to your problem,
at least in case of adding XSD types, if not generally.

  {-# OPTIONS -fglasgow-exts #-}
  {-# OPTIONS -fallow-undecidable-instances #-}

  module B where

  import List
  import Data.Typeable -- Just to implement one of example mixins

  -- Mixin class - could have better name

  class Mixin a t where
  mixin :: t - a - (String - String)

  -- Serializer class

  -- class Serializer has an additional parameter t which will be used
  -- for passing a mixin to it. Also it is a subclass of Mixin a t, but
  -- it doesn't mean adding unneccesary constraints to Serializer -
  -- one of Mixin's implementations will be identity.
  --
  -- It is important that encodePrim's implementations don't call
  -- directly to encodePrim, only to encode, which makes the
  -- mixin work.
  class Mixin a t = Serializer a t where
  encodePrim :: t - a - String

  encode :: Serializer a t = t - a - String
  encode t x = mixin t x (encodePrim t x)

  -- Serializer instances - I used undecidable instances here.

  instance Mixin Int t = Serializer Int t where
  encodePrim _ = show

  instance Mixin Char t = Serializer Char t where
  encodePrim _ = show

  instance (Serializer a t, Mixin [a] t) = Serializer [a] t where
  encodePrim t l = [ ++ concat (intersperse ,  (map (encode t) l)) ++ ]

  -- example Mixins

  data Id = Id

  instance Mixin a Id where
  mixin Id _ = id

  data TypeOf = TypeOf

  instance Typeable a = Mixin a TypeOf where
  mixin TypeOf t s = ( ++ s ++  ::  ++ show (typeOf t) ++ )

  instance Mixin a (String - String) where
  mixin f a = f

  -- this one can be used for combining mixins
  instance (Mixin a x, Mixin a y) = Mixin a (x, y) where
  mixin (x, y) a = mixin x a . mixin y a

  -- some unTypeable type

  data T a = T a

  instance (Serializer a t, Mixin (T a) t) = Serializer (T a) t where
  encodePrim t (T a) = (T  ++ encode t a ++ )

Example uses:

  *B putStrLn $ encode Id 'a'
  'a'
  *B putStrLn $ encode TypeOf 'a'
  ('a' :: Char)
  *B putStrLn $ encode Id ([1..4] :: [Int])
  [1, 2, 3, 4]
  *B putStrLn $ encode TypeOf ([1..4] :: [Int])
  ([(1 :: Int), (2 :: Int), (3 :: Int), (4 :: Int)] :: [Int])
  *B putStrLn $ encode (TypeOf, TypeOf) ([1..4] :: [Int])
  (([((1 :: Int) :: Int), ((2 :: Int) :: Int), ((3 :: Int) :: Int), ((4 ::
  Int) :: Int)] :: [Int]) :: [Int])
  *B putStrLn $ encode Id (T Hello)
  (T ['H', 'e', 'l', 'l', 'o'])
  *B putStrLn $ encode TypeOf (T Hello)

  interactive:1:
  No instances for (Typeable (T [Char]), Show (IO ()))
arising from use of `encode' at interactive:1
  In the second argument of `($)', namely `encode TypeOf (T Hello)'
  In the definition of `it':
  it = putStrLn $ (encode TypeOf (T Hello))

  interactive:1:
  No instances for (Typeable (T [Char]), Show (IO ()))
arising from use of `print' at interactive:1
  In a 'do' expression: print it

I hope that helps,

Best regards,
Tom

-- 
.signature: Too many levels of symbolic links

Re: [Haskell] XML Serialization and type constraints

2004-08-25 Thread Simon D. Foster
On Wed, 2004-08-25 at 08:39, Tomasz Zielonka wrote:
- snip -

 I hope that helps,
 
 Best regards,
 Tom

That method works perfectly! Thank you so much! I assume there is no way
of achieving this without overlapping instances?

Thanks,

-Si.

-- 
Simon D. Foster [EMAIL PROTECTED]
Sheffield University

___
Haskell mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell


Re: [Haskell] XML Serialization and type constraints

2004-08-25 Thread Tomasz Zielonka
On Wed, Aug 25, 2004 at 01:54:08PM +0100, Simon D. Foster wrote:
 On Wed, 2004-08-25 at 08:39, Tomasz Zielonka wrote:
 - snip -
 
  I hope that helps,
  
  Best regards,
  Tom
 
 That method works perfectly! Thank you so much! I assume there is no way
 of achieving this without overlapping instances?

Not overlapping, only undecidable. Well, I am not sure. I already
thought about it and I think that it would be possible, but the code
could be much less readable. These instances should be quite 'decidable',
unless someone makes instances of Serializer and Mixin mutually
recursive.

Maybe I will try after work, unless someone else has some good idea?

Best regards,
Tom

-- 
.signature: Too many levels of symbolic links
___
Haskell mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell


Re: [Haskell] XML Serialization and type constraints

2004-08-25 Thread Simon D. Foster
On Wed, 2004-08-25 at 14:00, Tomasz Zielonka wrote:
 On Wed, Aug 25, 2004 at 01:54:08PM +0100, Simon D. Foster wrote:
  On Wed, 2004-08-25 at 08:39, Tomasz Zielonka wrote:
  - snip -
  
   I hope that helps,
   
   Best regards,
   Tom
  
  That method works perfectly! Thank you so much! I assume there is no way
  of achieving this without overlapping instances?

I think I jumped the gun it a bit; it almost works, but when I try to
declare a serializer for a type with several parts e.g.

data Person = Person PackedString PackedString Int

instance (Hook Person t) = Serializer Person t where ...

If I try to call encode on any of the attributes I get;

Could not deduce (Hook PackedString t)
from the context (Serializer Person t,
  Hook Person t,
  Hook Person t)

Thus, I have to add a (Hook x t) constraint for every type that is part
of the given data-type. For your example try;

data D = D Int  
instance (Mixin D t) = Serializer D t where
  encodePrim t (D n) = (D  ++ encode t n ++ )

Is there anyway of getting around this?

Thanks,

-Si.

-- 
Simon D. Foster [EMAIL PROTECTED]
Sheffield University

___
Haskell mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell


Re: [Haskell] XML Serialization and type constraints

2004-08-25 Thread Tomasz Zielonka
On Wed, Aug 25, 2004 at 04:14:48PM +0100, Simon D. Foster wrote:
 I think I jumped the gun it a bit; it almost works, but when I try to
 declare a serializer for a type with several parts e.g.
 
 data Person = Person PackedString PackedString Int
 
 instance (Hook Person t) = Serializer Person t where ...
 
 If I try to call encode on any of the attributes I get;
 
 Could not deduce (Hook PackedString t)
 from the context (Serializer Person t,
   Hook Person t,
   Hook Person t)
 
 Thus, I have to add a (Hook x t) constraint for every type that is part
 of the given data-type. For your example try;
 
 data D = D Int  
 instance (Mixin D t) = Serializer D t where
   encodePrim t (D n) = (D  ++ encode t n ++ )
 
 Is there anyway of getting around this?

Perhaps you could just 'encode Id' that parts?

Best regards,
Tom

-- 
.signature: Too many levels of symbolic links
___
Haskell mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell


[Haskell] Call for participation: GPCE'04 -- Generative Programming and Component Engineering

2004-08-25 Thread Eelco Visser

 CALL FOR PARTICIPATION

--
   Third International Conference on
   Generative Programming and Component Engineering (GPCE'04)

 Vancouver, October 24-28, 2004
co-located with OOPSLA 2004 and ISMM 2004

  http://gpce04.gpce.org
--
   Online Registration
http://www.regmaster.com/oopsla2004.html
 early registration with reduced rates closes September 16
--

Generative and component approaches have the potential to
revolutionize software development in a similar way as automation and
components revolutionized manufacturing. Generative Programming
(developing programs that synthesize other programs), Component
Engineering (raising the level of modularization and analysis in
application design), and Domain-Specific Languages (elevating program
specifications to compact domain-specific notations that are easier to
write and maintain) are key technologies for automating program
development.

GPCE arose as a joint conference, merging the prior conference on
Generative and Component-Based Software Engineering (GCSE) and the
Workshop on Semantics, Applications, and Implementation of Program
Generation (SAIG). The goal of GPCE is to provide a meeting place for
researchers and practitioners interested in cutting edge approaches to
software development. We aim to foster further cross-fertilization
between the software engineering research community on the one hand,
and the programming languages community on the other, in addition to
supporting the original research goals of both the GCSE and the SAIG
communities. We seek papers both in software engineering and in
programming languages, and especially those that bridge the gap and
are accessible to both communities at the same time.

   * Invited speakers
  * Keynote: Jack Greenfield on Software Factories
  * Peter Mosses on Modular Language Descriptions

   * Technical program
  * 25 papers
  * Aspect-orientation
  * Staged programming
  * Meta-programming
  * Model-driven approaches
  * Product lines
  * Domain-specific languages

   * Tutorials
  * Adaptive Object-Model Architecture: Dynamically Adapting
to Changing Requirements
  * Multi-stage Programming in Meta-OCaml
  * Generative Software Development
  * Program Transformation Systems: Theory and Practice
for Software Generation, Maintenance and Reengineering

   * Workshops
  * Software Transformation Systems Workshop
  * First MetaOCaml Workshop
  * Young Researchers Workshop
  * Workshop on Best Practices Model-Driven Software
Development
  * Workshop on Managing Variabilities Consistently
in Design and Code

   * Demonstrations
  * Implementation of DSLs using staged interpreters
in MetaOCaml
  * MetaEdit+: Domain-Specific Modeling for Full
Code Generation Demonstrated
  * Towards Domain-Driven Development: the SmartTools
Software Factory
  * Xirc: Cross-Artifact Information Retrieval
  * C-SAW and GenAWeave: A Two-Level Aspect
Weaving Toolsuite
  * The Concern Manipulation Environment
  * Program Transformations for Re-Engineering
C++ Components


___
Haskell mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell


Re: [Haskell] XML Serialization and type constraints

2004-08-25 Thread Simon D. Foster
On Wed, 2004-08-25 at 16:19, Tomasz Zielonka wrote:
  
  Is there anyway of getting around this?
 
 Perhaps you could just 'encode Id' that parts?
 
 Best regards,
 Tom

Ok then, well it looks like this method is going to very cumbersome to
use; for example a context for a reasonably simple complex data-type
would be;

(Hook Element t, Hook Bool t, Hook [ERS] t, Hook (Selection ERS) t, Hook
ERS t, Hook (Maybe PackedString) t, Hook PackedString t, Hook
IsQualified t, Hook (Ser t) t, Hook Int t, Hook (Maybe QName) t, Hook
QName t)

(and baring in mind most of the auto-generated code will have types
namespace qualified making that humongously long).

So I was thinking of another method of doing this;

First of all I though of scrapping the extra type-class and just using a
simple extra parameter; e.g. type Mixer a = a - (String - String). But
this doesn't work for any sort of recursive since the a is always
unified with the top-level type. Unless there's someway of getting
around this?

Another thought I had was to use an existentially quantified type to
represent the Mix function;

type Mix = forall a . a - (String - String)

but I don't think this will allow extra constraints to be brought in. 

Is there any other way of doing this without another type-class?

-Si.


-- 
Simon D. Foster [EMAIL PROTECTED]
Sheffield University

___
Haskell mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell


Re: [Haskell] XML Serialization and type constraints

2004-08-25 Thread Tomasz Zielonka
On Wed, Aug 25, 2004 at 08:38:51PM +0100, Simon D. Foster wrote:
 Ok then, well it looks like this method is going to very cumbersome to
 use; for example a context for a reasonably simple complex data-type
 would be;
 
 (Hook Element t, Hook Bool t, Hook [ERS] t, Hook (Selection ERS) t, Hook
 ERS t, Hook (Maybe PackedString) t, Hook PackedString t, Hook
 IsQualified t, Hook (Ser t) t, Hook Int t, Hook (Maybe QName) t, Hook
 QName t)

Well, yes, that can be tiresome. You can copy/paste this from compiler
error message, but that won't help you to keep these huge contexts up to
date if you remove some fields of your data types.

Hmmm, it is worse that I thought. The contexts will accumulate, like a
snowball. If you have:

data A = A Int
data B = B A
data C = C B
data D = D C

then in the instance for D you would have to include context for all
Int, A, B, C and D.

Apparently this solution doesn't scale. I can think about some hack, but
I'm not sure you will like it, because it introduces more type classes,
one per datatype.

  data S = S { sA :: Int, sB :: String, sC :: [Int] }

  class (Mixin Int t, Mixin Char t, Mixin String t, Mixin [Int] t, Mixin S t) = 
Mixin_S t
  instance (Mixin Int t, Mixin Char t, Mixin String t, Mixin [Int] t, Mixin S t) = 
Mixin_S t

  instance (Mixin_S t) = Serializer S t where
  encodePrim t s =
  concat
  [ S { 
  , encode t (sA s)
  , , 
  , encode t (sB s)
  , , 
  , encode t (sC s)
  ,  }
  ]

  data R = R { rA :: Int, rS :: S }

  class (Mixin_S t, Mixin Int t, Mixin R t) = Mixin_R t where
  instance (Mixin_S t, Mixin Int t, Mixin R t) = Mixin_R t where

  instance (Mixin_R t) = Serializer R t where
  encodePrim t r =
  concat
  [ R { 
  , encode t (rA r)
  , , 
  , encode t (rS r)
  ,  }
  ]

I am moving this big contexts to superclasses of additional classes
Mixin_S and Mixin_R. This way the contexts don't accumulate. These
class/instance pairs could be easily generated with Template Haskell.
But it's a bit ugly.

 Is there any other way of doing this without another type-class?

That would be interesting.

Best regards,
Tom

-- 
.signature: Too many levels of symbolic links
___
Haskell mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell