Commit dde1e0cd authored by Andrei Paskevich's avatar Andrei Paskevich

Ident: handle tight prefix symbols inside Ident

parent cb870251
......@@ -50,9 +50,10 @@ let attr_compare a1 a2 = Pervasives.compare a1.attr_tag a2.attr_tag
(** Naming convention *)
type notation =
| SNword of string
| SNinfix of string
| SNprefix of string
| SNword of string (* plus *)
| SNinfix of string (* + *)
| SNtight of string (* ! *)
| SNprefix of string (* -_ *)
| SNget of string (* [] *)
| SNset of string (* []<- *)
| SNupdate of string (* [<-] *)
......@@ -73,25 +74,14 @@ let op_rcut s = "mixfix [_..]" ^ s
let op_equ = op_infix "="
let op_neq = op_infix "<>"
let sn_encode = function
| SNinfix s -> op_infix s
| SNprefix s -> op_prefix s
| SNget s -> op_get s
| SNset s -> op_set s
| SNupdate s -> op_update s
| SNcut s -> op_cut s
| SNlcut s -> op_lcut s
| SNrcut s -> op_rcut s
| SNword s -> s
let op_tight = op_prefix
let print_sn fmt w =
let lspace p = if p.[0] = '*' then " " else "" in
let rspace p = if p.[String.length p - 1] = '*' then " " else "" in
match w with (* infix/prefix never empty, mixfix never have stars *)
match w with (* infix/prefix never empty, mixfix cannot have stars *)
| SNinfix p -> Format.fprintf fmt "(%s%s%s)" (lspace p) p (rspace p)
| SNprefix p when p.[0] = '!' || p.[0] = '?' ->
Format.fprintf fmt "(%s%s)" p (rspace p)
| SNtight p -> Format.fprintf fmt "(%s%s)" p (rspace p)
| SNprefix p -> Format.fprintf fmt "(%s%s_)" (lspace p) p
| SNget p -> Format.fprintf fmt "([]%s)" p
| SNset p -> Format.fprintf fmt "([]%s<-)" p
......@@ -133,7 +123,9 @@ let sn_decode s =
let m = skip_quote l in
if l = k && k < 8 then SNword s (* null infix/prefix *) else
let w = if k = 6 then SNinfix (String.sub s 6 (m - 6)) else
if k = 7 then SNprefix (String.sub s 7 (m - 7)) else
if k = 7 then let op = String.sub s 7 (m - 7) in
if s.[7] = '!' || s.[7] = '?' then
SNtight op else SNprefix op else
let p = if l < m then String.sub s l (m - l) else "" in
match String.sub s 8 (l - 8) with
| "]" -> SNget p | "]<-" -> SNset p | "<-]" -> SNupdate p
......@@ -224,19 +216,12 @@ let find_unique indices name =
let specname ind =
(* If the symbol is infix/prefix *and* the name has not been
sanitized for provers, we don't want to disambiguate with
a number but with a symbol: "+" becomes "+'" "+''" etc.
a number but with a quote symbol: "+" becomes "+'" "+''" etc.
This allows to parse the ident again (for transformations). *)
if ind <= 0 then name else
match sn_decode name with
| SNinfix s -> op_infix (s ^ String.make ind '\'')
| SNprefix s -> op_prefix (s ^ String.make ind '\'')
| SNget s -> op_get (s ^ String.make ind '\'')
| SNset s -> op_set (s ^ String.make ind '\'')
| SNupdate s -> op_update (s ^ String.make ind '\'')
| SNcut s -> op_cut (s ^ String.make ind '\'')
| SNlcut s -> op_lcut (s ^ String.make ind '\'')
| SNrcut s -> op_rcut (s ^ String.make ind '\'')
| SNword _ -> name ^ string_of_int ind in
| SNword _ -> name ^ string_of_int ind
| _ -> name ^ String.make ind '\'' in
let testname ind = Hstr.mem indices (specname ind) in
let rec advance ind =
if testname ind then advance (succ ind) else ind in
......
......@@ -32,9 +32,10 @@ val list_attributes : unit -> string list
(** {2 Naming convention} *)
type notation =
| SNword of string
| SNinfix of string
| SNprefix of string
| SNword of string (* plus *)
| SNinfix of string (* + *)
| SNtight of string (* ! *)
| SNprefix of string (* -_ *)
| SNget of string (* [] *)
| SNset of string (* []<- *)
| SNupdate of string (* [<-] *)
......@@ -42,18 +43,8 @@ type notation =
| SNlcut of string (* [.._] *)
| SNrcut of string (* [_..] *)
val sn_encode : notation -> string
(* encode the symbol name as a string *)
val sn_decode : string -> notation
(* decode the string as a symbol name *)
val print_decoded : Format.formatter -> string -> unit
(* decode the string as a symbol name and pretty-print it *)
(* specialized encoders *)
val op_infix : string -> string
val op_tight : string -> string
val op_prefix : string -> string
val op_get : string -> string
val op_set : string -> string
......@@ -64,6 +55,12 @@ val op_rcut : string -> string
val op_equ : string
val op_neq : string
val sn_decode : string -> notation
(* decode the string as a symbol name *)
val print_decoded : Format.formatter -> string -> unit
(* decode the string as a symbol name and pretty-print it *)
(** {2 Identifiers} *)
type ident = private {
......
......@@ -131,11 +131,6 @@ let print_vs fmt vs =
let forget_var vs = forget_id iprinter vs.vs_name
(* pretty-print infix and prefix logic symbols *)
let tight_op s =
s <> "" && (let c = String.get s 0 in c = '!' || c = '?')
(* theory names always start with an upper case letter *)
let print_th fmt th =
let sanitizer = Strings.capitalize in
......@@ -256,7 +251,7 @@ and print_app pri ls fmt tl =
if tl = [] then print_ls fmt ls else
let s = id_unique iprinter ls.ls_name in
match Ident.sn_decode s, tl with
| Ident.SNprefix s, [t1] when tight_op s ->
| Ident.SNtight s, [t1] ->
fprintf fmt (protect_on (pri > 8) "@[%s%a@]")
s (print_lterm 8) t1
| Ident.SNprefix s, [t1] ->
......
......@@ -1171,9 +1171,6 @@ let forget_let_defn = function
| LDsym (s,_) -> forget_rs s
| LDrec rdl -> List.iter (fun fd -> forget_rs fd.rec_sym) rdl
let tight_op s =
s <> "" && (let c = String.get s 0 in c = '!' || c = '?')
let print_rs fmt s = match s.rs_logic with
| RLnone | RLlemma ->
Ident.print_decoded fmt (id_unique sprinter s.rs_name)
......@@ -1231,7 +1228,7 @@ let print_capp pri s fmt vl =
if vl = [] then print_rs fmt s else
let p = id_unique sprinter s.rs_name in
match Ident.sn_decode p, vl with
| Ident.SNprefix o, [t1] when tight_op o ->
| Ident.SNtight o, [t1] ->
fprintf fmt (protect_on (pri > 7) "%s%a") o print_pv t1
| Ident.SNprefix o, [t1] ->
fprintf fmt (protect_on (pri > 4) "%s %a") o print_pv t1
......
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