-(* calculate the CoreType of a WeakExpr *)
-Fixpoint coreTypeOfWeakExpr (ce:WeakExpr) : ???CoreType :=
- match ce with
- | WEVar (weakExprVar v t) => OK t
- | WELit lit => OK (haskLiteralToCoreType lit)
- | WEApp e1 e2 => coreTypeOfWeakExpr e1 >>= fun t' =>
- match t' with
- | (TyConApp 2 tc (t1::t2::nil)) =>
- if (tyCon_eq tc ArrowTyCon)
- then OK t2
- else Error ("found non-function type "+++(weakTypeToString t')+++" in EApp")
- | _ => Error ("found non-function type "+++(weakTypeToString t')+++" in EApp")
- end
- | WETyApp e t => coreTypeOfWeakExpr e >>= fun te =>
- match te with
- | ForAllTy v ct => OK (replaceCoreVar ct v t)
- | _ => Error ("found non-forall type "+++(weakTypeToString te)+++" in ETyApp")
- end
- | WECoApp e co => coreTypeOfWeakExpr e >>= fun te =>
- match te with
- | TyConApp 2 tc ((PredTy (EqPred t1 t2))::t3::nil) =>
- if (tyCon_eq tc ArrowTyCon)
- then OK t3
- else Error ("found non-coercion type "+++(weakTypeToString te)+++" in ETyApp")
- | _ => Error ("found non-coercion type "+++(weakTypeToString te)+++" in ETyApp")
- end
- | WELam (weakExprVar ev vt) e => coreTypeOfWeakExpr e >>= fun t' => OK (TyConApp ArrowTyCon (vt::t'::nil))
- | WETyLam tv e => coreTypeOfWeakExpr e >>= fun t' => match tv with weakTypeVar tvc _ => OK (ForAllTy tvc t') end
- | WECoLam (weakCoerVar cv φ₁ φ₂) e =>
- coreTypeOfWeakExpr e >>= fun t' => OK (TyConApp ArrowTyCon ((PredTy (EqPred φ₁ φ₂))::t'::nil))
- | WELet ev ve e => coreTypeOfWeakExpr e
- | WELetRec rb e => coreTypeOfWeakExpr e
- | WENote n e => coreTypeOfWeakExpr e
- | WECast e (weakCoercion t1 t2 _) => OK t2
- | WECase scrutinee tbranches n tc type_params alts => OK tbranches
- | WEBrak ec e => coreTypeOfWeakExpr e >>= fun t' => match ec with weakTypeVar ecc _ =>
- OK (TyConApp hetMetCodeTypeTyCon ((TyVarTy ecc)::t'::nil)) end
- | WEEsc ec e => coreTypeOfWeakExpr e >>= fun t' => match ec with weakTypeVar ecc _ =>
- match t' with
- | (TyConApp 2 tc ((TyVarTy ec')::t''::nil)) =>
- if (tyCon_eq tc hetMetCodeTypeTyCon)
- then if eqd_dec ecc ec' then OK t''
- else Error "level mismatch in escapification"
- else Error "ill-typed escapification"
- | _ => Error "ill-typed escapification"
- end end
+(* some very simple-minded cleanups to produce "prettier" expressions *)
+Fixpoint simplifyWeakExpr (me:WeakExpr) : WeakExpr :=
+ match me with
+ | WEVar wv => WEVar wv
+ | WELit lit => WELit lit
+ | WEApp e1 e2 => WEApp (simplifyWeakExpr e1) (simplifyWeakExpr e2)
+ | WETyApp e t => WETyApp (simplifyWeakExpr e ) t
+ | WECoApp e co => CoreEApp (simplifyWeakExpr e ) co
+ | WENote n e => CoreENote n (simplifyWeakExpr e )
+ | WELam ev e => CoreELam ev (simplifyWeakExpr e )
+ | WETyLam tv e => CoreELam tv (simplifyWeakExpr e )
+ | WECoLam cv e => CoreELam cv (simplifyWeakExpr e )
+ | WECast e co => CoreECast (simplifyWeakExpr e ) co
+ | WEBrak v wtv e t => WEBrak v wtv (simplifyWeakExpr e ) t
+ | WEEsc v wtv e t => WEEsc v wtv (simplifyWeakExpr e ) t
+ | WECSP v wtv e t => WECSP v wtv (simplifyWeakExpr e ) t
+ | WELet v ebind ebody => WELet v (simplifyWeakExpr ebind) (simplifyWeakExpr ebody)
+ | WECase vs es tb tc tys alts => WECase vs es tb tc tys (* FIXME alts *)
+ (* un-letrec-ify multi branch letrecs *)
+ | WELetRec mlr e => WELetRec mlr (simplifyWeakExpr e )