\begin{code}
module Convert( convertToHsExpr, convertToPat, convertToHsDecls,
- convertToHsType, thRdrNameGuesses ) where
+ convertToHsType, convertToHsPred,
+ thRdrNameGuesses ) where
import HsSyn as Hs
import qualified Class
convertToHsType loc t
= initCvt loc $ wrapMsg "type" t $ cvtType t
+convertToHsPred :: SrcSpan -> TH.Pred -> Either Message (LHsPred RdrName)
+convertToHsPred loc t
+ = initCvt loc $ wrapMsg "type" t $ cvtPred t
+
-------------------------------------------------------------------
newtype CvtM a = CvtM { unCvtM :: SrcSpan -> Either Message a }
-- Push down the source location;
Unsafe -> PlayRisky
Safe -> PlaySafe False
Threadsafe -> PlaySafe True
+ Interruptible -> PlayInterruptible
cvtForD (ExportF callconv as nm ty)
= do { nm' <- vNameL nm
= defaultInlinePragma
cvtInlineSpec (Just (TH.InlineSpec inline conlike opt_activation))
= InlinePragma { inl_act = opt_activation', inl_rule = matchinfo
- , inl_inline = inline, inl_sat = Nothing }
+ , inl_inline = inl_spec, inl_sat = Nothing }
where
matchinfo = cvtRuleMatchInfo conlike
opt_activation' = cvtActivation opt_activation
cvtRuleMatchInfo False = FunLike
cvtRuleMatchInfo True = ConLike
+ inl_spec | inline = Inline
+ | otherwise = NoInline
+ -- Currently we have no way to say Inlinable
+
cvtActivation Nothing | inline = AlwaysActive
| otherwise = NeverActive
cvtActivation (Just (False, phase)) = ActiveBefore phase
; return $ HsLam (mkMatchGroup [mkSimpleMatch ps' e']) }
cvt (TupE [e]) = cvt e -- Singleton tuples treated like nothing (just parens)
cvt (TupE es) = do { es' <- mapM cvtl es; return $ ExplicitTuple (map Present es') Boxed }
- cvt (CondE x y z) = do { x' <- cvtl x; y' <- cvtl y; z' <- cvtl z
- ; return $ HsIf x' y' z' }
+ cvt (CondE x y z) = do { x' <- cvtl x; y' <- cvtl y; z' <- cvtl z;
+ ; return $ HsIf (Just noSyntaxExpr) x' y' z' }
cvt (LetE ds e) = do { ds' <- cvtLocalDecs (ptext (sLit "a let expression")) ds
; e' <- cvtl e; return $ HsLet ds' e' }
cvt (CaseE e ms)
cvtLit (FloatPrimL f) = do { force f; return $ HsFloatPrim f }
cvtLit (DoublePrimL f) = do { force f; return $ HsDoublePrim f }
cvtLit (CharL c) = do { force c; return $ HsChar c }
-cvtLit (StringL s)
- = do { let { s' = mkFastString s }
- ; force s'
- ; return $ HsString s'
- }
+cvtLit (StringL s) = do { let { s' = mkFastString s }
+ ; force s'
+ ; return $ HsString s' }
+cvtLit (StringPrimL s) = do { let { s' = mkFastString s }
+ ; force s'
+ ; return $ HsStringPrim s' }
cvtLit _ = panic "Convert.cvtLit: Unexpected literal"
-- cvtLit should not be called on IntegerL, RationalL
-- That precondition is established right here in
; return $ ConPatIn c' $ Hs.RecCon (HsRecFields fs' Nothing) }
cvtp (ListP ps) = do { ps' <- cvtPats ps; return $ ListPat ps' void }
cvtp (SigP p t) = do { p' <- cvtPat p; t' <- cvtType t; return $ SigPatIn p' t' }
+cvtp (ViewP e p) = do { e' <- cvtl e; p' <- cvtPat p; return $ ViewPat e' p' void }
cvtPatFld :: (TH.Name, TH.Pat) -> CvtM (HsRecField RdrName (LPat RdrName))
cvtPatFld (s,p)
mk_uniq_occ :: OccName.NameSpace -> String -> Int# -> OccName.OccName
mk_uniq_occ ns occ uniq
= OccName.mkOccName ns (occ ++ '[' : shows (mk_uniq uniq) "]")
- -- The idea here is to make a name that
- -- a) the user could not possibly write, and
- -- b) cannot clash with another NameU
- -- Previously I generated an Exact RdrName with mkInternalName.
- -- This works fine for local binders, but does not work at all for
- -- top-level binders, which must have External Names, since they are
- -- rapidly baked into data constructors and the like. Baling out
- -- and generating an unqualified RdrName here is the simple solution
+ -- See Note [Unique OccNames from Template Haskell]
-- The packing and unpacking is rather turgid :-(
mk_occ :: OccName.NameSpace -> String -> OccName.OccName
mk_uniq u = mkUniqueGrimily (I# u)
\end{code}
+Note [Unique OccNames from Template Haskell]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The idea here is to make a name that
+ a) the user could not possibly write (it has a "["
+ and letters or digits from the unique)
+ b) cannot clash with another NameU
+Previously I generated an Exact RdrName with mkInternalName. This
+works fine for local binders, but does not work at all for top-level
+binders, which must have External Names, since they are rapidly baked
+into data constructors and the like. Baling out and generating an
+unqualified RdrName here is the simple solution
+
+See also Note [Suppressing uniques in OccNames] in OccName, which
+suppresses the unique when opt_SuppressUniques is on.