Commit 6fb58a7a authored by Raphaël Rieu-Helft's avatar Raphaël Rieu-Helft

Merge branch 'ocaml_printer_precedences' into 'master'

Move the Ocaml printer to a precedence-based system

Closes #284

See merge request !104
parents 4508d668 81369020
......@@ -16,12 +16,6 @@ module ref.Ref
syntax val (:=) "%1 = %2" prec 14 13 14
end
module mach.int.Unsigned
syntax constant zero_unsigned "0"
end
module mach.int.Int32
syntax type int32 "int32_t"
......
This diff is collapsed.
......@@ -116,7 +116,7 @@ val gen_syntax_arguments_typed_prec :
val syntax_arguments_typed_prec :
string -> (int -> term Pp.pp) -> ty Pp.pp -> term -> int list -> term list Pp.pp
(** (syntax_arguments_typed templ print_arg prec_list fmt l) prints in the
(** (syntax_arguments_typed_prec templ print_arg prec_list fmt l) prints in the
formatter fmt the list l using the template templ, the printer print_arg
and the precedence list prec_list *)
......
......@@ -59,6 +59,7 @@ module C = struct
| Eindex of expr * expr (* Array access *)
| Edot of expr * string (* Field access with dot *)
| Earrow of expr * string (* Pointer access with arrow *)
| Esyntaxrename of string * expr list (* syntax val f "g" w/o params *)
| Esyntax of string * ty * (ty array) * (expr*ty) list * int list
(* template, type and type arguments of result, typed arguments, precedence level *)
......@@ -172,7 +173,9 @@ module C = struct
| Edot (e,i) -> Edot (propagate_in_expr id v e, i)
| Earrow (e,i) -> Earrow (propagate_in_expr id v e, i)
| Esyntax (s,t,ta,l,p) ->
Esyntax (s,t,ta,List.map (fun (e,t) -> (propagate_in_expr id v e),t) l,p)
Esyntax (s,t,ta,List.map (fun (e,t) -> (propagate_in_expr id v e),t) l,p)
| Esyntaxrename (s, l) ->
Esyntaxrename (s, List.map (propagate_in_expr id v) l)
| Enothing -> Enothing
| Econst c -> Econst c
| Elikely e -> Elikely (propagate_in_expr id v e)
......@@ -400,6 +403,7 @@ module C = struct
| Esize_type _ -> true
| Eindex (_,_) | Edot (_,_) | Earrow (_,_) -> false
| Esyntax (_,_,_,_,_) -> false
| Esyntaxrename _ -> false
let rec get_const_expr (d,s) =
let fail () = raise (Unsupported "non-constant array size") in
......@@ -558,8 +562,8 @@ module Print = struct
| Ecast(ty, e) ->
fprintf fmt (protect_on (prec < 2) "(%a)%a")
(print_ty ~paren:false) ty (print_expr ~prec:2) e
| Ecall (Esyntax (s, _, _, [],_), l) ->
(* function defined in the prelude *)
| Esyntaxrename (s, l) ->
(* call to function defined in the prelude *)
fprintf fmt (protect_on (prec < 1) "%s(%a)")
s (print_list comma (print_expr ~prec:15)) l
| Ecall (e,l) ->
......@@ -988,29 +992,29 @@ module MLToC = struct
unboxed_params args in
match query_syntax info.syntax rs.rs_name with
| Some s ->
begin
try
let _ =
Str.search_forward
(Str.regexp "[%]\\([tv]?\\)[0-9]+") s 0 in
let rty = ty_of_ity (match e.e_ity with
| C _ -> assert false
| I i -> i) in
let rtyargs = match rty.ty_node with
| Tyvar _ -> [||]
| Tyapp (_,args) ->
Array.of_list (List.map (ty_of_ty info) args)
in
let p = Mid.find rs.rs_name info.prec in
C.Esyntax(s,ty_of_ty info rty, rtyargs, params, p)
with Not_found ->
if args=[]
then C.(Esyntax(s, Tnosyntax, [||], [], [])) (*constant*)
else
(*function defined in the prelude *)
let cargs = List.map fst params in
C.(Ecall(Esyntax(s, Tnosyntax, [||], [], []), cargs))
end
let complex s =
String.contains s '%'
|| String.contains s ' '
|| String.contains s '(' in
if complex s
then
let rty = ty_of_ity (match e.e_ity with
| C _ -> assert false
| I i -> i) in
let rtyargs = match rty.ty_node with
| Tyvar _ -> [||]
| Tyapp (_,args) ->
Array.of_list (List.map (ty_of_ty info) args)
in
let p = Mid.find rs.rs_name info.prec in
C.Esyntax(s,ty_of_ty info rty, rtyargs, params, p)
else
if args=[]
then C.(Esyntax(s, Tnosyntax, [||], [], [])) (*constant*)
else
(*function defined in the prelude *)
let cargs = List.map fst params in
C.(Esyntaxrename (s, cargs))
| None ->
match rs.rs_field with
| None ->
......
This diff is collapsed.
......@@ -325,6 +325,13 @@ module TestExtraction
()
done
let test_if (b:bool) (t:ty) : int =
if b
then let r = ref 0 in
r := (match t with A -> 1 | B -> 2 | C -> 3 end);
!r
else match t with A -> 2 | B -> 3 | C -> 1 end
end
(*
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment