diff options
| author | letouzey | 2010-04-16 14:12:57 +0000 |
|---|---|---|
| committer | letouzey | 2010-04-16 14:12:57 +0000 |
| commit | f57a38bb53dc06cef1cee78c60946aa5e6d3cf0b (patch) | |
| tree | b8e8006cb5ecd58174fcc76ccb2e90d437906996 /plugins/extraction/scheme.ml | |
| parent | a36fe20505fee708d8d88700aa7fedd4d4157364 (diff) | |
Extraction: ad-hoc identifier type with annotations for reductions
* An inductive constructor Dummy instead of a constant dummy_name
* The Tmp constructor indicates that the corresponding MLlam or
MLletin is extraction-specific and can be reduced if possible
* When inlining a glob (for instance a recursor), we tag some
lambdas as reducible. In (nat_rect Fo Fs n), the head lams of
Fo and Fs are treated this way, in order for the recursive call
inside nat_rect to be correctly pushed as deeper as possible.
* This way, we can stop allowing by default linear beta/let
reduction even under binders (can be activated back via
Set Extraction Flag).
* Btw, fix the strange definition of non_stricts for (x y).
git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@12938 85f007b7-540e-0410-9357-904b9bb8a0f7
Diffstat (limited to 'plugins/extraction/scheme.ml')
| -rw-r--r-- | plugins/extraction/scheme.ml | 6 |
1 files changed, 3 insertions, 3 deletions
diff --git a/plugins/extraction/scheme.ml b/plugins/extraction/scheme.ml index 50339d473d..9cc34634a9 100644 --- a/plugins/extraction/scheme.ml +++ b/plugins/extraction/scheme.ml @@ -72,10 +72,10 @@ let rec pp_expr env args = pp_expr env (stl @ args) f | MLlam _ as a -> let fl,a' = collect_lams a in - let fl,env' = push_vars fl env in + let fl,env' = push_vars (List.map id_of_mlid fl) env in apply (pp_abst (pp_expr env' [] a') (List.rev fl)) | MLletin (id,a1,a2) -> - let i,env' = push_vars [id] env in + let i,env' = push_vars [id_of_mlid id] env in apply (hv 0 (hov 2 @@ -123,7 +123,7 @@ and pp_cons_args env = function and pp_one_pat env (r,ids,t) = - let ids,env' = push_vars (List.rev ids) env in + let ids,env' = push_vars (List.rev_map id_of_mlid ids) env in let args = if ids = [] then mt () else (str " " ++ prlist_with_sep spc pr_id (List.rev ids)) |