X-Git-Url: http://git.megacz.com/?p=coq-hetmet.git;a=blobdiff_plain;f=src%2FExtraction.v;fp=src%2FExtraction.v;h=dfca44c27bbf5b23e9971b09267f23ef3b8852a1;hp=d04df843643b3d90000997bb69e088e619bace58;hb=f6732490f83e19174b8a8a6b487da95913d9f02d;hpb=8efffc7368b5e54c42461f45a9708ff2828409a4 diff --git a/src/Extraction.v b/src/Extraction.v index d04df84..dfca44c 100644 --- a/src/Extraction.v +++ b/src/Extraction.v @@ -104,22 +104,24 @@ Section core2proof. eol+++"\end{document}"+++ eol. + Definition handleExpr' (ce:@CoreExpr CoreVar) : ???string := + addErrorMessage ("input CoreSyn: " +++ ce) + (addErrorMessage ("input CoreType: " +++ coreTypeOfCoreExpr ce) ( + coreExprToWeakExpr ce >>= fun we => + addErrorMessage ("WeakExpr: " +++ we) + ((addErrorMessage ("CoreType of WeakExpr: " +++ coreTypeOfCoreExpr (weakExprToCoreExpr we)) + ((weakTypeOfWeakExpr we) >>= fun t => + (addErrorMessage ("WeakType: " +++ t) + ((weakTypeToType'' φ t ★) >>= fun τ => + addErrorMessage ("HaskType: " +++ τ) + ((weakExprToStrongExpr Γ Δ φ ψ ξ τ nil we) >>= fun e => + OK (eol+++"$$"+++ nd_ml_toLatex (@expr2proof _ _ _ _ _ _ e)+++"$$"+++eol) + )))))))). + Definition handleExpr (ce:@CoreExpr CoreVar) : string := - match coreExprToWeakExpr ce with - | Error s => Prelude_error ("unable to convert GHC Core expression into Coq HaskWeak expression due to:\n "+++s) - | OK we => match weakTypeOfWeakExpr we >>= fun t => weakTypeToType φ t with - | Error s => Prelude_error ("unable to calculate HaskType of a HaskWeak expression because: " +++ s) - | OK τ => match τ with - | haskTypeOfSomeKind ★ τ' => - match weakExprToStrongExpr Γ Δ φ ψ ξ τ' nil (*(makeClosedExpression*) we (* ) *) with - | Error s => Prelude_error ("unable to convert HaskWeak to HaskStrong due to:\n "+++s) - | OK e' => eol+++"$$"+++ nd_ml_toLatex (@expr2proof _ _ _ _ _ _ e')+++"$$"+++eol - end - | haskTypeOfSomeKind κ τ' => - Prelude_error ("encountered 'expression' of kind "+++κ+++" at top level (type "+++τ' - +++"); shouldn't happen") - end - end + match handleExpr' ce with + | OK x => x + | Error s => Prelude_error s end. Definition handleBind (bind:@CoreBind CoreVar) : string :=