Revu compilation des boucles for pour le cas ou la borne est max_int (pour une boucle 'to') ou min_int (pour une boucle 'downto') (PR#415)

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@5277 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
master
Xavier Leroy 2002-11-18 10:50:49 +00:00
parent 2fb5cf5111
commit fca6240f90
2 changed files with 12 additions and 11 deletions

View File

@ -951,6 +951,7 @@ let rec transl = function
let tst = match dir with Upto -> Cgt | Downto -> Clt in
let inc = match dir with Upto -> Caddi | Downto -> Csubi in
let raise_num = next_raise_count () in
let id_prev = Ident.rename id in
return_unit
(Clet
(id, transl low,
@ -962,11 +963,13 @@ let rec transl = function
Cloop
(Csequence
(remove_unit(transl body),
Clet(id_prev, Cvar id,
Csequence
(Cassign(id, Cop(inc, [Cvar id; Cconst_int 2])),
(Cassign(id,
Cop(inc, [Cvar id; Cconst_int 2])),
Cifthenelse
(Cop(Ccmpi tst, [Cvar id; high]),
Cexit (raise_num,[]), Ctuple []))))),
(Cop(Ccmpi Ceq, [Cvar id_prev; high]),
Cexit (raise_num,[]), Ctuple [])))))),
Ctuple []))))
| Uassign(id, exp) ->
return_unit(Cassign(id, transl exp))

View File

@ -619,19 +619,17 @@ let rec comp_expr env exp sz cont =
comp_expr env cond sz (Kbranchif lbl_loop :: add_const_unit cont))
| Lfor(param, start, stop, dir, body) ->
let lbl_loop = new_label() in
let lbl_test = new_label() in
let lbl_exit = new_label() in
let offset = match dir with Upto -> 1 | Downto -> -1 in
let comp = match dir with Upto -> Cle | Downto -> Cge in
let comp = match dir with Upto -> Cgt | Downto -> Clt in
comp_expr env start sz
(Kpush :: comp_expr env stop (sz+1)
(Kpush :: Kbranch lbl_test ::
(Kpush :: Kpush :: Kacc 2 :: Kintcomp comp :: Kbranchif lbl_exit ::
Klabel lbl_loop :: Kcheck_signals ::
comp_expr (add_var param (sz+1) env) body (sz+2)
(Kacc 1 :: Koffsetint offset :: Kassign 1 ::
Klabel lbl_test ::
Kacc 0 :: Kpush :: Kacc 2 :: Kintcomp comp ::
Kbranchif lbl_loop ::
add_const_unit (add_pop 2 cont))))
(Kacc 1 :: Kpush :: Koffsetint offset :: Kassign 2 ::
Kacc 1 :: Kintcomp Cneq :: Kbranchif lbl_loop ::
Klabel lbl_exit :: add_const_unit (add_pop 2 cont))))
| Lswitch(arg, sw) ->
let (branch, cont1) = make_branch cont in
let c = ref (discard_dead_code cont1) in