Add TH support for type-level literals.
authorIavor S. Diatchki <iavor.diatchki@gmail.com>
Thu, 15 Mar 2012 07:05:55 +0000 (00:05 -0700)
committerIavor S. Diatchki <iavor.diatchki@gmail.com>
Thu, 15 Mar 2012 07:05:55 +0000 (00:05 -0700)
compiler/hsSyn/Convert.lhs
compiler/typecheck/TcSplice.lhs

index 4bff46c..0072abc 100644 (file)
@@ -297,6 +297,7 @@ cvt_tyinst_hdr cxt tc tys
            }
     collect (SigT (VarT tv) ki) = return [KindedTV tv ki]
     collect (SigT ty _)         = collect ty
+    collect (LitT _)    = return []
 
 -------------------------------------------------------------------
 --             Partitioning declarations
index 79f4169..1ff9dc1 100644 (file)
@@ -1303,7 +1303,7 @@ reifyFamilyInstance fi
 reifyType :: TypeRep.Type -> TcM TH.Type
 -- Monadic only because of failure
 reifyType ty@(ForAllTy _ _)        = reify_for_all ty
-reifyType (LitTy {})        = failWith $ ptext $ sLit "Type-level literal canont be reifyed yet."
+reifyType (LitTy t)         = do { r <- reifyTyLit t; return (TH.LitT r) }
 reifyType (TyVarTy tv)      = return (TH.VarT (reifyName tv))
 reifyType (TyConApp tc tys) = reify_tc_app tc tys   -- Do not expand type synonyms here
 reifyType (AppTy t1 t2)     = do { [r1,r2] <- reifyTypes [t1,t2] ; return (r1 `TH.AppT` r2) }
@@ -1320,6 +1320,10 @@ reify_for_all ty
   where
     (tvs, cxt, tau) = tcSplitSigmaTy ty
 
+reifyTyLit :: TypeRep.TyLit -> TcM TH.TyLit
+reifyTyLit (NumTyLit n) = return (TH.NumTyLit n)
+reifyTyLit (StrTyLit s) = return (TH.StrTyLit (unpackFS s))
+
 reifyTypes :: [Type] -> TcM [TH.Type]
 reifyTypes = mapM reifyType