-(* calculate the CoreType of a WeakExpr *)
-Fixpoint coreTypeOfWeakExpr (ce:WeakExpr) : ???CoreType :=
- match ce with
- | WEVar v => match coreVarSort v with
- | CoreExprVar t => OK t
- | CoreTypeVar _ => Error "found tyvar in expression"
- | CoreCoerVar _ => Error "found coercion variable in expression"
- end
- | WELit lit => OK (haskLiteralToCoreType lit)
- | WEApp e1 e2 => coreTypeOfWeakExpr e1 >>= fun t' =>
- match t' with
- | FunTy t1 t2 => OK t2
- | (TyConApp 2 tc (t1::t2::nil)) =>
- if (tyCon_eq tc ArrowTyCon)
- then OK t2
- else Error ("found non-function type "+++(coreTypeToString t')+++" in EApp")
- | _ => Error ("found non-function type "+++(coreTypeToString t')+++" in EApp")
- end
- | WETyApp e t => coreTypeOfWeakExpr e >>= fun te =>
- match te with
- | ForAllTy v ct => match coreVarSort v with
- | CoreExprVar _ => Error "found an expression variable inside an forall-type!"
- | CoreTypeVar _ => OK (replaceCoreVar ct v t)
- | CoreCoerVar _ => Error "found a coercion variable inside an forall-type!"
- end
- | _ => Error ("found non-forall type "+++(coreTypeToString te)+++" in ETyApp")
- end
- | WECoApp e co => coreTypeOfWeakExpr e >>= fun te =>
- match te with
- | FunTy (PredTy (EqPred t1 t2)) t3 => OK t3
- | TyConApp 2 tc ((PredTy (EqPred t1 t2))::t3::nil) =>
- if (tyCon_eq tc ArrowTyCon)
- then OK t3
- else Error ("found non-coercion type "+++(coreTypeToString te)+++" in ETyApp")
- | _ => Error ("found non-coercion type "+++(coreTypeToString te)+++" in ETyApp")
- end
- | WELam ev e => coreTypeOfWeakExpr e >>= fun t' => match coreVarSort ev with
- | CoreExprVar vt => OK (FunTy vt t')
- | CoreTypeVar _ => Error "found a type variable in a WELam!"
- | CoreCoerVar _ => Error "found a coercion variable in a WELam!"
- end
- | WETyLam tv e => coreTypeOfWeakExpr e >>= fun t' => OK (ForAllTy tv t')
- | WECoLam cv e => coreTypeOfWeakExpr e >>= fun t' => match coreVarSort cv with
- | CoreExprVar vt => Error "found an expression variable in a WECoLam!"
- | CoreTypeVar _ => Error "found a type variable in a WECoLam!"
- | CoreCoerVar (φ₁,φ₂) => OK (FunTy (PredTy (EqPred φ₁ φ₂)) t')
- end
- | WELet ev ve e => coreTypeOfWeakExpr e
- | WELetRec rb e => coreTypeOfWeakExpr e
- | WENote n e => coreTypeOfWeakExpr e
- | WECast e co => OK (snd (coreCoercionKind co))
- | WECase scrutinee tbranches n tc type_params alts => OK tbranches
- | WEBrak ec e => coreTypeOfWeakExpr e >>= fun t' => OK (TyConApp hetMetCodeTypeTyCon ((TyVarTy ec)::t'::nil))
- | WEEsc ec e => coreTypeOfWeakExpr e >>= fun t' =>
- match t' with
- | (TyConApp 2 tc ((TyVarTy ec')::t''::nil)) =>
- if (tyCon_eq tc hetMetCodeTypeTyCon)
- then if eqd_dec ec ec' then OK t''
- else Error "level mismatch in escapification"
- else Error "ill-typed escapification"
- | _ => Error "ill-typed escapification"
- end
+(*
+Fixpoint weakExprVarOccursFree (wvf:WeakExprVar)(we:WeakExpr) : bool :=
+ match we with
+ | WEVar wv => if eqd_dec (wvf:CoreVar) (wv:CoreVar) then true else false
+ | WELit lit => false
+ | WEApp e1 e2 => weakExprVarOccursFree wvf e1 || weakExprVarOccursFree wvf e2
+ | WETyApp e t => weakExprVarOccursFree wvf e
+ | WECoApp e co => weakExprVarOccursFree wvf e
+ | WENote n e => weakExprVarOccursFree wvf e
+ | WELam ev e => if eqd_dec (wvf:CoreVar) (ev:CoreVar) then false else weakExprVarOccursFree wvf e
+ | WETyLam tv e => weakExprVarOccursFree wvf e
+ | WECoLam cv e => weakExprVarOccursFree wvf e
+ | WECast e co => weakExprVarOccursFree wvf e
+ | WEBrak v wtv e t => weakExprVarOccursFree wvf e
+ | WEEsc v wtv e t => weakExprVarOccursFree wvf e
+ | WECSP v wtv e t => weakExprVarOccursFree wvf e
+ | WELet v ebind ebody => weakExprVarOccursFree wvf ebind
+ || if eqd_dec (wvf:CoreVar) (v:CoreVar) then false else weakExprVarOccursFree wvf ebody
+ | WECase vs es tb tc tys alts =>
+ if weakExprVarOccursFree wvf es
+ then true
+ else (fix weakExprVarOccursFreeBranches (alts:Tree ??(_)) : bool :=
+ match alts with
+ | T_Leaf None => false
+ | T_Leaf (Some (_,_,_,v',e')) =>
+ if fold_left bor (map (fun v'':WeakExprVar => if eqd_dec (wvf:CoreVar) (v'':CoreVar) then true else false ) v') false
+ then false
+ else weakExprVarOccursFree wvf e'
+ | T_Branch b1 b2 => weakExprVarOccursFreeBranches b1 ||
+ weakExprVarOccursFreeBranches b2
+ end) alts
+ | WELetRec mlr e => false