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 ...@@ -16,12 +16,6 @@ module ref.Ref
syntax val (:=) "%1 = %2" prec 14 13 14 syntax val (:=) "%1 = %2" prec 14 13 14
end end
module mach.int.Unsigned
syntax constant zero_unsigned "0"
end
module mach.int.Int32 module mach.int.Int32
syntax type int32 "int32_t" syntax type int32 "int32_t"
......
This diff is collapsed.
...@@ -116,7 +116,7 @@ val gen_syntax_arguments_typed_prec : ...@@ -116,7 +116,7 @@ val gen_syntax_arguments_typed_prec :
val syntax_arguments_typed_prec : val syntax_arguments_typed_prec :
string -> (int -> term Pp.pp) -> ty Pp.pp -> term -> int list -> term list Pp.pp 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 formatter fmt the list l using the template templ, the printer print_arg
and the precedence list prec_list *) and the precedence list prec_list *)
......
...@@ -59,6 +59,7 @@ module C = struct ...@@ -59,6 +59,7 @@ module C = struct
| Eindex of expr * expr (* Array access *) | Eindex of expr * expr (* Array access *)
| Edot of expr * string (* Field access with dot *) | Edot of expr * string (* Field access with dot *)
| Earrow of expr * string (* Pointer access with arrow *) | 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 | Esyntax of string * ty * (ty array) * (expr*ty) list * int list
(* template, type and type arguments of result, typed arguments, precedence level *) (* template, type and type arguments of result, typed arguments, precedence level *)
...@@ -172,7 +173,9 @@ module C = struct ...@@ -172,7 +173,9 @@ module C = struct
| Edot (e,i) -> Edot (propagate_in_expr id v e, i) | Edot (e,i) -> Edot (propagate_in_expr id v e, i)
| Earrow (e,i) -> Earrow (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,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 | Enothing -> Enothing
| Econst c -> Econst c | Econst c -> Econst c
| Elikely e -> Elikely (propagate_in_expr id v e) | Elikely e -> Elikely (propagate_in_expr id v e)
...@@ -400,6 +403,7 @@ module C = struct ...@@ -400,6 +403,7 @@ module C = struct
| Esize_type _ -> true | Esize_type _ -> true
| Eindex (_,_) | Edot (_,_) | Earrow (_,_) -> false | Eindex (_,_) | Edot (_,_) | Earrow (_,_) -> false
| Esyntax (_,_,_,_,_) -> false | Esyntax (_,_,_,_,_) -> false
| Esyntaxrename _ -> false
let rec get_const_expr (d,s) = let rec get_const_expr (d,s) =
let fail () = raise (Unsupported "non-constant array size") in let fail () = raise (Unsupported "non-constant array size") in
...@@ -558,8 +562,8 @@ module Print = struct ...@@ -558,8 +562,8 @@ module Print = struct
| Ecast(ty, e) -> | Ecast(ty, e) ->
fprintf fmt (protect_on (prec < 2) "(%a)%a") fprintf fmt (protect_on (prec < 2) "(%a)%a")
(print_ty ~paren:false) ty (print_expr ~prec:2) e (print_ty ~paren:false) ty (print_expr ~prec:2) e
| Ecall (Esyntax (s, _, _, [],_), l) -> | Esyntaxrename (s, l) ->
(* function defined in the prelude *) (* call to function defined in the prelude *)
fprintf fmt (protect_on (prec < 1) "%s(%a)") fprintf fmt (protect_on (prec < 1) "%s(%a)")
s (print_list comma (print_expr ~prec:15)) l s (print_list comma (print_expr ~prec:15)) l
| Ecall (e,l) -> | Ecall (e,l) ->
...@@ -988,29 +992,29 @@ module MLToC = struct ...@@ -988,29 +992,29 @@ module MLToC = struct
unboxed_params args in unboxed_params args in
match query_syntax info.syntax rs.rs_name with match query_syntax info.syntax rs.rs_name with
| Some s -> | Some s ->
begin let complex s =
try String.contains s '%'
let _ = || String.contains s ' '
Str.search_forward || String.contains s '(' in
(Str.regexp "[%]\\([tv]?\\)[0-9]+") s 0 in if complex s
let rty = ty_of_ity (match e.e_ity with then
| C _ -> assert false let rty = ty_of_ity (match e.e_ity with
| I i -> i) in | C _ -> assert false
let rtyargs = match rty.ty_node with | I i -> i) in
| Tyvar _ -> [||] let rtyargs = match rty.ty_node with
| Tyapp (_,args) -> | Tyvar _ -> [||]
Array.of_list (List.map (ty_of_ty info) args) | Tyapp (_,args) ->
in Array.of_list (List.map (ty_of_ty info) args)
let p = Mid.find rs.rs_name info.prec in in
C.Esyntax(s,ty_of_ty info rty, rtyargs, params, p) let p = Mid.find rs.rs_name info.prec in
with Not_found -> C.Esyntax(s,ty_of_ty info rty, rtyargs, params, p)
if args=[] else
then C.(Esyntax(s, Tnosyntax, [||], [], [])) (*constant*) if args=[]
else then C.(Esyntax(s, Tnosyntax, [||], [], [])) (*constant*)
(*function defined in the prelude *) else
let cargs = List.map fst params in (*function defined in the prelude *)
C.(Ecall(Esyntax(s, Tnosyntax, [||], [], []), cargs)) let cargs = List.map fst params in
end C.(Esyntaxrename (s, cargs))
| None -> | None ->
match rs.rs_field with match rs.rs_field with
| None -> | None ->
......
This diff is collapsed.
...@@ -325,6 +325,13 @@ module TestExtraction ...@@ -325,6 +325,13 @@ module TestExtraction
() ()
done 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 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