+\begin{code}
+runAnnotation target expr = do
+ expr_ty <- newFlexiTyVarTy liftedTypeKind
+
+ -- Find the classes we want instances for in order to call toAnnotationWrapper
+ data_class <- tcLookupClass dataClassName
+
+ -- Check the instances we require live in another module (we want to execute it..)
+ -- and check identifiers live in other modules using TH stage checks. tcSimplifyStagedExpr
+ -- also resolves the LIE constraints to detect e.g. instance ambiguity
+ ((wrapper, expr'), const_binds) <- tcSimplifyStagedExpr topAnnStage $ do
+ expr' <- tcPolyExprNC expr expr_ty
+ -- By instantiating the call >here< it gets registered in the
+ -- LIE consulted by tcSimplifyStagedExpr
+ -- and hence ensures the appropriate dictionary is bound by const_binds
+ wrapper <- instCall AnnOrigin [expr_ty] [mkClassPred data_class [expr_ty]]
+ return (wrapper, expr')
+
+ -- We manually wrap the typechecked expression in a call to toAnnotationWrapper
+ loc <- getSrcSpanM
+ to_annotation_wrapper_id <- tcLookupId toAnnotationWrapperName
+ let specialised_to_annotation_wrapper_expr = L loc (HsWrap wrapper (HsVar to_annotation_wrapper_id))
+ wrapped_expr' = mkHsDictLet const_binds $
+ L loc (HsApp specialised_to_annotation_wrapper_expr expr')
+
+ -- If we have type checking problems then potentially zonking
+ -- (and certainly compilation) may fail. Give up NOW!
+ failIfErrsM
+
+ -- Zonk the type variables out of that raw expression. Note that
+ -- in particular we don't call recordThUse, since we don't
+ -- necessarily use any code or definitions from that package.
+ zonked_wrapped_expr' <- zonkTopLExpr wrapped_expr'
+
+ -- Run the appropriately wrapped expression to get the value of
+ -- the annotation and its dictionaries. The return value is of
+ -- type AnnotationWrapper by construction, so this conversion is
+ -- safe
+ flip runMetaAW zonked_wrapped_expr' $ \annotation_wrapper ->
+ case annotation_wrapper of
+ AnnotationWrapper value | let serialized = toSerialized serializeWithData value ->
+ -- Got the value and dictionaries: build the serialized value and
+ -- call it a day. We ensure that we seq the entire serialized value
+ -- in order that any errors in the user-written code for the
+ -- annotation are exposed at this point. This is also why we are
+ -- doing all this stuff inside the context of runMeta: it has the
+ -- facilities to deal with user error in a meta-level expression
+ seqSerialized serialized `seq` Annotation {
+ ann_target = target,
+ ann_value = serialized
+ }