From haskellmail@yahoo.com.sg Wed Apr 30 08:29:04 2003
From: haskellmail@yahoo.com.sg (Kenny Lu Zhuo Ming)
Date: Wed, 30 Apr 2003 15:29:04 +0800
Subject: unsafe parsing
Message-ID: <001601c30eea$3f203f80$22528489@comp.nus.edu.sg>
This is a multi-part message in MIME format.
------=_NextPart_000_000F_01C30F2D.3BEC6940
Content-Type: text/plain;
charset="iso-8859-1"
Content-Transfer-Encoding: quoted-printable
Hi all,
I am currently write a program to type a dynamic string consist of 'A' =
or 'B'
for short, it works in this manner:=20
for 'A', it returns A :: A
for 'B', it returns B :: B
for "A", it returns Cons A Nil :: Cons A Nil
for "AB", it returns Cons A (Cons B Nil) :: Cons A (Cons B Nil)
...
The problem is I have to specifically annotate the output type, which is =
unaffordable, because I might have arbitrary-long string,
and I have infinitely many possible singleton types.
It seems it is impossible to do it in a type-safe way. Anyone of you =
have any idea to walk around that?
Regards,
Kenny
module Test where
data Content =3D C1 Char
| C2 String deriving Eq
class MyType a where
parse :: Content -> (Maybe a)
data A =3D A deriving (Show,Eq)
instance MyType A where
parse (C1 'A') =3D Just A
parse _ =3D Nothing
data B =3D B deriving (Show,Eq)
instance MyType B where
parse (C1 'B') =3D Just B
parse _ =3D Nothing
data Cons x xs =3D Cons x xs deriving Show
instance (MyType x,MyType xs) =3D> MyType (Cons x xs) where
parse (C2 (x:xs)) =3D let maybehd =3D parse (C1 x) in
case maybehd of=20
Just hd ->
let maybetl =3D parse (C2 xs) in
case maybetl of=20
Just tl ->
Just ((Cons hd) tl)
Nothing -> Nothing
Nothing -> Nothing
parse _ =3D Nothing
data Nil =3D Nil deriving (Show,Eq)
instance MyType Nil where=20
parse (C2 []) =3D Just Nil
parse _ =3D Nothing
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
Hugs session for:
/usr/share/hugs/lib/Prelude.hs
Test.hs
Type :? for help
Test> parse (C2 "A") :: Maybe (Cons A Nil)
Just (Cons A Nil)
------=_NextPart_000_000F_01C30F2D.3BEC6940
Content-Type: text/html;
charset="iso-8859-1"
Content-Transfer-Encoding: quoted-printable
Hi all,
I am currently write a program to type =
a dynamic=20
string consist of 'A' or 'B'
for short, it works in this =
manner:=20
for 'A', it returns A :: A
for 'B', it returns B :: B
for "A", it returns Cons A Nil :: Cons =
A=20
Nil
for "AB", it returns Cons A (Cons B =
Nil) :: Cons A=20
(Cons B Nil)
...
The problem is I have to specifically =
annotate the=20
output type, which is unaffordable, because I might have arbitrary-long=20
string,
and I have infinitely many =
possible singleton=20
types.
It seems it is impossible to do it in a =
type-safe=20
way. Anyone of you have any idea to walk around that?
Regards,
Kenny
module Test where
data Content =3D C1=20
Char
| C2 String deriving =
Eq
class MyType a =
where
parse ::=20
Content -> (Maybe a)
data A =3D A deriving =
(Show,Eq)
instance MyType A =
where
parse=20
(C1 'A') =3D Just A
parse _ =3D =
Nothing
data B =3D B deriving =
(Show,Eq)
instance MyType B =
where
parse=20
(C1 'B') =3D Just B
parse _ =3D =
Nothing
data Cons x xs =3D Cons x xs deriving Show
instance (MyType x,MyType xs) =3D> MyType (Cons x xs)=20
where
parse (C2 (x:xs)) =3D let maybehd =3D =
parse (C1 x)=20
in
case maybehd of=20
Just hd=20
->
let maybetl =3D parse (C2 xs)=20
in
case maybetl of=20
Just tl=20
->
Just ((Cons hd)=20
tl)
Nothing ->=20
Nothing
Nothing ->=20
Nothing
parse _ =3D Nothing
data Nil =3D Nil deriving (Show,Eq)
instance MyType Nil where
parse (C2 =
[]) =3D Just=20
Nil
parse _ =3D Nothing
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
Hugs session =
for:
/usr/share/hugs/lib/Prelude.hs
Test.hs
Type :?=20
for help
Test> parse (C2 "A") :: Maybe (Cons A Nil)
Just (Cons =
A=20
Nil)
------=_NextPart_000_000F_01C30F2D.3BEC6940--
From alethenorio@home.se Wed Apr 30 14:29:05 2003
From: alethenorio@home.se (Alexandre Weffort Thenorio)
Date: Wed, 30 Apr 2003 15:29:05 +0200
Subject: Is it possible to build in a file in a haskell program??
References: <003f01c30e9a$75397c80$0800a8c0@thenorio>
<16047.20018.342986.569557@cerise.nosuchdomain.co.uk>
Message-ID: <006001c30f1c$795e25e0$0800a8c0@thenorio>
Thanks a lot guys. "Show" seems to have solved the problem. The only weird
thing is that created file is not exactly the same size (100 bytes bigger)
but hopefully that should not be a problem. Just would like to point that
openFile function from IO library did not write the right string
representation (Just small part of it) while openFileEx in IOExts library
did write the whole thing. Maybe it is a bug? As a last question I am
curious about a thing you guys typed a lot latelly, What does the $ sign
(Dollar) does??
Thanks again
Alex
----- Original Message -----
From: "Glynn Clements"
To: "Alexandre Weffort Thenorio"
Cc: "Keith Wansbrough" ;
Sent: Wednesday, April 30, 2003 6:16 AM
Subject: Re: Is it possible to build in a file in a haskell program??
Alexandre Weffort Thenorio wrote:
> OK. Here is what happen. I wrote the small haskell program that write
> another haskell program containing a string representation of the bin
file.
>
> If use openFile function the string representation is not complete
(Doesn't
> write the whole bin file, bug maybe) but if I use openFileEx (IOExts
> Library, Lang Package) it writes the whole thing
>
> BUT both ways it still gives me a file with a binary string representation
> (Weird sings) like:
>
> module MyBinFile ( mybinfile ) where
> mybinfile :: String
> mybinfile = "Ì þs$>Ì Ì þVÌ 01o ¦·?sfÌ{%z-æÇdæÇe_
> Æe\\\\ÃàQ'%Ñàz&òÆdÑày&çÖà{ÇdÖà|Çez-ÆdçÆeç? 00
> 0...."
>
> thus of course giving me a error in character literal in third line when
> trying to run the old main (That is gonna rewrite the bin file). Any
ideas??
Use "show", e.g.
hPutStrLn outFile $ "mybinfile = " ++ show theString
--
Glynn Clements
From ddarius@hotpop.com Wed Apr 30 14:41:18 2003
From: ddarius@hotpop.com (Derek Elkins)
Date: Wed, 30 Apr 2003 09:41:18 -0400
Subject: Is it possible to build in a file in a haskell program??
In-Reply-To: <006001c30f1c$795e25e0$0800a8c0@thenorio>
References:
<003f01c30e9a$75397c80$0800a8c0@thenorio>
<16047.20018.342986.569557@cerise.nosuchdomain.co.uk>
<006001c30f1c$795e25e0$0800a8c0@thenorio>
Message-ID: <20030430094118.0000397d.ddarius@hotpop.com>
On Wed, 30 Apr 2003 15:29:05 +0200
"Alexandre Weffort Thenorio" wrote:
> Thanks a lot guys. "Show" seems to have solved the problem. The only
> weird thing is that created file is not exactly the same size (100
> bytes bigger) but hopefully that should not be a problem. Just would
> like to point that openFile function from IO library did not write the
> right string representation (Just small part of it) while openFileEx
> in IOExts library did write the whole thing. Maybe it is a bug? As a
> last question I am curious about a thing you guys typed a lot latelly,
> What does the $ sign(Dollar) does??
>
> Thanks again
>
> Alex
If the file is opened in text mode it will stop at the first EOF
character in the output. I imagine that that was the problem with
openFile.
$ is just a low precedence right associative function application. It's
mainly used to avoid parentheses. It's definition is f $ x = f x. You
can change something like f (g (h x)) into f $ g $ x.
From ddarius@hotpop.com Wed Apr 30 14:47:06 2003
From: ddarius@hotpop.com (Derek Elkins)
Date: Wed, 30 Apr 2003 09:47:06 -0400
Subject: unsafe parsing
In-Reply-To: <001601c30eea$3f203f80$22528489@comp.nus.edu.sg>
References: <001601c30eea$3f203f80$22528489@comp.nus.edu.sg>
Message-ID: <20030430094706.00003c9a.ddarius@hotpop.com>
On Wed, 30 Apr 2003 15:29:04 +0800
"Kenny Lu Zhuo Ming" wrote:
> Hi all,
>
> I am currently write a program to type a dynamic string consist of 'A'
> or 'B'
>
> for short, it works in this manner:
> for 'A', it returns A :: A
> for 'B', it returns B :: B
> for "A", it returns Cons A Nil :: Cons A Nil
> for "AB", it returns Cons A (Cons B Nil) :: Cons A (Cons B Nil)
> ...
>
> The problem is I have to specifically annotate the output type, which
> is unaffordable, because I might have arbitrary-long string, and I
> have infinitely many possible singleton types. It seems it is
> impossible to do it in a type-safe way. Anyone of you have any idea to
> walk around that?
>
>
>
> Regards,
> Kenny
Is there any reason [Either A B] couldn't be used? Otherwise, you may
want to look at the thread "polymorphic stanamically typed balanced
trees" on this list (or haskell-cafe), and/or SimulatingDependentTypes
on the Haskell Wiki (it's linked from haskell.org).
SimulatingDependentTypes also has a link to the aforementioned thread.
From alethenorio@home.se Wed Apr 30 14:56:04 2003
From: alethenorio@home.se (Alexandre Weffort Thenorio)
Date: Wed, 30 Apr 2003 15:56:04 +0200
Subject: Is it possible to build in a file in a haskell program??
References:
<003f01c30e9a$75397c80$0800a8c0@thenorio>
<16047.20018.342986.569557@cerise.nosuchdomain.co.uk>
<006001c30f1c$795e25e0$0800a8c0@thenorio>
<20030430094118.0000397d.ddarius@hotpop.com>
Message-ID: <008201c30f20$3e3a8ae0$0800a8c0@thenorio>
Yes you are right (I tested with openFile in TextMode) but as far as I can
see openFile cannot be changed to any other mode than TextMode thus openFile
does not work with binary files (.bin) whereas openFileEx can be set to
BinaryMode instead of TextMode which gives me the right output. Thanks for
pointing it out. Why isn't IO and IOExts put together in one library. For
example functions like openFile can be rewritten to work the same way as
openFileEx thus eliminating one function and making it easier for the user
not to have to compile the program with lang package.
Best Regards
NooK
----- Original Message -----
From: "Derek Elkins"
To:
Sent: Wednesday, April 30, 2003 3:41 PM
Subject: Re: Is it possible to build in a file in a haskell program??
> On Wed, 30 Apr 2003 15:29:05 +0200
> "Alexandre Weffort Thenorio" wrote:
>
> > Thanks a lot guys. "Show" seems to have solved the problem. The only
> > weird thing is that created file is not exactly the same size (100
> > bytes bigger) but hopefully that should not be a problem. Just would
> > like to point that openFile function from IO library did not write the
> > right string representation (Just small part of it) while openFileEx
> > in IOExts library did write the whole thing. Maybe it is a bug? As a
> > last question I am curious about a thing you guys typed a lot latelly,
> > What does the $ sign(Dollar) does??
> >
> > Thanks again
> >
> > Alex
>
> If the file is opened in text mode it will stop at the first EOF
> character in the output. I imagine that that was the problem with
> openFile.
>
> $ is just a low precedence right associative function application. It's
> mainly used to avoid parentheses. It's definition is f $ x = f x. You
> can change something like f (g (h x)) into f $ g $ x.
>
> _______________________________________________
> Haskell mailing list
> Haskell@haskell.org
> http://www.haskell.org/mailman/listinfo/haskell
>
From ddarius@hotpop.com Wed Apr 30 15:27:32 2003
From: ddarius@hotpop.com (Derek Elkins)
Date: Wed, 30 Apr 2003 10:27:32 -0400
Subject: Is it possible to build in a file in a haskell program??
In-Reply-To: <008201c30f20$3e3a8ae0$0800a8c0@thenorio>
References:
<003f01c30e9a$75397c80$0800a8c0@thenorio>
<16047.20018.342986.569557@cerise.nosuchdomain.co.uk>
<006001c30f1c$795e25e0$0800a8c0@thenorio>
<20030430094118.0000397d.ddarius@hotpop.com>
<008201c30f20$3e3a8ae0$0800a8c0@thenorio>
Message-ID: <20030430102732.000020c6.ddarius@hotpop.com>
On Wed, 30 Apr 2003 15:56:04 +0200
"Alexandre Weffort Thenorio" wrote:
> Yes you are right (I tested with openFile in TextMode) but as far as I
> can see openFile cannot be changed to any other mode than TextMode
> thus openFile does not work with binary files (.bin) whereas
> openFileEx can be set to BinaryMode instead of TextMode which gives me
> the right output. Thanks for pointing it out. Why isn't IO and IOExts
> put together in one library. For example functions like openFile can
> be rewritten to work the same way as openFileEx thus eliminating one
> function and making it easier for the user not to have to compile the
> program with lang package.
>
> Best Regards
>
> NooK
IO is Standard Haskell 98, IOExts are extensions (i.e.non-standard).
From gk@ninebynine.org Wed Apr 30 19:20:06 2003
From: gk@ninebynine.org (Graham Klyne)
Date: Wed, 30 Apr 2003 19:20:06 +0100
Subject: Multiparameter classes in HUGS and GHC
Message-ID: <5.1.0.14.2.20030430182613.00ba1dc8@127.0.0.1>
I've trying to understand better how to use multiparameter classes, and in
particular the things that can be declared as instances. I've consulted
the following:
[1] http://www.haskell.org/onlinereport/decls.html#sect4.3.2
[2]
http://www.haskell.org/ghc/docs/latest/html/users_guide/type-extensions.html#MULTI-PARAM-TYPE-CLASSES
(particularly 7.3.5.1 item 3)
[3] http://research.microsoft.com/Users/simonpj/Papers/type-class-design-space/
[4] http://cvs.haskell.org/Hugs/pages/hugsman/exts.html (section 7.1)
From my reading, it seems that while strict Haskell 98 does not permit
type expressions or synonyms to be declared as class instances, both GHC
and HUGS claim to relax this restriction (presumably following the analysis
in [3]).
My problem is that I can't get HUGS to accept a type expression or synonym
to be declared as an instance of a (multiparameter) class; I'm getting the
error "Illegal type in class constraint". After some wrestling with the
system, I have managed to figure how to declare instances that use type
constructors. I feel I may be missing something blindingly obvious. My
spike code is below: the uncommented sections compile OK, but the
commented-out sections do not.
#g
--
[[
class (Eq k, Show k) => Pair a k v where
newPair :: (k,v) -> a k v
getPair :: a k v -> (k,v)
newtype MyPair1 k v = P1 (Int,String)
instance Pair MyPair1 Int String where
newPair (x,y) = P1 (x,y)
getPair (P1 (x,y)) = (x,y)
data MyPair2 k v = P2 Int String
instance Pair MyPair2 Int String where
newPair (x,y) = P2 x y
getPair (P2 x y) = (x,y)
data (Eq a, Show a) => MyPair3 a b = P3 a b
instance Pair MyPair3 Int String where
newPair (x,y) = P3 x y
getPair (P3 x y) = (x,y)
{-
-- The following DO NOT work because instances
-- "must take the form of a type constructor T applied
-- to simple type variables" (though this may be relaxed
-- in the multiparameter case: see [1]).
--
-- Apparently, GHC *does* allow this, though HUGS
-- apparently does not, though it does claim to [2].
--
-- [1]
http://research.microsoft.com/Users/simonpj/Papers/type-class-design-space/
--
-- [2] http://cvs.haskell.org/Hugs/pages/hugsman/exts.html (section 7.1)
-}
type MyPair4 k v = (k,v)
{-
instance Pair (Int,String) Int String where
newPair = id
getPair = id
instance Pair (MyPair4 Int String) Int String where
newPair = id
getPair = id
instance Pair (MyPair4 k v) Int String where
newPair = id
getPair = id
-}
]]
I'm using the November 2002 release of HUGS with Hugs extensions enabled:
[[
Current settings: +fewuiRWX -stgGl.qQkoOIHTN -h250000 -p"%s> " -r$$ -c40
Search path :
-P{Hugs}\lib:{Hugs}\lib\exts:{Hugs}\lib\win32:{Hugs}\lib\hugs;
{Hugs}\libraries\HUnit-1.0
Project Path :
Source suffixes : -S.hs;.lhs
Editor setting : -E"C:\\Program Files\\TextPad 4\\TextPad.exe"
Preprocessor : -F
Compatibility : Hugs Extensions (-98)
]]
-------------------
Graham Klyne
PGP: 0FAA 69FF C083 000B A2E9 A131 01B9 1C7A DBCA CB5E
From heringto@cs.unc.edu Wed Apr 30 19:45:52 2003
From: heringto@cs.unc.edu (Dean Herington)
Date: Wed, 30 Apr 2003 14:45:52 -0400
Subject: Multiparameter classes in HUGS and GHC
References: <5.1.0.14.2.20030430182613.00ba1dc8@127.0.0.1>
Message-ID: <3EB019E0.CBE76E3D@cs.unc.edu>
Graham Klyne wrote:
> class (Eq k, Show k) => Pair a k v where
> newPair :: (k,v) -> a k v
> getPair :: a k v -> (k,v)
>
> type MyPair4 k v = (k,v)
>
> instance Pair (Int,String) Int String where
> newPair = id
> getPair = id
The kinds are wrong here. `Pair` takes as its first argument a type constructor of kind: * -> * -> *.
The following works (with appropriate extensions enabled):
instance Pair (,) Int String where
newPair = id
getPair = id
> instance Pair (MyPair4 Int String) Int String where
> newPair = id
> getPair = id
Again the kinds are wrong. However, you can't make a Pair instance out of MyPair4 because the latter is
a `type` rather than `newtype` or `data`.
Hope this helps.
Dean
From oleg@pobox.com Wed Apr 30 21:18:51 2003
From: oleg@pobox.com (oleg@pobox.com)
Date: Wed, 30 Apr 2003 13:18:51 -0700 (PDT)
Subject: Deeply uncurried products, as categorists might like them
Message-ID: <200304302018.h3UKIpoB086928@adric.fnmoc.navy.mil>
This is a belated answer to a Haskell-categorical question posted two
years ago on comp.lang.functional [1]:
] It is common in (say) category theory to write
]
] max3 = max . (max * id)
Can we write this in Haskell? Specifically, can we write something
more complex:
max7 = max3 . ((max2 * max3) * max2)
We show that we can, exactly in this notation (modulo alpha
conversion). A potentially useful side-effect is a deep uncurrying of
arbitrarily complex pairs, such as ((1,2),(3,(4,5)))
The simplest max3 can be expressed in the desired form:
*> prod x y = \(argx,argy) -> ((x argx),(y argy))
*> max2 x y = if x < y then y else x
*>
*> max3:: Ord a => a->a->a->a
*> max3 = (curry (curry ((uncurry max2) . ((uncurry max2) `prod` id))))
Alas, the solution uses too much curry to be
palatable. Generalizations to longer functions are mind-racking. Thus
the problem is how to get the compiler (GHC) put and take the right
amount of curry automatically.
It seems that a polyvariadic composition combinator [2] can help. The
combinator is specified as follows: given
f:: a1->a2->.... ->cp, where cp is not functional
and g:: cp->d
then
f `mcomp` g:: a1->a2->.... ->d
of obvious meaning. In the simplest case of f::a->b (b not
functional), "f `mcomp` g = g . f" . For a reason I can't recall
`mcomp` has the reverse order of arguments compared to the regular
composition. Given such a combinator, defined in the
appendix, we can introduce a categorical product as
*> prod f g = f `mcomp` (\fresult -> g `mcomp` (\gresult -> (fresult,gresult)))
or, after some eta-reductions,
*> prod f g = mcomp f ((mcomp g) . (,))
Given two functions,
f:: a1->a2->...->an->c |c,d non-exponential types
g:: b1->b2->...->bn->d
their product f `prod` g:: a1->a2->...->an->b1->b2->...->bn->(c,d)
The number of as and bs is arbitrary.
We can subject the expression for prod to even more eta-reductions,
yielding the following compact, combinational definition:
> prod:: (MCompose a b (c -> d) e, MCompose f g (b,g) d) =>
> (h -> a) -> (c -> f) -> h -> e
> prod = (. ((. (,)) . mcomp)) . mcomp
The constraints in the prod's type are intricately related. The final
expression for prod bears some similarity with Unlambda code. Perhaps
because both Unlambda and the category theory eschew "elements" in
favor of combinations of arrows. Probably there are other
similarities.
Now we are ready to define our maxima. To make our approach truly
polymorphic, we have to restrict it first by the following
declaration. It's not much a restriction because the type under the
wrapper can be anything at all. Unfortunately, the intuitionist logic of
class instances makes it impossible to say directly "forall x. (NOT
Constraint x)". Thus we have to resort to the contortions:
> newtype W a = W a deriving Show
We also need a projected identity and the basic max:
> tid:: (Ord a) => (W a)->(W a)
> tid = id
> max2 (W x) (W y) = if x < y then W y else W x
We also need to "invert" the prod operation -- to deeply uncurry
arbitrarily complex pairs.
> -- An uncurrying application: flattening the product
> class FApp f a c | a c -> f where
> fapp:: f -> a -> c
>
> instance FApp (Char->c) Char c where
> fapp = ($)
>
> instance FApp ((W a)-> c) (W a) c where
> fapp = ($)
>
> instance (FApp fx a r, FApp r b c) => FApp fx (a,b) c where
> fapp f = uncurry (fapp . (fapp f))
> -- test
> fappt = fapp (\a b c d e -> [a,b,c,d,e]) (('a','b'),('c',('d','e')))
Combinators fapp and mcomp will occur together. Therefore, we define
> fcomp a = (. fapp) (mcomp a)
That expression can be further reduced to "fcomp = (. fapp) . mcomp"
However, doing so blows the Unlambda fuse in GHC.
Now we can indeed write our maxima:
> max3:: Ord a => W a->W a->W a->W a
> max3 = (max2 `prod` tid) `fcomp` max2
which looks almost the same as the categorical expression for max3.
We can easily generalize:
> max4:: Ord a => W a->W a->W a->W a -> W a
> max4 = (max2 `prod` max2) `fcomp` max2
which would, in the categorical notation, be written as
max2 . (max2 * max2)
Our notation is almost a literal translation. There are other
expressions for max4, for the other commuting branches:
> -- max41 = max2 . (max3 * id)
> max41:: Ord a => W a->W a->W a->W a -> W a
> max41 = (max3 `prod` tid) `fcomp` max2
> -- max42 = max2 . (id * max3)
> max42:: Ord a => W a->W a->W a->W a -> W a
> max42 = (tid `prod` max3) `fcomp` max2
> -- max51 = max2 . ((max2 * id) . (max2 * max2))
> max51:: Ord a => W a->W a->W a->W a -> W a -> W a
> max51 = ((max2 `prod` max2) `fcomp` (max2 `prod` tid)) `fcomp` max2
And finally,
> max7:: Ord a => W a->W a->W a->W a->W a->W a->W a->W a
> max7 = ((max2 `prod` max3) `prod` max2) `fcomp` max3
>
> max7t = max7 (W 'a') (W 'b') (W 'c') (W 'd') (W 'e') (W 'f') (W 'g')
Perhaps the wrapper W also has some categorical significance.
[1] "Re: On products and max3"
A thread on a newsgroup comp.lang.functional, Thu, 12 Apr 2001 02:14:27 +0000
[2] http://pobox.com/~oleg/ftp/Haskell/polyvar-comp.lhs
The code was originally posted as "Re: composition" on
a newsgroup comp.lang.functional on Wed, 30 Oct 2002 19:09:32 -0800
Appendix: polyvariadic composition, to make this whole code work.
Excerpted from [2].
Compilation flags: -fglasgow-exts
> class MCompose f2 cp gresult result | f2 cp gresult -> result, f2->cp
> where
> mcomp:: (f1->f2) -> (cp->gresult) -> (f1 -> result)
>
> -- Class instances. Please keep in mind that cp must be a non-functional type
> -- and f2 and cp must be the same. These instances enumerate the base cases.
>
> instance MCompose (Maybe b) (Maybe b) c c where
> --mcomp f::(a->(Maybe b)) g::((Maybe b)->c) :: a->c
> mcomp f g = g . f
>
> instance MCompose [b] [b] c c where
> --mcomp f::(a->[b]) g::([b]->c) :: a->c
> mcomp f g = g . f
>
> instance MCompose Int Int c c where
> --mcomp f::(a->Int) g::(Int->c) :: a->c
> mcomp f g = g . f
>
> instance MCompose Char Char c c where
> --mcomp f::(a->Char) g::(Char->c) :: a->c
> mcomp f g = g . f
>
> instance MCompose (W a) (W a) c c where
> --mcomp f::(x->(W a)) g::((W a)->c) :: x->c
> mcomp f g = g . f
>
> instance MCompose (a,b) (a,b) c c where
> mcomp f g = g . f
>
> -- Induction case
> instance (MCompose f2 cp gresult result) =>
> MCompose (f1->f2) cp gresult (f1->result) where
> mcomp f g = \a -> mcomp (f a) g
>
From oleg@pobox.com Wed Apr 30 23:48:11 2003
From: oleg@pobox.com (oleg@pobox.com)
Date: Wed, 30 Apr 2003 15:48:11 -0700 (PDT)
Subject: GHC doesn't like its own type?
Message-ID: <200304302248.h3UMmBaA087146@adric.fnmoc.navy.mil>
The previously message "Deeply uncurried products, as categorists
might like them" can be used to demonstrate certain behavior of GHC
that seems a bit odd. If we save the text of that message in a file,
/tmp/a.lhs, we can load it into GHC:
$ ghci -fglasgow-exts /tmp/a.lhs
GHC Interactive, version 5.04.1
Ok, modules loaded: Main.
*Main>
The whole code loads and typechecks. The code contains the following
definition, without an explicit type signature:
> fcomp a = (. fapp) (mcomp a)
We can ask GHCi to tell us the type of fcomp:
*Main> :type fcomp
forall result f1 a f2 c cp.
(FApp a cp c, MCompose f2 cp c result) =>
(f1 -> f2) -> a -> f1 -> result
and make that type, verbatim, to be the signature of fcomp:
> fcomp:: forall result f1 a f2 c cp. (FApp a cp c, MCompose f2 cp c result) => (f1 -> f2) -> a -> f1 -> result
> fcomp a = (. fapp) (mcomp a)
If we reload the file, we get an error:
/tmp/a.lhs:124:
Could not deduce (FApp a cp c1)
from the context (FApp a cp c, MCompose f2 cp c result)
Probable fix:
Add (FApp a cp c1) to the type signature(s) for `fcomp'
arising from use of `fapp' at /tmp/a.lhs:124
In the second argument of `(.)', namely `fapp'
In the definition of `fcomp': (. fapp) (mcomp a)
/tmp/a.lhs:124:
Could not deduce (MCompose f2 cp c1 result)
from the context (FApp a cp c, MCompose f2 cp c result)
Probable fix:
Add (MCompose f2 cp c1 result) to the type signature(s) for `fcomp'
arising from use of `mcomp' at /tmp/a.lhs:124
In the first argument of `(. fapp)', namely `(mcomp a)'
In the definition of `fcomp': (. fapp) (mcomp a)
I used to think that the inferred type is the most general type, and
that the compiler would accept as explicit the type that it itself
inferred. I was wrong?
The second odd circumstance is best illustrated by the following
transcript. Assume that /tmp/a.lhs is the text of the previous message
as it was posted:
$ ghci -fglasgow-exts /tmp/a.lhs
GHC Interactive, version 5.04.1, for Haskell 98.
Loading package base ... linking ... done.
Loading package haskell98 ... linking ... done.
Compiling Main ( /tmp/a.lhs, interpreted )
/tmp/a.lhs:76: Warning: No 'main' defined in module Main
Ok, modules loaded: Main.
*Main> let x = \f -> fapp f (('a','b'),('c',('d','e')))
Bus error (core dumped)
Incidentally, if I enter
> x = \f -> fapp f (('a','b'),('c',('d','e')))
into /tmp/a.lhs and load the file into GHCi, I get
ghc-5.04.1: panic! (the `impossible' happened, GHC version 5.04.1):
rdrNameModule zddFApp
From levent.erkok@intel.com Wed Apr 30 23:57:51 2003
From: levent.erkok@intel.com (Erkok, Levent)
Date: Wed, 30 Apr 2003 15:57:51 -0700
Subject: GHC doesn't like its own type?
Message-ID: <88FA49DAE6B6D611AD740002A5072D3C0496BF92@orsmsx111.jf.intel.com>
Sometimes ghc/hugs will reject a program when you provide a type signature
that it can deduce itself. This has been observed before: See Simon PJ's
message:
http://www.mail-archive.com/haskell@haskell.org/msg06764.html
Of course, the "bus error" and the "panic" are truly GHC bugs, you might be
better off reporting them at:
http://sourceforge.net/tracker/?group_id=8032&atid=108032
-Levent.
> -----Original Message-----
> From: oleg@pobox.com [mailto:oleg@pobox.com]
> Sent: Wednesday, April 30, 2003 3:48 PM
> To: haskell@haskell.org
> Subject: GHC doesn't like its own type?
>
>
> The previously message "Deeply uncurried products, as categorists
> might like them" can be used to demonstrate certain behavior of GHC
> that seems a bit odd. If we save the text of that message in a file,
> /tmp/a.lhs, we can load it into GHC:
>
> $ ghci -fglasgow-exts /tmp/a.lhs
> GHC Interactive, version 5.04.1
> Ok, modules loaded: Main.
> *Main>
>
> The whole code loads and typechecks. The code contains the following
> definition, without an explicit type signature:
>
> > fcomp a = (. fapp) (mcomp a)
>
> We can ask GHCi to tell us the type of fcomp:
>
> *Main> :type fcomp
> forall result f1 a f2 c cp.
> (FApp a cp c, MCompose f2 cp c result) =>
> (f1 -> f2) -> a -> f1 -> result
>
> and make that type, verbatim, to be the signature of fcomp:
>
> > fcomp:: forall result f1 a f2 c cp. (FApp a cp c, MCompose f2 cp c
> result) => (f1 -> f2) -> a -> f1 -> result
> > fcomp a = (. fapp) (mcomp a)
>
> If we reload the file, we get an error:
>
> /tmp/a.lhs:124:
> Could not deduce (FApp a cp c1)
> from the context (FApp a cp c, MCompose f2 cp c result)
> Probable fix:
> Add (FApp a cp c1) to the type signature(s) for `fcomp'
> arising from use of `fapp' at /tmp/a.lhs:124
> In the second argument of `(.)', namely `fapp'
> In the definition of `fcomp': (. fapp) (mcomp a)
>
> /tmp/a.lhs:124:
> Could not deduce (MCompose f2 cp c1 result)
> from the context (FApp a cp c, MCompose f2 cp c result)
> Probable fix:
> Add (MCompose f2 cp c1 result) to the type signature(s) for
> `fcomp'
> arising from use of `mcomp' at /tmp/a.lhs:124
> In the first argument of `(. fapp)', namely `(mcomp a)'
> In the definition of `fcomp': (. fapp) (mcomp a)
>
> I used to think that the inferred type is the most general type, and
> that the compiler would accept as explicit the type that it itself
> inferred. I was wrong?
>
> The second odd circumstance is best illustrated by the following
> transcript. Assume that /tmp/a.lhs is the text of the previous message
> as it was posted:
>
> $ ghci -fglasgow-exts /tmp/a.lhs
> GHC Interactive, version 5.04.1, for Haskell 98.
> Loading package base ... linking ... done.
> Loading package haskell98 ... linking ... done.
> Compiling Main ( /tmp/a.lhs, interpreted )
>
> /tmp/a.lhs:76: Warning: No 'main' defined in module Main
> Ok, modules loaded: Main.
> *Main> let x = \f -> fapp f (('a','b'),('c',('d','e')))
> Bus error (core dumped)
>
> Incidentally, if I enter
> > x = \f -> fapp f (('a','b'),('c',('d','e')))
> into /tmp/a.lhs and load the file into GHCi, I get
>
> ghc-5.04.1: panic! (the `impossible' happened, GHC version 5.04.1):
> rdrNameModule zddFApp
> _______________________________________________
> Haskell mailing list
> Haskell@haskell.org
> http://www.haskell.org/mailman/listinfo/haskell
From gk@ninebynine.org Wed Apr 30 21:26:06 2003
From: gk@ninebynine.org (Graham Klyne)
Date: Wed, 30 Apr 2003 21:26:06 +0100
Subject: Multiparameter classes in HUGS and GHC
In-Reply-To: <3EB019E0.CBE76E3D@cs.unc.edu>
References: <5.1.0.14.2.20030430182613.00ba1dc8@127.0.0.1>
Message-ID: <5.1.0.14.2.20030430210825.032057a8@127.0.0.1>
At 14:45 30/04/2003 -0400, Dean Herington wrote:
>Again the kinds are wrong. However, you can't make a Pair instance out of
>MyPair4 because the latter is
>a `type` rather than `newtype` or `data`.
>
>Hope this helps.
Yes, very much, thank you.
If I now have this right, it's the distinction between a parametric
polymorphic type and an algebraic type constructor that I had failed to
properly appreciate. Now I'm alerted to it, I don't know why I didn't
realize sooner that something there was wrong.
I discover that I can also use:
[[
type MyPair5 = (,)
instance Pair MyPair5 Int String where
newPair = id
getPair = id
]]
though I'm not sure how MyPair5 is interpreted as a type synonym ;-)
There's a small matter that still puzzles me a little. In:
[[
data (Eq a, Show a) => MyPair3 a b = P3 a b
instance Pair MyPair3 Int String where
newPair (x,y) = P3 x y
getPair (P3 x y) = (x,y)
]]
(which seems OK), "Pair3" is a type _expression_ of kind (* -> * -> *), the
corresponding _constructor_ for which is P3. Yet, according to [1], "(,)"
is a type _constructor_. I guess there may be some terminological
crossover here as type constructors often use the same name as the
corresponding type expression?
[1] http://haskell.org/onlinereport/decls.html#sect4.1.2
#g
-------------------
Graham Klyne
PGP: 0FAA 69FF C083 000B A2E9 A131 01B9 1C7A DBCA CB5E