-Here, the level of @f@ is zero, the level of @g@ is one,
+Here, the level of @f@ is zero, the level of @g@ is one,
-- Ids, to their own binding group,
-- and *only* in their own RHSs
-- Ids, to their own binding group,
-- and *only* in their own RHSs
-libCaseBind env (CoNonRec binder rhs)
- = (addBinders env [binder], CoNonRec binder (libCase env rhs))
+libCaseBind env (NonRec binder rhs)
+ = (addBinders env [binder], NonRec binder (libCase env rhs))
-libCaseBind env (CoRec pairs)
- = (env_body, CoRec pairs')
+libCaseBind env (Rec pairs)
+ = (env_body, Rec pairs')
-- copy of the original binding. In particular, the original
-- binding might have been for a TopLevId, and this copy clearly
-- will not be top-level!
-- copy of the original binding. In particular, the original
-- binding might have been for a TopLevId, and this copy clearly
-- will not be top-level!
-- It is enough to change just the binder, because subsequent
-- simplification will propagate the right info from the binder.
-- It is enough to change just the binder, because subsequent
-- simplification will propagate the right info from the binder.
-libCase env (CoLit lit) = CoLit lit
-libCase env (CoVar v) = mkCoLetsNoUnboxed (libCaseId env v) (CoVar v)
-libCase env (CoApp fun arg) = mkCoLetsNoUnboxed (libCaseAtom env arg) (CoApp (libCase env fun) arg)
+libCase env (Lit lit) = Lit lit
+libCase env (Var v) = mkCoLetsNoUnboxed (libCaseId env v) (Var v)
+libCase env (App fun arg) = mkCoLetsNoUnboxed (libCaseAtom env arg) (App (libCase env fun) arg)
-libCase env (CoCon con tys args) = mkCoLetsNoUnboxed (libCaseAtoms env args) (CoCon con tys args)
-libCase env (CoPrim op tys args) = mkCoLetsNoUnboxed (libCaseAtoms env args) (CoPrim op tys args)
+libCase env (Con con tys args) = mkCoLetsNoUnboxed (libCaseAtoms env args) (Con con tys args)
+libCase env (Prim op tys args) = mkCoLetsNoUnboxed (libCaseAtoms env args) (Prim op tys args)
-libCase env (CoLam binders body)
- = CoLam binders (libCase env' body)
- where
- env' = addBinders env binders
+libCase env (Lam binder body)
+ = Lam binder (libCase (addBinders env [binder]) body)
where
do_alt (con,args,rhs) = (con, args, libCase (addBinders env args) rhs)
where
do_alt (con,args,rhs) = (con, args, libCase (addBinders env args) rhs)
-libCaseDeflt env CoNoDefault
- = CoNoDefault
-libCaseDeflt env (CoBindDefault binder rhs)
- = CoBindDefault binder (libCase (addBinders env [binder]) rhs)
+libCaseDeflt env NoDefault
+ = NoDefault
+libCaseDeflt env (BindDefault binder rhs)
+ = BindDefault binder (libCase (addBinders env [binder]) rhs)
-libCaseAtom :: LibCaseEnv -> PlainCoreAtom -> [PlainCoreBinding]
-libCaseAtom env (CoVarAtom arg_id) = libCaseId env arg_id
-libCaseAtom env (CoLitAtom lit) = []
+libCaseAtom :: LibCaseEnv -> CoreArg -> [CoreBinding]
+libCaseAtom env (VarArg arg_id) = libCaseId env arg_id
+libCaseAtom env (LitArg lit) = []
libCaseId env v
| maybeToBool maybe_rec_bind && -- It's a use of a recursive thing
there_are_free_scruts -- with free vars scrutinised in RHS
libCaseId env v
| maybeToBool maybe_rec_bind && -- It's a use of a recursive thing
there_are_free_scruts -- with free vars scrutinised in RHS
maybe_rec_bind = lookupRecId env v
Just the_bind = maybe_rec_bind
rec_id_level = lookupLevel env v
there_are_free_scruts = freeScruts env rec_id_level
maybe_rec_bind = lookupRecId env v
Just the_bind = maybe_rec_bind
rec_id_level = lookupLevel env v
there_are_free_scruts = freeScruts env rec_id_level
addRecBinds (LibCaseEnv bomb lvl lvl_env rec_env scruts) pairs
= LibCaseEnv bomb lvl' lvl_env' rec_env' scruts
where
lvl' = lvl + 1
lvl_env' = growIdEnvList lvl_env [(binder,lvl) | (binder,_) <- pairs]
addRecBinds (LibCaseEnv bomb lvl lvl_env rec_env scruts) pairs
= LibCaseEnv bomb lvl' lvl_env' rec_env' scruts
where
lvl' = lvl + 1
lvl_env' = growIdEnvList lvl_env [(binder,lvl) | (binder,_) <- pairs]
addScrutedVar env@(LibCaseEnv bomb lvl lvl_env rec_env scruts) scrut_var
| bind_lvl < lvl
= LibCaseEnv bomb lvl lvl_env rec_env scruts'
-- Add to scruts iff the scrut_var is being scrutinised at
addScrutedVar env@(LibCaseEnv bomb lvl lvl_env rec_env scruts) scrut_var
| bind_lvl < lvl
= LibCaseEnv bomb lvl lvl_env rec_env scruts'
-- Add to scruts iff the scrut_var is being scrutinised at
-> LibCaseLevel -- Level of the recursive Id
-> Bool -- True <=> there is an enclosing case of a variable
-- bound outside (ie level <=) the recursive Id.
-> LibCaseLevel -- Level of the recursive Id
-> Bool -- True <=> there is an enclosing case of a variable
-- bound outside (ie level <=) the recursive Id.