From 351c92f5c61082e9e8f5e1c9364f1836416f17d3 Mon Sep 17 00:00:00 2001
From: mdenes
Date: Mon, 11 Feb 2013 09:45:49 +0000
Subject: Fixing bug in native compiler with let patterns in fixpoint
 definitions. Typical example: Fixpoint f (m : nat) (o := true) (n : nat)
 {struct n} := n. Was raising an "index out of bounds" exception at
 compile-time. Nota: this construction is still incorrectly handled by the VM.

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@16197 85f007b7-540e-0410-9357-904b9bb8a0f7
---
 kernel/nativecode.ml | 38 ++++++++++++++++++++++++++------------
 1 file changed, 26 insertions(+), 12 deletions(-)

(limited to 'kernel/nativecode.ml')

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index 6b92474769..9fee03ca1d 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -615,13 +615,27 @@ let merge_branches t =
       let lf,env_n = push_rels (empty_env ()) ids in
       let t_params = Array.make ndef [||] in
       let t_norm_f = Array.make ndef (Gnorm (l,-1)) in
+      let mk_let envi (id,def) t = MLlet (id,def,t) in
+      let mk_lam_or_let (params,lets,env) (id,def) =
+        let ln,env' = push_rel env id in
+        match def with
+        | None -> (ln::params,lets,env')
+        | Some lam -> (params, (ln,ml_of_lam env l lam)::lets,env')
+      in
       let ml_of_fix i body =
-	let idsi,bodyi = decompose_Llam body in
-	let paramsi, envi = push_rels env_n idsi in
-	t_norm_f.(i) <- fresh_gnorm l;
-	let bodyi = ml_of_lam envi l bodyi in
-	t_params.(i) <- paramsi;
-	mkMLlam paramsi bodyi in
+        let varsi, bodyi = decompose_Llam_Llet body in
+        let paramsi,letsi,envi = 
+          Array.fold_left mk_lam_or_let ([],[],env_n) varsi
+        in
+        let paramsi,letsi =
+          Array.of_list (List.rev paramsi), Array.of_list (List.rev letsi)
+        in
+        t_norm_f.(i) <- fresh_gnorm l;
+        let bodyi = ml_of_lam envi l bodyi in
+        t_params.(i) <- paramsi;
+        let bodyi = Array.fold_right (mk_let envi) letsi bodyi in
+        mkMLlam paramsi bodyi
+      in
       let tnorm = Array.mapi ml_of_fix tb in
       let fvn,fvr = !(env_n.env_named), !(env_n.env_urel) in
       let fv_params = fv_params env_n in
@@ -667,12 +681,12 @@ let merge_branches t =
       let t_params = Array.make ndef [||] in
       let t_norm_f = Array.make ndef (Gnorm (l,-1)) in
       let ml_of_fix i body =
-	let idsi,bodyi = decompose_Llam body in
-	let paramsi, envi = push_rels env_n idsi in
-	t_norm_f.(i) <- fresh_gnorm l;
-	let bodyi = ml_of_lam envi l bodyi in
-	t_params.(i) <- paramsi;
-	mkMLlam paramsi bodyi in
+        let idsi,bodyi = decompose_Llam body in
+        let paramsi, envi = push_rels env_n idsi in
+        t_norm_f.(i) <- fresh_gnorm l;
+        let bodyi = ml_of_lam envi l bodyi in
+        t_params.(i) <- paramsi;
+        mkMLlam paramsi bodyi in
       let tnorm = Array.mapi ml_of_fix tb in
       let fvn,fvr = !(env_n.env_named), !(env_n.env_urel) in
       let fv_params = fv_params env_n in
-- 
cgit v1.2.3