First version for ForInt loops

This commit is contained in:
Lesenechal Remi 2019-10-11 17:41:26 +02:00
parent 2c4183f008
commit d8e44476ba
3 changed files with 47 additions and 7 deletions

View File

@ -667,7 +667,42 @@ and simpl_single_instruction : Raw.instruction -> (_ -> expression result) resul
let%bind body = simpl_block l.block.value in let%bind body = simpl_block l.block.value in
let%bind body = body None in let%bind body = body None in
return_statement @@ e_loop cond body return_statement @@ e_loop cond body
| Loop (For (ForInt {region; _} | ForCollect {region ; _})) -> | Loop (For (ForInt fi)) ->
(* cond part *)
let%bind _var = ok @@ e_variable fi.value.assign.value.name.value in
let%bind _value = simpl_expression fi.value.assign.value.expr in
let%bind _bound = simpl_expression fi.value.bound in
let%bind _comp = match fi.value.down with
| Some _ -> ok @@ e_annotation (e_constant "GE" [_var ; _bound]) t_bool
| None -> ok @@ e_annotation (e_constant "LE" [_var ; _bound]) t_bool
in
(* body part *)
let%bind _body = simpl_block fi.value.block.value in
let%bind _body = _body None in
let%bind _step = match fi.value.step with
| Some (_,e) -> simpl_expression e
| None -> ok (e_int 1) in
let%bind _ctrl = match fi.value.down with
| Some _ ->
let%bind _addi = ok @@ e_constant "SUB" [ _var ; _step ] in
ok @@ e_assign fi.value.assign.value.name.value [] _addi
| None ->
let%bind _subi = ok @@ e_constant "ADD" [ _var ; _step ] in
ok @@ e_assign fi.value.assign.value.name.value [] _subi
in
let rec add_to_seq expr = match expr.expression with
| E_sequence (_,a) -> add_to_seq a
| _ -> e_sequence _body _ctrl in
let%bind _body' = ok @@ add_to_seq _body in
let%bind _loop = ok @@ e_loop _comp _body' in
let _ = Format.printf " -> %a\n" Ast_simplified.PP.expression _body' in
return_statement @@
e_let_in (fi.value.assign.value.name.value, Some t_int) _value _loop
| Loop (For (ForCollect {region ; _})) ->
fail @@ unsupported_for_loops region fail @@ unsupported_for_loops region
| Cond c -> ( | Cond c -> (
let (c , loc) = r_split c in let (c , loc) = r_split c in

View File

@ -16,12 +16,12 @@ function while_sum (var n : nat) : nat is block {
} }
} with r } with r
(* function for_sum (var n : nat) : nat is block { function for_sum (var n : nat) : nat is block {
for i := 1 to 100 for i := 1 to 100 step 1
begin begin
n := n + 1; n := n + 1n ;
end } end }
with n *) with n
function dummy (const n : nat) : nat is block { function dummy (const n : nat) : nat is block {
while (False) block { skip } while (False) block { skip }

View File

@ -658,13 +658,18 @@ let loop () : unit result =
let make_input = e_nat in let make_input = e_nat in
let make_expected = fun n -> e_nat (n * (n + 1) / 2) in let make_expected = fun n -> e_nat (n * (n + 1) / 2) in
expect_eq_n_pos_mid program "while_sum" make_input make_expected expect_eq_n_pos_mid program "while_sum" make_input make_expected
<<<<<<< HEAD
in(* For loop is currently unsupported in(* For loop is currently unsupported
let%bind () = let%bind () =
=======
in
let%bind () =
>>>>>>> First version for ForInt loops
let make_input = e_nat in let make_input = e_nat in
let make_expected = fun n -> e_nat (n * (n + 1) / 2) in let make_expected = fun n -> e_nat (n + 100) in
expect_eq_n_pos_mid program "for_sum" make_input make_expected expect_eq_n_pos_mid program "for_sum" make_input make_expected
in *) in
ok () ok ()
(* Don't know how to assert parse error happens in this test framework (* Don't know how to assert parse error happens in this test framework