Commit 4d20dc8b authored by Simon Peyton Jones's avatar Simon Peyton Jones

Merge branch 'master' of http://darcs.haskell.org/ghc

parents 4f7599db 30eee196
......@@ -20,12 +20,6 @@ Category: Development
Build-Type: Simple
Cabal-Version: >= 1.2.3
Flag base4
Description: Choose the even newer, even smaller, split-up base package.
Flag base3
Description: Choose the new smaller, split-up base package.
Flag dynlibs
Description: Dynamic library support
Default: False
......@@ -54,26 +48,20 @@ Flag stage3
Library
Exposed: False
if flag(base4)
Build-Depends: base >= 4 && < 5
if flag(base3)
Build-Depends: base >= 3 && < 4
if !flag(base3) && !flag(base4)
Build-Depends: base < 3
Build-Depends: base >= 4 && < 5,
directory >= 1 && < 1.2,
process >= 1 && < 1.2,
bytestring >= 0.9 && < 0.11,
time < 1.5,
containers >= 0.1 && < 0.6,
array >= 0.1 && < 0.5,
filepath >= 1 && < 1.4,
Cabal,
hpc
if flag(stage1) && impl(ghc < 7.5)
Build-Depends: old-time >= 1 && < 1.2
if flag(base3) || flag(base4)
Build-Depends: directory >= 1 && < 1.2,
process >= 1 && < 1.2,
bytestring >= 0.9 && < 0.11,
time < 1.5,
containers >= 0.1 && < 0.6,
array >= 0.1 && < 0.5
Build-Depends: filepath >= 1 && < 1.4
Build-Depends: Cabal, hpc
if os(windows)
Build-Depends: Win32
else
......@@ -89,10 +77,6 @@ Library
Build-Depends: bin-package-db
Build-Depends: hoopl
-- GHC 6.4.2 needs to be able to find WCsubst.c, which needs to be
-- able to find WCsubst.h
Include-Dirs: ../libraries/base/cbits, ../libraries/base/include
Extensions: CPP, MagicHash, UnboxedTuples, PatternGuards,
ForeignFunctionInterface, EmptyDataDecls,
TypeSynonymInstances, MultiParamTypeClasses,
......
......@@ -183,7 +183,7 @@ cvtDec (NewtypeD ctxt tc tvs constr derivs)
= do { (ctxt', tc', tvs') <- cvt_tycl_hdr ctxt tc tvs
; con' <- cvtConstr constr
; derivs' <- cvtDerivs derivs
; let defn = TyData { td_ND = DataType, td_cType = Nothing
; let defn = TyData { td_ND = NewType, td_cType = Nothing
, td_ctxt = ctxt'
, td_kindSig = Nothing
, td_cons = [con'], td_derivs = derivs' }
......
This diff is collapsed.
......@@ -321,6 +321,10 @@ $tab+ { warn Opt_WarnTabs (text "Tab character") }
"[" @varid "|" / { ifExtension qqEnabled }
{ lex_quasiquote_tok }
-- qualified quasi-quote (#5555)
"[" @qual @varid "|" / { ifExtension qqEnabled }
{ lex_qquasiquote_tok }
}
<0> {
......@@ -562,7 +566,14 @@ data Token
| ITidEscape FastString -- $x
| ITparenEscape -- $(
| ITtyQuote -- ''
| ITquasiQuote (FastString,FastString,RealSrcSpan) -- [:...|...|]
| ITquasiQuote (FastString,FastString,RealSrcSpan)
-- ITquasiQuote(quoter, quote, loc)
-- represents a quasi-quote of the form
-- [quoter| quote |]
| ITqQuasiQuote (FastString,FastString,FastString,RealSrcSpan)
-- ITqQuasiQuote(Qual, quoter, quote, loc)
-- represents a qualified quasi-quote of the form
-- [Qual.quoter| quote |]
-- Arrow notation extension
| ITproc
......@@ -1423,6 +1434,18 @@ getCharOrFail i = do
-- -----------------------------------------------------------------------------
-- QuasiQuote
lex_qquasiquote_tok :: Action
lex_qquasiquote_tok span buf len = do
let (qual, quoter) = splitQualName (stepOn buf) (len - 2) False
quoteStart <- getSrcLoc
quote <- lex_quasiquote quoteStart ""
end <- getSrcLoc
return (L (mkRealSrcSpan (realSrcSpanStart span) end)
(ITqQuasiQuote (qual,
quoter,
mkFastString (reverse quote),
mkRealSrcSpan quoteStart end)))
lex_quasiquote_tok :: Action
lex_quasiquote_tok span buf len = do
let quoter = tail (lexemeToString buf (len - 1))
......
......@@ -350,6 +350,7 @@ TH_ID_SPLICE { L _ (ITidEscape _) } -- $x
'$(' { L _ ITparenEscape } -- $( exp )
TH_TY_QUOTE { L _ ITtyQuote } -- ''T
TH_QUASIQUOTE { L _ (ITquasiQuote _) }
TH_QQUASIQUOTE { L _ (ITqQuasiQuote _) }
%monad { P } { >>= } { return }
%lexer { lexer } { L _ ITeof }
......@@ -1360,6 +1361,10 @@ quasiquote :: { Located (HsQuasiQuote RdrName) }
; ITquasiQuote (quoter, quote, quoteSpan) = unLoc $1
; quoterId = mkUnqual varName quoter }
in L1 (mkHsQuasiQuote quoterId (RealSrcSpan quoteSpan) quote) }
| TH_QQUASIQUOTE { let { loc = getLoc $1
; ITqQuasiQuote (qual, quoter, quote, quoteSpan) = unLoc $1
; quoterId = mkQual varName (qual, quoter) }
in sL (getLoc $1) (mkHsQuasiQuote quoterId (RealSrcSpan quoteSpan) quote) }
exp :: { LHsExpr RdrName }
: infixexp '::' sigtype { LL $ ExprWithTySig $1 $3 }
......
......@@ -79,6 +79,14 @@ occurAnalysePgm this_mod active_rule imp_rules vects binds
(rulesFreeVars imp_rules `unionVarSet` vectsFreeVars vects)
-- The RULES and VECTORISE declarations keep things alive!
-- Note [Preventing loops due to imported functions rules]
imp_rules_edges = foldr (plusVarEnv_C unionVarSet) emptyVarEnv
[ mapVarEnv (const maps_to) (exprFreeIds arg `delVarSetList` ru_bndrs imp_rule)
| imp_rule <- imp_rules
, let maps_to = exprFreeIds (ru_rhs imp_rule)
`delVarSetList` ru_bndrs imp_rule
, arg <- ru_args imp_rule ]
go :: OccEnv -> [CoreBind] -> (UsageDetails, [CoreBind])
go _ []
= (initial_uds, [])
......@@ -86,7 +94,7 @@ occurAnalysePgm this_mod active_rule imp_rules vects binds
= (final_usage, bind' ++ binds')
where
(bs_usage, binds') = go env binds
(final_usage, bind') = occAnalBind env env bind bs_usage
(final_usage, bind') = occAnalBind env env imp_rules_edges bind bs_usage
occurAnalyseExpr :: CoreExpr -> CoreExpr
-- Do occurrence analysis, and discard occurence info returned
......@@ -110,12 +118,13 @@ Bindings
\begin{code}
occAnalBind :: OccEnv -- The incoming OccEnv
-> OccEnv -- Same, but trimmed by (binderOf bind)
-> IdEnv IdSet -- Mapping from FVs of imported RULE LHSs to RHS FVs
-> CoreBind
-> UsageDetails -- Usage details of scope
-> (UsageDetails, -- Of the whole let(rec)
[CoreBind])
occAnalBind env _ (NonRec binder rhs) body_usage
occAnalBind env _ imp_rules_edges (NonRec binder rhs) body_usage
| isTyVar binder -- A type let; we don't gather usage info
= (body_usage, [NonRec binder rhs])
......@@ -123,15 +132,17 @@ occAnalBind env _ (NonRec binder rhs) body_usage
= (body_usage, [])
| otherwise -- It's mentioned in the body
= (body_usage' +++ rhs_usage3, [NonRec tagged_binder rhs'])
= (body_usage' +++ rhs_usage4, [NonRec tagged_binder rhs'])
where
(body_usage', tagged_binder) = tagBinder body_usage binder
(rhs_usage1, rhs') = occAnalRhs env (Just tagged_binder) rhs
rhs_usage2 = addIdOccs rhs_usage1 (idUnfoldingVars binder)
rhs_usage3 = addIdOccs rhs_usage2 (idRuleVars binder)
-- See Note [Rules are extra RHSs] and Note [Rule dependency info]
rhs_usage4 = maybe rhs_usage3 (addIdOccs rhs_usage3) $ lookupVarEnv imp_rules_edges binder
-- See Note [Preventing loops due to imported functions rules]
occAnalBind _ env (Rec pairs) body_usage
occAnalBind _ env imp_rules_edges (Rec pairs) body_usage
= foldr occAnalRec (body_usage, []) sccs
-- For a recursive group, we
-- * occ-analyse all the RHSs
......@@ -144,7 +155,7 @@ occAnalBind _ env (Rec pairs) body_usage
sccs = {-# SCC "occAnalBind.scc" #-} stronglyConnCompFromEdgedVerticesR nodes
nodes :: [Node Details]
nodes = {-# SCC "occAnalBind.assoc" #-} map (makeNode env bndr_set) pairs
nodes = {-# SCC "occAnalBind.assoc" #-} map (makeNode env imp_rules_edges bndr_set) pairs
\end{code}
Note [Dead code]
......@@ -404,6 +415,86 @@ It's up the programmer not to write silly rules like
RULE f x = f x
and the example above is just a more complicated version.
Note [Preventing loops due to imported functions rules]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider:
import GHC.Base (foldr)
{-# RULES "filterList" forall p. foldr (filterFB (:) p) [] = filter p #-}
filter p xs = build (\c n -> foldr (filterFB c p) n xs)
filterFB c p = ...
f = filter p xs
Note that filter is not a loop-breaker, so what happens is:
f = filter p xs
= {inline} build (\c n -> foldr (filterFB c p) n xs)
= {inline} foldr (filterFB (:) p) [] xs
= {RULE} filter p xs
We are in an infinite loop.
A more elaborate example (that I actually saw in practice when I went to
mark GHC.List.filter as INLINABLE) is as follows. Say I have this module:
{-# LANGUAGE Rank2Types #-}
module GHCList where
import Prelude hiding (filter)
import GHC.Base (build)
{-# INLINABLE filter #-}
filter :: (a -> Bool) -> [a] -> [a]
filter p [] = []
filter p (x:xs) = if p x then x : filter p xs else filter p xs
{-# NOINLINE [0] filterFB #-}
filterFB :: (a -> b -> b) -> (a -> Bool) -> a -> b -> b
filterFB c p x r | p x = x `c` r
| otherwise = r
{-# RULES
"filter" [~1] forall p xs. filter p xs = build (\c n -> foldr
(filterFB c p) n xs)
"filterList" [1] forall p. foldr (filterFB (:) p) [] = filter p
#-}
Then (because RULES are applied inside INLINABLE unfoldings, but inlinings
are not), the unfolding given to "filter" in the interface file will be:
filter p [] = []
filter p (x:xs) = if p x then x : build (\c n -> foldr (filterFB c p) n xs)
else build (\c n -> foldr (filterFB c p) n xs
Note that because this unfolding does not mention "filter", filter is not
marked as a strong loop breaker. Therefore at a use site in another module:
filter p xs
= {inline}
case xs of [] -> []
(x:xs) -> if p x then x : build (\c n -> foldr (filterFB c p) n xs)
else build (\c n -> foldr (filterFB c p) n xs)
build (\c n -> foldr (filterFB c p) n xs)
= {inline} foldr (filterFB (:) p) [] xs
= {RULE} filter p xs
And we are in an infinite loop again, except that this time the loop is producing an
infinitely large *term* (an unrolling of filter) and so the simplifier finally
dies with "ticks exhausted"
Because of this problem, we make a small change in the occurrence analyser
designed to mark functions like "filter" as strong loop breakers on the basis that:
1. The RHS of filter mentions the local function "filterFB"
2. We have a rule which mentions "filterFB" on the LHS and "filter" on the RHS
So for each RULE for an *imported* function we are going to add dependency edges between
the FVS of the rule LHS and the FVS of the rule RHS. We don't do anything special for
RULES on local functions because the standard occurrence analysis stuff is pretty good
at getting loop-breakerness correct there.
It is important to note that even with this extra hack we aren't always going to get
things right. For example, it might be that the rule LHS mentions an imported Id,
and another module has a RULE that can rewrite that imported Id to one of our local
Ids.
Note [Specialising imported functions]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
BUT for *automatically-generated* rules, the programmer can't be
......@@ -566,8 +657,8 @@ instance Outputable Details where
, ptext (sLit "rule =") <+> ppr (nd_active_rule_fvs nd)
])
makeNode :: OccEnv -> VarSet -> (Var, CoreExpr) -> Node Details
makeNode env bndr_set (bndr, rhs)
makeNode :: OccEnv -> IdEnv IdSet -> VarSet -> (Var, CoreExpr) -> Node Details
makeNode env imp_rules_edges bndr_set (bndr, rhs)
= (details, varUnique bndr, keysUFM node_fvs)
where
details = ND { nd_bndr = bndr
......@@ -591,7 +682,9 @@ makeNode env bndr_set (bndr, rhs)
is_active = occ_rule_act env :: Activation -> Bool
rules = filterOut isBuiltinRule (idCoreRules bndr)
rules_w_fvs :: [(Activation, VarSet)] -- Find the RHS fvs
rules_w_fvs = [ (ru_act rule, fvs)
rules_w_fvs = maybe id (\ids -> ((AlwaysActive, ids):)) (lookupVarEnv imp_rules_edges bndr)
-- See Note [Preventing loops due to imported functions rules]
[ (ru_act rule, fvs)
| rule <- rules
, let fvs = exprFreeVars (ru_rhs rule)
`delVarSetList` ru_bndrs rule
......@@ -1191,7 +1284,7 @@ occAnal env (Case scrut bndr ty alts)
occAnal env (Let bind body)
= case occAnal env_body body of { (body_usage, body') ->
case occAnalBind env env_body bind body_usage of { (final_usage, new_binds) ->
case occAnalBind env env_body emptyVarEnv bind body_usage of { (final_usage, new_binds) ->
(final_usage, mkLets new_binds body') }}
where
env_body = trimOccEnv env (bindersOf bind)
......
......@@ -210,17 +210,15 @@ tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport _ _ _ (CLabel _))
tcCheckFIType sig_ty arg_tys res_ty (CImport cconv safety mh CWrapper) = do
-- Foreign wrapper (former f.e.d.)
-- The type must be of the form ft -> IO (FunPtr ft), where ft is a
-- valid foreign type. For legacy reasons ft -> IO (Ptr ft) as well
-- as ft -> IO Addr is accepted, too. The use of the latter two forms
-- is DEPRECATED, though.
-- The type must be of the form ft -> IO (FunPtr ft), where ft is a valid
-- foreign type. For legacy reasons ft -> IO (Ptr ft) is accepted, too.
-- The use of the latter form is DEPRECATED, though.
checkCg checkCOrAsmOrLlvmOrInterp
cconv' <- checkCConv cconv
case arg_tys of
[arg1_ty] -> do checkForeignArgs isFFIExternalTy arg1_tys
checkForeignRes nonIOok checkSafe isFFIExportResultTy res1_ty
checkForeignRes mustBeIO checkSafe isFFIDynResultTy res_ty
-- ToDo: Why are res1_ty and res_ty not equal?
checkForeignRes mustBeIO checkSafe (isFFIDynTy arg1_ty) res_ty
where
(arg1_tys, res1_ty) = tcSplitFunTys arg1_ty
_ -> addErrTc (illegalForeignTyErr empty sig_ty)
......@@ -230,12 +228,13 @@ tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport cconv safety mh (CFunction ta
| isDynamicTarget target = do -- Foreign import dynamic
checkCg checkCOrAsmOrLlvmOrInterp
cconv' <- checkCConv cconv
case arg_tys of -- The first arg must be Ptr, FunPtr, or Addr
case arg_tys of -- The first arg must be Ptr or FunPtr
[] -> do
check False (illegalForeignTyErr empty sig_ty)
(arg1_ty:arg_tys) -> do
dflags <- getDynFlags
check (isFFIDynArgumentTy arg1_ty)
let curried_res_ty = foldr FunTy res_ty arg_tys
check (isFFIDynTy curried_res_ty arg1_ty)
(illegalForeignTyErr argument arg1_ty)
checkForeignArgs (isFFIArgumentTy dflags safety) arg_tys
checkForeignRes nonIOok checkSafe (isFFIImportResultTy dflags) res_ty
......
......@@ -831,7 +831,7 @@ runMeta show_code run_and_convert expr
; either_hval <- tryM $ liftIO $
HscMain.hscCompileCoreExpr hsc_env src_span ds_expr
; case either_hval of {
Left exn -> failWithTc (mk_msg "compile and link" exn) ;
Left exn -> fail_with_exn "compile and link" exn ;
Right hval -> do
{ -- Coerce it to Q t, and run it
......@@ -859,12 +859,16 @@ runMeta show_code run_and_convert expr
Right v -> return v
Left se -> case fromException se of
Just IOEnvFailure -> failM -- Error already in Tc monad
_ -> failWithTc (mk_msg "run" se) -- Exception
_ -> fail_with_exn "run" se -- Exception
}}}
where
mk_msg s exn = vcat [text "Exception when trying to" <+> text s <+> text "compile-time code:",
nest 2 (text (Panic.showException exn)),
if show_code then nest 2 (text "Code:" <+> ppr expr) else empty]
-- see Note [Concealed TH exceptions]
fail_with_exn phase exn = do
exn_msg <- liftIO $ Panic.safeShowException exn
let msg = vcat [text "Exception when trying to" <+> text phase <+> text "compile-time code:",
nest 2 (text exn_msg),
if show_code then nest 2 (text "Code:" <+> ppr expr) else empty]
failWithTc msg
\end{code}
Note [Exceptions in TH]
......@@ -896,6 +900,21 @@ like that. Here's how it's processed:
- other errors, we add an error to the bag
and then fail
Note [Concealed TH exceptions]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
When displaying the error message contained in an exception originated from TH
code, we need to make sure that the error message itself does not contain an
exception. For example, when executing the following splice:
$( error ("foo " ++ error "bar") )
the message for the outer exception is a thunk which will throw the inner
exception when evaluated.
For this reason, we display the message of a TH exception using the
'safeShowException' function, which recursively catches any exception thrown
when showing an error message.
To call runQ in the Tc monad, we need to make TcM an instance of Quasi:
......
......@@ -102,8 +102,7 @@ module TcType (
isFFIImportResultTy, -- :: DynFlags -> Type -> Bool
isFFIExportResultTy, -- :: Type -> Bool
isFFIExternalTy, -- :: Type -> Bool
isFFIDynArgumentTy, -- :: Type -> Bool
isFFIDynResultTy, -- :: Type -> Bool
isFFIDynTy, -- :: Type -> Type -> Bool
isFFIPrimArgumentTy, -- :: DynFlags -> Type -> Bool
isFFIPrimResultTy, -- :: DynFlags -> Type -> Bool
isFFILabelTy, -- :: Type -> Bool
......@@ -1338,19 +1337,24 @@ isFFIImportResultTy dflags ty
isFFIExportResultTy :: Type -> Bool
isFFIExportResultTy ty = checkRepTyCon legalFEResultTyCon ty
isFFIDynArgumentTy :: Type -> Bool
-- The argument type of a foreign import dynamic must be Ptr, FunPtr, Addr,
-- or a newtype of either.
isFFIDynArgumentTy = checkRepTyConKey [ptrTyConKey, funPtrTyConKey]
isFFIDynResultTy :: Type -> Bool
-- The result type of a foreign export dynamic must be Ptr, FunPtr, Addr,
-- or a newtype of either.
isFFIDynResultTy = checkRepTyConKey [ptrTyConKey, funPtrTyConKey]
isFFIDynTy :: Type -> Type -> Bool
-- The type in a foreign import dynamic must be Ptr, FunPtr, or a newtype of
-- either, and the wrapped function type must be equal to the given type.
-- We assume that all types have been run through normalizeFfiType, so we don't
-- need to worry about expanding newtypes here.
isFFIDynTy expected ty
-- Note [Foreign import dynamic]
-- In the example below, expected would be 'CInt -> IO ()', while ty would
-- be 'FunPtr (CDouble -> IO ())'.
| Just (tc, [ty']) <- splitTyConApp_maybe ty
, tyConUnique tc `elem` [ptrTyConKey, funPtrTyConKey]
, eqType ty' expected
= True
| otherwise
= False
isFFILabelTy :: Type -> Bool
-- The type of a foreign label must be Ptr, FunPtr, Addr,
-- or a newtype of either.
-- The type of a foreign label must be Ptr, FunPtr, or a newtype of either.
isFFILabelTy = checkRepTyConKey [ptrTyConKey, funPtrTyConKey]
isFFIPrimArgumentTy :: DynFlags -> Type -> Bool
......@@ -1401,6 +1405,21 @@ checkRepTyConKey keys
= checkRepTyCon (\tc -> tyConUnique tc `elem` keys)
\end{code}
Note [Foreign import dynamic]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
A dynamic stub must be of the form 'FunPtr ft -> ft' where ft is any foreign
type. Similarly, a wrapper stub must be of the form 'ft -> IO (FunPtr ft)'.
We use isFFIDynTy to check whether a signature is well-formed. For example,
given a (illegal) declaration like:
foreign import ccall "dynamic"
foo :: FunPtr (CDouble -> IO ()) -> CInt -> IO ()
isFFIDynTy will compare the 'FunPtr' type 'CDouble -> IO ()' with the curried
result type 'CInt -> IO ()', and return False, as they are not equal.
----------------------------------------------
These chaps do the work; they are not exported
----------------------------------------------
......
......@@ -199,6 +199,8 @@ match menv subst (AppTy ty1a ty1b) ty2
= do { subst' <- match menv subst ty1a ty2a
; match menv subst' ty1b ty2b }
match _ subst (LitTy x) (LitTy y) | x == y = return subst
match _ _ _ _
= Nothing
......@@ -339,6 +341,8 @@ typesCantMatch prs = any (\(s,t) -> cant_match s t) prs
| Just (f1, a1) <- repSplitAppTy_maybe ty1
= cant_match f1 f2 || cant_match a1 a2
cant_match (LitTy x) (LitTy y) = x /= y
cant_match _ _ = False -- Safe!
-- Things we could add;
......@@ -453,6 +457,8 @@ unify subst ty1 (AppTy ty2a ty2b)
= do { subst' <- unify subst ty1a ty2a
; unify subst' ty1b ty2b }
unify subst (LitTy x) (LitTy y) | x == y = return subst
unify _ ty1 ty2 = failWith (misMatch ty1 ty2)
-- ForAlls??
......
......@@ -22,7 +22,7 @@ module Panic (
panic, sorry, panicFastInt, assertPanic, trace,
Exception.Exception(..), showException, try, tryMost, throwTo,
Exception.Exception(..), showException, safeShowException, try, tryMost, throwTo,
installSignalHandlers, interruptTargetThread
) where
......@@ -113,6 +113,18 @@ short_usage = "Usage: For basic information, try the `--help' option."
showException :: Exception e => e -> String
showException = show
-- | Show an exception which can possibly throw other exceptions.
-- Used when displaying exception thrown within TH code.
safeShowException :: Exception e => e -> IO String
safeShowException e = do
-- ensure the whole error message is evaluated inside try
r <- try (return $! forceList (showException e))
case r of
Right msg -> return msg
Left e' -> safeShowException (e' :: SomeException)
where
forceList [] = []
forceList xs@(x : xt) = x `seq` forceList xt `seq` xs
-- | Append a description of the given exception to this string.
showGhcException :: GhcException -> String -> String
......
......@@ -980,6 +980,12 @@
<entry>dynamic</entry>
<entry><option>-XNoTypeOperators</option></entry>
</row>
<row>
<entry><option>-XExplicitNamespaces</option></entry>
<entry>Enable using the keyword <literal>type</literal> to specify the namespace of entries in imports and exports.</entry>
<entry>dynamic</entry>
<entry><option>-XNoExplicitNamespaces</option></entry>
</row>
<row>
<entry><option>-XDoRec</option></entry>
<entry>Enable <link linkend="recursive-do-notation">recursive do notation</link>.</entry>
......
......@@ -5371,6 +5371,52 @@ Note that this requires <option>-XTypeOperators</option>.
</para>
</sect3>
<sect3 id="promoted-literals">
<title>Promoted Literals</title>
<para>
Numeric and string literals are prmoted to the type level, giving convenient
access to a large number of predefined type-level constants. Numeric literals
are of kind <literal>Nat</literal>, while string literals are of kind
<literal>Symbol</literal>. These kinds are defined in the module
<literal>GHC.TypeLits</literal>.
</para>
<para>
Here is an exampe of using type-level numeric literals to provide a safe
interface to a low-level function:
<programlisting>
import GHC.TypeLits
import Data.Word
import Foreign
newtype ArrPtr (n :: Nat) a = ArrPtr (Ptr a)
clearPage :: ArrPtr 4096 Word8 -> IO ()
clearPage (ArrPtr p) = ...
</programlisting>
</para>
<para>
Here is an example of using type-level string literals to simulate
simple record operations:
<programlisting>
data Label (l :: Symbol) = Get
class Has a l b | a l -> b where
from :: a -> Label l -> b
data Point = Point Int Int deriving Show
instance Has Point "x" Int where from (Point x _) _ = x
instance Has Point "y" Int where from (Point _ y) _ = y
example = from (Point 1 2) (Get :: Label "x")
</programlisting>
</para>
</sect3>
</sect2>
<sect2 id="kind-polymorphism-limitations">
......
......@@ -1688,7 +1688,8 @@ checkAdd ii = do
IIDecl d -> do
let modname = unLoc (ideclName d)
m <- lookupModuleName modname
pkgqual = ideclPkgQual d
m <- GHC.lookupModule modname pkgqual
when safe $ do
t <- GHC.isModuleTrusted m
when (not t) $
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment