Skip to content

GitLab

why3
why3
Commit 9ceb1577 authored by MARCHE Claude's avatar MARCHE Claude
Browse files
Options

file locations: a lot of cleaning

parent 404ecebf
Hide whitespace changes
Inline Side-by-side
Showing with 157 additions and 213 deletions
src/core/ident.ml
View file @ 9ceb1577
......@@ -74,6 +74,7 @@ let end_regexp = Str.regexp "end:\\([0-9]+\\)"
let id_fresh ?(labels = []) nm = create_ident nm Fresh labels
let id_user ?(labels = []) nm loc =
(*
let (f,li,b,e) = Loc.extract loc in
let f = ref f in
let li = ref li in
......@@ -101,6 +102,8 @@ let id_user ?(labels = []) nm loc =
{Lexing.pos_fname = !f; Lexing.pos_lnum = !li;
Lexing.pos_bol = 0; Lexing.pos_cnum = !e})
in
*)
let l = labels in
create_ident nm (User loc) l
let id_derive ?(labels = []) nm id = create_ident nm (Derived id) labels
......
src/driver/driver_lexer.mll
View file @ 9ceb1577
......@@ -98,7 +98,7 @@ rule token = parse
{ raise (IllegalCharacter c) }
{
let loc lb = (lexeme_start_p lb, lexeme_end_p lb)
let loc lb = Loc.extract (lexeme_start_p lb, lexeme_end_p lb)
let with_location f lb =
try f lb with e -> raise (Loc.Located (loc lb, e))
......
src/driver/driver_parser.mly
View file @ 9ceb1577
......@@ -20,8 +20,8 @@
%{
open Driver_ast
open Parsing
let loc () = (symbol_start_pos (), symbol_end_pos ())
let loc_i i = (rhs_start_pos i, rhs_end_pos i)
let loc () = Loc.extract (symbol_start_pos (), symbol_end_pos ())
let loc_i i = Loc.extract (rhs_start_pos i, rhs_end_pos i)
let infix s = "infix " ^ s
let prefix s = "prefix " ^ s
%}
......
src/ide/gmain.ml
View file @ 9ceb1577
......@@ -204,14 +204,14 @@ let () =
let read_file fn =
let fn = Filename.concat project_dir fn in
let fn = Filename.concat project_dir fn in
let theories = Env.read_file gconfig.env fn in
let theories =
Theory.Mnm.fold
(fun name th acc ->
match th.Theory.th_name.Ident.id_origin with
| Ident.User l -> (Loc.extract l,name,th)::acc
| _ -> (Loc.dummy_floc,name,th)::acc)
| Ident.User l -> (l,name,th)::acc
| _ -> (Loc.dummy_position,name,th)::acc)
theories []
in
let theories = List.sort
......@@ -554,21 +554,21 @@ module Helpers = struct
| Running -> !image_running
| InternalFailure _ -> !image_failure
| Done r -> match r.Call_provers.pr_answer with
| Call_provers.Valid ->
if obsolete then !image_valid else !image_valid_obs
| Call_provers.Invalid ->
if obsolete then !image_invalid else !image_invalid_obs
| Call_provers.Timeout ->
if obsolete then !image_timeout else !image_timeout_obs
| Call_provers.Unknown _ ->
if obsolete then !image_unknown else !image_unknown_obs
| Call_provers.Failure _ ->
if obsolete then !image_failure else !image_failure_obs
| Call_provers.HighFailure ->
if obsolete then !image_failure else !image_failure_obs
| Call_provers.Valid ->
if obsolete then !image_valid_obs else !image_valid
| Call_provers.Invalid ->
if obsolete then !image_invalid_obs else !image_invalid
| Call_provers.Timeout ->
if obsolete then !image_timeout_obs else !image_timeout
| Call_provers.Unknown _ ->
if obsolete then !image_unknown_obs else !image_unknown
| Call_provers.Failure _ ->
if obsolete then !image_failure_obs else !image_failure
| Call_provers.HighFailure ->
if obsolete then !image_failure_obs else !image_failure
let set_row_status b row =
if b then
if b then
begin
goals_view#collapse_row (goals_model#get_path row);
goals_model#set ~row ~column:status_column !image_yes;
......@@ -600,13 +600,13 @@ module Helpers = struct
end
let rec check_goal_proved g =
let b1 = Hashtbl.fold
(fun _ a acc -> acc ||
let b1 = Hashtbl.fold
(fun _ a acc -> acc ||
match a.proof_state with
| Done { Call_provers.pr_answer = Call_provers.Valid} -> true
| _ -> false) g.external_proofs false
in
let b = Hashtbl.fold
let b = Hashtbl.fold
(fun _ t acc -> acc || t.transf_proved) g.transformations b1
in
if g.proved <> b then
......@@ -626,7 +626,7 @@ module Helpers = struct
set_row_status b t.transf_row;
check_goal_proved t.parent_goal
end
(* deprecated *)
let set_file_verified f =
......@@ -678,9 +678,9 @@ module Helpers = struct
let row = a.proof_row in
goals_model#set ~row ~column:status_column
(image_of_result ~obsolete res);
let t = match res with
| Done { Call_provers.pr_time = time } ->
| Done { Call_provers.pr_time = time } ->
Format.sprintf "%.2f" time
| _ -> ""
in
......@@ -859,7 +859,7 @@ let trans_list =
let trans_of_name =
let h = Hashtbl.create 13 in
List.iter
List.iter
(fun n -> Hashtbl.add h n (lookup_trans n))
trans_list;
Hashtbl.find h
......@@ -873,20 +873,20 @@ exception Not_applicable
let apply_trans t task =
match t with
| Trans_one t ->
| Trans_one t ->
let t' = Trans.apply t task in
if task == t' then raise Not_applicable; [t']
| Trans_list t ->
| Trans_list t ->
match Trans.apply t task with
| [t'] as l -> if task == t' then raise Not_applicable; l
| l -> l
let apply_transformation ~callback t task =
match t with
| Trans_one t ->
| Trans_one t ->
let callback t = callback [t] in
Scheduler.apply_transformation ~callback t task
| Trans_list t ->
| Trans_list t ->
Scheduler.apply_transformation_l ~callback t task
......@@ -916,8 +916,8 @@ let rec reimport_any_goal parent gid gname t db_goal goal_obsolete =
}
in
let (_pa : Model.proof_attempt) =
Helpers.add_external_proof_row ~obsolete ~edit goal p a
(Scheduler.Done r)
Helpers.add_external_proof_row ~obsolete ~edit goal p a
(Scheduler.Done r)
in
((* something TODO ?*))
with Not_found ->
......@@ -1158,11 +1158,11 @@ let redo_external_proof q g a =
a.Model.proof_state <- result;
*)
Helpers.set_proof_state ~obsolete:false a result (*time*) ;
let db_res, time =
let db_res, time =
match result with
| Scheduler.Scheduled | Scheduler.Running ->
| Scheduler.Scheduled | Scheduler.Running ->
Db.Undone, 0.0
| Scheduler.InternalFailure _ ->
| Scheduler.InternalFailure _ ->
Db.Done Call_provers.HighFailure, 0.0
| Scheduler.Done r ->
if r.Call_provers.pr_answer = Call_provers.Valid then
......@@ -1246,19 +1246,19 @@ let prover_on_selected_goals pr =
let transformation_on_goal g trans_name trans =
if not g.Model.proved then
let callback subgoals =
ignore
(Thread.create
ignore
(Thread.create
(fun subgoals ->
let b =
match subgoals with
| [task] ->
| [task] ->
let s1 = task_checksum g.Model.task in
let s2 = task_checksum task in
(*
eprintf "Transformation returned only one task. sum before = %s, sum after = %s@." (task_checksum g.Model.task) (task_checksum task);
eprintf "addresses: %x %x@." (Obj.magic g.Model.task) (Obj.magic task);
*)
s1 <> s2
s1 <> s2
(* task != g.Model.task *)
| _ -> true
in
......@@ -1269,27 +1269,27 @@ let transformation_on_goal g trans_name trans =
(GtkThread.sync Db.add_transformation)
g.Model.goal_db transf_id
in
let tr = (GtkThread.sync Helpers.add_transformation_row)
g db_transf trans_name
let tr = (GtkThread.sync Helpers.add_transformation_row)
g db_transf trans_name
in
let goal_name = g.Model.goal_name in
let fold =
let fold =
fun (acc,count) subtask ->
let _id = (Task.task_goal subtask).Decl.pr_name in
let subgoal_name =
goal_name ^ "." ^ (string_of_int count)
in
let sum = task_checksum subtask in
let subtask_db =
Db.add_subgoal db_transf subgoal_name sum
let subtask_db =
Db.add_subgoal db_transf subgoal_name sum
in
let goal =
Helpers.add_goal_row (Model.Transf tr)
Helpers.add_goal_row (Model.Transf tr)
subgoal_name None subtask subtask_db
in
(goal :: acc, count+1)
(goal :: acc, count+1)
in
let goals,_ =
let goals,_ =
List.fold_left (GtkThread.sync fold) ([],1) subgoals
in
tr.Model.subgoals <- List.rev goals;
......@@ -1306,7 +1306,7 @@ let rec split_goal_or_children g =
if not g.Model.proved then
begin
let r = ref true in
Hashtbl.iter
Hashtbl.iter
(fun _ t ->
r := false;
List.iter split_goal_or_children
......@@ -1318,7 +1318,7 @@ let rec inline_goal_or_children g =
if not g.Model.proved then
begin
let r = ref true in
Hashtbl.iter
Hashtbl.iter
(fun _ t ->
r := false;
List.iter inline_goal_or_children
......@@ -1780,7 +1780,7 @@ let color_loc (v:GSourceView2.source_view) l b e =
let scroll_to_id id =
match id.Ident.id_origin with
| Ident.User loc ->
let (f,l,b,e) = Loc.extract loc in
let (f,l,b,e) = Loc.get loc in
if f <> !current_file then
begin
source_view#source_buffer#set_text (source_text f);
......@@ -1799,9 +1799,10 @@ let scroll_to_id id =
set_current_file ""
let color_label = function
| _, Some loc when (fst loc).Lexing.pos_fname = !current_file ->
let _, l, b, e = Loc.extract loc in
color_loc source_view l b e
| _, Some loc ->
let f, l, b, e = Loc.get loc in
if f = !current_file then
color_loc source_view l b e
| _ ->
()
......@@ -1994,7 +1995,7 @@ let remove_transf t =
let g = t.Model.parent_goal in
Hashtbl.remove g.Model.transformations "split" (* hack !! *);
Helpers.check_goal_proved g
let confirm_remove_row r =
let row = filter_model#get_iter r in
......
src/parser/lexer.mll
View file @ 9ceb1577
......@@ -136,7 +136,7 @@
let n = String.length s in
if n > 0 && s.[0] = '+' then String.sub s 1 (n-1) else s
let loc lb = (lexeme_start_p lb, lexeme_end_p lb)
let loc lb = Loc.extract (lexeme_start_p lb, lexeme_end_p lb)
}
......
src/parser/parser.pre.mly
View file @ 9ceb1577
......@@ -54,20 +54,24 @@
open Parsing
let loc () = (symbol_start_pos (), symbol_end_pos ())
let floc () = Loc.extract (loc ())
let loc_i i = (rhs_start_pos i, rhs_end_pos i)
let floc_i i = Loc.extract (loc_i i)
let loc_ij i j = (rhs_start_pos i, rhs_end_pos j)
let floc_ij i j = Loc.extract (loc_ij i j)
let mk_ppl loc d = { pp_loc = loc; pp_desc = d }
let mk_pp d = mk_ppl (loc ()) d
let mk_pp_i i d = mk_ppl (loc_i i) d
let mk_pp d = mk_ppl (floc ()) d
let mk_pp_i i d = mk_ppl (floc_i i) d
let mk_pat p = { pat_loc = loc (); pat_desc = p }
let mk_pat p = { pat_loc = floc (); pat_desc = p }
let infix_ppl loc a i b = mk_ppl loc (PPbinop (a, i, b))
let infix_pp a i b = infix_ppl (loc ()) a i b
let infix_pp a i b = infix_ppl (floc ()) a i b
let prefix_ppl loc p a = mk_ppl loc (PPunop (p, a))
let prefix_pp p a = prefix_ppl (loc ()) p a
let prefix_pp p a = prefix_ppl (floc ()) p a
let infix s = "infix " ^ s
let prefix s = "prefix " ^ s
......@@ -77,37 +81,26 @@
let add_lab id l = { id with id_lab = l }
let user_loc fname lnum bol cnum1 cnum2 =
let pos = {
Lexing.pos_fname = fname;
Lexing.pos_lnum = lnum;
Lexing.pos_bol = bol;
Lexing.pos_cnum = cnum1 }
in
pos, { pos with Lexing.pos_cnum = cnum2 }
let () = Exn_printer.register
(fun fmt exn -> match exn with
| Parsing.Parse_error -> Format.fprintf fmt "syntax error"
| _ -> raise exn
)
let mk_expr d = { expr_loc = loc (); expr_desc = d }
let mk_expr_i i d = { expr_loc = loc_i i; expr_desc = d }
let mk_expr d = { expr_loc = floc (); expr_desc = d }
let mk_expr_i i d = { expr_loc = floc_i i; expr_desc = d }
let cast_body c ((p,e,q) as t) = match c with
| None -> t
| Some pt -> p, { e with expr_desc = Ecast (e, pt) }, q
let join (b,_) (_,e) = (b,e)
let rec mk_apply f = function
| [] ->
assert false
| [a] ->
Eapply (f, a)
| a :: l ->
let loc = join f.expr_loc a.expr_loc in
let loc = Loc.join f.expr_loc a.expr_loc in
mk_apply { expr_loc = loc; expr_desc = Eapply (f, a) } l
let mk_apply_id id =
......@@ -117,27 +110,27 @@
mk_apply e
let mk_misfix2 op e1 e2 =
let id = { id = misfix op; id_lab = []; id_loc = loc_i 2 } in
let id = { id = misfix op; id_lab = []; id_loc = floc_i 2 } in
mk_expr (mk_apply_id id [e1; e2])
let mk_misfix3 op e1 e2 e3 =
let id = { id = misfix op; id_lab = []; id_loc = loc_i 2 } in
let id = { id = misfix op; id_lab = []; id_loc = floc_i 2 } in
mk_expr (mk_apply_id id [e1; e2; e3])
let mk_infix e1 op e2 =
let id = { id = infix op; id_lab = []; id_loc = loc_i 2 } in
let id = { id = infix op; id_lab = []; id_loc = floc_i 2 } in
mk_expr (mk_apply_id id [e1; e2])
let mk_prefix op e1 =
let id = { id = prefix op; id_lab = []; id_loc = loc_i 1 } in
let id = { id = prefix op; id_lab = []; id_loc = floc_i 1 } in
mk_expr (mk_apply_id id [e1])
let exit_exn () = Qident { id = "%Exit"; id_lab = []; id_loc = loc () }
let id_anonymous () = { id = "_"; id_lab = []; id_loc = loc () }
let id_unit () = { id = "unit"; id_lab = []; id_loc = loc () }
let exit_exn () = Qident { id = "%Exit"; id_lab = []; id_loc = floc () }
let id_anonymous () = { id = "_"; id_lab = []; id_loc = floc () }
let id_unit () = { id = "unit"; id_lab = []; id_loc = floc () }
let ty_unit () = Tpure (PPTtyapp ([], Qident (id_unit ())))
let id_lt_nat () = Qident { id = "lt_nat"; id_lab = []; id_loc = loc () }
let id_lt_nat () = Qident { id = "lt_nat"; id_lab = []; id_loc = floc () }
let empty_effect = { pe_reads = []; pe_writes = []; pe_raises = [] }
......@@ -272,7 +265,7 @@ new_decl:
{ let env = ref_get env_ref in let lenv = ref_get lenv_ref in
ref_set uc_ref (Typing.add_decl env lenv (ref_get uc_ref) $1) }
| namespace_head namespace_import namespace_name list0_decl END
{ ref_set uc_ref (Typing.close_namespace (loc ()) $2 $3 (ref_get uc_ref)) }
{ ref_set uc_ref (Typing.close_namespace (floc ()) $2 $3 (ref_get uc_ref)) }
;
namespace_head:
......@@ -300,19 +293,19 @@ decl:
| INDUCTIVE list1_inductive_decl
{ IndDecl $2 }
| AXIOM ident labels COLON lexpr
{ PropDecl (loc (), Kaxiom, add_lab $2 $3, $5) }
{ PropDecl (floc (), Kaxiom, add_lab $2 $3, $5) }
| LEMMA ident labels COLON lexpr
{ PropDecl (loc (), Klemma, add_lab $2 $3, $5) }
{ PropDecl (floc (), Klemma, add_lab $2 $3, $5) }
| GOAL ident labels COLON lexpr
{ PropDecl (loc (), Kgoal, add_lab $2 $3, $5) }
{ PropDecl (floc (), Kgoal, add_lab $2 $3, $5) }
| USE use
{ UseClone (loc (), $2, None) }
{ UseClone (floc (), $2, None) }
| CLONE use clone_subst
{ UseClone (loc (), $2, Some $3) }
{ UseClone (floc (), $2, Some $3) }
| META ident list1_meta_arg_sep_comma
{ Meta (loc (), $2, $3) }
{ Meta (floc (), $2, $3) }
| META STRING list1_meta_arg_sep_comma
{ Meta (loc (), mk_id $2 (loc_i 2), $3) }
{ Meta (floc (), mk_id $2 (floc_i 2), $3) }
;
/* Use and clone */
......@@ -379,7 +372,7 @@ list1_type_decl:
type_decl:
| lident labels type_args typedefn
{ { td_loc = loc (); td_ident = add_lab $1 $2;
{ { td_loc = floc (); td_ident = add_lab $1 $2;
td_params = $3; td_def = $4 } }
;
......@@ -407,7 +400,7 @@ list1_record_field:
record_field:
| opt_mutable lident labels COLON primitive_type
{ loc (), $1, add_lab $2 $3, $5 }
{ floc (), $1, add_lab $2 $3, $5 }
;
typecases:
......@@ -416,7 +409,7 @@ typecases:
;
typecase:
| uident labels params { (loc (), add_lab $1 $2, $3) }
| uident labels params { (floc (), add_lab $1 $2, $3) }
;
/* Logic declarations */
......@@ -428,7 +421,7 @@ list1_logic_decl:
logic_decl:
| lident_rich labels params logic_type_option logic_def_option
{ { ld_loc = loc (); ld_ident = add_lab $1 $2;
{ { ld_loc = floc (); ld_ident = add_lab $1 $2;
ld_params = $3; ld_type = $4; ld_def = $5 } }
;
......@@ -451,7 +444,7 @@ list1_inductive_decl:
inductive_decl:
| lident_rich labels params inddefn
{ { in_loc = loc (); in_ident = add_lab $1 $2;
{ { in_loc = floc (); in_ident = add_lab $1 $2;
in_params = $3; in_def = $4 } }
;
......@@ -466,7 +459,7 @@ indcases:
;
indcase:
| ident labels COLON lexpr { (loc (), add_lab $1 $2, $4) }
| ident labels COLON lexpr { (floc (), add_lab $1 $2, $4) }
;
/* Type expressions */
......@@ -531,19 +524,19 @@ lexpr:
| NOT lexpr
{ prefix_pp PPnot $2 }
| lexpr EQUAL lexpr
{ mk_pp (PPinfix ($1, mk_id (infix "=") (loc_i 2), $3)) }
{ mk_pp (PPinfix ($1, mk_id (infix "=") (floc_i 2), $3)) }
| lexpr LTGT lexpr
{ prefix_pp PPnot (mk_pp (PPinfix ($1, mk_id (infix "=") (loc_i 2), $3))) }
{ prefix_pp PPnot (mk_pp (PPinfix ($1, mk_id (infix "=") (floc_i 2), $3))) }
| lexpr OP1 lexpr
{ mk_pp (PPinfix ($1, mk_id (infix $2) (loc_i 2), $3)) }
{ mk_pp (PPinfix ($1, mk_id (infix $2) (floc_i 2), $3)) }
| lexpr OP2 lexpr
{ mk_pp (PPinfix ($1, mk_id (infix $2) (loc_i 2), $3)) }
{ mk_pp (PPinfix ($1, mk_id (infix $2) (floc_i 2), $3)) }
| lexpr OP3 lexpr
{ mk_pp (PPinfix ($1, mk_id (infix $2) (loc_i 2), $3)) }
{ mk_pp (PPinfix ($1, mk_id (infix $2) (floc_i 2), $3)) }
| lexpr OP4 lexpr
{ mk_pp (PPinfix ($1, mk_id (infix $2) (loc_i 2), $3)) }
{ mk_pp (PPinfix ($1, mk_id (infix $2) (floc_i 2), $3)) }
| any_op lexpr %prec prefix_op
{ mk_pp (PPapp (Qident (mk_id (prefix $1) (loc_i 2)), [$2])) }
{ mk_pp (PPapp (Qident (mk_id (prefix $1) (floc_i 2)), [$2])) }
| qualid list1_lexpr_arg
{ mk_pp (PPapp ($1, $2)) }
| IF lexpr THEN lexpr ELSE lexpr
......@@ -599,7 +592,7 @@ lexpr_arg:
| FALSE
{ mk_pp PPfalse }
| OPPREF lexpr_arg
{ mk_pp (PPapp (Qident (mk_id (prefix $1) (loc_i 2)), [$2])) }
{ mk_pp (PPapp (Qident (mk_id (prefix $1) (floc_i 2)), [$2])) }
| lexpr_sub
{ $1 }
;
......@@ -608,7 +601,7 @@ lexpr_dot:
| lqualid_rich
{ mk_pp (PPvar $1) }
| OPPREF lexpr_dot
{ mk_pp (PPapp (Qident (mk_id (prefix $1) (loc_i 2)), [$2])) }
{ mk_pp (PPapp (Qident (mk_id (prefix $1) (floc_i 2)), [$2])) }
| lexpr_sub
{ $1 }
;
......@@ -627,10 +620,10 @@ lexpr_sub:
| LEFTREC lexpr_arg WITH list1_field_value opt_semicolon RIGHTREC
{ mk_pp (PPupdate ($2, List.rev $4)) }
| lexpr_arg LEFTSQ lexpr RIGHTSQ
{ mk_pp (PPapp (Qident (mk_id (misfix "[]") (loc ())), [$1; $3])) }
{ mk_pp (PPapp (Qident (mk_id (misfix "[]") (floc ())), [$1; $3])) }
| lexpr_arg LEFTSQ lexpr OP1 lexpr RIGHTSQ
{ let op = "[" ^ $4 ^ "]" in
mk_pp (PPapp (Qident (mk_id (misfix op) (loc ())), [$1; $3; $5])) }
mk_pp (PPapp (Qident (mk_id (misfix op) (floc ())), [$1; $3; $5])) }
;
quant:
......@@ -797,22 +790,22 @@ lident_rich:
| lident
{ $1 }
| LEFTPAR lident_op RIGHTPAR
{ mk_id (infix $2) (loc ()) }
{ mk_id (infix $2) (floc ()) }
| LEFTPAR_STAR_RIGHTPAR
{ mk_id (infix "*") (loc ()) }
{ mk_id (infix "*") (floc ()) }
| LEFTPAR lident_op UNDERSCORE RIGHTPAR
{ mk_id (prefix $2) (loc ()) }
{ mk_id (prefix $2) (floc ()) }
| LEFTPAR OPPREF RIGHTPAR
{ mk_id (prefix $2) (loc ()) }
{ mk_id (prefix $2) (floc ()) }
| LEFTPAR LEFTSQ RIGHTSQ RIGHTPAR
{ mk_id (misfix "[]") (loc ()) }
{ mk_id (misfix "[]") (floc ()) }
| LEFTPAR LEFTSQ OP1 RIGHTSQ RIGHTPAR
{ mk_id (misfix ("[" ^ $3 ^ "]")) (loc ()) }
{ mk_id (misfix ("[" ^ $3 ^ "]")) (floc ()) }
;
lident:
| LIDENT { mk_id $1 (loc ()) }
| MODEL { mk_id "model" (loc ()) }
| LIDENT { mk_id $1 (floc ()) }
| MODEL { mk_id "model" (floc ()) }
;
lident_op:
......@@ -831,7 +824,7 @@ any_op:
;
uident:
| UIDENT { mk_id $1 (loc ()) }
| UIDENT { mk_id $1 (floc ()) }
;
lq_lident:
......@@ -878,10 +871,10 @@ label:
| STRING
{ Ident.label $1 }
| STRING BACKQUOTE INTEGER BACKQUOTE INTEGER
BACKQUOTE INTEGER BACKQUOTE INTEGER BACKQUOTE STRING
{ let loc = user_loc $11 (int_of_string $3) (int_of_string $5)
(int_of_string $7) (int_of_string $9) in
Ident.label ~loc $1 }
BACKQUOTE INTEGER BACKQUOTE STRING
{ let loc = Loc.user_position $9 (int_of_string $3) (int_of_string $5)
(int_of_string $7)
in Ident.label ~loc $1 }
;