Fixed some ocaml backend related bugs

2 files changed, 19 insertions, 8 deletions

diff --git a/src/ocaml_backend.ml b/src/ocaml_backend.ml
index f103f818..feadb2d5 100644
--- a/src/ocaml_backend.ml
+++ b/src/ocaml_backend.ml
@@ -122,7 +122,7 @@ let ocaml_lit (L_aux (lit_aux, _)) =
   | L_num n -> parens (string "big_int_of_int" ^^ space ^^ string (string_of_int n))
   | L_undef -> failwith "undefined should have been re-written prior to ocaml backend"
   | L_string str -> string_lit str
-  | L_real str -> parens (string "Num.num_of_string" ^^ space ^^ dquotes (string (String.escaped str)))
+  | L_real str -> parens (string "real_of_string" ^^ space ^^ dquotes (string (String.escaped str)))
   | _ -> string "LIT"
 
 let rec ocaml_pat ctx (P_aux (pat_aux, _) as pat) =
@@ -202,11 +202,20 @@ let rec ocaml_exp ctx (E_aux (exp_aux, _) as exp) =
      ^/^ string "in"
      ^/^ string "loop ()"
   | E_lit _ | E_list _ | E_id _ | E_tuple _ -> ocaml_atomic_exp ctx exp
-  | E_for (id, exp_from, exp_to, exp_step, _, exp_body) ->
+  | E_for (id, exp_from, exp_to, exp_step, ord, exp_body) ->
      let loop_var = separate space [string "let"; zencode ctx id; equals; string "ref"; ocaml_atomic_exp ctx exp_from; string "in"] in
-     let loop_mod = string "add_big_int" ^^ space ^^ zencode ctx id ^^ space ^^ ocaml_atomic_exp ctx exp_step in
+     let loop_mod =
+       match ord with
+       | Ord_aux (Ord_inc, _) -> string "add_big_int" ^^ space ^^ zencode ctx id ^^ space ^^ ocaml_atomic_exp ctx exp_step
+       | Ord_aux (Ord_dec, _) -> string "sub_big_int" ^^ space ^^ zencode ctx id ^^ space ^^ ocaml_atomic_exp ctx exp_step
+     in
+     let loop_compare =
+       match ord with
+       | Ord_aux (Ord_inc, _) -> string "le_big_int"
+       | Ord_aux (Ord_dec, _) -> string "gt_big_int"
+     in
      let loop_body =
-       separate space [string "if"; zencode ctx id; string "<="; ocaml_atomic_exp ctx exp_to]
+       separate space [string "if"; loop_compare; zencode ctx id; ocaml_atomic_exp ctx exp_to]
        ^/^ separate space [string "then";
              parens (ocaml_atomic_exp ctx exp_body ^^ semi ^^ space ^^ string "loop" ^^ space ^^ parens loop_mod)]
        ^/^ string "else ()"
diff --git a/src/type_check.ml b/src/type_check.ml
index 751e70e5..6c5205fe 100644
--- a/src/type_check.ml
+++ b/src/type_check.ml
@@ -2644,9 +2644,9 @@ and infer_exp env (E_aux (exp_aux, (l, ())) as exp) =
      annot_exp (E_loop (loop_type, checked_cond, checked_body)) unit_typ
   | E_for (v, f, t, step, ord, body) ->
      begin
-       let f, t = match ord with
-         | Ord_aux (Ord_inc, _) -> f, t
-         | Ord_aux (Ord_dec, _) -> t, f (* reverse direction for downto loop *)
+       let f, t, is_dec = match ord with
+         | Ord_aux (Ord_inc, _) -> f, t, false
+         | Ord_aux (Ord_dec, _) -> t, f, true (* reverse direction to typechecking downto as upto loop *)
        in
        let inferred_f = irule infer_exp env f in
        let inferred_t = irule infer_exp env t in
@@ -2668,7 +2668,9 @@ and infer_exp env (E_aux (exp_aux, (l, ())) as exp) =
               let env = Env.add_constraint (nc_and (nc_lteq l1 (nvar kid)) (nc_lteq (nvar kid) u2)) env in
               let loop_vtyp = atom_typ (nvar kid) in
               let checked_body = crule check_exp (Env.add_local v (Immutable, loop_vtyp) env) body unit_typ in
-              annot_exp (E_for (v, inferred_f, inferred_t, checked_step, ord, checked_body)) unit_typ
+              if not is_dec (* undo reverse direction in annoteded ast for downto loop *)
+              then annot_exp (E_for (v, inferred_f, inferred_t, checked_step, ord, checked_body)) unit_typ
+              else annot_exp (E_for (v, inferred_t, inferred_f, checked_step, ord, checked_body)) unit_typ
             end
        | _, _ -> typ_error l "Ranges in foreach overlap"
      end