diff options
| author |  letouzey <letouzey@85f007b7-540e-0410-9357-904b9bb8a0f7> | 2001-04-10 12:39:36 +0000 |
|---|---|---|
| committer | letouzey <letouzey@85f007b7-540e-0410-9357-904b9bb8a0f7> | 2001-04-10 12:39:36 +0000 |
| commit | 8eaf1799ec07bf823a366920e39d79e827f94971 (patch) | |
| tree | 075a113a5d594980573e4b633d3b5332ea625656 | |
| parent | bcecd4f3d6ea0fa6e03cb3ecbbbfa0a0b9f977c8 (diff) | |
bug lift dans IsRel de extract_type. Axiomes dans extract_type
git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@1570 85f007b7-540e-0410-9357-904b9bb8a0f7
| -rw-r--r-- | contrib/extraction/TODO | 5 | ||||
| -rw-r--r-- | contrib/extraction/extraction.ml | 14 |
2 files changed, 10 insertions, 9 deletions
diff --git a/contrib/extraction/TODO b/contrib/extraction/TODO index d125ecbdc..827a62c2d 100644 --- a/contrib/extraction/TODO +++ b/contrib/extraction/TODO @@ -7,3 +7,8 @@ 5. Syntaxe Haskell + 6. Renommage des var de type caml + + 7. Eta expansion pour contourner typage Caml + + diff --git a/contrib/extraction/extraction.ml b/contrib/extraction/extraction.ml index 4db7e41ea..ab791fc7c 100644 --- a/contrib/extraction/extraction.ml +++ b/contrib/extraction/extraction.ml @@ -251,12 +251,6 @@ let axiom_message sp = [< 'sTR "You must specify an extraction for axiom"; 'sPC; pr_sp sp; 'sPC; 'sTR "first" >] -let unrealizable_axiom sp = - errorlabstrm "axiom_message" - [< 'sTR "Axiom"; 'sPC; pr_sp sp; 'sPC; - 'sTR "does not correspond to an ML type" >] - - (*s Tables to keep the extraction of inductive types and constructors. *) type inductive_extraction_result = @@ -330,10 +324,13 @@ let rec extract_type env c = | IsRel n -> (match lookup_rel_value n env with | Some t -> - extract_rec env fl t args + extract_rec env fl (lift n t) args | None -> let id = id_of_name (fst (lookup_rel_type n env)) in Tmltype (Tvar id, [], fl)) + | IsConst (sp,a) when is_axiom sp -> + let id = basename sp in + Tmltype (Tvar id, [], id :: fl) | IsConst (sp,a) -> let cty = constant_type env Evd.empty (sp,a) in if is_arity env Evd.empty cty then @@ -342,7 +339,6 @@ let rec extract_type env c = else begin (* We can't keep as ML type abbreviation a CIC constant which type is not an arity: we reduce this constant. *) - if is_axiom sp then unrealizable_axiom sp; let cvalue = constant_value env (sp,a) in extract_rec env fl (applist (cvalue, args)) [] end @@ -558,7 +554,7 @@ and extract_app env ctx (f,tyf,sf) args = MLapp (f', mlargs) -and signature_of_application env f t a = +and signature_of_application env f t a = let nargs = Array.length a in let t = if nb_prod t >= nargs then |