\begin{code}
module Convert( convertToHsExpr, convertToPat, convertToHsDecls,
- convertToHsType, thRdrNameGuesses ) where
+ convertToHsType, convertToHsPred,
+ thRdrNameGuesses ) where
import HsSyn as Hs
import qualified Class
import OccName
import SrcLoc
import Type
+import Coercion
import TysWiredIn
import BasicTypes as Hs
import ForeignCall
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;
collect (VarT tv) = return [PlainTV tv]
collect (ConT _) = return []
collect (TupleT _) = return []
+ collect (UnboxedTupleT _) = return []
collect ArrowT = return []
collect ListT = return []
collect (AppT t1 t2)
Unsafe -> PlayRisky
Safe -> PlaySafe False
Threadsafe -> PlaySafe True
+ Interruptible -> PlayInterruptible
cvtForD (ExportF callconv as nm ty)
= do { nm' <- vNameL nm
cvtInlineSpec Nothing
= defaultInlinePragma
cvtInlineSpec (Just (TH.InlineSpec inline conlike opt_activation))
- = InlinePragma { inl_act = opt_activation', inl_rule = matchinfo, inl_inline = inline }
+ = InlinePragma { inl_act = opt_activation', inl_rule = matchinfo
+ , 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 (UnboxedTupE [e]) = cvt e -- Singleton tuples treated like nothing (just parens)
+ cvt (UnboxedTupE es) = do { es' <- mapM cvtl es; return $ ExplicitTuple (map Present es') Unboxed }
+ 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
cvtp (TH.VarP s) = do { s' <- vName s; return $ Hs.VarPat s' }
cvtp (TupP [p]) = cvtp p
cvtp (TupP ps) = do { ps' <- cvtPats ps; return $ TuplePat ps' Boxed void }
+cvtp (UnboxedTupP [p]) = cvtp p
+cvtp (UnboxedTupP ps) = do { ps' <- cvtPats ps; return $ TuplePat ps' Unboxed void }
cvtp (ConP s ps) = do { s' <- cNameL s; ps' <- cvtPats ps; return $ ConPatIn s' (PrefixCon ps') }
cvtp (InfixP p1 s p2) = do { s' <- cNameL s; p1' <- cvtPat p1; p2' <- cvtPat p2
; return $ ConPatIn s' (InfixCon p1' p2') }
; 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)
cvt_tv :: TH.TyVarBndr -> CvtM (LHsTyVarBndr RdrName)
cvt_tv (TH.PlainTV nm)
= do { nm' <- tName nm
- ; returnL $ UserTyVar nm'
+ ; returnL $ UserTyVar nm' placeHolderKind
}
cvt_tv (TH.KindedTV nm ki)
= do { nm' <- tName nm
-> failWith (ptext (sLit "Illegal 1-tuple type constructor"))
| otherwise
-> mk_apps (HsTyVar (getRdrName (tupleTyCon Boxed n))) tys'
+ UnboxedTupleT n
+ | length tys' == n -- Saturated
+ -> if n==1 then return (head tys') -- Singleton tuples treated
+ -- like nothing (ie just parens)
+ else returnL (HsTupleTy Unboxed tys')
+ | n == 1
+ -> failWith (ptext (sLit "Illegal 1-unboxed-tuple type constructor"))
+ | otherwise
+ -> mk_apps (HsTyVar (getRdrName (tupleTyCon Unboxed n))) tys'
ArrowT
| [x',y'] <- tys' -> returnL (HsFunTy x' y')
| otherwise -> mk_apps (HsTyVar (getRdrName funTyCon)) tys'
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.