X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=src%2FHaskCoreToWeak.v;h=6e1b58fc1ece127b932cc87933b9e7c87b49f634;hb=bb960df7c29c851ca9d13f2d0c8f351ac24045ca;hp=c4bd768d69ca1e4b373242bce7ceb4f5b112d0d3;hpb=2ec43bc871b579bac89707988c4855ee1d6c8eda;p=coq-hetmet.git diff --git a/src/HaskCoreToWeak.v b/src/HaskCoreToWeak.v index c4bd768..6e1b58f 100644 --- a/src/HaskCoreToWeak.v +++ b/src/HaskCoreToWeak.v @@ -4,8 +4,8 @@ Generalizable All Variables. Require Import Preamble. -Require Import General. Require Import Coq.Lists.List. +Require Import General. Require Import HaskKinds. Require Import HaskLiteralsAndTyCons. Require Import HaskCoreVars. @@ -15,9 +15,6 @@ Require Import HaskWeakVars. Require Import HaskWeakTypes. Require Import HaskWeak. -Variable ModalBoxTyCon : TyCon. Extract Inlined Constant ModalBoxTyCon => "TysWiredIn.hetMetCodeTypeTyCon". -Variable ArrowTyCon : TyCon. Extract Constant ArrowTyCon => "Type.funTyCon". - Variable tyConOrTyFun : CoreTyCon -> sum TyCon TyFun. Extract Inlined Constant tyConOrTyFun => "tyConOrTyFun". Variable coreViewDeep : CoreType -> CoreType. Extract Inlined Constant coreViewDeep => "coreViewDeep". Variable coreCoercionToWeakCoercion : CoreCoercion -> WeakCoercion. @@ -218,9 +215,8 @@ Fixpoint coreExprToWeakExpr (ce:@CoreExpr CoreVar) : ???WeakExpr := | WCoerVar _ => Error "found a coercion variable in a case" | WExprVar ev => coreTypeToWeakType (coreTypeOfCoreExpr e) >>= fun te' => - coreExprToWeakExpr e >>= fun e' => expectTyConApp te' nil >>= fun tca => - let (tc,lt) := tca in + let (tc,lt) := tca:(TyCon * list WeakType) in ((fix mkBranches (branches: list (@triple CoreAltCon (list CoreVar) (@CoreExpr CoreVar))) : ???(list (WeakAltCon*list WeakTypeVar*list WeakCoerVar*list WeakExprVar*WeakExpr)) := match branches with @@ -233,9 +229,9 @@ Fixpoint coreExprToWeakExpr (ce:@CoreExpr CoreVar) : ???WeakExpr := | LitAlt lit => OK ((WeakLitAlt lit,nil,nil,nil,e')::rest') | DataAlt dc => let vars := map coreVarToWeakVar vars in OK (((WeakDataAlt dc), - (General.filter (map (fun x => match x with WTypeVar v => Some v | _ => None end) vars)), - (General.filter (map (fun x => match x with WCoerVar v => Some v | _ => None end) vars)), - (General.filter (map (fun x => match x with WExprVar v => Some v | _ => None end) vars)), + (filter (map (fun x => match x with WTypeVar v => Some v | _ => None end) vars)), + (filter (map (fun x => match x with WCoerVar v => Some v | _ => None end) vars)), + (filter (map (fun x => match x with WExprVar v => Some v | _ => None end) vars)), e')::rest') end end) alts)