Add support for infix operators

generator/js_of_ast.ml

@@ -11,6 +11,7 @@ open Mytools
 open Attributes
 open Log
 
+  
 let hashtbl_size = 256
 let type_tbl   = Hashtbl.create hashtbl_size
 let record_tbl = Hashtbl.create hashtbl_size
@@ -28,7 +29,7 @@ let print_type_tbl () =
   in Hashtbl.iter (fun cstr elems -> Printf.printf ({|%s -> [%s]|} ^^ "\n") cstr (print_str_list elems)) type_tbl; ()
 
 (**
- * Useful functions (shadow show_list from Mytools)
+ * Useful functions (Warning: shadows `show_list' from Mytools)
  *)
     
 let show_list_f f sep l = l
@@ -39,7 +40,15 @@ let show_list sep l =
   List.fold_left (fun acc x -> acc ^ (if acc = "" then "" else sep) ^ x) "" l
 
 let is_sbool x = List.mem x ["true" ; "false"] 
-    
+
+let is_infix f args = match args with
+  | _ :: [] | [] -> false
+  | x :: xs ->
+     let open Location in
+     let f_loc = (f.exp_loc.loc_start, f.exp_loc.loc_end) in
+     let args_loc = (x.exp_loc.loc_start, x.exp_loc.loc_end) in
+     if fst args_loc < fst f_loc then true else false
+                                               
 (**
  * Before-hand definitions of Pretty-Printer-Format for converting ocaml
  * to ECMAScript, therefore all of them are in a single place.
@@ -66,6 +75,10 @@ let ppf_apply f args =
   Printf.sprintf "@[<v 0>%s(%s)@]"
     f args
 
+let ppf_apply_infix f arg1 arg2 =
+  Printf.sprintf "@[<v 0>%s %s %s@]"
+                 arg1 f arg2
+    
 let ppf_match value cases =
   let s =
     Printf.sprintf "switch (%s.type) {@,@[<v 2>@,%s@,@]@,}"
@@ -196,11 +209,14 @@ and js_of_expression e = match e.exp_desc with
     let args, body = explore [c.c_lhs] c.c_rhs
     in ppf_function args body
   | Texp_apply (f, exp_l)                 ->
-    let sl = exp_l
-          |> List.map (fun (_, eo, _) -> match eo with None -> out_of_scope "optional apply arguments" | Some ei -> js_of_expression ei)
-          |> String.concat ", " in
-     let se = js_of_expression f in
-     ppf_apply se sl
+     let sl' = exp_l
+               |> List.map (fun (_, eo, _) -> match eo with None -> out_of_scope "optional apply arguments" | Some ei -> ei) in
+     let sl = exp_l
+              |> List.map (fun (_, eo, _) -> match eo with None -> out_of_scope "optional apply arguments" | Some ei -> js_of_expression ei) in
+    let se = js_of_expression f in
+    if is_infix f sl' && List.length exp_l = 2
+    then ppf_apply_infix se (List.hd sl) (List.hd (List.tl sl))
+    else ppf_apply se (String.concat ", " sl)
   | Texp_match (exp, l, [], Total) ->
      let se = js_of_expression exp in
      let sb = List.fold_left (fun acc x -> acc ^ js_of_branch x se) "" l in
@@ -278,7 +294,7 @@ and js_of_let_pattern pat expr =
   let sexpr = js_of_expression expr in
   match pat.pat_desc with
   | Tpat_var (id, _) ->
-     Printf.sprintf "@[<v 0>var %s = %s;@,@]" (Ident.name id) sexpr
+     L.log_line (Printf.sprintf "@[<v 0>var %s = %s;@,@]" (Ident.name id) sexpr) (L.Add (Ident.name id))
   | Tpat_tuple (pat_l)
   | Tpat_array (pat_l) ->
      let l = List.map (function pat -> match pat.pat_desc with

generator/log.ml

@@ -121,9 +121,9 @@ struct
       | (None, str)   :: xs -> Buffer.add_string buf str;
                                aux xs                   
       | (Some x, str) :: xs -> let log_info = match Hashtbl.find info_tbl x with
-                                 | Add x   -> "print (\"Variable x has been introduced with value: \"); print(x);@,"
-                                 | Redef x -> "print (\"Variable x has been redefined with value: \"); print(x);@,"
-                                 | Del x   -> "print (\"Variable x has been deleted from the context \");@,"
+                                 | Add x   -> "@[<v 0>@,print (\"Variable " ^ x ^ " has been introduced with value: \");@,print("^ x ^");@,@]"
+                                 | Redef x -> "print (\"Variable " ^ x ^ " has been redefined with value: \"); print("^ x ^");@,"
+                                 | Del x   -> "print (\"Variable " ^ x ^ " has been deleted from the context \");@,"
                                in Buffer.add_string buf str;
                                   Buffer.add_string buf log_info;
                                   aux xs

generator/stdlib_ml/stdlib.mli

 val add : 'a -> 'a -> 'a
+val ( + ) : 'a -> 'a -> 'a
 val sub : 'a -> 'a -> 'a
+val ( - ) : 'a -> 'a -> 'a
 val mul : 'a -> 'a -> 'a
+val ( * ) : 'a -> 'a -> 'a
 val div : 'a -> 'a -> 'a
-
+val ( / ) : 'a -> 'a -> 'a
+                 
 val eq : 'a -> 'a -> bool
+val ( === ) : 'a -> 'a -> 'a
 val le : 'a -> 'a -> bool
+val ( < ) : 'a -> 'a -> 'a
 val ge : 'a -> 'a -> bool
+val ( > ) : 'a -> 'a -> 'a
 
 val leq : 'a -> 'a -> bool
+val ( <= ) : 'a -> 'a -> 'a
 val geq : 'a -> 'a -> bool
+val ( >= ) : 'a -> 'a -> 'a
 
 val print : 'a -> unit
 

generator/tests/calc.ml

@@ -7,18 +7,18 @@ type expr =
 
 let rec eval_ expr = match expr with
   | Const n -> n
-  | Add (ls, rs) -> add (eval_ ls) (eval_ rs)
-  | Sub (ls, rs) -> sub (eval_ ls) (eval_ rs)
-  | Mul (ls, rs) -> mul (eval_ ls) (eval_ rs)
-  | Div (ls, rs) -> div (eval_ ls) (eval_ rs)
+  | Add (ls, rs) -> eval_ ls + eval_ rs
+  | Sub (ls, rs) -> eval_ ls - eval_ rs
+  | Mul (ls, rs) -> eval_ ls * eval_ rs
+  | Div (ls, rs) -> eval_ ls / eval_ rs
 
 let rec print_expr expr = match expr with
   | Const n -> to_string n
-  | Add (ls, rs) -> (add (add  (add (add "(" (print_expr ls)) ")") " + ") (print_expr rs))
-  | Sub (ls, rs) -> (add (add  (add (add "(" (print_expr ls)) ")") " - ") (print_expr rs))
-  | Mul (ls, rs) -> (add (add  (add (add "(" (print_expr ls)) ")") " * ") (print_expr rs))
-  | Div (ls, rs) -> (add (add  (add (add "(" (print_expr ls)) ")") " / ") (print_expr rs))
+  | Add (ls, rs) -> "(" + (print_expr ls) + ")" + " + " + (print_expr rs)
+  | Sub (ls, rs) -> "(" + (print_expr ls) + ")" + " - " + (print_expr rs)
+  | Mul (ls, rs) -> "(" + (print_expr ls) + ")" + " * " + (print_expr rs)
+  | Div (ls, rs) -> "(" + (print_expr ls) + ")" + " / " + (print_expr rs)
 
 let f =
     let source = parse "((1972 / 29) / 2) + 8" in
-    print (add (add (print_expr source) " = ") (to_string (eval_ source)))
+    print ((print_expr source) + " = " + to_string (eval_ source))