X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Ftypecheck%2FInst.lhs;h=89112516178679258532aa09e698c8ffc6c8b386;hb=2020b0c6d9bbf48d1ec63d9faa3e034c6c8b88b8;hp=fd242812a52b6bc88db6d80bc0cb9f88a4be2119;hpb=7b0181919416d8f04324575b7e17031ca692f5b0;p=ghc-hetmet.git diff --git a/ghc/compiler/typecheck/Inst.lhs b/ghc/compiler/typecheck/Inst.lhs index fd24281..8911251 100644 --- a/ghc/compiler/typecheck/Inst.lhs +++ b/ghc/compiler/typecheck/Inst.lhs @@ -10,59 +10,66 @@ module Inst ( Inst(..), -- Visible only to TcSimplify InstOrigin(..), OverloadedLit(..), - LIE(..), emptyLIE, unitLIE, plusLIE, consLIE, zonkLIE, plusLIEs, + SYN_IE(LIE), emptyLIE, unitLIE, plusLIE, consLIE, zonkLIE, plusLIEs, - InstanceMapper(..), + SYN_IE(InstanceMapper), newDicts, newDictsAtLoc, newMethod, newMethodWithGivenTy, newOverloadedLit, - instType, tyVarsOfInst, lookupInst, + instType, tyVarsOfInst, lookupInst, lookupSimpleInst, isDict, isTyVarDict, zonkInst, instToId, matchesInst, - instBindingRequired, instCanBeGeneralised - + instBindingRequired, instCanBeGeneralised, + + pprInst ) where -import Ubiq +IMP_Ubiq() +IMPORT_1_3(Ratio(Rational)) -import HsSyn ( HsLit(..), HsExpr(..), HsBinds, - InPat, OutPat, Stmt, Qual, Match, - ArithSeqInfo, PolyType, Fake ) -import RnHsSyn ( RenamedArithSeqInfo(..), RenamedHsExpr(..) ) -import TcHsSyn ( TcIdOcc(..), TcExpr(..), TcIdBndr(..), - mkHsTyApp, mkHsDictApp ) +import HsSyn ( HsLit(..), HsExpr(..), HsBinds, Fixity, + InPat, OutPat, Stmt, DoOrListComp, Match, + ArithSeqInfo, HsType, Fake ) +import RnHsSyn ( SYN_IE(RenamedArithSeqInfo), SYN_IE(RenamedHsExpr) ) +import TcHsSyn ( TcIdOcc(..), SYN_IE(TcExpr), SYN_IE(TcIdBndr), + mkHsTyApp, mkHsDictApp, tcIdTyVars ) import TcMonad -import TcEnv ( tcLookupGlobalValueByKey ) -import TcType ( TcType(..), TcRhoType(..), TcMaybe, TcTyVarSet(..), - tcInstType, tcInstTcType, zonkTcType ) +import TcEnv ( tcLookupGlobalValueByKey, tcLookupTyConByKey ) +import TcType ( SYN_IE(TcType), SYN_IE(TcRhoType), TcMaybe, SYN_IE(TcTyVarSet), + tcInstType, zonkTcType ) import Bag ( emptyBag, unitBag, unionBags, unionManyBags, listToBag, consBag ) -import Class ( Class(..), GenClass, ClassInstEnv(..), getClassInstEnv ) +import Class ( classInstEnv, + SYN_IE(Class), GenClass, SYN_IE(ClassInstEnv), SYN_IE(ClassOp) + ) +import ErrUtils ( addErrLoc, SYN_IE(Error) ) import Id ( GenId, idType, mkInstId ) +import PrelInfo ( isCcallishClass, isNoDictClass ) import MatchEnv ( lookupMEnv, insertMEnv ) -import Name ( mkLocalName, getLocalName, Name ) +import Name ( OccName(..), Name, mkLocalName, mkSysLocalName, occNameString ) import Outputable -import PprType ( GenClass, TyCon, GenType, GenTyVar ) +import PprType ( GenClass, TyCon, GenType, GenTyVar, pprParendGenType ) import PprStyle ( PprStyle(..) ) import Pretty -import RnHsSyn ( RnName{-instance NamedThing-} ) -import SpecEnv ( SpecEnv(..) ) -import SrcLoc ( SrcLoc, mkUnknownSrcLoc ) -import Type ( GenType, eqSimpleTy, +import SpecEnv ( SpecEnv ) +import SrcLoc ( SrcLoc, noSrcLoc ) +import Type ( GenType, eqSimpleTy, instantiateTy, isTyVarTy, mkDictTy, splitForAllTy, splitSigmaTy, - splitRhoTy, matchTy, tyVarsOfType, tyVarsOfTypes ) -import TyVar ( GenTyVar ) + splitRhoTy, matchTy, tyVarsOfType, tyVarsOfTypes, + mkSynTy + ) +import TyVar ( unionTyVarSets, GenTyVar ) import TysPrim ( intPrimTy ) -import TysWiredIn ( intDataCon ) -import Unique ( Unique, showUnique, - fromRationalClassOpKey, fromIntClassOpKey, fromIntegerClassOpKey ) -import Util ( panic, zipEqual, zipWithEqual, assoc, assertPanic ) - +import TysWiredIn ( intDataCon, integerTy ) +import Unique ( showUnique, fromRationalClassOpKey, rationalTyConKey, + fromIntClassOpKey, fromIntegerClassOpKey, Unique + ) +import Util ( panic, zipEqual, zipWithEqual, assoc, assertPanic, pprTrace{-ToDo:rm-} ) \end{code} %************************************************************************ @@ -154,86 +161,101 @@ newDicts :: InstOrigin s -> [(Class, TcType s)] -> NF_TcM s (LIE s, [TcIdOcc s]) newDicts orig theta - = tcGetSrcLoc `thenNF_Tc` \ loc -> - tcGetUniques (length theta) `thenNF_Tc` \ new_uniqs -> - let - mk_dict u (clas, ty) = Dict u clas ty orig loc - dicts = zipWithEqual mk_dict new_uniqs theta - in - returnNF_Tc (listToBag dicts, map instToId dicts) - -newDictsAtLoc orig loc theta -- Local function, similar to newDicts, - -- but with slightly different interface - = tcGetUniques (length theta) `thenNF_Tc` \ new_uniqs -> - let + = tcGetSrcLoc `thenNF_Tc` \ loc -> + newDictsAtLoc orig loc theta `thenNF_Tc` \ (dicts, ids) -> + returnNF_Tc (listToBag dicts, ids) +{- + tcGetUniques (length theta) `thenNF_Tc` \ new_uniqs -> + let mk_dict u (clas, ty) = Dict u clas ty orig loc - dicts = zipWithEqual mk_dict new_uniqs theta - in - returnNF_Tc (dicts, map instToId dicts) + dicts = zipWithEqual "newDicts" mk_dict new_uniqs theta + in + returnNF_Tc (listToBag dicts, map instToId dicts) +-} + +-- Local function, similar to newDicts, +-- but with slightly different interface +newDictsAtLoc :: InstOrigin s + -> SrcLoc + -> [(Class, TcType s)] + -> NF_TcM s ([Inst s], [TcIdOcc s]) +newDictsAtLoc orig loc theta = + tcGetUniques (length theta) `thenNF_Tc` \ new_uniqs -> + let + mk_dict u (clas, ty) = Dict u clas ty orig loc + dicts = zipWithEqual "newDictsAtLoc" mk_dict new_uniqs theta + in + returnNF_Tc (dicts, map instToId dicts) newMethod :: InstOrigin s -> TcIdOcc s -> [TcType s] -> NF_TcM s (LIE s, TcIdOcc s) newMethod orig id tys - = -- Get the Id type and instantiate it at the specified types - (case id of - RealId id -> let (tyvars, rho) = splitForAllTy (idType id) - in tcInstType (tyvars `zipEqual` tys) rho - TcId id -> let (tyvars, rho) = splitForAllTy (idType id) - in tcInstTcType (tyvars `zipEqual` tys) rho - ) `thenNF_Tc` \ rho_ty -> - - -- Our friend does the rest - newMethodWithGivenTy orig id tys rho_ty + = -- Get the Id type and instantiate it at the specified types + (case id of + RealId id -> let (tyvars, rho) = splitForAllTy (idType id) + in + (if length tyvars /= length tys then pprTrace "newMethod" (ppr PprDebug (idType id)) else \x->x) $ + tcInstType (zip{-Equal "newMethod"-} tyvars tys) rho + TcId id -> let (tyvars, rho) = splitForAllTy (idType id) + in returnNF_Tc (instantiateTy (zipEqual "newMethod(2)" tyvars tys) rho) + ) `thenNF_Tc` \ rho_ty -> + -- Our friend does the rest + newMethodWithGivenTy orig id tys rho_ty newMethodWithGivenTy orig id tys rho_ty - = tcGetSrcLoc `thenNF_Tc` \ loc -> - tcGetUnique `thenNF_Tc` \ new_uniq -> - let + = tcGetSrcLoc `thenNF_Tc` \ loc -> + tcGetUnique `thenNF_Tc` \ new_uniq -> + let meth_inst = Method new_uniq id tys rho_ty orig loc - in - returnNF_Tc (unitLIE meth_inst, instToId meth_inst) + in + returnNF_Tc (unitLIE meth_inst, instToId meth_inst) newMethodAtLoc :: InstOrigin s -> SrcLoc -> Id -> [TcType s] -> NF_TcM s (Inst s, TcIdOcc s) newMethodAtLoc orig loc real_id tys -- Local function, similar to newMethod but with -- slightly different interface - = -- Get the Id type and instantiate it at the specified types - let - (tyvars,rho) = splitForAllTy (idType real_id) - in - tcInstType (tyvars `zipEqual` tys) rho `thenNF_Tc` \ rho_ty -> - tcGetUnique `thenNF_Tc` \ new_uniq -> - let + = -- Get the Id type and instantiate it at the specified types + let + (tyvars,rho) = splitForAllTy (idType real_id) + in + tcInstType (zipEqual "newMethodAtLoc" tyvars tys) rho `thenNF_Tc` \ rho_ty -> + tcGetUnique `thenNF_Tc` \ new_uniq -> + let meth_inst = Method new_uniq (RealId real_id) tys rho_ty orig loc - in - returnNF_Tc (meth_inst, instToId meth_inst) + in + returnNF_Tc (meth_inst, instToId meth_inst) newOverloadedLit :: InstOrigin s -> OverloadedLit -> TcType s -> NF_TcM s (LIE s, TcIdOcc s) newOverloadedLit orig lit ty - = tcGetSrcLoc `thenNF_Tc` \ loc -> - tcGetUnique `thenNF_Tc` \ new_uniq -> - let + = tcGetSrcLoc `thenNF_Tc` \ loc -> + tcGetUnique `thenNF_Tc` \ new_uniq -> + let lit_inst = LitInst new_uniq lit ty orig loc - in - returnNF_Tc (unitLIE lit_inst, instToId lit_inst) + in + returnNF_Tc (unitLIE lit_inst, instToId lit_inst) \end{code} \begin{code} instToId :: Inst s -> TcIdOcc s instToId (Dict u clas ty orig loc) - = TcId (mkInstId u (mkDictTy clas ty) (mkLocalName u SLIT("dict") loc)) + = TcId (mkInstId u (mkDictTy clas ty) (mkLocalName u str loc)) + where + str = VarOcc (SLIT("d.") _APPEND_ (occNameString (getOccName clas))) + instToId (Method u id tys rho_ty orig loc) - = TcId (mkInstId u tau_ty (mkLocalName u (getLocalName id) loc)) + = TcId (mkInstId u tau_ty (mkLocalName u str loc)) where (_, tau_ty) = splitRhoTy rho_ty -- NB The method Id has just the tau type + str = VarOcc (SLIT("m.") _APPEND_ (occNameString (getOccName id))) + instToId (LitInst u list ty orig loc) - = TcId (mkInstId u ty (mkLocalName u SLIT("lit") loc)) + = TcId (mkInstId u ty (mkSysLocalName u SLIT("lit") loc)) \end{code} \begin{code} @@ -270,7 +292,9 @@ zonkInst (LitInst u lit ty orig loc) \begin{code} tyVarsOfInst :: Inst s -> TcTyVarSet s tyVarsOfInst (Dict _ _ ty _ _) = tyVarsOfType ty -tyVarsOfInst (Method _ _ tys rho _ _) = tyVarsOfTypes tys +tyVarsOfInst (Method _ id tys rho _ _) = tyVarsOfTypes tys `unionTyVarSets` tcIdTyVars id + -- The id might not be a RealId; in the case of + -- locally-overloaded class methods, for example tyVarsOfInst (LitInst _ _ ty _ _) = tyVarsOfType ty \end{code} @@ -318,19 +342,12 @@ must be witnessed by an actual binding; the second tells whether an \begin{code} instBindingRequired :: Inst s -> Bool -instBindingRequired inst - = case getInstOrigin inst of - CCallOrigin _ _ -> False -- No binding required - LitLitOrigin _ -> False - OccurrenceOfCon _ -> False - other -> True +instBindingRequired (Dict _ clas _ _ _) = not (isNoDictClass clas) +instBindingRequired other = True instCanBeGeneralised :: Inst s -> Bool -instCanBeGeneralised inst - = case getInstOrigin inst of - CCallOrigin _ _ -> False -- Can't be generalised - LitLitOrigin _ -> False -- Can't be generalised - other -> True +instCanBeGeneralised (Dict _ clas _ _ _) = not (isCcallishClass clas) +instCanBeGeneralised other = True \end{code} @@ -341,36 +358,29 @@ relevant in error messages. \begin{code} instance Outputable (Inst s) where - ppr sty (LitInst uniq lit ty orig loc) - = ppHang (ppSep [case lit of - OverloadedIntegral i -> ppInteger i - OverloadedFractional f -> ppRational f, - ppStr "at", - ppr sty ty, - show_uniq sty uniq - ]) - 4 (show_origin sty orig) - - ppr sty (Dict uniq clas ty orig loc) - = ppHang (ppSep [ppr sty clas, - ppStr "at", - ppr sty ty, - show_uniq sty uniq - ]) - 4 (show_origin sty orig) - - ppr sty (Method uniq id tys rho orig loc) - = ppHang (ppSep [ppr sty id, - ppStr "at", - ppr sty tys, - show_uniq sty uniq - ]) - 4 (show_origin sty orig) - -show_uniq PprDebug uniq = ppr PprDebug uniq -show_uniq sty uniq = ppNil - -show_origin sty orig = ppBesides [ppLparen, pprOrigin sty orig, ppRparen] + ppr sty inst = ppr_inst sty ppNil (\ o l -> ppNil) inst + +pprInst sty hdr inst = ppr_inst sty hdr (\ o l -> pprOrigin hdr o l sty) inst + +ppr_inst sty hdr ppr_orig (LitInst u lit ty orig loc) + = ppHang (ppr_orig orig loc) + 4 (ppCat [case lit of + OverloadedIntegral i -> ppInteger i + OverloadedFractional f -> ppRational f, + ppPStr SLIT("at"), + ppr sty ty, + show_uniq sty u]) + +ppr_inst sty hdr ppr_orig (Dict u clas ty orig loc) + = ppHang (ppr_orig orig loc) + 4 (ppCat [ppr sty clas, pprParendGenType sty ty, show_uniq sty u]) + +ppr_inst sty hdr ppr_orig (Method u id tys rho orig loc) + = ppHang (ppr_orig orig loc) + 4 (ppCat [ppr sty id, ppPStr SLIT("at"), interppSP sty tys, show_uniq sty u]) + +show_uniq PprDebug u = ppr PprDebug u +show_uniq sty u = ppNil \end{code} Printing in error messages @@ -413,7 +423,9 @@ lookupInst :: Inst s lookupInst dict@(Dict _ clas ty orig loc) = case lookupMEnv matchTy (get_inst_env clas orig) ty of - Nothing -> failTc (noInstanceErr dict) + Nothing -> tcAddSrcLoc loc $ + tcAddErrCtxt (pprOrigin ""{-hdr-} orig loc) $ + failTc (noInstanceErr dict) Just (dfun_id, tenv) -> let @@ -453,15 +465,22 @@ lookupInst inst@(LitInst u (OverloadedIntegral i) ty orig loc) = -- Alas, it is overloaded and a big literal! tcLookupGlobalValueByKey fromIntegerClassOpKey `thenNF_Tc` \ from_integer -> newMethodAtLoc orig loc from_integer [ty] `thenNF_Tc` \ (method_inst, method_id) -> - returnTc ([method_inst], (instToId inst, HsApp (HsVar method_id) (HsLitOut (HsInt i) ty))) + returnTc ([method_inst], (instToId inst, HsApp (HsVar method_id) (HsLitOut (HsInt i) integerTy))) where intprim_lit = HsLitOut (HsIntPrim i) intPrimTy int_lit = HsApp (HsVar (RealId intDataCon)) intprim_lit lookupInst inst@(LitInst u (OverloadedFractional f) ty orig loc) = tcLookupGlobalValueByKey fromRationalClassOpKey `thenNF_Tc` \ from_rational -> + + -- The type Rational isn't wired in so we have to conjure it up + tcLookupTyConByKey rationalTyConKey `thenNF_Tc` \ rational_tycon -> + let + rational_ty = mkSynTy rational_tycon [] + rational_lit = HsLitOut (HsFrac f) rational_ty + in newMethodAtLoc orig loc from_rational [ty] `thenNF_Tc` \ (method_inst, method_id) -> - returnTc ([method_inst], (instToId inst, HsApp (HsVar method_id) (HsLitOut (HsFrac f) ty))) + returnTc ([method_inst], (instToId inst, HsApp (HsVar method_id) rational_lit)) \end{code} There is a second, simpler interface, when you want an instance of a @@ -470,15 +489,21 @@ appropriate dictionary if it exists. It is used only when resolving ambiguous dictionaries. \begin{code} -lookupClassInstAtSimpleType :: Class -> Type -> Maybe Id - -lookupClassInstAtSimpleType clas ty - = case (lookupMEnv matchTy (getClassInstEnv clas) ty) of - Nothing -> Nothing - Just (dfun,_) -> ASSERT( null tyvars && null theta ) - Just dfun - where - (tyvars, theta, _) = splitSigmaTy (idType dfun) +lookupSimpleInst :: ClassInstEnv + -> Class + -> Type -- Look up (c,t) + -> TcM s [(Class,Type)] -- Here are the needed (c,t)s + +lookupSimpleInst class_inst_env clas ty + = case (lookupMEnv matchTy class_inst_env ty) of + Nothing -> failTc (noSimpleInst clas ty) + Just (dfun,tenv) -> returnTc [(c,instantiateTy tenv t) | (c,t) <- theta] + where + (_, theta, _) = splitSigmaTy (idType dfun) + +noSimpleInst clas ty sty + = ppSep [ppPStr SLIT("No instance for class"), ppQuote (ppr sty clas), + ppPStr SLIT("at type"), ppQuote (ppr sty ty)] \end{code} @@ -499,7 +524,7 @@ mkInstSpecEnv :: Class -- class mkInstSpecEnv clas inst_ty inst_tvs inst_theta = mkSpecEnv (catMaybes (map maybe_spec_info matches)) where - matches = matchMEnv matchTy (getClassInstEnv clas) inst_ty + matches = matchMEnv matchTy (classInstEnv clas) inst_ty maybe_spec_info (_, match_info, MkInstTemplate dfun _ []) = Just (SpecInfo (map (assocMaybe match_info) inst_tvs) (length inst_theta) dfun) @@ -554,9 +579,10 @@ data InstOrigin s | ClassDeclOrigin -- Manufactured during a class decl - | DerivingOrigin InstanceMapper - Class - TyCon +-- NO MORE! +-- | DerivingOrigin InstanceMapper +-- Class +-- TyCon -- During "deriving" operations we have an ever changing -- mapping of classes to instances, so we record it inside the @@ -572,7 +598,7 @@ data InstOrigin s -- origin information. This is a bit of a hack, but it works -- fine. (Patrick is to blame [WDP].) - | DefaultDeclOrigin -- Related to a `default' declaration +-- | DefaultDeclOrigin -- Related to a `default' declaration | ValSpecOrigin Name -- in a SPECIALIZE pragma for a value @@ -597,58 +623,50 @@ data InstOrigin s -- find a mapping from classes to envts inside the dict origin. get_inst_env :: Class -> InstOrigin s -> ClassInstEnv -get_inst_env clas (DerivingOrigin inst_mapper _ _) - = fst (inst_mapper clas) +-- get_inst_env clas (DerivingOrigin inst_mapper _ _) +-- = fst (inst_mapper clas) get_inst_env clas (InstanceSpecOrigin inst_mapper _ _) = fst (inst_mapper clas) -get_inst_env clas other_orig = getClassInstEnv clas +get_inst_env clas other_orig = classInstEnv clas -pprOrigin :: PprStyle -> InstOrigin s -> Pretty +pprOrigin :: String -> InstOrigin s -> SrcLoc -> Error -pprOrigin sty (OccurrenceOf id) - = ppBesides [ppPStr SLIT("at a use of an overloaded identifier: `"), +pprOrigin hdr orig locn + = addErrLoc locn hdr $ \ sty -> + case orig of + OccurrenceOf id -> + ppBesides [ppPStr SLIT("at a use of an overloaded identifier: `"), ppr sty id, ppChar '\''] -pprOrigin sty (OccurrenceOfCon id) - = ppBesides [ppPStr SLIT("at a use of an overloaded constructor: `"), + OccurrenceOfCon id -> + ppBesides [ppPStr SLIT("at a use of an overloaded constructor: `"), ppr sty id, ppChar '\''] -pprOrigin sty (InstanceDeclOrigin) - = ppStr "in an instance declaration" -pprOrigin sty (LiteralOrigin lit) - = ppCat [ppStr "at an overloaded literal:", ppr sty lit] -pprOrigin sty (ArithSeqOrigin seq) - = ppCat [ppStr "at an arithmetic sequence:", ppr sty seq] -pprOrigin sty (SignatureOrigin) - = ppStr "in a type signature" -pprOrigin sty (DoOrigin) - = ppStr "in a do statement" -pprOrigin sty (ClassDeclOrigin) - = ppStr "in a class declaration" -pprOrigin sty (DerivingOrigin _ clas tycon) - = ppBesides [ppStr "in a `deriving' clause; class `", - ppr sty clas, - ppStr "'; offending type `", - ppr sty tycon, - ppStr "'"] -pprOrigin sty (InstanceSpecOrigin _ clas ty) - = ppBesides [ppStr "in a SPECIALIZE instance pragma; class \"", + InstanceDeclOrigin -> + ppPStr SLIT("in an instance declaration") + LiteralOrigin lit -> + ppCat [ppPStr SLIT("at an overloaded literal:"), ppr sty lit] + ArithSeqOrigin seq -> + ppCat [ppPStr SLIT("at an arithmetic sequence:"), ppr sty seq] + SignatureOrigin -> + ppPStr SLIT("in a type signature") + DoOrigin -> + ppPStr SLIT("in a do statement") + ClassDeclOrigin -> + ppPStr SLIT("in a class declaration") + InstanceSpecOrigin _ clas ty -> + ppBesides [ppStr "in a SPECIALIZE instance pragma; class \"", ppr sty clas, ppStr "\" type: ", ppr sty ty] -pprOrigin sty (DefaultDeclOrigin) - = ppStr "in a `default' declaration" -pprOrigin sty (ValSpecOrigin name) - = ppBesides [ppStr "in a SPECIALIZE user-pragma for `", - ppr sty name, ppStr "'"] -pprOrigin sty (CCallOrigin clabel Nothing{-ccall result-}) - = ppBesides [ppStr "in the result of the _ccall_ to `", - ppStr clabel, ppStr "'"] -pprOrigin sty (CCallOrigin clabel (Just arg_expr)) - = ppBesides [ppStr "in an argument in the _ccall_ to `", + ValSpecOrigin name -> + ppBesides [ppPStr SLIT("in a SPECIALIZE user-pragma for `"), + ppr sty name, ppChar '\''] + CCallOrigin clabel Nothing{-ccall result-} -> + ppBesides [ppPStr SLIT("in the result of the _ccall_ to `"), + ppStr clabel, ppChar '\''] + CCallOrigin clabel (Just arg_expr) -> + ppBesides [ppPStr SLIT("in an argument in the _ccall_ to `"), ppStr clabel, ppStr "', namely: ", ppr sty arg_expr] -pprOrigin sty (LitLitOrigin s) - = ppBesides [ppStr "in this ``literal-literal'': ", ppStr s] -pprOrigin sty UnknownOrigin - = ppStr "in... oops -- I don't know where the overloading came from!" + LitLitOrigin s -> + ppBesides [ppPStr SLIT("in this ``literal-literal'': "), ppStr s] + UnknownOrigin -> + ppPStr SLIT("in... oops -- I don't know where the overloading came from!") \end{code} - - -