opt_HiMap,
opt_HiVersion,
opt_IgnoreIfacePragmas,
+ opt_IgnoreAsserts,
opt_IrrefutableTuples,
opt_LiberateCaseThreshold,
opt_MaxContextReductionDepth,
opt_HiMap = lookup_str "-himap=" -- file saying where to look for .hi files
opt_HiVersion = lookup_def_int "-fhi-version=" 0 -- what version we're compiling.
opt_IgnoreIfacePragmas = lookUp SLIT("-fignore-interface-pragmas")
+opt_IgnoreAsserts = lookUp SLIT("-fignore-asserts")
opt_IrrefutableTuples = lookUp SLIT("-firrefutable-tuples")
opt_MaxContextReductionDepth = lookup_def_int "-fcontext-stack" mAX_CONTEXT_REDUCTION_DEPTH
opt_MultiParamClasses = opt_GlasgowExts
import RnHsSyn
import RnMonad
import RnEnv
-import CmdLineOpts ( opt_GlasgowExts )
+import CmdLineOpts ( opt_GlasgowExts, opt_IgnoreAsserts )
import BasicTypes ( Fixity(..), FixityDirection(..) )
import PrelInfo ( numClass_RDR, fractionalClass_RDR, eqClass_RDR,
ccallableClass_RDR, creturnableClass_RDR,
import TysPrim ( charPrimTyCon, addrPrimTyCon, intPrimTyCon,
floatPrimTyCon, doublePrimTyCon
)
-import Name ( nameUnique, isLocallyDefined, NamedThing(..) )
+import Name ( nameUnique, isLocallyDefined, NamedThing(..)
+ , mkSysLocalName, nameSrcLoc
+ )
import NameSet
import UniqFM ( isNullUFM )
import FiniteMap ( elemFM )
newImportedGlobalFromRdrName assertErr_RDR `thenRn` \ name ->
addOccurrenceName name `thenRn_`
getSrcLocRn `thenRn` \ sloc ->
- let
- expr = HsApp (HsVar name)
+
+ -- if we're ignoring asserts, return (\ _ e -> e)
+ -- if not, return (assertError "src-loc")
+
+ if opt_IgnoreAsserts then
+ getUniqRn `thenRn` \ uniq ->
+ let
+ vname = mkSysLocalName uniq SLIT("v")
+ expr = HsLam ignorePredMatch
+ loc = nameSrcLoc vname
+ ignorePredMatch = Match [] [WildPatIn, VarPatIn vname] Nothing
+ (GRHSs [GRHS [ExprStmt (HsVar vname) loc] loc]
+ EmptyBinds Nothing)
+ in
+ returnRn expr
+ else
+ let
+ expr =
+ HsApp (HsVar name)
(HsLit (HsString (_PK_ (showSDoc (ppr sloc)))))
- in
- returnRn expr
+
+ in
+ returnRn expr
+
\end{code}
%************************************************************************
in
writeMutVarSST names_var (us, mapInst', cache) `thenSST_`
returnSST uniq
+
+getUniqRn :: RnM s d Unique
+getUniqRn (RnDown {rn_ns = names_var}) l_down
+ = readMutVarSST names_var `thenSST` \ (us, mapInst, cache) ->
+ let
+ (us1,us') = splitUniqSupply us
+ in
+ writeMutVarSST names_var (us', mapInst, cache) `thenSST_`
+ returnSST (uniqFromSupply us1)
\end{code}
================ Occurrences =====================
%
-% $Id: glasgow_exts.vsgml,v 1.7 1999/03/26 19:50:31 sof Exp $
+% $Id: glasgow_exts.vsgml,v 1.8 1999/03/30 11:26:24 sof Exp $
%
% GHC Language Extensions.
%
<label id="sec:assertions">
<p>
-If you want to use assertions in your standard Haskell code, you
-could define something like the following:
+If you want to make use of assertions in your standard Haskell code, you
+could define a function like the following:
<tscreen><verb>
assert :: Bool -> a -> a
</verb></tscreen>
which works, but gives you back a less than useful error message --
-an assertion failed, but which?
+an assertion failed, but which and where?
One way out is to define an extended <tt/assert/ function which also
takes a descriptive string to include in the error message and
assertion was made,
<tscreen><verb>
-assert pred val ==> assertError "Main.hs,15" pred val
+assert pred val ==> assertError "Main.hs|15" pred val
</verb></tscreen>
The rewrite is only performed by the compiler when applications of
<tt>Exception.assert</tt> are spotted, so you can still define and use
your own versions of <tt/assert/, should you so wish. If not, import
-<tt/Exception/ to use <tt/assert/ in your code.
+<tt/Exception/ to make use <tt/assert/ in your code.
+
+To have the compiler ignore uses of assert, use the compiler option
+@-fignore-asserts@. <nidx>-fignore-asserts option</nidx> That is,
+expressions of the form @assert pred e@ will be rewritten to @e@.
Assertion failures can be caught, see the documentation for the
Hugs/GHC Exception library for information of how.
/^-keep-s-files?-too$/ && do { $Keep_s_file_too = 1; next arg; };
/^-fignore-interface-pragmas$/ && do { push(@HsC_flags, $_); next arg; };
+ /^-fignore-asserts$/ && do { push(@HsC_flags, $_); next arg; };
/^-fno-implicit-prelude$/ && do { $NoImplicitPrelude= 1; push(@HsC_flags, $_); next arg; };