X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FdeSugar%2FDsMeta.hs;h=11a53233b03e6c216d21caff1ab5ecc36e1666db;hb=ff8e1d01524b48e028b09e2b04b2e5303cb6d95f;hp=f24641213d3967fbd7b670779ef659fa10ac8150;hpb=ab22f4e6456820c1b5169d75f5975a94e61f54ce;p=ghc-hetmet.git diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs index f246412..11a5323 100644 --- a/compiler/deSugar/DsMeta.hs +++ b/compiler/deSugar/DsMeta.hs @@ -33,7 +33,6 @@ import qualified Language.Haskell.TH as TH import HsSyn import Class import PrelNames -import OccName -- To avoid clashes with DsMeta.varName we must make a local alias for -- OccName.varName we do this by removing varName from the import of -- OccName above, making a qualified instance of OccName and using @@ -42,10 +41,8 @@ import qualified OccName import Module import Id -import OccName import Name import NameEnv -import Type import TcType import TyCon import TysWiredIn @@ -398,6 +395,7 @@ repPred (HsClassP cls tys) = do tcon <- repTy (HsTyVar cls) tys1 <- repLTys tys repTapps tcon tys1 +repPred p@(HsEqualP _ _) = notHandled "Equational constraint" (ppr p) repPred p@(HsIParam _ _) = notHandled "Implicit parameter constraint" (ppr p) -- yield the representation of a list of types @@ -529,11 +527,11 @@ repE e@(ExplicitPArr ty es) = notHandled "Parallel arrays" (ppr e) repE e@(ExplicitTuple es boxed) | isBoxed boxed = do { xs <- repLEs es; repTup xs } | otherwise = notHandled "Unboxed tuples" (ppr e) -repE (RecordCon c _ flds) +repE (RecordCon c _ (HsRecordBinds flds)) = do { x <- lookupLOcc c; fs <- repFields flds; repRecCon x fs } -repE (RecordUpd e flds _ _) +repE (RecordUpd e (HsRecordBinds flds) _ _ _) = do { x <- repLE e; fs <- repFields flds; repRecUpd x fs } @@ -566,6 +564,7 @@ repE (HsSpliceE (HsSplice n _)) repE e@(PArrSeq {}) = notHandled "Parallel arrays" (ppr e) repE e@(HsCoreAnn {}) = notHandled "Core annotations" (ppr e) repE e@(HsSCC {}) = notHandled "Cost centres" (ppr e) +repE e@(HsTickPragma {}) = notHandled "Tick Pragma" (ppr e) repE e@(HsBracketOut {}) = notHandled "TH brackets" (ppr e) repE e = notHandled "Expression form" (ppr e) @@ -702,8 +701,8 @@ rep_val_binds (ValBindsOut binds sigs) = do { core1 <- rep_binds' (unionManyBags (map snd binds)) ; core2 <- rep_sigs' sigs ; return (core1 ++ core2) } -rep_val_binds (ValBindsOut binds sigs) - = panic "rep_val_binds: ValBindsOut" +rep_val_binds (ValBindsIn binds sigs) + = panic "rep_val_binds: ValBindsIn" rep_binds :: LHsBinds Name -> DsM [Core TH.DecQ] rep_binds binds = do { binds_w_locs <- rep_binds' binds @@ -1267,10 +1266,13 @@ mk_integer i = do integer_ty <- lookupType integerTyConName return $ HsInteger i integer_ty mk_rational r = do rat_ty <- lookupType rationalTyConName return $ HsRat r rat_ty +mk_string s = do string_ty <- lookupType stringTyConName + return $ HsString s repOverloadedLiteral :: HsOverLit Name -> DsM (Core TH.Lit) repOverloadedLiteral (HsIntegral i _) = do { lit <- mk_integer i; repLiteral lit } repOverloadedLiteral (HsFractional f _) = do { lit <- mk_rational f; repLiteral lit } +repOverloadedLiteral (HsIsString s _) = do { lit <- mk_string s; repLiteral lit } -- The type Rational will be in the environment, becuase -- the smart constructor 'TH.Syntax.rationalL' uses it in its type, -- and rationalL is sucked in when any TH stuff is used