%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
%
\section[TcSimplify]{TcSimplify}
#include "HsVersions.h"
module TcSimplify (
- tcSimplify, tcSimplifyAndCheck, tcSimplifyWithExtraGlobals,
+ tcSimplify, tcSimplifyAndCheck,
tcSimplifyTop, tcSimplifyThetas, tcSimplifyCheckThetas, tcSimplifyRank2,
bindInstsOfLocalFuns
) where
-import Ubiq
+IMP_Ubiq()
import HsSyn ( MonoBinds(..), HsExpr(..), InPat, OutPat, HsLit,
- Match, HsBinds, Qual, PolyType, ArithSeqInfo,
- GRHSsAndBinds, Stmt, Fake )
-import TcHsSyn ( TcIdOcc(..), TcIdBndr(..), TcExpr(..), TcMonoBinds(..) )
+ Match, HsBinds, HsType, ArithSeqInfo, Fixity,
+ GRHSsAndBinds, Stmt, DoOrListComp, Fake )
+import HsBinds ( andMonoBinds )
+import TcHsSyn ( TcIdOcc(..), SYN_IE(TcIdBndr), SYN_IE(TcExpr),
+ SYN_IE(TcMonoBinds), SYN_IE(TcDictBinds) )
import TcMonad
-import Inst ( lookupInst, tyVarsOfInst, isTyVarDict, isDict, matchesInst,
- instToId, instBindingRequired, instCanBeGeneralised, newDictsAtLoc,
- Inst(..), LIE(..), zonkLIE, emptyLIE, plusLIE, unitLIE, consLIE,
- InstOrigin(..), OverloadedLit )
+import Inst ( lookupInst, lookupSimpleInst,
+ tyVarsOfInst, isTyVarDict, isDict,
+ matchesInst, instToId, instBindingRequired,
+ instCanBeGeneralised, newDictsAtLoc,
+ pprInst,
+ Inst(..), SYN_IE(LIE), zonkLIE, emptyLIE,
+ plusLIE, unitLIE, consLIE, InstOrigin(..),
+ OverloadedLit )
import TcEnv ( tcGetGlobalTyVars )
-import TcType ( TcType(..), TcTyVar(..), TcTyVarSet(..), TcMaybe, tcInstType )
+import SpecEnv ( SpecEnv )
+import TcType ( SYN_IE(TcType), SYN_IE(TcTyVar), SYN_IE(TcTyVarSet), TcMaybe, tcInstType )
import Unify ( unifyTauTy )
import Bag ( Bag, unitBag, listToBag, foldBag, filterBag, emptyBag, bagToList,
snocBag, consBag, unionBags, isEmptyBag )
-import Class ( isNumericClass, isStandardClass, isCcallishClass,
- isSuperClassOf, getSuperDictSelId )
+import Class ( GenClass, SYN_IE(Class), SYN_IE(ClassInstEnv),
+ isSuperClassOf, classSuperDictSelId, classInstEnv
+ )
import Id ( GenId )
-import Maybes ( expectJust, firstJust, catMaybes, seqMaybe, maybeToBool, Maybe(..) )
-import Outputable ( Outputable(..) )
+import PrelInfo ( isNumericClass, isStandardClass, isCcallishClass )
+
+import Maybes ( expectJust, firstJust, catMaybes, seqMaybe, maybeToBool )
+import Outputable ( Outputable(..){-instance * []-} )
+import PprStyle
import PprType ( GenType, GenTyVar )
import Pretty
-import SrcLoc ( mkUnknownSrcLoc )
-import Util
-import Type ( GenType, Type(..), TauType(..), mkTyVarTy, getTyVar, eqSimpleTy )
-import TysWiredIn ( intTy )
-import TyVar ( GenTyVar, GenTyVarSet(..),
+import SrcLoc ( noSrcLoc )
+import Type ( GenType, SYN_IE(Type), SYN_IE(TauType), mkTyVarTy, getTyVar, eqSimpleTy,
+ getTyVar_maybe )
+import TysWiredIn ( intTy, unitTy )
+import TyVar ( GenTyVar, SYN_IE(GenTyVarSet),
elementOfTyVarSet, emptyTyVarSet, unionTyVarSets,
isEmptyTyVarSet, tyVarSetToList )
import Unique ( Unique )
+import Util
\end{code}
-> LIE s -- Given; these constrain only local tyvars
-> LIE s -- Wanted
-> TcM s (LIE s, -- Free
- [(TcIdOcc s,TcExpr s)], -- Bindings
+ TcMonoBinds s, -- Bindings
LIE s) -- Remaining wanteds; no dups
tcSimpl squash_consts global_tvs local_tvs givens wanteds
elimSCs givens locals `thenNF_Tc` \ (sc_binds, locals2) ->
-- Finished
- returnTc (globals, bagToList (sc_binds `unionBags` tycon_binds), locals2)
+ returnTc (globals, sc_binds `AndMonoBinds` tycon_binds, locals2)
where
is_ambiguous (Dict _ _ ty _ _)
= not (getTyVar "is_ambiguous" ty `elementOfTyVarSet` local_tvs)
:: TcTyVarSet s -- ``Local'' type variables
-> LIE s -- Wanted
-> TcM s (LIE s, -- Free
- [(TcIdOcc s,TcExpr s)], -- Bindings
+ TcDictBinds s, -- Bindings
LIE s) -- Remaining wanteds; no dups
tcSimplify local_tvs wanteds
tcSimpl False global_tvs local_tvs emptyBag wanteds
\end{code}
-@tcSimplifyWithExtraGlobals@ is just like @tcSimplify@ except that you get
-to specify some extra global type variables that the simplifer will treat
-as free in the environment.
-
-\begin{code}
-tcSimplifyWithExtraGlobals
- :: TcTyVarSet s -- Extra ``Global'' type variables
- -> TcTyVarSet s -- ``Local'' type variables
- -> LIE s -- Wanted
- -> TcM s (LIE s, -- Free
- [(TcIdOcc s,TcExpr s)], -- Bindings
- LIE s) -- Remaining wanteds; no dups
-
-tcSimplifyWithExtraGlobals extra_global_tvs local_tvs wanteds
- = tcGetGlobalTyVars `thenNF_Tc` \ global_tvs ->
- tcSimpl False
- (global_tvs `unionTyVarSets` extra_global_tvs)
- local_tvs emptyBag wanteds
-\end{code}
-
@tcSimplifyAndCheck@ is similar to the above, except that it checks
that there is an empty wanted-set at the end. It may still return
some of constant insts, which have to be resolved finally at the end.
:: TcTyVarSet s -- ``Local'' type variables; ASSERT is fixpoint
-> LIE s -- Given
-> LIE s -- Wanted
- -> TcM s (LIE s, -- Free
- [(TcIdOcc s,TcExpr s)]) -- Bindings
+ -> TcM s (LIE s, -- Free
+ TcDictBinds s) -- Bindings
tcSimplifyAndCheck local_tvs givens wanteds
= tcGetGlobalTyVars `thenNF_Tc` \ global_tvs ->
tcSimplifyRank2 :: TcTyVarSet s -- ``Local'' type variables; ASSERT is fixpoint
-> LIE s -- Given
-> TcM s (LIE s, -- Free
- [(TcIdOcc s,TcExpr s)]) -- Bindings
+ TcDictBinds s) -- Bindings
tcSimplifyRank2 local_tvs givens
checkTc (isEmptyBag wanteds) (reduceErr wanteds) `thenTc_`
- returnTc (free, bagToList dict_binds)
+ returnTc (free, dict_binds)
\end{code}
@tcSimplifyTop@ deals with constant @Insts@, using the standard simplification
mechansim with the extra flag to say ``beat out constant insts''.
\begin{code}
-tcSimplifyTop :: LIE s -> TcM s [(TcIdOcc s, TcExpr s)]
+tcSimplifyTop :: LIE s -> TcM s (TcDictBinds s)
tcSimplifyTop dicts
- = tcGetGlobalTyVars `thenNF_Tc` \ global_tvs ->
- tcSimpl True emptyTyVarSet emptyTyVarSet emptyBag dicts `thenTc` \ (_, binds, _) ->
+ = tcSimpl True emptyTyVarSet emptyTyVarSet emptyBag dicts `thenTc` \ (_, binds, _) ->
returnTc binds
\end{code}
-@tcSimplifyThetas@ simplifies class-type constraints formed by
-@deriving@ declarations and when specialising instances. We are
-only interested in the simplified bunch of class/type constraints.
-
-\begin{code}
-tcSimplifyThetas :: (Class -> TauType -> InstOrigin s) -- Creates an origin for the dummy dicts
- -> [(Class, TauType)] -- Simplify this
- -> TcM s [(Class, TauType)] -- Result
-
-tcSimplifyThetas = panic "tcSimplifyThetas"
-
-{- LATER
-tcSimplifyThetas mk_inst_origin theta
- = let
- dicts = listToBag (map mk_dummy_dict theta)
- in
- -- Do the business (this is just the heart of "tcSimpl")
- elimTyCons True (\tv -> False) emptyLIE dicts `thenTc` \ (_, _, dicts2) ->
-
- -- Deal with superclass relationships
- elimSCs [] dicts2 `thenNF_Tc` \ (_, dicts3) ->
-
- returnTc (map unmk_dummy_dict (bagToList dicts3))
- where
- mk_dummy_dict (clas, ty) = Dict uniq clas ty (mk_inst_origin clas ty) mkUnknownSrcLoc
- uniq = panic "tcSimplifyThetas:uniq"
-
- unmk_dummy_dict (Dict _ clas ty _ _) = (clas, ty)
--}
-\end{code}
-
-@tcSimplifyCheckThetas@ just checks class-type constraints, essentially;
-used with \tr{default} declarations. We are only interested in
-whether it worked or not.
-
-\begin{code}
-tcSimplifyCheckThetas :: InstOrigin s -- context; for error msg
- -> [(Class, TauType)] -- Simplify this
- -> TcM s ()
-
-tcSimplifyCheckThetas = panic "tcSimplifyCheckThetas"
-
-{- LATER
-tcSimplifyCheckThetas origin theta
- = let
- dicts = map mk_dummy_dict theta
- in
- -- Do the business (this is just the heart of "tcSimpl")
- elimTyCons True (\tv -> False) emptyLIE dicts `thenTc` \ _ ->
-
- returnTc ()
- where
- mk_dummy_dict (clas, ty)
- = Dict uniq clas ty origin mkUnknownSrcLoc
-
- uniq = panic "tcSimplifyCheckThetas:uniq"
--}
-\end{code}
-
-
%************************************************************************
%* *
\subsection[elimTyCons]{@elimTyCons@}
-> LIE s -- Given
-> LIE s -- Wanted
-> TcM s (LIE s, -- Free
- Bag (TcIdOcc s, TcExpr s), -- Bindings
+ TcDictBinds s, -- Bindings
LIE s -- Remaining wanteds; no dups;
-- dicts only (no Methods)
)
returnTc (free,binds,irreds)
where
-- eTC :: LIE s -> [Inst s]
--- -> TcM s (LIE s, LIE s, Bag (TcIdOcc s, TcExpr s), LIE s)
+-- -> TcM s (LIE s, LIE s, TcDictBinds s, LIE s)
- eTC givens [] = returnTc (givens, emptyBag, emptyBag, emptyBag)
+ eTC givens [] = returnTc (givens, emptyBag, EmptyMonoBinds, emptyBag)
eTC givens (wanted:wanteds)
-- Case 0: same as an existing inst
let
-- Create a new binding iff it's needed
this = expectJust "eTC" maybe_equiv
- new_binds | instBindingRequired wanted = (instToId wanted, HsVar (instToId this))
- `consBag` binds
+ new_binds | instBindingRequired wanted = (VarMonoBind (instToId wanted) (HsVar (instToId this)))
+ `AndMonoBinds` binds
| otherwise = binds
in
returnTc (givens1, frees, new_binds, irreds)
simplify_it simplify_always givens wanted wanteds
-- Recover immediately on no-such-instance errors
- = recoverTc (returnTc (wanted `consBag` givens, emptyLIE, emptyBag, emptyLIE))
+ = recoverTc (returnTc (wanted `consBag` givens, emptyLIE, EmptyMonoBinds, emptyLIE))
(simplify_one simplify_always givens wanted)
`thenTc` \ (givens1, frees1, binds1, irreds1) ->
eTC givens1 wanteds `thenTc` \ (givens2, frees2, binds2, irreds2) ->
returnTc (givens2, frees1 `plusLIE` frees2,
- binds1 `unionBags` binds2,
+ binds1 `AndMonoBinds` binds2,
irreds1 `plusLIE` irreds2)
| otherwise
= -- An binding is required for this inst
- lookupInst wanted `thenTc` \ (simpler_wanteds, bind@(_,rhs)) ->
+ lookupInst wanted `thenTc` \ (simpler_wanteds, bind@(VarMonoBind _ rhs)) ->
if (not_var rhs && not simplify_always) then
-- Ho ho! It isn't trivial to simplify "wanted",
-- because the rhs isn't a simple variable. Unless the flag
-- simplify_always is set, just give up now and
-- just fling it out the top.
- returnTc (wanted `consLIE` givens, unitLIE wanted, emptyBag, emptyLIE)
+ returnTc (wanted `consLIE` givens, unitLIE wanted, EmptyMonoBinds, emptyLIE)
else
-- Aha! Either it's easy, or simplify_always is True
-- so we must do it right here.
eTC givens simpler_wanteds `thenTc` \ (givens1, frees1, binds1, irreds1) ->
returnTc (wanted `consLIE` givens1, frees1,
- binds1 `snocBag` bind,
+ binds1 `AndMonoBinds` bind,
irreds1)
not_var :: TcExpr s -> Bool
elimSCs :: LIE s -- Given; no dups
-> LIE s -- Wanted; no dups; all dictionaries, all
-- constraining just a type variable
- -> NF_TcM s (Bag (TcIdOcc s,TcExpr s), -- Bindings
+ -> NF_TcM s (TcDictBinds s, -- Bindings
LIE s) -- Minimal wanted set
elimSCs givens wanteds
elimSCs_help :: LIE s -- Given; no dups
-> [Inst s] -- Wanted; no dups;
- -> NF_TcM s (Bag (TcIdOcc s, TcExpr s), -- Bindings
+ -> NF_TcM s (TcDictBinds s, -- Bindings
LIE s) -- Minimal wanted set
-elimSCs_help given [] = returnNF_Tc (emptyBag, emptyLIE)
+elimSCs_help given [] = returnNF_Tc (EmptyMonoBinds, emptyLIE)
elimSCs_help givens (wanted:wanteds)
= trySC givens wanted `thenNF_Tc` \ (givens1, binds1, irreds1) ->
elimSCs_help givens1 wanteds `thenNF_Tc` \ (binds2, irreds2) ->
- returnNF_Tc (binds1 `unionBags` binds2, irreds1 `plusLIE` irreds2)
+ returnNF_Tc (binds1 `AndMonoBinds` binds2, irreds1 `plusLIE` irreds2)
trySC :: LIE s -- Givens
-> Inst s -- Wanted
-> NF_TcM s (LIE s, -- New givens,
- Bag (TcIdOcc s,TcExpr s), -- Bindings
+ TcDictBinds s, -- Bindings
LIE s) -- Irreducible wanted set
trySC givens wanted@(Dict _ wanted_class wanted_ty wanted_orig loc)
| not (maybeToBool maybe_best_subclass_chain)
= -- No superclass relationship
- returnNF_Tc (givens, emptyBag, unitLIE wanted)
+ returnNF_Tc ((wanted `consLIE` givens), EmptyMonoBinds, unitLIE wanted)
| otherwise
= -- There's a subclass relationship with a "given"
let
mk_bind (dict,clas) dict_sub@(Dict _ dict_sub_class ty _ _)
= ((dict_sub, dict_sub_class),
- (instToId dict, DictApp (TyApp (HsVar (RealId (getSuperDictSelId dict_sub_class
+ (VarMonoBind (instToId dict)
+ (DictApp (TyApp (HsVar (RealId (classSuperDictSelId dict_sub_class
clas)))
[ty])
- [instToId dict_sub]))
+ [instToId dict_sub])))
(_, new_binds) = mapAccumR mk_bind (wanted,wanted_class) (given : intermediates)
in
returnNF_Tc (wanted `consLIE` givens `plusLIE` listToBag intermediates,
- listToBag new_binds,
+ andMonoBinds new_binds,
emptyLIE)
where
sortSC dicts = sortLt lt (bagToList dicts)
where
(Dict _ c1 ty1 _ _) `lt` (Dict _ c2 ty2 _ _)
- = if ty1 `eqSimpleTy` ty2 then
- maybeToBool (c2 `isSuperClassOf` c1)
- else
- -- order is immaterial, I think...
- False
+ = maybeToBool (c2 `isSuperClassOf` c1)
+ -- The ice is a bit thin here because this "lt" isn't a total order
+ -- But it *is* transitive, so it works ok
\end{code}
%************************************************************************
%* *
+\subsection[simple]{@Simple@ versions}
+%* *
+%************************************************************************
+
+Much simpler versions when there are no bindings to make!
+
+@tcSimplifyThetas@ simplifies class-type constraints formed by
+@deriving@ declarations and when specialising instances. We are
+only interested in the simplified bunch of class/type constraints.
+
+\begin{code}
+tcSimplifyThetas :: (Class -> ClassInstEnv) -- How to find the ClassInstEnv
+ -> [(Class, TauType)] -- Given
+ -> [(Class, TauType)] -- Wanted
+ -> TcM s [(Class, TauType)]
+
+
+tcSimplifyThetas inst_mapper given wanted
+ = elimTyConsSimple inst_mapper wanted `thenTc` \ wanted1 ->
+ returnTc (elimSCsSimple given wanted1)
+\end{code}
+
+@tcSimplifyCheckThetas@ just checks class-type constraints, essentially;
+used with \tr{default} declarations. We are only interested in
+whether it worked or not.
+
+\begin{code}
+tcSimplifyCheckThetas :: [(Class, TauType)] -- Simplify this to nothing at all
+ -> TcM s ()
+
+tcSimplifyCheckThetas theta
+ = elimTyConsSimple classInstEnv theta `thenTc` \ theta1 ->
+ ASSERT( null theta1 )
+ returnTc ()
+\end{code}
+
+
+\begin{code}
+elimTyConsSimple :: (Class -> ClassInstEnv)
+ -> [(Class,Type)]
+ -> TcM s [(Class,Type)]
+elimTyConsSimple inst_mapper theta
+ = elim theta
+ where
+ elim [] = returnTc []
+ elim ((clas,ty):rest) = elim_one clas ty `thenTc` \ r1 ->
+ elim rest `thenTc` \ r2 ->
+ returnTc (r1++r2)
+
+ elim_one clas ty
+ = case getTyVar_maybe ty of
+
+ Just tv -> returnTc [(clas,ty)]
+
+ otherwise -> recoverTc (returnTc []) $
+ lookupSimpleInst (inst_mapper clas) clas ty `thenTc` \ theta ->
+ elim theta
+
+elimSCsSimple :: [(Class,Type)] -- Given
+ -> [(Class,Type)] -- Wanted
+ -> [(Class,Type)] -- Subset of wanted; no dups, no subclass relnships
+
+elimSCsSimple givens [] = []
+elimSCsSimple givens (c_t@(clas,ty) : rest)
+ | any (`subsumes` c_t) givens ||
+ any (`subsumes` c_t) rest -- (clas,ty) is old hat
+ = elimSCsSimple givens rest
+ | otherwise -- (clas,ty) is new
+ = c_t : elimSCsSimple (c_t : givens) rest
+ where
+ rest' = elimSCsSimple rest
+ (c1,t1) `subsumes` (c2,t2) = t1 `eqSimpleTy` t2 &&
+ (c1 == c2 || maybeToBool (c2 `isSuperClassOf` c1))
+-- We deal with duplicates here ^^^^^^^^
+-- It's a simple place to do it, although it's done in elimTyCons in the
+-- full-blown version of the simpifier.
+\end{code}
+
+%************************************************************************
+%* *
\subsection[binds-for-local-funs]{@bindInstsOfLocalFuns@}
%* *
%************************************************************************
where
bind_inst inst@(Method uniq (TcId id) tys rho orig loc) (insts, binds)
| id `is_elem` local_ids
- = lookupInst inst `thenTc` \ (dict_insts, (id,rhs)) ->
+ = lookupInst inst `thenTc` \ (dict_insts, bind) ->
returnTc (listToBag dict_insts `plusLIE` insts,
- VarMonoBind id rhs `AndMonoBinds` binds)
+ bind `AndMonoBinds` binds)
bind_inst some_other_inst (insts, binds)
-- Either not a method, or a method instance for an id not in local_ids
\end{verbatim}
Since we're not using the result of @foo@, the result if (presumably)
@void@.
-WDP Comment: no such thing as voidTy; so not quite in yet (94/07).
-SLPJ comment: since
\begin{code}
disambigOne :: [SimpleDictInfo s] -> TcM s ()
disambigOne dict_infos
- | not (isStandardNumericDefaultable classes)
- = failTc (ambigErr dicts) -- no default
-
- | otherwise -- isStandardNumericDefaultable dict_infos
+ | any isNumericClass classes && all isStandardClass classes
= -- THE DICTS OBEY THE DEFAULTABLE CONSTRAINT
-- SO, TRY DEFAULT TYPES IN ORDER
tcGetDefaultTys `thenNF_Tc` \ default_tys ->
let
try_default [] -- No defaults work, so fail
- = failTc (defaultErr dicts default_tys)
+ = failTc (ambigErr dicts)
try_default (default_ty : default_tys)
= tryTc (try_default default_tys) $ -- If default_ty fails, we try
-- default_tys instead
- tcSimplifyCheckThetas DefaultDeclOrigin thetas `thenTc` \ _ ->
+ tcSimplifyCheckThetas thetas `thenTc` \ _ ->
returnTc default_ty
where
thetas = classes `zip` repeat default_ty
-- See if any default works, and if so bind the type variable to it
try_default default_tys `thenTc` \ chosen_default_ty ->
tcInstType [] chosen_default_ty `thenNF_Tc` \ chosen_default_tc_ty -> -- Tiresome!
- unifyTauTy (mkTyVarTy tyvar) chosen_default_tc_ty
+ unifyTauTy chosen_default_tc_ty (mkTyVarTy tyvar)
+
+ | all isCcallishClass classes
+ = -- Default CCall stuff to (); we don't even both to check that () is an
+ -- instance of CCallable/CReturnable, because we know it is.
+ unifyTauTy (mkTyVarTy tyvar) unitTy
+
+ | otherwise -- No defaults
+ = failTc (ambigErr dicts)
where
(_,_,tyvar) = head dict_infos -- Should be non-empty
\end{code}
-@isStandardNumericDefaultable@ sees whether the dicts have the
-property required for defaulting; namely at least one is numeric, and
-all are standard; or all are CcallIsh.
-
-\begin{code}
-isStandardNumericDefaultable :: [Class] -> Bool
-
-isStandardNumericDefaultable classes
- | any isNumericClass classes && all isStandardClass classes
- = True
-
-isStandardNumericDefaultable classes
- | all isCcallishClass classes
- = True
-
-isStandardNumericDefaultable classes
- = False
-\end{code}
-
Errors and contexts
\begin{code}
genCantGenErr insts sty -- Can't generalise these Insts
- = ppHang (ppStr "Cannot generalise these overloadings (in a _ccall_):")
- 4 (ppAboves (map (ppr sty) (bagToList insts)))
+ = hang (ptext SLIT("Cannot generalise these overloadings (in a _ccall_):"))
+ 4 (vcat (map (ppr sty) (bagToList insts)))
\end{code}
\begin{code}
ambigErr insts sty
- = ppHang (ppStr "Ambiguous overloading")
- 4 (ppAboves (map (ppr sty) insts))
+ = vcat (map (pprInst sty "Ambiguous overloading") insts)
\end{code}
@reduceErr@ complains if we can't express required dictionaries in
\begin{code}
reduceErr insts sty
- = ppHang (ppStr "Type signature lacks context required by inferred type")
- 4 (ppHang (ppStr "Context reqd: ")
- 4 (ppAboves (map (ppr sty) (bagToList insts)))
- )
+ = vcat (map (pprInst sty "Context required by inferred type, but missing on a type signature")
+ (bagToList insts))
\end{code}
-\begin{code}
-defaultErr dicts defaulting_tys sty
- = ppHang (ppStr "Ambiguously-overloaded types could not be resolved:")
- 4 (ppAboves [
- ppHang (ppStr "Conflicting:")
- 4 (ppInterleave ppSemi (map (ppr sty) dicts)),
- ppHang (ppStr "Defaulting types :")
- 4 (ppr sty defaulting_tys),
- ppStr "([Int, Double] is the default list of defaulting types.)" ])
-\end{code}