Type of a self build let expression

[Sven Urbanski]

Hi ghc-users,

I'm having trouble reconstructing a specific let expression.

Let's assume we have the following file Main.hs:

module Main where

data HList b = Null
            | Node b (HList b)

foo2 :: e -> Int
foo2 n = len (pow Null (42::Int))

len :: HList a -> Int
len Null = 0

pow :: HList a -> a -> HList a
pow h x = h


Now I can calculate the type in ghci:

:t let (_,x) = (pow x (42::Int), Null) in x

which prints:
let (_,x) = (pow x (42::Int), Null) in x :: HList Int
or short:
HList Int

This is exactly what I need.

Note that this is not the same as
:t let x = Null in x

The type of x depends on the context.
Or in other words: I want to know the most general type of a parameter
of a function
when all other parameters of that function are given.


So I wrote a function to create such a LetExpr with the ghc api. Then
I can calculate the type of the LetExpr.
My function returns some let expr but the result of the calculation of
the type is different.
The resulting type of my function is always: HList b.


The problem is, during construction I have to give the variable "x" a
type, which in this case is "HList b".
It seems that to create a HsVar I already need to know the type of the HsVar
(but I don't, that's kind of the purpose of the function).

How can i calculate the type like in ghci?

I am using ghc 6.12.3.

I would very much appreciate any help.

The rest of this mail contains the functions that I use to create the LetExpr.

Thanks,
Sven


makeLocalVar :: Type -> Unique -> OccName -> Id
makeLocalVar t u occn = mkLocalVar VanillaId (mkSystemName u occn) t
vanillaIdInfo


replaceFirstParam :: HsExpr Id -> HsExpr Id -> HsExpr Id
replaceFirstParam (HsApp (L noSrcSpan (HsApp l1 r1)) r2) param = HsApp
(noLoc $ HsApp l1 (noLoc param)) r2
replaceFirstParam (HsApp l r) param = HsApp l (noLoc param)
replaceFirstParam f x = error ("unknown type for replaceFirstParam!"
++ showOutputable f)


makeLetExpr :: HsExpr Id -> HsExpr Id -> DsM (HsExpr Id)
makeLetExpr e@(HsVar id) parent = trace ("let parent: " ++
showOutputable parent ++ "; expr: " ++ showOutputable e) $ do
  supply  <- getUniqueSupplyM
  typeX   <- hsExpr2TypeDo e
  let uniqName   = uniqFromSupply supply :: Unique
            -- the let construct:
      hslet      = HsLet locbinds lhsExpr
      lhsExpr    = noLoc hsExpr :: LHsExpr Id -- the very right side
of the let (the part after 'in') ...
      hsExpr     = HsVar locVarX :: HsExpr Id  -- is "the_x"!

      locVarX    = makeLocalVar typeX uniqName occnX :: Id
      occnX      = mkVarOcc "x" :: OccName
      locVarUndef= makeLocalVar typeUndef uniqName occn_ :: Id
      occn_      = mkVarOcc "underscore" :: OccName

            -- right side of the expr (e.g. '(pow x, bar Null)'):
      rhs_       = L noSrcSpan _expr :: LHsExpr Id
      rhsX       = L noSrcSpan xexpr :: LHsExpr Id
      _expr      = replaceFirstParam parent hsExpr :: HsExpr Id
      xexpr      = e :: HsExpr Id

            -- the_x = xyz
      vbindUndef = VarBind locVarUndef rhs_ :: HsBindLR Id Id
      vbindX     = VarBind locVarX rhsX :: HsBindLR Id Id

      locbinds   = bt :: HsLocalBinds Id
      bt         = HsValBinds lr :: HsLocalBindsLR Id Id
      recflag    = NonRecursive :: RecFlag
      lhsbinds   = listToBag [noLoc vbindX] :: LHsBinds Id
      lhsbinds2  = listToBag [noLoc vbindUndef] :: LHsBinds Id
      lr         = ValBindsOut [(recflag, lhsbinds2), (recflag,
lhsbinds)] [] :: HsValBindsLR Id Id

      typeUndef  = error "dont know the type!"
  return $ trace ("let replace:" ++ showOutputable _expr ++ "\nlet
res:" ++ showOutputable hslet) $ hslet


hsExpr2TypeDo :: HsExpr Id -> DsM Type
hsExpr2TypeDo hsexpr = do
  let ioCoreE = dsExpr hsexpr
  x <- ioCoreE
  return (exprType x)