X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Ftypecheck%2FTcExpr.lhs;h=d3860c7e9f63582ddf8140b47b481c8d4f0f11e3;hb=26741ec416bae2c502ef00a2ba0e79050a32cb67;hp=6b2bec7a860b4a93e7221ef31c65926b9b2ed006;hpb=a77abe6a30ea2763cfa1c0ca83cdce9b7200ced2;p=ghc-hetmet.git diff --git a/ghc/compiler/typecheck/TcExpr.lhs b/ghc/compiler/typecheck/TcExpr.lhs index 6b2bec7..d3860c7 100644 --- a/ghc/compiler/typecheck/TcExpr.lhs +++ b/ghc/compiler/typecheck/TcExpr.lhs @@ -8,13 +8,13 @@ module TcExpr ( tcExpr ) where -import Ubiq +IMP_Ubiq() -import HsSyn ( HsExpr(..), Qual(..), Stmt(..), +import HsSyn ( HsExpr(..), Qualifier(..), Stmt(..), HsBinds(..), Bind(..), MonoBinds(..), ArithSeqInfo(..), HsLit(..), Sig, GRHSsAndBinds, Match, Fake, InPat, OutPat, PolyType, - irrefutablePat, collectPatBinders ) + failureFreePat, collectPatBinders ) import RnHsSyn ( RenamedHsExpr(..), RenamedQual(..), RenamedStmt(..), RenamedRecordBinds(..), RnName{-instance Outputable-} @@ -24,47 +24,51 @@ import TcHsSyn ( TcExpr(..), TcQual(..), TcStmt(..), mkHsTyApp ) -import TcMonad +import TcMonad hiding ( rnMtoTcM ) import Inst ( Inst, InstOrigin(..), OverloadedLit(..), LIE(..), emptyLIE, plusLIE, plusLIEs, newOverloadedLit, newMethod, newMethodWithGivenTy, newDicts ) import TcBinds ( tcBindsAndThen ) import TcEnv ( tcLookupLocalValue, tcLookupGlobalValue, tcLookupClassByKey, - tcLookupGlobalValueByKey, newMonoIds, tcGetGlobalTyVars + tcLookupGlobalValueByKey, newMonoIds, tcGetGlobalTyVars, + tcExtendGlobalTyVars ) import TcMatches ( tcMatchesCase, tcMatch ) import TcMonoType ( tcPolyType ) import TcPat ( tcPat ) import TcSimplify ( tcSimplifyAndCheck, tcSimplifyRank2 ) import TcType ( TcType(..), TcMaybe(..), - tcInstId, tcInstType, tcInstTheta, tcInstTcType, tcInstTyVars, + tcInstId, tcInstType, tcInstSigTcType, + tcInstSigType, tcInstTcType, tcInstTheta, newTyVarTy, zonkTcTyVars, zonkTcType ) import TcKind ( TcKind ) -import Class ( Class(..), classSig ) +import Class ( SYN_IE(Class), classSig ) import FieldLabel ( fieldLabelName ) -import Id ( Id(..), GenId, idType, dataConFieldLabels, dataConSig ) +import Id ( idType, dataConFieldLabels, dataConSig, SYN_IE(Id), GenId ) import Kind ( Kind, mkBoxedTypeKind, mkTypeKind, mkArrowKind ) -import GenSpecEtc ( checkSigTyVars, checkSigTyVarsGivenGlobals ) +import GenSpecEtc ( checkSigTyVars ) import Name ( Name{-instance Eq-} ) -import PrelInfo ( intPrimTy, charPrimTy, doublePrimTy, - floatPrimTy, addrPrimTy, addrTy, - boolTy, charTy, stringTy, mkListTy, - mkTupleTy, mkPrimIoTy ) -import Type ( mkFunTy, mkAppTy, mkTyVarTy, mkTyVarTys, - getTyVar_maybe, getFunTy_maybe, +import Type ( mkFunTy, mkAppTy, mkTyVarTy, mkTyVarTys, mkRhoTy, + getTyVar_maybe, getFunTy_maybe, instantiateTy, splitForAllTy, splitRhoTy, splitSigmaTy, splitFunTy, isTauTy, mkFunTys, tyVarsOfType, getForAllTy_maybe, getAppDataTyCon, maybeAppDataTyCon ) -import TyVar ( GenTyVar, TyVarSet(..), unionTyVarSets, mkTyVarSet ) +import TyVar ( GenTyVar, SYN_IE(TyVarSet), unionTyVarSets, mkTyVarSet ) +import TysPrim ( intPrimTy, charPrimTy, doublePrimTy, + floatPrimTy, addrPrimTy + ) +import TysWiredIn ( addrTy, + boolTy, charTy, stringTy, mkListTy, + mkTupleTy, mkPrimIoTy, primIoDataCon + ) import Unify ( unifyTauTy, unifyTauTyList, unifyTauTyLists, unifyFunTy ) import Unique ( Unique, cCallableClassKey, cReturnableClassKey, enumFromClassOpKey, enumFromThenClassOpKey, enumFromToClassOpKey, enumFromThenToClassOpKey, - monadClassKey, monadZeroClassKey ) - ---import Name ( Name ) -- Instance + thenMClassOpKey, zeroClassOpKey + ) import Outputable ( interpp'SP ) import PprType ( GenType, GenTyVar ) -- Instances import Maybes ( maybeToBool ) @@ -166,9 +170,10 @@ tcExpr (HsLit lit@(HsString str)) %************************************************************************ \begin{code} -tcExpr (HsPar expr) = tcExpr expr +tcExpr (HsPar expr) -- preserve parens so printing needn't guess where they go + = tcExpr expr -tcExpr (NegApp expr n) = tcExpr (HsApp (HsVar n) expr) +tcExpr (NegApp expr neg) = tcExpr (HsApp neg expr) tcExpr (HsLam match) = tcMatch match `thenTc` \ (match',lie,ty) -> @@ -261,10 +266,11 @@ tcExpr (CCall lbl args may_gc is_asm ignored_fake_result_ty) -- Construct the extra insts, which encode the -- constraints on the argument and result types. - mapNF_Tc new_arg_dict (args `zip` arg_tys) `thenNF_Tc` \ ccarg_dicts_s -> - newDicts result_origin [(cReturnableClass, result_ty)] `thenNF_Tc` \ (ccres_dict, _) -> + mapNF_Tc new_arg_dict (zipEqual "tcExpr:CCall" args arg_tys) `thenNF_Tc` \ ccarg_dicts_s -> + newDicts result_origin [(cReturnableClass, result_ty)] `thenNF_Tc` \ (ccres_dict, _) -> - returnTc (CCall lbl args' may_gc is_asm result_ty, + returnTc (HsCon primIoDataCon [result_ty] [CCall lbl args' may_gc is_asm result_ty], + -- do the wrapping in the newtype constructor here foldr plusLIE ccres_dict ccarg_dicts_s `plusLIE` args_lie, mkPrimIoTy result_ty) \end{code} @@ -314,32 +320,8 @@ tcExpr (ListComp expr quals) \end{code} \begin{code} -tcExpr (HsDo stmts src_loc) - = -- get the Monad and MonadZero classes - -- create type consisting of a fresh monad tyvar - tcAddSrcLoc src_loc $ - newTyVarTy monadKind `thenNF_Tc` \ m -> - tcDoStmts False m stmts `thenTc` \ ((stmts',monad,mzero), lie, do_ty) -> - - -- create dictionaries for monad and possibly monadzero - (if monad then - tcLookupClassByKey monadClassKey `thenNF_Tc` \ monadClass -> - newDicts DoOrigin [(monadClass, m)] - else - returnNF_Tc (emptyLIE, [panic "TcExpr: MonadZero dictionary"]) - ) `thenNF_Tc` \ (m_lie, [m_id]) -> - (if mzero then - tcLookupClassByKey monadZeroClassKey `thenNF_Tc` \ monadZeroClass -> - newDicts DoOrigin [(monadZeroClass, m)] - else - returnNF_Tc (emptyLIE, [panic "TcExpr: MonadZero dictionary"]) - ) `thenNF_Tc` \ (mz_lie, [mz_id]) -> - - returnTc (HsDoOut stmts' m_id mz_id src_loc, - lie `plusLIE` m_lie `plusLIE` mz_lie, - do_ty) - where - monadKind = mkArrowKind mkBoxedTypeKind mkBoxedTypeKind +tcExpr expr@(HsDo stmts src_loc) + = tcDoStmts stmts src_loc \end{code} \begin{code} @@ -361,7 +343,7 @@ tcExpr (ExplicitTuple exprs) tcExpr (RecordCon (HsVar con) rbinds) = tcId con `thenNF_Tc` \ (con_expr, con_lie, con_tau) -> let - (_, record_ty) = splitFunTy con_tau + (_, record_ty) = splitFunTy con_tau in -- Con is syntactically constrained to be a data constructor ASSERT( maybeToBool (maybeAppDataTyCon record_ty ) ) @@ -394,14 +376,14 @@ tcExpr (RecordUpd record_expr rbinds) -- Check that the field names are plausible zonkTcType record_ty `thenNF_Tc` \ record_ty' -> let - (tycon, inst_tys, data_cons) = _trace "getAppDataTyCon.TcExpr" $ getAppDataTyCon record_ty' + (tycon, inst_tys, data_cons) = trace "TcExpr.getAppDataTyCon" $ getAppDataTyCon record_ty' -- The record binds are non-empty (syntax); so at least one field -- label will have been unified with record_ty by tcRecordBinds; -- field labels must be of data type; hencd the getAppDataTyCon must succeed. (tyvars, theta, _, _) = dataConSig (head data_cons) in - tcInstTheta (tyvars `zipEqual` inst_tys) theta `thenNF_Tc` \ theta' -> - newDicts RecordUpdOrigin theta' `thenNF_Tc` \ (con_lie, dicts) -> + tcInstTheta (zipEqual "tcExpr:RecordUpd" tyvars inst_tys) theta `thenNF_Tc` \ theta' -> + newDicts RecordUpdOrigin theta' `thenNF_Tc` \ (con_lie, dicts) -> checkTc (any (checkRecordFields rbinds) data_cons) (badFieldsUpd rbinds) `thenTc_` @@ -483,7 +465,7 @@ tcExpr in_expr@(ExprWithTySig expr poly_ty) -- Check the tau-type part tcSetErrCtxt (exprSigCtxt in_expr) $ - tcInstType [] sigma_sig `thenNF_Tc` \ sigma_sig' -> + tcInstSigType sigma_sig `thenNF_Tc` \ sigma_sig' -> let (sig_tyvars', sig_theta', sig_tau') = splitSigmaTy sigma_sig' in @@ -586,14 +568,19 @@ tcArg expected_arg_ty arg -- of instantiating a function involving rank-2 polymorphism, so there -- isn't any danger of using the same tyvars twice -- The argument type shouldn't be overloaded type (hence ASSERT) + + -- To ensure that the forall'd type variables don't get unified with each + -- other or any other types, we make fresh *signature* type variables + -- and unify them with the tyvars. + tcInstSigTcType expected_arg_ty `thenNF_Tc` \ (sig_tyvars, sig_rho) -> let - (expected_tyvars, expected_theta, expected_tau) = splitSigmaTy expected_arg_ty + (sig_theta, sig_tau) = splitRhoTy sig_rho in - ASSERT( null expected_theta ) -- And expected_tyvars are all DontBind things - + ASSERT( null sig_theta ) -- And expected_tyvars are all DontBind things + -- Type-check the arg and unify with expected type tcExpr arg `thenTc` \ (arg', lie_arg, actual_arg_ty) -> - unifyTauTy expected_tau actual_arg_ty `thenTc_` ( + unifyTauTy sig_tau actual_arg_ty `thenTc_` -- Check that the arg_tyvars havn't been constrained -- The interesting bit here is that we must include the free variables @@ -605,32 +592,29 @@ tcArg expected_arg_ty arg -- So now s' isn't unconstrained because it's linked to a. -- Conclusion: include the free vars of the expected arg type in the -- list of "free vars" for the signature check. - tcAddErrCtxt (rank2ArgCtxt arg expected_arg_ty) $ - tcGetGlobalTyVars `thenNF_Tc` \ env_tyvars -> - zonkTcTyVars (tyVarsOfType expected_arg_ty) `thenNF_Tc` \ free_tyvars -> - checkSigTyVarsGivenGlobals - (env_tyvars `unionTyVarSets` free_tyvars) - expected_tyvars expected_tau `thenTc_` - - -- Check that there's no overloading involved - -- Even if there isn't, there may be some Insts which mention the expected_tyvars, - -- but which, on simplification, don't actually need a dictionary involving - -- the tyvar. So we have to do a proper simplification right here. - tcSimplifyRank2 (mkTyVarSet expected_tyvars) - lie_arg `thenTc` \ (free_insts, inst_binds) -> - - -- This HsLet binds any Insts which came out of the simplification. - -- It's a bit out of place here, but using AbsBind involves inventing - -- a couple of new names which seems worse. - returnTc (TyLam expected_tyvars (HsLet (mk_binds inst_binds) arg'), free_insts) + + tcAddErrCtxt (rank2ArgCtxt arg expected_arg_ty) ( + tcExtendGlobalTyVars (tyVarsOfType expected_arg_ty) ( + checkSigTyVars sig_tyvars sig_tau + ) `thenTc_` + + -- Check that there's no overloading involved + -- Even if there isn't, there may be some Insts which mention the expected_tyvars, + -- but which, on simplification, don't actually need a dictionary involving + -- the tyvar. So we have to do a proper simplification right here. + tcSimplifyRank2 (mkTyVarSet sig_tyvars) + lie_arg `thenTc` \ (free_insts, inst_binds) -> + + -- This HsLet binds any Insts which came out of the simplification. + -- It's a bit out of place here, but using AbsBind involves inventing + -- a couple of new names which seems worse. + returnTc (TyLam sig_tyvars (HsLet (mk_binds inst_binds) arg'), free_insts) ) where - mk_binds [] - = EmptyBinds + mk_binds [] = EmptyBinds mk_binds ((inst,rhs):inst_binds) - = (SingleBind (NonRecBind (VarMonoBind inst rhs))) - `ThenBinds` + = (SingleBind (NonRecBind (VarMonoBind inst rhs))) `ThenBinds` mk_binds inst_binds \end{code} @@ -647,40 +631,45 @@ tcId name = -- Look up the Id and instantiate its type tcLookupLocalValue name `thenNF_Tc` \ maybe_local -> - (case maybe_local of - Just tc_id -> let - (tyvars, rho) = splitForAllTy (idType tc_id) - in - tcInstTyVars tyvars `thenNF_Tc` \ (tyvars', arg_tys', tenv) -> - tcInstTcType tenv rho `thenNF_Tc` \ rho' -> - returnNF_Tc (TcId tc_id, arg_tys', rho') - - Nothing -> tcLookupGlobalValue name `thenNF_Tc` \ id -> - let - (tyvars, rho) = splitForAllTy (idType id) - in - tcInstTyVars tyvars `thenNF_Tc` \ (tyvars', arg_tys, tenv) -> - tcInstType tenv rho `thenNF_Tc` \ rho' -> - returnNF_Tc (RealId id, arg_tys, rho') - - ) `thenNF_Tc` \ (tc_id_occ, arg_tys, rho) -> - - -- Is it overloaded? - case splitRhoTy rho of - ([], tau) -> -- Not overloaded, so just make a type application - returnNF_Tc (mkHsTyApp (HsVar tc_id_occ) arg_tys, emptyLIE, tau) - - (theta, tau) -> -- Overloaded, so make a Method inst - newMethodWithGivenTy (OccurrenceOf tc_id_occ) - tc_id_occ arg_tys rho `thenNF_Tc` \ (lie, meth_id) -> - returnNF_Tc (HsVar meth_id, lie, tau) -\end{code} + case maybe_local of + Just tc_id -> instantiate_it (TcId tc_id) (idType tc_id) + Nothing -> tcLookupGlobalValue name `thenNF_Tc` \ id -> + tcInstType [] (idType id) `thenNF_Tc` \ inst_ty -> + let + (tyvars, rho) = splitForAllTy inst_ty + in + instantiate_it2 (RealId id) tyvars rho + where + -- The instantiate_it loop runs round instantiating the Id. + -- It has to be a loop because we are now prepared to entertain + -- types like + -- f:: forall a. Eq a => forall b. Baz b => tau + -- We want to instantiate this to + -- f2::tau {f2 = f1 b (Baz b), f1 = f a (Eq a)} + instantiate_it tc_id_occ ty + = tcInstTcType ty `thenNF_Tc` \ (tyvars, rho) -> + instantiate_it2 tc_id_occ tyvars rho + + instantiate_it2 tc_id_occ tyvars rho + | null theta -- Is it overloaded? + = returnNF_Tc (mkHsTyApp (HsVar tc_id_occ) arg_tys, emptyLIE, tau) + + | otherwise -- Yes, it's overloaded + = newMethodWithGivenTy (OccurrenceOf tc_id_occ) + tc_id_occ arg_tys rho `thenNF_Tc` \ (lie1, meth_id) -> + instantiate_it meth_id tau `thenNF_Tc` \ (expr, lie2, final_tau) -> + returnNF_Tc (expr, lie1 `plusLIE` lie2, final_tau) + + where + (theta, tau) = splitRhoTy rho + arg_tys = mkTyVarTys tyvars +\end{code} %************************************************************************ %* * -\subsection{@tcQuals@ typchecks list comprehension qualifiers} +\subsection{@tcQuals@ typechecks list-comprehension qualifiers} %* * %************************************************************************ @@ -708,6 +697,12 @@ tcListComp expr (qual@(GeneratorQual pat rhs) : quals) tcAddErrCtxt (qualCtxt qual) ( tcPat pat `thenTc` \ (pat', lie_pat, pat_ty) -> tcExpr rhs `thenTc` \ (rhs', lie_rhs, rhs_ty) -> + -- NB: the environment has been extended with the new binders + -- which the rhs can't "see", but the renamer should have made + -- sure that everything is distinct by now, so there's no problem. + -- Putting the tcExpr before the newMonoIds messes up the nesting + -- of error contexts, so I didn't bother + unifyTauTy (mkListTy pat_ty) rhs_ty `thenTc_` returnTc (GeneratorQual pat' rhs', lie_pat `plusLIE` lie_rhs) @@ -739,63 +734,78 @@ tcListComp expr (LetQual binds : quals) %************************************************************************ \begin{code} -tcDoStmts :: Bool -- True => require a monad - -> TcType s -- m - -> [RenamedStmt] - -> TcM s (([TcStmt s], - Bool, -- True => Monad - Bool), -- True => MonadZero - LIE s, - TcType s) - -tcDoStmts monad m [stmt@(ExprStmt exp src_loc)] - = tcAddSrcLoc src_loc $ - tcSetErrCtxt (stmtCtxt stmt) $ - tcExpr exp `thenTc` \ (exp', exp_lie, exp_ty) -> - (if monad then - newTyVarTy mkTypeKind `thenNF_Tc` \ a -> - unifyTauTy (mkAppTy m a) exp_ty - else - returnTc () - ) `thenTc_` - returnTc (([ExprStmt exp' src_loc], monad, False), exp_lie, exp_ty) - -tcDoStmts _ m (stmt@(ExprStmt exp src_loc) : stmts) - = tcAddSrcLoc src_loc ( - tcSetErrCtxt (stmtCtxt stmt) ( - tcExpr exp `thenTc` \ (exp', exp_lie, exp_ty) -> - newTyVarTy mkTypeKind `thenNF_Tc` \ a -> - unifyTauTy (mkAppTy m a) exp_ty `thenTc_` - returnTc (ExprStmt exp' src_loc, exp_lie) - )) `thenTc` \ (stmt', stmt_lie) -> - tcDoStmts True m stmts `thenTc` \ ((stmts', _, mzero), stmts_lie, stmts_ty) -> - returnTc ((stmt':stmts', True, mzero), - stmt_lie `plusLIE` stmts_lie, - stmts_ty) - -tcDoStmts _ m (stmt@(BindStmt pat exp src_loc) : stmts) - = tcAddSrcLoc src_loc ( - tcSetErrCtxt (stmtCtxt stmt) ( - tcPat pat `thenTc` \ (pat', pat_lie, pat_ty) -> - tcExpr exp `thenTc` \ (exp', exp_lie, exp_ty) -> - newTyVarTy mkTypeKind `thenNF_Tc` \ a -> - unifyTauTy a pat_ty `thenTc_` - unifyTauTy (mkAppTy m a) exp_ty `thenTc_` - returnTc (BindStmt pat' exp' src_loc, pat_lie `plusLIE` exp_lie, irrefutablePat pat') - )) `thenTc` \ (stmt', stmt_lie, failure_free) -> - tcDoStmts True m stmts `thenTc` \ ((stmts', _, mzero), stmts_lie, stmts_ty) -> - returnTc ((stmt':stmts', True, mzero || not failure_free), - stmt_lie `plusLIE` stmts_lie, - stmts_ty) - -tcDoStmts monad m (LetStmt binds : stmts) - = tcBindsAndThen -- No error context, but a binding group is - combine -- rather a large thing for an error context anyway - binds - (tcDoStmts monad m stmts) - where - combine binds' (stmts', monad, mzero) = ((LetStmt binds' : stmts'), monad, mzero) +tcDoStmts stmts src_loc + = -- get the Monad and MonadZero classes + -- create type consisting of a fresh monad tyvar + tcAddSrcLoc src_loc $ + newTyVarTy (mkArrowKind mkBoxedTypeKind mkBoxedTypeKind) `thenNF_Tc` \ m -> + + + -- Build the then and zero methods in case we need them + tcLookupGlobalValueByKey thenMClassOpKey `thenNF_Tc` \ then_sel_id -> + tcLookupGlobalValueByKey zeroClassOpKey `thenNF_Tc` \ zero_sel_id -> + newMethod DoOrigin + (RealId then_sel_id) [m] `thenNF_Tc` \ (m_lie, then_id) -> + newMethod DoOrigin + (RealId zero_sel_id) [m] `thenNF_Tc` \ (mz_lie, zero_id) -> + + let + get_m_arg ty + = newTyVarTy mkTypeKind `thenNF_Tc` \ arg_ty -> + unifyTauTy (mkAppTy m arg_ty) ty `thenTc_` + returnTc arg_ty + + go [stmt@(ExprStmt exp src_loc)] + = tcAddSrcLoc src_loc $ + tcSetErrCtxt (stmtCtxt stmt) $ + tcExpr exp `thenTc` \ (exp', exp_lie, exp_ty) -> + returnTc ([ExprStmt exp' src_loc], exp_lie, exp_ty) + + go (stmt@(ExprStmt exp src_loc) : stmts) + = tcAddSrcLoc src_loc ( + tcSetErrCtxt (stmtCtxt stmt) ( + tcExpr exp `thenTc` \ (exp', exp_lie, exp_ty) -> + get_m_arg exp_ty `thenTc` \ a -> + returnTc (a, exp', exp_lie) + )) `thenTc` \ (a, exp', exp_lie) -> + go stmts `thenTc` \ (stmts', stmts_lie, stmts_ty) -> + get_m_arg stmts_ty `thenTc` \ b -> + returnTc (ExprStmtOut exp' src_loc a b : stmts', + exp_lie `plusLIE` stmts_lie `plusLIE` m_lie, + stmts_ty) + + go (stmt@(BindStmt pat exp src_loc) : stmts) + = newMonoIds (collectPatBinders pat) mkBoxedTypeKind $ \ _ -> + tcAddSrcLoc src_loc ( + tcSetErrCtxt (stmtCtxt stmt) ( + tcPat pat `thenTc` \ (pat', pat_lie, pat_ty) -> + tcExpr exp `thenTc` \ (exp', exp_lie, exp_ty) -> + -- See comments with tcListComp on GeneratorQual + + get_m_arg exp_ty `thenTc` \ a -> + unifyTauTy a pat_ty `thenTc_` + returnTc (a, pat', exp', pat_lie `plusLIE` exp_lie) + )) `thenTc` \ (a, pat', exp', stmt_lie) -> + go stmts `thenTc` \ (stmts', stmts_lie, stmts_ty) -> + get_m_arg stmts_ty `thenTc` \ b -> + returnTc (BindStmtOut pat' exp' src_loc a b : stmts', + stmt_lie `plusLIE` stmts_lie `plusLIE` m_lie `plusLIE` + (if failureFreePat pat' then emptyLIE else mz_lie), + stmts_ty) + + go (LetStmt binds : stmts) + = tcBindsAndThen -- No error context, but a binding group is + combine -- rather a large thing for an error context anyway + binds + (go stmts) + where + combine binds' stmts' = LetStmt binds' : stmts' + in + go stmts `thenTc` \ (stmts', final_lie, final_ty) -> + returnTc (HsDoOut stmts' then_id zero_id src_loc, + final_lie, + final_ty) \end{code} Game plan for record bindings