|
Matthew You’d probably find it helpful to
look at the data type in HsExpr, which has at least some comments. You probably want to add –dppr-debug
when printing this stuff. Without –dppr-debug, GHC doesn’t
print all the uniques so all the $dnum’s look the same, but they are
really different! (It’s a bit of a bug that it every prints in such
a confusing way.) The HsExpr tree is decorated here and
there with types. In HsExpr (and other HsSyn files) a PostTcType is a field
that is bottom before type checking, but which is “filled in” by
the type checker. Furthermore, each Id has a type, which you can get by
calling idType :: Id -> Type. In the case of overloaded literals like “1”,
we generate an HsOverLit, which is defined in HsLit and used by the HsLit
constructor in HsExpr. The HsOverlit is decorated with a conversion
function (a “SyntaxExpr”, which is just a synonym for HsExpr),
which converts from an Integer to whatever the type the literal has. (Or
from Rational in the case of a literal like 3.2.) So what you want
is the type of this _expression_; it’ll be Integer -> <the type you
want>. Unfortunately, while there is no technical
difficulty with writing hsExprType
:: HsExpr Id -> Type it doesn’t currently exist,
because GHC hasn’t needed it until now. A related function,
hsPatType *does* exist (in
TcHsSyn). If it’d be useful to you, you could write it, and we
could put it back into GHC. I’m sure others would find it
useful too. I’m copying GHC developers for
general interest. Simon From:
Matthew Fuchs Simon, I’m back after vacation and fooling around with
GHC again. I haven’t tried the wiki yet, but I do have a
question. If I take a module, such as: module Itest where pluster 1 = (+) pluster 2 = (-) foobar = ((pluster 1)
((pluster 2) 3 4)
(pluster
((pluster 2) 4 3) 3 3)) and run it through checkedModule, I get back a
complex structure. If I just pull out the typecheckedSource, I get the
listing below (as printed by ppr). I’m trying to pull this apart to
figure out what the pieces are. In particular, how do I determine from
this (or rather, how does my program) determine that 1, 2, 3, and 4, are
Integers and not some other Num? And is there any way to tell that the
application (pluster 1) when it appears in the code will result in a function
from Integer->Integer without needing to analyze the signature of pluster? Thanks, Matthew [AbsBinds [a, a] [$dNum,
$dNum] [Itest.pluster <= [a, a] pluster] Itest.pluster
[T] :: forall a a.
(GHC.Num.Num a, GHC.Num.Num a) =>
a -> a -> a -> a
[] { - =
(GHC.Num.-) a $dNum ==
= (GHC.Base.==) a $dEq
$dEq = GHC.Num.$p1Num a $dNum
lit_ayQ = fromInteger 2
fromInteger = GHC.Num.fromInteger a $dNum + =
(GHC.Num.+) a $dNum
$dNum = $dNum ==
= (==)
lit_ayS = fromInteger 1
fromInteger = fromInteger
pluster 1 = (+)
pluster 2 = (-) }, AbsBinds [] []
[Itest.foobar <= [] foobar] Itest.foobar
[T] :: GHC.Num.Integer [] { lit_ayU =
fromInteger 3
fromInteger = GHC.Num.fromInteger GHC.Num.Integer $dNum
lit_ayZ = lit_ayU
lit_az0 = fromInteger 3
fromInteger = GHC.Num.fromInteger GHC.Num.Integer $dNum lit_az1
= fromInteger 4
fromInteger = fromInteger
lit_az2 = fromInteger 2
fromInteger = GHC.Num.fromInteger GHC.Num.Integer $dNum
pluster = Itest.pluster [GHC.Num.Integer, GHC.Num.Integer]
[$dNum, $dNum]
$dNum = $dNum
$dNum = $dNum
pluster = Itest.pluster [GHC.Num.Integer, GHC.Num.Integer]
[$dNum, $dNum]
$dNum = $dNum
$dNum = $dNum
lit_az6 = fromInteger 4
fromInteger = fromInteger
lit_ayT = lit_ayU
lit_az7 = fromInteger 2
fromInteger = GHC.Num.fromInteger GHC.Num.Integer $dNum
pluster = Itest.pluster [GHC.Num.Integer, GHC.Num.Integer]
[$dNum, $dNum]
$dNum = $dNum
$dNum = $dNum
lit_aza = fromInteger 1
fromInteger = GHC.Num.fromInteger GHC.Num.Integer $dNum
pluster = Itest.pluster [GHC.Num.Integer, GHC.Num.Integer]
[$dNum, $dNum]
$dNum = $dNum
$dNum = $dNum
foobar = ((pluster 1) ((pluster 2) 3 4)
(pluster ((pluster 2) 4 3) 3 3)) }, $dNum = GHC.Num.$f3,
$dNum = GHC.Num.$f3, $dNum = GHC.Num.$f3, $dNum = GHC.Num.$f3,
$dNum = GHC.Num.$f3] |
_______________________________________________ Cvs-ghc mailing list [EMAIL PROTECTED] http://www.haskell.org/mailman/listinfo/cvs-ghc
