From 9545a01076cc7b79d0d3278b1ba12e3249149716 Mon Sep 17 00:00:00 2001 From: letouzey Date: Fri, 21 May 2010 16:13:58 +0000 Subject: Extract Inductive is now possible toward non-inductive types (e.g. nat => int) For instance: Extract Inductive nat => int [ "0" "succ" ] "(fun fO fS n => if n=0 then fO () else fS (n-1))". See Extraction.v for more details and caveat. git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@13025 85f007b7-540e-0410-9357-904b9bb8a0f7 --- plugins/extraction/scheme.ml | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) (limited to 'plugins/extraction/scheme.ml') diff --git a/plugins/extraction/scheme.ml b/plugins/extraction/scheme.ml index 6a44812da..f7a0b5a53 100644 --- a/plugins/extraction/scheme.ml +++ b/plugins/extraction/scheme.ml @@ -94,7 +94,15 @@ let rec pp_expr env args = prlist_with_sep spc (pp_cons_args env) args') in if i = Coinductive then paren (str "delay " ++ st) else st - | MLcase ((i,_),t, pv) -> + | MLcase (_,t,pv) when is_custom_match pv -> + let mkfun (_,ids,e) = + if ids <> [] then named_lams (List.rev ids) e + else dummy_lams (ast_lift 1 e) 1 + in + hov 2 (str (find_custom_match pv) ++ fnl () ++ + prvect (fun tr -> pp_expr env [] (mkfun tr) ++ fnl ()) pv + ++ pp_expr env [] t) + | MLcase ((i,_),t, pv) -> let e = if i <> Coinductive then pp_expr env [] t else paren (str "force" ++ spc () ++ pp_expr env [] t) -- cgit v1.2.3