Merge branch 'dev' of gitlab.com:ligolang/ligo into rinderknecht@pprint_comments

src/main/compile/of_core.ml

@@ -22,7 +22,7 @@ let compile_expression ?(env = Ast_typed.Environment.empty) ~(state : Typesystem
   ok @@ (ae_typed',state)
 
 let apply (entry_point : string) (param : Ast_core.expression) : (Ast_core.expression , _) result =
-  let name = Var.of_name entry_point in
+  let name = Location.wrap @@ Var.of_name entry_point in
   let entry_point_var : Ast_core.expression =
     { content  = Ast_core.E_variable name ;
       sugar    = None ;
@@ -39,6 +39,6 @@ let list_declarations (program : Ast_core.program) : string list =
       let open Location in
       let open Ast_core in
       match el.wrap_content with
-      | Declaration_constant (var,_,_,_) -> (Var.to_name var)::prev
+      | Declaration_constant (var,_,_,_) -> (Var.to_name var.wrap_content)::prev
       | _ -> prev) 
     [] program

src/main/compile/of_imperative.ml

@@ -17,6 +17,6 @@ let list_declarations (program : program) : string list =
     (fun prev el -> 
       let open Location in
       match el.wrap_content with
-      | Declaration_constant (var,_,_,_) -> (Var.to_name var)::prev
+      | Declaration_constant (var,_,_,_) -> (Var.to_name var.wrap_content)::prev
       | _ -> prev) 
     [] program

src/main/compile/of_sugar.ml

@@ -14,6 +14,6 @@ let list_declarations (program : program) : string list =
     (fun prev el -> 
       let open Location in
       match el.wrap_content with
-      | Declaration_constant (var,_,_,_) -> (Var.to_name var)::prev
+      | Declaration_constant (var,_,_,_) -> (Var.to_name var.wrap_content)::prev
       | _ -> prev) 
     [] program

src/passes/03-tree_abstraction/cameligo/compiler.ml

@@ -195,7 +195,7 @@ let rec compile_expression :
     let (p , loc) = r_split p in
     let var =
       let name = Var.of_name p.struct_name.value in
-      e_variable ~loc name in
+      e_variable ~loc (Location.wrap ?loc:(Some loc) name) in
     let path = p.field_path in
     let path' =
       let aux (s:Raw.selection) =
@@ -222,7 +222,7 @@ let rec compile_expression :
 let compile_update (u: Raw.update Region.reg) =
   let u, loc     = r_split u in
   let name, path = compile_path u.record in
-  let var        = e_variable (Var.of_name name) in
+  let var        = e_variable (Location.wrap ?loc:(Some loc) @@ Var.of_name name) in
   let record     = if path = [] then var else e_accessor var path in
   let updates    = u.updates.value.ne_elements in
   let%bind updates' =
@@ -248,7 +248,7 @@ in trace (abstracting_expr_tracer t) @@
       let%bind ty_opt =
         bind_map_option (fun (re,te) -> let%bind te = compile_type_expression te in ok(Location.lift re,te)) lhs_type in
       let%bind rhs = compile_expression let_rhs in
-      let rhs_b = Var.fresh ~name:"rhs" () in
+      let rhs_b = Location.wrap @@ Var.fresh ~name:"rhs" () in
       let rhs',rhs_b_expr =
         match ty_opt with
           None -> rhs, e_variable ~loc rhs_b
@@ -256,7 +256,8 @@ in trace (abstracting_expr_tracer t) @@
       let%bind body = compile_expression body in
       let prepare_variable (ty_var: Raw.variable * Raw.type_expr option) =
         let variable, ty_opt = ty_var in
-        let var_expr = Var.of_name variable.value in
+        let (variable,loc) = r_split variable in
+        let var_expr = Location.wrap ?loc:(Some loc) @@ Var.of_name variable in
         let%bind ty_expr_opt =
           match ty_opt with
           | Some ty -> bind_map_option compile_type_expression (Some ty)
@@ -343,7 +344,7 @@ in trace (abstracting_expr_tracer t) @@
   | EVar c ->
       let (c',loc) = r_split c in
       (match constants c' with
-       | None   -> return @@ e_variable ~loc (Var.of_name c.value)
+       | None   -> return @@ e_variable ~loc (Location.wrap ?loc:(Some loc) @@ Var.of_name c.value)
        | Some s -> return @@ e_constant s [])
   | ECall x -> (
       let ((e1 , e2) , loc) = r_split x in
@@ -357,7 +358,7 @@ in trace (abstracting_expr_tracer t) @@
       | EVar f -> (
           let (f , f_loc) = r_split f in
           match constants f with
-          | None   -> return @@ chain_application (e_variable ~loc:f_loc (Var.of_name f)) args
+          | None   -> return @@ chain_application (e_variable ~loc:f_loc (Location.wrap ?loc:(Some f_loc) @@ Var.of_name f)) args
           | Some s -> return @@ e_constant ~loc s args
               )
       | e1 ->
@@ -463,7 +464,8 @@ in trace (abstracting_expr_tracer t) @@
                   let x' = x.value in
                   match x'.pattern with
                   | Raw.PVar y ->
-                    let var_name = Var.of_name y.value in
+                    let (y,loc) = r_split y in
+                    let var_name = Location.wrap ?loc:(Some loc) @@ Var.of_name y in
                     let%bind type_expr = compile_type_expression x'.type_expr in
                     return @@ e_let_in (var_name , Some type_expr) false e rhs
                   | _ -> default_action ()
@@ -603,8 +605,9 @@ and compile_fun lamb' : (expr , abs_error) result =
   let rec layer_arguments (arguments: (Raw.variable * type_expression) list) =
     match arguments with
     | hd :: tl ->
+      let (hd_binder,hd_loc) = r_split (fst hd) in
       let (binder , input_type) =
-        (Var.of_name (fst hd).value , snd hd) in
+        (Location.wrap ?loc:(Some hd_loc) @@ Var.of_name hd_binder , snd hd) in
       e_lambda ~loc (binder) (Some input_type) output_type (layer_arguments tl)
     | [] -> body
   in
@@ -705,7 +708,8 @@ and compile_declaration : Raw.declaration -> (declaration Location.wrap list , a
               | None -> ok None
             in
             let%bind compile_rhs_expr = compile_expression rhs_expr in
-              ok @@ loc x @@ Declaration_constant (Var.of_name v.value, v_type_expression, inline, compile_rhs_expr) )
+            let (v_binder,v_loc) = r_split v in
+            ok @@ loc x @@ Declaration_constant (Location.wrap ?loc:(Some v_loc) @@ Var.of_name v_binder, v_type_expression, inline, compile_rhs_expr) )
           in let%bind variables = ok @@ npseq_to_list pt.value
           in let%bind expr_bind_lst =
                match let_rhs with
@@ -789,7 +793,8 @@ and compile_declaration : Raw.declaration -> (declaration Location.wrap list , a
         )
       | Some t -> ok @@ Some t
       in
-      let binder = Var.of_name var.value in
+      let (var_binder, var_loc) = r_split var in
+      let fun_name = Location.wrap ?loc:(Some var_loc) @@ Var.of_name var_binder in
       let%bind rhs' = match recursive with
         None -> ok @@ rhs'
         | Some _ -> match rhs'.expression_content with
@@ -797,11 +802,11 @@ and compile_declaration : Raw.declaration -> (declaration Location.wrap list , a
             (match lhs_type with
               None -> fail @@ untyped_recursive_fun var.Region.region
               | Some (lhs_type) ->
-              let expression_content = E_recursive {fun_name=binder;fun_type=lhs_type;lambda} in
+              let expression_content = E_recursive {fun_name;fun_type=lhs_type;lambda} in
               ok @@ {rhs' with expression_content})
           | _ -> ok @@ rhs'
       in
-      ok @@ [loc x @@ (Declaration_constant (Var.of_name var.value , lhs_type , inline, rhs'))]
+      ok @@ [loc x @@ (Declaration_constant (fun_name , lhs_type , inline, rhs'))]
     )
 
 and compile_cases : (Raw.pattern * expression) list -> (matching_expr, abs_error) result =
@@ -840,8 +845,7 @@ and compile_cases : (Raw.pattern * expression) list -> (matching_expr, abs_error
         let%bind pat =
           trace_option (unsupported_cst_constr t) @@ pat_opt in
         let%bind single_pat = get_single pat in
-        let%bind var = get_var single_pat in
+        ok (const.value, single_pat)
-        ok (const.value, var)
     | _ -> fail @@ only_constructors t in
   let rec get_constr_opt (t:Raw.pattern) =
     match t with
@@ -859,8 +863,7 @@ and compile_cases : (Raw.pattern * expression) list -> (matching_expr, abs_error
           | None -> ok None
           | Some pat ->
               let%bind single_pat = get_single pat in
-              let%bind var = get_var single_pat in
+              ok (Some single_pat)
-              ok (Some var)
         in ok (const.value , var_opt)
     | _ -> fail @@ only_constructors t in
   let%bind patterns =
@@ -873,7 +876,8 @@ and compile_cases : (Raw.pattern * expression) list -> (matching_expr, abs_error
   match patterns with
   | [(PFalse _, f) ; (PTrue _, t)]
   | [(PTrue _, t) ; (PFalse _, f)] ->
-      ok @@ Match_variant ([((Constructor "true", Var.of_name "_"), t); ((Constructor "false", Var.of_name "_"), f)])
+    let muted = Location.wrap @@ Var.of_name "_" in
+    ok @@ Match_variant ([((Constructor "true", muted), t); ((Constructor "false", muted), f)])
   | [(PList (PCons c), cons); (PList (PListComp sugar_nil), nil)]
   | [(PList (PListComp sugar_nil), nil); (PList (PCons c), cons)] ->
       let%bind () =
@@ -882,19 +886,26 @@ and compile_cases : (Raw.pattern * expression) list -> (matching_expr, abs_error
         @@ sugar_nil.value.elements in
       let%bind (a, b) =
         let a, _, b = c.value in
+        let a_loc = Location.lift (Raw.pattern_to_region a) in
+        let b_loc = Location.lift (Raw.pattern_to_region b) in
         let%bind a = get_var a in
         let%bind b = get_var b in
+        let a = Location.wrap ?loc:(Some a_loc) @@ Var.of_name a in
+        let b = Location.wrap ?loc:(Some b_loc) @@ Var.of_name b in
         ok (a, b) in
-      ok @@ Match_list {match_cons=(Var.of_name a, Var.of_name b, cons); match_nil=nil}
+      ok @@ Match_list {match_cons=(a, b, cons); match_nil=nil}
   | lst ->
       let as_variant () =
         trace_strong (unsupported_pattern_type (List.map fst lst)) @@
         let%bind constrs =
           let aux (x, y) =
-            let%bind x' = get_constr x
+            let%bind (c,v) = get_constr x in
-            in ok (x', y)
+            let v_loc = Location.lift (Raw.pattern_to_region v) in
+            let%bind v = get_var v in
+            let v' = Location.wrap ?loc:(Some v_loc) @@ Var.of_name v in
+            ok ((Constructor c, v'), y)
           in bind_map_list aux lst
-        in ok @@ ez_match_variant constrs in
+        in ok @@ Match_variant constrs in
       let as_option () =
         trace_strong (unsupported_pattern_type (List.map fst lst)) @@
         let aux (x, y) =
@@ -906,8 +917,11 @@ and compile_cases : (Raw.pattern * expression) list -> (matching_expr, abs_error
             (("None" , None) , none_expr) ]
         | [ (("None", None), none_expr);
             (("Some", Some some_var), some_expr) ] ->
+          let var_loc = Location.lift (Raw.pattern_to_region some_var) in
+          let%bind var_binder = get_var some_var in
+          let proj = Location.wrap ?loc:(Some var_loc) @@ Var.of_name var_binder in
           ok @@ Match_option {
-                    match_some = (Var.of_name some_var, some_expr);
+                   match_some = (proj, some_expr);
                    match_none = none_expr }
         | _ -> fail @@ corner_case "bad option pattern"
       in bind_or (as_option () , as_variant ())

src/passes/03-tree_abstraction/cameligo/decompiler.ml

@@ -98,7 +98,7 @@ let rec decompile_type_expr : AST.type_expression -> _ result = fun te ->
 
 let get_e_variable : AST.expression -> _ result = fun expr ->
   match expr.expression_content with
-    E_variable var -> ok @@ var
+    E_variable var -> ok @@ var.wrap_content
   | _ -> failwith @@
     Format.asprintf "%a should be a variable expression"
     AST.PP.expression expr
@@ -127,7 +127,7 @@ let rec decompile_expression : AST.expression -> _ result = fun expr ->
   let return_expr_with_par expr = return_expr @@ CST.EPar (wrap @@ par @@ expr) in
   match expr.expression_content with
     E_variable name ->
-    let var = decompile_variable name in
+    let var = decompile_variable name.wrap_content in
     return_expr @@ CST.EVar (var)
   | E_constant {cons_name; arguments} ->
     let expr = CST.EVar (wrap @@ Predefined.constant_to_string cons_name) in
@@ -194,7 +194,7 @@ let rec decompile_expression : AST.expression -> _ result = fun expr ->
   | E_recursive _ ->
     failwith "corner case : annonymous recursive function"
   | E_let_in {let_binder;rhs;let_result;inline} ->
-    let var = CST.PVar (decompile_variable @@ fst let_binder) in
+    let var = CST.PVar (decompile_variable @@ (fst let_binder).wrap_content) in
     let binders = (var,[]) in
     let%bind lhs_type = bind_map_option (bind_compose (ok <@ prefix_colon) decompile_type_expr) @@ snd let_binder in
     let%bind let_rhs = decompile_expression rhs in
@@ -263,7 +263,7 @@ let rec decompile_expression : AST.expression -> _ result = fun expr ->
       Access_record var::path -> ok @@ (var,path)
     | _ -> failwith "Impossible case %a"
     in
-    let%bind field_path = decompile_to_path (Var.of_name var) path in
+    let%bind field_path = decompile_to_path (Location.wrap @@ Var.of_name var) path in
     let%bind field_expr = decompile_expression update in
     let field_assign : CST.field_path_assignment = {field_path;assignment=rg;field_expr} in
     let updates = updates.value.ne_elements in
@@ -382,7 +382,7 @@ let rec decompile_expression : AST.expression -> _ result = fun expr ->
     AST.PP.expression expr
 
 and decompile_to_path : AST.expression_variable -> AST.access list -> (CST.path, _) result = fun var access ->
-  let struct_name = decompile_variable var in
+  let struct_name = decompile_variable var.wrap_content in
   match access with
     [] -> ok @@ CST.Name struct_name
   | lst ->
@@ -399,7 +399,7 @@ and decompile_to_selection : AST.access -> (CST.selection, _) result = fun acces
     "Can't decompile access_map to selection"
 
 and decompile_lambda : AST.lambda -> _ = fun {binder;input_type;output_type;result} ->
-    let%bind param_decl = pattern_type binder input_type in
+    let%bind param_decl = pattern_type binder.wrap_content input_type in
     let param = (param_decl, []) in
     let%bind ret_type = bind_map_option (bind_compose (ok <@ prefix_colon) decompile_type_expr) output_type in
     let%bind return = decompile_expression result in
@@ -413,7 +413,7 @@ and decompile_matching_cases : AST.matching_expr -> ((CST.expr CST.case_clause R
 fun m ->
   let%bind cases = match m with
     Match_variable (var, ty_opt, expr) ->
-    let%bind pattern = pattern_type var ty_opt in
+    let%bind pattern = pattern_type var.wrap_content ty_opt in
     let%bind rhs = decompile_expression expr in
     let case : _ CST.case_clause = {pattern; arrow=rg; rhs}in
     ok @@ [wrap case]
@@ -425,9 +425,9 @@ fun m ->
         let%bind type_expr = decompile_type_expr ty in
         ok @@ CST.PTyped (wrap @@ CST.{pattern;colon=rg;type_expr})
       in
-      bind list_to_nsepseq @@ bind_map_list aux @@ List.combine lst ty_lst
+      bind list_to_nsepseq @@ bind_map_list aux @@ List.combine (List.map (fun (e:AST.expression_variable) -> e.wrap_content) lst) ty_lst
     | None ->
-      let aux var = CST.PVar (decompile_variable var) in
+      let aux (var:AST.expression_variable) = CST.PVar (decompile_variable var.wrap_content) in
       list_to_nsepseq @@ List.map aux lst
     in
     let pattern : CST.pattern = PTuple (wrap @@ tuple) in
@@ -439,13 +439,13 @@ fun m ->
     let%bind rhs = decompile_expression match_none in
     let none_case : _ CST.case_clause = {pattern=PConstr (PNone rg);arrow=rg; rhs} in
     let%bind rhs = decompile_expression @@ snd match_some in
-    let var = CST.PVar (decompile_variable @@ fst match_some)in
+    let var = CST.PVar (decompile_variable @@ (fst match_some).wrap_content)in
     let some_case : _ CST.case_clause = {pattern=PConstr (PSomeApp (wrap (rg,var)));arrow=rg; rhs} in
     ok @@ [wrap some_case;wrap none_case]
   | Match_list {match_nil; match_cons} ->
     let (hd,tl,expr) = match_cons in
-    let hd = CST.PVar (decompile_variable hd) in
+    let hd = CST.PVar (decompile_variable hd.wrap_content) in
-    let tl = CST.PVar (decompile_variable tl) in
+    let tl = CST.PVar (decompile_variable tl.wrap_content) in
     let cons = (hd,rg,tl) in
     let%bind rhs = decompile_expression @@ expr in
     let cons_case : _ CST.case_clause = {pattern=PList (PCons (wrap cons));arrow=rg; rhs} in
@@ -453,10 +453,10 @@ fun m ->
     let nil_case : _ CST.case_clause = {pattern=PList (PListComp (wrap @@ inject brackets None));arrow=rg; rhs} in
     ok @@ [wrap cons_case; wrap nil_case]
   | Match_variant lst ->
-    let aux ((c,v),e) =
+    let aux ((c,(v:AST.expression_variable)),e) =
       let AST.Constructor c = c in
       let constr = wrap @@ c in
-      let var : CST.pattern = PVar (decompile_variable v) in
+      let var : CST.pattern = PVar (decompile_variable v.wrap_content) in
       let tuple = var in
       let pattern : CST.pattern = PConstr (PConstrApp (wrap (constr, Some tuple))) in
       let%bind rhs = decompile_expression e in
@@ -476,7 +476,7 @@ let decompile_declaration : AST.declaration Location.wrap -> (CST.declaration, _
     ok @@ CST.TypeDecl (wrap (CST.{kwd_type=rg; name; eq=rg; type_expr}))
   | Declaration_constant (var, ty_opt, inline, expr) ->
     let attributes : CST.attributes = decompile_attributes inline in
-    let var = CST.PVar (decompile_variable var) in
+    let var = CST.PVar (decompile_variable var.wrap_content) in
     let binders = (var,[]) in
     match expr.expression_content with
       E_lambda lambda ->

src/passes/03-tree_abstraction/pascaligo/compiler.ml

@@ -282,14 +282,14 @@ let rec compile_expression : CST.expr -> (AST.expr , abs_error) result = fun e -
       match param with
         ParamConst p ->
         let (p, _) = r_split p in
-        let (var, _loc) = r_split p.var in
+        let (var, loc) = r_split p.var in
         let%bind p_type = bind_map_option (compile_type_expression <@ snd) p.param_type in
-        return (var, p_type)
+        return (Location.wrap ?loc:(Some loc) @@ Var.of_name var, p_type)
       | ParamVar p ->
         let (p, _) = r_split p in
-        let (var, _loc) = r_split p.var in
+        let (var, loc) = r_split p.var in
         let%bind p_type = bind_map_option (compile_type_expression <@ snd) p.param_type in
-        return (var, p_type)
+        return (Location.wrap ?loc:(Some loc) @@ Var.of_name var, p_type)
     in
     let (func, loc) = r_split func in
     let (param, loc_par)  = r_split func.param in
@@ -299,15 +299,15 @@ let rec compile_expression : CST.expr -> (AST.expr , abs_error) result = fun e -
     let%bind body = compile_expression func.return in
     let (lambda, fun_type) = match param_type with
       ty::[] ->
-      e_lambda ~loc (Var.of_name @@ List.hd param) ty ret_type body,
+      e_lambda ~loc (List.hd param) ty ret_type body,
       Option.map (fun (a,b) -> t_function a b)@@ Option.bind_pair (ty,ret_type)
     (* Cannot be empty *)
     | lst ->
       let lst = Option.bind_list lst in
       let input_type = Option.map t_tuple lst in
-      let binder = Var.fresh ~name:"parameter" () in
+      let binder = Location.wrap ?loc:(Some loc_par) @@ Var.fresh ~name:"parameter" () in
       e_lambda ~loc binder input_type (ret_type) @@
-        e_matching_tuple_ez ~loc:loc_par (e_variable binder) param lst body,
+        e_matching_tuple ~loc:loc_par (e_variable binder) param lst body,
       Option.map (fun (a,b) -> t_function a b)@@ Option.bind_pair (input_type,ret_type)
     in
     return @@ Option.unopt ~default:lambda @@
@@ -443,7 +443,11 @@ fun compiler cases ->
         tl::[] -> return (fst cons,tl)
       | _ -> fail @@ unsupported_deep_list_patterns @@ fst cons
       in
+      let hd_loc = Location.lift @@ Raw.pattern_to_region hd in
+      let tl_loc = Location.lift @@ Raw.pattern_to_region hd in
       let%bind (hd,tl) = bind_map_pair compile_simple_pattern (hd,tl) in
+      let hd = Location.wrap ?loc:(Some hd_loc) hd in
+      let tl = Location.wrap ?loc:(Some tl_loc) tl in
       let match_cons = (hd,tl,econs) in
         return (match_nil,match_cons)
     | _ -> fail @@ unsupported_deep_list_patterns @@ fst @@ List.hd cases
@@ -460,21 +464,24 @@ fun compiler cases ->
       ( match c with
         PUnit _ ->
          fail @@ unsupported_pattern_type constr
-      | PFalse _ -> return (Constructor "false", Var.of_name "_")
+      | PFalse _ -> return (Constructor "false", Location.wrap @@ Var.of_name "_")
-      | PTrue  _ -> return (Constructor "true", Var.of_name "_")
+      | PTrue  _ -> return (Constructor "true", Location.wrap @@ Var.of_name "_")
-      | PNone  _ -> return (Constructor "None", Var.of_name "_")
+      | PNone  _ -> return (Constructor "None", Location.wrap @@ Var.of_name "_")
       | PSomeApp some ->
         let (some,_) = r_split some in
         let (_, pattern) = some in
-        let (pattern,_) = r_split pattern in
+        let (pattern,loc) = r_split pattern in
         let%bind pattern = compile_simple_pattern pattern.inside in
-        return (Constructor "Some", pattern)
+        return (Constructor "Some", Location.wrap ?loc:(Some loc) pattern)
       | PConstrApp constr ->
         let (constr, _) = r_split constr in
         let (constr, patterns) = constr in
         let (constr, _) = r_split constr in
+        let pattern_loc = match patterns with
+          | Some (v:CST.tuple_pattern) -> Location.lift v.region
+          | None -> Location.generated in
         let%bind pattern = bind_map_option compile_simple_tuple_pattern patterns in
-        let pattern = Option.unopt ~default:(Var.of_name "_") pattern in
+        let pattern = Location.wrap ?loc:(Some pattern_loc) @@ Option.unopt ~default:(Var.of_name "_") pattern in
         return (Constructor constr, pattern)
     )
     | _ -> fail @@ unsupported_pattern_type constr
@@ -488,8 +495,8 @@ fun compiler cases ->
   let%bind cases = bind_map_ne_list aux cases in
   match cases with
   | (PVar var, expr), [] ->
-    let (var, _) = r_split var in
+    let (var, loc) = r_split var in
-    let var = Var.of_name var in
+    let var = Location.wrap ?loc:(Some loc) @@ Var.of_name var in
     return @@ AST.Match_variable (var, None, expr)
   | (PTuple tuple, _expr), [] ->
     fail @@ unsupported_tuple_pattern @@ CST.PTuple tuple
@@ -511,12 +518,14 @@ and compile_parameters (params : CST.parameters) =
     match param with
       ParamConst pc ->
       let (pc, _loc) = r_split pc in
-      let (var, _) = r_split pc.var in
+      let (var, loc) = r_split pc.var in
+      let var = Location.wrap ?loc:(Some loc) @@ Var.of_name var in
       let%bind param_type = bind_map_option (compile_type_expression <@ snd) pc.param_type in
       return (var, param_type)
     | ParamVar pv ->
       let (pv, _loc) = r_split pv in
-      let (var, _) = r_split pv.var in
+      let (var, loc) = r_split pv.var in
+      let var = Location.wrap ?loc:(Some loc) @@ Var.of_name var in
       let%bind param_type = bind_map_option (compile_type_expression <@ snd) pv.param_type in
       return (var, param_type)
   in
@@ -600,27 +609,32 @@ and compile_instruction : ?next: AST.expression -> CST.instruction -> _ result
     return @@ e_while ~loc cond body
   | Loop (For (ForInt fl)) ->
     let (fl, loc) = r_split fl in
-    let (binder, _) = r_split fl.binder in
+    let (binder, binder_loc) = r_split fl.binder in
     let%bind start = compile_expression fl.init in
     let%bind bound = compile_expression fl.bound in
     let%bind increment = Option.unopt ~default:(ok @@ e_int_z Z.one) @@
       Option.map (compile_expression <@ snd) fl.step
     in
     let%bind body  = compile_block fl.block in
-    return @@ e_for_ez ~loc binder start bound increment body
+    return @@ e_for ~loc (Location.wrap ?loc:(Some binder_loc) @@ Var.of_name binder) start bound increment body
   | Loop (For (ForCollect el)) ->
     let (el, loc) = r_split el in
     let binder =
-      let (key, _) = r_split el.var in
+      let (key, loc) = r_split el.var in
-      let value = Option.map (fun x -> fst (r_split (snd x))) el.bind_to in
+      let key' = Location.wrap ?loc:(Some loc) @@ Var.of_name key in
-      (key,value)
+      let value = Option.map
+        (fun x -> 
+          let (v,loc) = r_split (snd x) in
+          Location.wrap ?loc:(Some loc) @@ Var.of_name v)
+        el.bind_to in
+      (key',value)
     in
     let%bind collection = compile_expression el.expr in
     let (collection_type, _) = match el.collection with
       Map loc -> (Map, loc) | Set loc -> (Set, loc) | List loc -> (List, loc)
     in
     let%bind body = compile_block el.block in
-    return @@ e_for_each_ez ~loc binder collection collection_type body
+    return @@ e_for_each ~loc binder collection collection_type body
   | ProcCall {value=(EVar var,args);region} ->
     let loc = Location.lift region in
     let (var, loc_var) = r_split var in
@@ -696,20 +710,22 @@ and compile_instruction : ?next: AST.expression -> CST.instruction -> _ result
 and compile_data_declaration : next:AST.expression -> ?attr:CST.attr_decl -> CST.data_decl -> _ = fun ~next ?attr data_decl ->
   let return loc name type_ init =
     let%bind attr = compile_attribute_declaration attr in
-    ok @@ e_let_in_ez ~loc name type_ attr init next in
+    ok @@ e_let_in ~loc (name,type_) attr init next in
   match data_decl with
     LocalConst const_decl ->
     let (cd, loc) = r_split const_decl in
-    let (name, _) = r_split cd.name in
+    let (name, ploc) = r_split cd.name in
     let%bind type_ = bind_map_option (compile_type_expression <@ snd)cd.const_type in
     let%bind init = compile_expression cd.init in
-    return loc name type_ init
+    let p = Location.wrap ?loc:(Some ploc) @@ Var.of_name name in
+    return loc p type_ init
   | LocalVar var_decl ->
     let (vd, loc) = r_split var_decl in
-    let (name, _) = r_split vd.name in
+    let (name, ploc) = r_split vd.name in
     let%bind type_ = bind_map_option (compile_type_expression <@ snd) vd.var_type in
     let%bind init = compile_expression vd.init in
-    return loc name type_ init
+    let p = Location.wrap ?loc:(Some ploc) @@ Var.of_name name in
+    return loc p type_ init
   | LocalFun fun_decl ->
     let (fun_decl,loc) = r_split fun_decl in
     let%bind (fun_name,fun_type,_attr,lambda) = compile_fun_decl fun_decl in
@@ -741,6 +757,7 @@ and compile_block : ?next:AST.expression -> CST.block CST.reg -> _ result = fun
 and compile_fun_decl ({kwd_recursive; fun_name; param; ret_type; return=r; attributes}: CST.fun_decl) =
   let%bind attr = compile_attribute_declaration attributes in
   let (fun_name, loc) = r_split fun_name in
+  let fun_binder = Location.wrap ?loc:(Some loc) @@ Var.of_name fun_name in
   let%bind ret_type = bind_map_option (compile_type_expression <@ snd) ret_type in
   let%bind param = compile_parameters param in
   let%bind result    = compile_expression r in
@@ -749,7 +766,7 @@ and compile_fun_decl ({kwd_recursive; fun_name; param; ret_type; return=r; attri
   let (lambda,fun_type) = (match param_type with
     ty::[] ->
     let lambda : AST.lambda = {
-      binder = (Var.of_name @@ List.hd param);
+      binder = List.hd param;
       input_type  = ty ;
       output_type = ret_type ;
       result;
@@ -758,25 +775,25 @@ and compile_fun_decl ({kwd_recursive; fun_name; param; ret_type; return=r; attri
   | lst ->
     let lst = Option.bind_list lst in
     let input_type = Option.map t_tuple lst in
-    let binder = Var.fresh ~name:"parameters" () in
+    let binder = Location.wrap @@ Var.fresh ~name:"parameters" () in
     let lambda : AST.lambda = {
       binder;
       input_type = input_type;
       output_type = ret_type;
-      result = e_matching_tuple_ez (e_variable binder) param lst result;
+      result = e_matching_tuple (e_variable binder) param lst result;
     } in
-    lambda,Option.map (fun (a,b) -> t_function a b)@@ Option.bind_pair (input_type,ret_type)
+    lambda,Option.map (fun (a,b) -> t_function a b) @@ Option.bind_pair (input_type,ret_type)
   )
   in
   (* This handle the recursion *)
   let%bind func = match kwd_recursive with
     Some reg ->
       let%bind fun_type = trace_option (untyped_recursive_fun loc) @@ fun_type in
-      return @@ e_recursive_ez ~loc:(Location.lift reg) fun_name fun_type lambda
+      return @@ e_recursive ~loc:(Location.lift reg) fun_binder fun_type lambda
   | None   ->
       return @@ make_e ~loc @@ E_lambda lambda
   in
-  return (fun_name,fun_type, attr, func)
+  return (fun_binder,fun_type, attr, func)
 
 (* Currently attributes are badly proccess, some adaptation are made to accomodate this
   maked as ATR *)
@@ -790,16 +807,17 @@ let compile_declaration : (CST.attr_decl option * _) -> CST.declaration -> _ = f
     let%bind type_expr = compile_type_expression type_expr in
     return region @@ AST.Declaration_type (Var.of_name name, type_expr)
   | ConstDecl {value={name; const_type; init; attributes=_};region} ->
-    let (name, _) = r_split name in
+    let (name, loc) = r_split name in
+    let name = Location.wrap ?loc:(Some loc) @@ Var.of_name name in
     let attributes = attr in (*ATR*)
     let%bind const_type = bind_map_option (compile_type_expression <@ snd) const_type in
     let%bind init = compile_expression init in
     let%bind attr = compile_attribute_declaration attributes in
-    return region @@ AST.Declaration_constant (Var.of_name name, const_type,attr,init)
+    return region @@ AST.Declaration_constant (name, const_type,attr,init)
   | FunDecl {value;region} ->
     let value = {value with attributes = attr} in (*ATR*)
     let%bind (fun_name,fun_type,attr,lambda) = compile_fun_decl value in
-    return region @@ AST.Declaration_constant (Var.of_name fun_name, fun_type, attr, lambda)
+    return region @@ AST.Declaration_constant (fun_name, fun_type, attr, lambda)
   | AttrDecl decl -> ok (Some decl, lst) (*ATR*)
 
 (* This should be change to the commented function when attributes are fixed

src/passes/03-tree_abstraction/pascaligo/decompiler.ml

@@ -99,7 +99,7 @@ let rec decompile_type_expr : AST.type_expression -> _ result = fun te ->
 
 let get_e_variable : AST.expression -> _ result = fun expr ->
   match expr.expression_content with
-    E_variable var -> ok @@ var
+    E_variable var -> ok @@ var.wrap_content
   | _ -> failwith @@
     Format.asprintf "%a should be a variable expression"
     AST.PP.expression expr
@@ -186,7 +186,7 @@ and decompile_eos : eos -> AST.expression -> ((CST.statement List.Ne.t option)*
   let return_inst inst = return_stat_ez @@ CST.Instr inst in
   match expr.expression_content with
     E_variable name ->
-    let var = decompile_variable name in
+    let var = decompile_variable name.wrap_content in
     return_expr @@ CST.EVar (var)
   | E_constant {cons_name; arguments} ->
     let expr = CST.EVar (wrap @@ Predefined.constant_to_string cons_name) in
@@ -255,7 +255,8 @@ and decompile_eos : eos -> AST.expression -> ((CST.statement List.Ne.t option)*
     return_expr_with_par @@ CST.EFun (wrap @@ fun_expr)
   | E_recursive _ ->
     failwith "corner case : annonymous recursive function"
-  | E_let_in {let_binder;rhs={expression_content=E_update {record={expression_content=E_variable var;_};path;update};_};let_result;inline=_} when Var.equal (fst let_binder) var ->
+  | E_let_in {let_binder;rhs={expression_content=E_update {record={expression_content=E_variable var;_};path;update};_};let_result;inline=_}
+      when Var.equal (fst let_binder).wrap_content var.wrap_content ->
     let%bind lhs = (match List.rev path with
       Access_map e :: path ->
       let%bind path  = decompile_to_path var @@ List.rev path in
@@ -356,7 +357,7 @@ and decompile_eos : eos -> AST.expression -> ((CST.statement List.Ne.t option)*
       Access_record var::path -> ok @@ (var,path)
     | _ -> failwith "Impossible case %a"
     in
-    let%bind field_path = decompile_to_path (Var.of_name var) path in
+    let%bind field_path = decompile_to_path (Location.wrap @@ Var.of_name var) path in
     let%bind field_expr = decompile_expression update in
     let field_assign : CST.field_path_assignment = {field_path;assignment=rg;field_expr} in
     let updates = updates.value.ne_elements in
@@ -469,7 +470,7 @@ and decompile_eos : eos -> AST.expression -> ((CST.statement List.Ne.t option)*
     let assign : CST.assignment = {lhs;assign=rg;rhs} in
     return_inst @@ Assign (wrap assign)
   | E_for {binder;start;final;increment;body} ->
-    let binder     = decompile_variable binder in
+    let binder     = decompile_variable binder.wrap_content in
     let%bind init  = decompile_expression start in
     let%bind bound = decompile_expression final in
     let%bind step  = decompile_expression increment in
@@ -479,8 +480,8 @@ and decompile_eos : eos -> AST.expression -> ((CST.statement List.Ne.t option)*
     let fl : CST.for_int = {kwd_for=rg;binder;assign=rg;init;kwd_to=rg;bound;step;block} in
     return_inst @@ CST.Loop (For (ForInt (wrap fl)))
   | E_for_each {binder;collection;collection_type;body} ->
-    let var = decompile_variable @@ fst binder in
+    let var = decompile_variable @@ (fst binder).wrap_content in
-    let bind_to = Option.map (fun x -> (rg,decompile_variable x)) @@ snd binder in
+    let bind_to = Option.map (fun (x:AST.expression_variable) -> (rg,decompile_variable x.wrap_content)) @@ snd binder in
     let%bind expr = decompile_expression collection in
     let collection = match collection_type with
       Map -> CST.Map rg | Set -> Set rg | List -> List rg in
@@ -505,7 +506,7 @@ and decompile_if_clause : AST.expression -> (CST.if_clause, _) result = fun e ->
     ok @@ CST.ClauseBlock (ShortBlock (wrap @@ braces @@ clause))
 
 and decompile_to_data_decl : (AST.expression_variable * AST.type_expression option) -> AST.expression -> bool -> (CST.data_decl, _) result = fun (name,ty_opt) expr inline ->
-  let name = decompile_variable name in
+  let name = decompile_variable name.wrap_content in
   let%bind const_type = bind_map_option (bind_compose (ok <@ prefix_colon) decompile_type_expr) ty_opt in
   let attributes : CST.attr_decl option = match inline with
     true -> Some (wrap @@ ne_inject (NEInjAttr rg) @@ (wrap @@ "inline",[]))
@@ -529,7 +530,7 @@ and decompile_to_data_decl : (AST.expression_variable * AST.type_expression opti
 
 and decompile_to_lhs : AST.expression_variable -> AST.access list -> (CST.lhs, _) result = fun var access ->
   match List.rev access with
-    [] -> ok @@ (CST.Path (Name (decompile_variable var)) : CST.lhs)
+    [] -> ok @@ (CST.Path (Name (decompile_variable var.wrap_content)) : CST.lhs)
   | hd :: tl ->
     match hd with
     | AST.Access_map e ->
@@ -542,7 +543,7 @@ and decompile_to_lhs : AST.expression_variable -> AST.access list -> (CST.lhs, _
       ok @@ (CST.Path (path) : CST.lhs)
 
 and decompile_to_path : AST.expression_variable -> AST.access list -> (CST.path, _) result = fun var access ->
-  let struct_name = decompile_variable var in
+  let struct_name = decompile_variable var.wrap_content in
   match access with
     [] -> ok @@ CST.Name struct_name
   | lst ->
@@ -559,7 +560,7 @@ and decompile_to_selection : AST.access -> (CST.selection, _) result = fun acces
     "Can't decompile access_map to selection"
 
 and decompile_lambda : AST.lambda -> _ = fun {binder;input_type;output_type;result} ->
-    let var = decompile_variable binder in
+    let var = decompile_variable binder.wrap_content in
     let%bind param_type = bind_map_option (bind_compose (ok <@ prefix_colon) decompile_type_expr) input_type in
     let param_const : CST.param_const = {kwd_const=rg;var;param_type} in
     let param_decl : CST.param_decl = ParamConst (wrap param_const) in
@@ -573,12 +574,12 @@ and decompile_matching_expr : type a.(AST.expr ->(a,_) result) -> AST.matching_e
 fun f m ->
   let%bind cases = match m with
     Match_variable (var, _ty_opt, expr) ->
-    let pattern : CST.pattern = PVar (decompile_variable var) in
+    let pattern : CST.pattern = PVar (decompile_variable var.wrap_content) in
     let%bind rhs = f expr in
     let case : _ CST.case_clause = {pattern; arrow=rg; rhs}in
     ok @@ [wrap case]
   | Match_tuple (lst, _ty_opt, expr) ->
-    let aux var = CST.PVar (decompile_variable var) in
+    let aux (var:AST.expression_variable) = CST.PVar (decompile_variable var.wrap_content) in
     let%bind tuple = list_to_nsepseq @@ List.map aux lst in
     let pattern : CST.pattern = PTuple (wrap @@ par @@ tuple) in
     let%bind rhs = f expr in
@@ -589,13 +590,13 @@ fun f m ->
     let%bind rhs = f match_none in
     let none_case : _ CST.case_clause = {pattern=PConstr (PNone rg);arrow=rg; rhs} in
     let%bind rhs = f @@ snd match_some in
-    let var = wrap @@ par @@ CST.PVar (decompile_variable @@ fst match_some)in
+    let var = wrap @@ par @@ CST.PVar (decompile_variable @@ (fst match_some).wrap_content)in
     let some_case : _ CST.case_clause = {pattern=PConstr (PSomeApp (wrap (rg,var)));arrow=rg; rhs} in
     ok @@ [wrap some_case;wrap none_case]
   | Match_list {match_nil; match_cons} ->
     let (hd,tl,expr) = match_cons in
-    let hd = CST.PVar (decompile_variable hd) in
+    let hd = CST.PVar (decompile_variable hd.wrap_content) in
-    let tl = CST.PVar (decompile_variable tl) in
+    let tl = CST.PVar (decompile_variable tl.wrap_content) in
     let cons = (hd,[rg,tl]) in
     let%bind rhs = f @@ expr in
     let cons_case : _ CST.case_clause = {pattern=PList (PCons (wrap cons));arrow=rg; rhs} in
@@ -603,10 +604,10 @@ fun f m ->
     let nil_case : _ CST.case_clause = {pattern=PList (PNil rg);arrow=rg; rhs} in
     ok @@ [wrap cons_case; wrap nil_case]
   | Match_variant lst ->
-    let aux ((c,v),e) =
+    let aux ((c,(v:AST.expression_variable)),e) =
       let AST.Constructor c = c in
       let constr = wrap @@ c in
-      let var : CST.pattern = PVar (decompile_variable v) in
+      let var : CST.pattern = PVar (decompile_variable v.wrap_content) in
       let tuple = wrap @@ par @@ (var,[]) in
       let pattern : CST.pattern = PConstr (PConstrApp (wrap (constr, Some tuple))) in
       let%bind rhs = f e in
@@ -637,7 +638,7 @@ let decompile_declaration : AST.declaration Location.wrap -> (CST.declaration, _
         Some attr_decl
     | false -> None
     in
-    let name = decompile_variable var in
+    let name = decompile_variable var.wrap_content in
     let fun_name = name in
     match expr.expression_content with
       E_lambda lambda ->

src/passes/05-purification/compiler.ml

@@ -3,6 +3,8 @@ module I = Ast_imperative
 module O = Ast_sugar
 open Trace
 
+let compare_var = Location.compare_content ~compare:Var.compare
+
 let rec add_to_end (expression: O.expression) to_add =
   match expression.expression_content with
   | O.E_let_in lt -> 
@@ -23,11 +25,11 @@ let repair_mutable_variable_in_matching (match_body : O.expression) (element_nam
           ok (true,(name::decl_var, free_var),O.e_let_in let_binder false false rhs let_result)
         | E_let_in {let_binder;mut=true; rhs;let_result} ->
           let (name,_) = let_binder in
-          if List.mem name decl_var then 
+          if List.mem ~compare:compare_var name decl_var then
             ok (true,(decl_var, free_var), O.e_let_in let_binder false false rhs let_result)
           else(
-            let free_var = if (List.mem name free_var) then free_var else name::free_var in
+            let free_var = if (List.mem ~compare:compare_var name free_var) then free_var else name::free_var in
-            let expr = O.e_let_in (env,None) false false (O.e_update (O.e_variable env) [O.Access_record (Var.to_name name)] (O.e_variable name)) let_result in
+            let expr = O.e_let_in (env,None) false false (O.e_update (O.e_variable env) [O.Access_record (Var.to_name name.wrap_content)] (O.e_variable name)) let_result in
             ok (true,(decl_var, free_var), O.e_let_in let_binder false  false rhs expr)
           )
         | E_constant {cons_name=C_MAP_FOLD;arguments= _}
@@ -63,12 +65,15 @@ and repair_mutable_variable_in_loops (for_body : O.expression) (element_names :
           ok (true,(name::decl_var, free_var),ass_exp)
         | E_let_in {let_binder;mut=true; rhs;let_result} ->
           let (name,_) = let_binder in
-          if List.mem name decl_var then 
+          if List.mem ~compare:compare_var name decl_var then
             ok (true,(decl_var, free_var), O.e_let_in let_binder false false rhs let_result)
           else(
-            let free_var = if (List.mem name free_var) then free_var else name::free_var in
+            let free_var =
+              if (List.mem ~compare:compare_var name free_var)
+              then free_var
+              else name::free_var in
             let expr = O.e_let_in (env,None) false false (
-              O.e_update (O.e_variable env) [O.Access_tuple Z.zero; O.Access_record (Var.to_name name)] (O.e_variable name)
+              O.e_update (O.e_variable env) [O.Access_tuple Z.zero; O.Access_record (Var.to_name name.wrap_content)] (O.e_variable name)
               )
               let_result in
             ok (true,(decl_var, free_var), O.e_let_in let_binder false  false rhs expr)
@@ -95,12 +100,12 @@ and store_mutable_variable (free_vars : I.expression_variable list) =
   if (List.length free_vars == 0) then
     O.e_unit ()
   else
-    let aux var = (O.Label (Var.to_name var), O.e_variable var) in
+    let aux (var:I.expression_variable) = (O.Label (Var.to_name var.wrap_content), O.e_variable var) in
     O.e_record @@ O.LMap.of_list (List.map aux free_vars)
  
 and restore_mutable_variable (expr : O.expression->O.expression) (free_vars : O.expression_variable list) (env : O.expression_variable) =
   let aux (f: O.expression -> O.expression) (ev: O.expression_variable) =
-    fun expr -> f (O.e_let_in (ev,None) true false (O.e_accessor (O.e_variable env) [O.Access_record (Var.to_name ev)]) expr)
+    fun expr -> f (O.e_let_in (ev,None) true false (O.e_accessor (O.e_variable env) [O.Access_record (Var.to_name ev.wrap_content)]) expr)
   in
   let ef = List.fold_left aux (fun e -> e) free_vars in
   fun e -> match e with 
@@ -252,13 +257,13 @@ and compile_expression' : I.expression -> (O.expression option -> O.expression,
       let%bind condition    = compile_expression condition in
       let%bind then_clause' = compile_expression then_clause in
       let%bind else_clause' = compile_expression else_clause in
-      let env = Var.fresh ~name:"env" () in
+      let env = Location.wrap (Var.fresh ~name:"env" ()) in
       let%bind ((_,free_vars_true), then_clause) = repair_mutable_variable_in_matching then_clause' [] env in
       let%bind ((_,free_vars_false), else_clause) = repair_mutable_variable_in_matching else_clause' [] env in
       let then_clause  = add_to_end then_clause (O.e_variable env) in
       let else_clause = add_to_end else_clause (O.e_variable env) in
 
-      let free_vars = List.sort_uniq Var.compare @@ free_vars_true @ free_vars_false in
+      let free_vars = List.sort_uniq compare_var @@ free_vars_true @ free_vars_false in
       if (List.length free_vars != 0) then 
         let cond_expr  = O.e_cond condition then_clause else_clause in
         let return_expr = fun expr ->
@@ -330,12 +335,12 @@ and compile_matching : I.matching -> Location.t -> (O.expression option -> O.exp
       let%bind match_none' = compile_expression match_none in
       let (n,expr) = match_some in
       let%bind expr' = compile_expression expr in
-      let env = Var.fresh ~name:"env" () in
+      let env = Location.wrap (Var.fresh ~name:"env" ()) in
       let%bind ((_,free_vars_none), match_none) = repair_mutable_variable_in_matching match_none' [] env in
       let%bind ((_,free_vars_some), expr) = repair_mutable_variable_in_matching expr' [n] env in
       let match_none = add_to_end match_none (O.e_variable env) in
       let expr       = add_to_end expr (O.e_variable env) in
-      let free_vars = List.sort_uniq Var.compare @@ free_vars_none @ free_vars_some in
+      let free_vars = List.sort_uniq compare_var @@ free_vars_none @ free_vars_some in
       if (List.length free_vars != 0) then
         let match_expr  = O.e_matching matchee (O.Match_option {match_none; match_some=(n,expr)}) in
         let return_expr = fun expr ->
@@ -350,12 +355,12 @@ and compile_matching : I.matching -> Location.t -> (O.expression option -> O.exp
       let%bind match_nil' = compile_expression match_nil in
       let (hd,tl,expr) = match_cons in
       let%bind expr' = compile_expression expr in
-      let env = Var.fresh ~name:"name" () in
+      let env = Location.wrap (Var.fresh ~name:"name" ()) in
       let%bind ((_,free_vars_nil), match_nil) = repair_mutable_variable_in_matching match_nil' [] env in
       let%bind ((_,free_vars_cons), expr) = repair_mutable_variable_in_matching expr' [hd;tl] env in
       let match_nil = add_to_end match_nil (O.e_variable env) in
       let expr      = add_to_end expr (O.e_variable env) in
-      let free_vars = List.sort_uniq Var.compare @@ free_vars_nil @ free_vars_cons in
+      let free_vars = List.sort_uniq compare_var @@ free_vars_nil @ free_vars_cons in
       if (List.length free_vars != 0) then
         let match_expr  = O.e_matching matchee (O.Match_list {match_nil; match_cons=(hd,tl,expr)}) in
         let return_expr = fun expr ->
@@ -367,7 +372,7 @@ and compile_matching : I.matching -> Location.t -> (O.expression option -> O.exp
       else
         return @@ O.e_matching ~loc matchee @@ O.Match_list {match_nil=match_nil'; match_cons=(hd,tl,expr')}
     | I.Match_variant lst ->
-      let env = Var.fresh ~name:"env" () in
+      let env = Location.wrap (Var.fresh ~name:"env" ()) in
       let aux fv ((c,n),expr) =
         let%bind expr = compile_expression expr in
         let%bind ((_,free_vars), case_clause) = repair_mutable_variable_in_matching expr [n] env in
@@ -375,7 +380,7 @@ and compile_matching : I.matching -> Location.t -> (O.expression option -> O.exp
         let case_clause = add_to_end case_clause (O.e_variable env) in
         ok (free_vars::fv,((c,n), case_clause, case_clause')) in
       let%bind (fv,cases) = bind_fold_map_list aux [] lst in
-      let free_vars = List.sort_uniq Var.compare @@ List.concat fv in
+      let free_vars = List.sort_uniq compare_var @@ List.concat fv in
       if (List.length free_vars == 0) then (
         let cases = List.map (fun case -> let (a,_,b) = case in (a,b)) cases in
         return @@ O.e_matching ~loc matchee @@ O.Match_variant cases
@@ -403,8 +408,8 @@ and compile_matching : I.matching -> Location.t -> (O.expression option -> O.exp
       return @@ O.e_matching ~loc matchee @@ O.Match_variable (lst,ty_opt,expr)
  
 and compile_while I.{condition;body} =
-  let env_rec = Var.fresh ~name:"env_rec" () in
+  let env_rec = Location.wrap @@ Var.fresh ~name:"env_rec" () in
-  let binder  = Var.fresh ~name:"binder"  () in
+  let binder  = Location.wrap @@ Var.fresh ~name:"binder"  () in
 
   let%bind cond = compile_expression condition in
   let ctrl = 
@@ -416,7 +421,7 @@ and compile_while I.{condition;body} =
   let for_body = add_to_end for_body ctrl in
 
   let aux name expr=
-    O.e_let_in (name,None) false false (O.e_accessor (O.e_variable binder) [Access_tuple Z.zero; Access_record (Var.to_name name)]) expr
+    O.e_let_in (name,None) false false (O.e_accessor (O.e_variable binder) [Access_tuple Z.zero; Access_record (Var.to_name name.wrap_content)]) expr
   in
   let init_rec = O.e_tuple [store_mutable_variable @@ captured_name_list] in
   let restore = fun expr -> List.fold_right aux captured_name_list expr in
@@ -438,7 +443,7 @@ and compile_while I.{condition;body} =
 
 
 and compile_for I.{binder;start;final;increment;body} =
-  let env_rec = Var.fresh ~name:"env_rec" () in
+  let env_rec = Location.wrap @@ Var.fresh ~name:"env_rec" () in
   (*Make the cond and the step *)
   let cond = I.e_annotation (I.e_constant C_LE [I.e_variable binder ; final]) (I.t_bool ()) in
   let%bind cond = compile_expression cond in
@@ -455,7 +460,7 @@ and compile_for I.{binder;start;final;increment;body} =
   let for_body = add_to_end for_body ctrl in
 
   let aux name expr=
-    O.e_let_in (name,None) false false (O.e_accessor (O.e_variable env_rec) [Access_tuple Z.zero; Access_record (Var.to_name name)]) expr
+    O.e_let_in (name,None) false false (O.e_accessor (O.e_variable env_rec) [Access_tuple Z.zero; Access_record (Var.to_name name.wrap_content)]) expr
   in
 
   (* restores the initial value of the free_var*)
@@ -483,8 +488,8 @@ and compile_for I.{binder;start;final;increment;body} =
   ok @@ restore_mutable_variable return_expr captured_name_list env_rec 
 
 and compile_for_each I.{binder;collection;collection_type; body} =
-  let env_rec = Var.fresh ~name:"env_rec" () in
+  let env_rec = Location.wrap @@ Var.fresh ~name:"env_rec" () in
-  let args    = Var.fresh ~name:"args" () in
+  let args    = Location.wrap @@ Var.fresh ~name:"args" () in
 
   let%bind element_names = ok @@ match snd binder with
     | Some v -> [fst binder;v]
@@ -498,7 +503,7 @@ and compile_for_each I.{binder;collection;collection_type; body} =
   let init_record = store_mutable_variable free_vars in
   let%bind collect = compile_expression collection in
   let aux name expr=
-    O.e_let_in (name,None) false false (O.e_accessor (O.e_variable args) [Access_tuple Z.zero; Access_record (Var.to_name name)]) expr
+    O.e_let_in (name,None) false false (O.e_accessor (O.e_variable args) [Access_tuple Z.zero; Access_record (Var.to_name name.wrap_content)]) expr
   in
   let restore = fun expr -> List.fold_right aux free_vars expr in
   let restore = match collection_type with

src/passes/07-desugaring/compiler.ml

@@ -171,11 +171,12 @@ let rec compile_expression : I.expression -> (O.expression , desugaring_error) r
       let%bind matchee = compile_expression condition in
       let%bind match_true = compile_expression then_clause in
       let%bind match_false = compile_expression else_clause in
-      return @@ O.E_matching {matchee; cases=Match_variant ([((Constructor "true", Var.of_name "_"),match_true);((Constructor "false", Var.of_name "_"), match_false)])}
+      let muted = Location.wrap @@ Var.of_name "_" in
+      return @@ O.E_matching {matchee; cases=Match_variant ([((Constructor "true", muted), match_true);((Constructor "false", muted), match_false)])}
     | I.E_sequence {expr1; expr2} ->
       let%bind expr1 = compile_expression expr1 in
       let%bind expr2 = compile_expression expr2 in
-      return @@ O.E_let_in {let_binder=(Var.of_name "_", Some (O.t_unit ())); rhs=expr1;let_result=expr2; inline=false}
+      return @@ O.E_let_in {let_binder=(Location.wrap @@ Var.of_name "_", Some (O.t_unit ())); rhs=expr1;let_result=expr2; inline=false}
     | I.E_skip -> ok @@ O.e_unit ~loc:sugar.location ~sugar ()
     | I.E_tuple t ->
       let aux (i,acc) el = 

src/passes/07-desugaring/decompiler.ml

@@ -66,7 +66,9 @@ let rec decompile_expression : O.expression -> (I.expression, desugaring_error)
       let%bind fun_type = decompile_type_expression fun_type in
       let%bind lambda = decompile_lambda lambda in
       return @@ I.E_recursive {fun_name;fun_type;lambda}
-    | O.E_let_in {let_binder;inline=false;rhs=expr1;let_result=expr2} when let_binder = (Var.of_name "_", Some (O.t_unit ())) ->
+    | O.E_let_in {let_binder = (var, ty);inline=false;rhs=expr1;let_result=expr2}
+      when Var.equal var.wrap_content (Var.of_name "_")
+           && Pervasives.(=) ty (Some (O.t_unit ())) ->
       let%bind expr1 = decompile_expression expr1 in
       let%bind expr2 = decompile_expression expr2 in
       return @@ I.E_sequence {expr1;expr2}

src/passes/09-typing/08-typer-old/typer.ml

@@ -743,7 +743,7 @@ and type_lambda e {
               match result.content with
               | I.E_let_in li -> (
                   match li.rhs.content with
-                  | I.E_variable name when name = (binder) -> (
+                  | I.E_variable name when Location.equal_content ~equal:Var.equal name binder -> (
                       match snd li.let_binder with
                       | Some ty -> ok ty
                       | None -> default_action li.rhs ()

src/passes/10-self_ast_typed/helpers.ml

@@ -256,7 +256,7 @@ type contract_type = {
 let fetch_contract_type : string -> program -> (contract_type, self_ast_typed_error) result = fun main_fname program ->
   let aux declt = match Location.unwrap declt with
     | Declaration_constant ({ binder ; expr=_ ; inline=_ } as p) ->
-       if Var.equal binder @@ Var.of_name main_fname
+       if Var.equal binder.wrap_content (Var.of_name main_fname)
        then Some p
        else None
     | Declaration_type _ -> None

src/passes/10-self_ast_typed/michelson_layout.ml

@@ -23,7 +23,7 @@ let constructor (constructor:constructor') (element:expression) (t:type_expressi
   }
 
 let match_var (t:type_expression) =
-  { expression_content = E_variable (Var.of_name "x") ;
+  { expression_content = E_variable (Location.wrap @@ Var.of_name "x") ;
     location = Location.generated ;
     type_expression = t ;
   }
@@ -151,20 +151,20 @@ let rec from_right_comb_or (to_convert:expression) (e:expression) (matchee_t,bod
   | [m] , bl::br::[] ->
     let cases = [
       { constructor = Constructor "M_left" ;
-        pattern = Var.of_name "x";
+        pattern = Location.wrap @@ Var.of_name "x";
         body = bl } ;
       { constructor = Constructor "M_right" ;
-        pattern = Var.of_name "x";
+        pattern = Location.wrap @@ Var.of_name "x";
         body = br } ] in
     ok @@ matching e m (Match_variant { cases ; tv = to_convert.type_expression })
   | m::mtl , b::btl ->
     let%bind body = from_right_comb_or to_convert e (mtl,btl) in
     let cases = [
       { constructor = Constructor "M_left" ;
-        pattern = Var.of_name "x";
+        pattern = Location.wrap @@ Var.of_name "x";
         body = b } ;
       { constructor = Constructor "M_right" ;
-        pattern = Var.of_name "x";
+        pattern = Location.wrap @@ Var.of_name "x";
         body } ] in
     ok @@ matching e m (Match_variant { cases ; tv = to_convert.type_expression })
   | _ -> fail @@ corner_case "from_right_comb conversion"
@@ -174,20 +174,20 @@ let rec from_left_comb_or (to_convert:expression) (e:expression) (matchee_t,bodi
   | [m] , bl::br::[] ->
     let cases = [
       { constructor = Constructor "M_right" ;
-        pattern = Var.of_name "x";
+        pattern = Location.wrap @@ Var.of_name "x";
         body = bl } ;
       { constructor = Constructor "M_left" ;
-        pattern = Var.of_name "x";
+        pattern = Location.wrap @@ Var.of_name "x";
         body = br } ] in
     ok @@ matching e m (Match_variant { cases ; tv = to_convert.type_expression })
   | m::mtl , b::btl ->
     let%bind body = from_left_comb_or to_convert e (mtl,btl) in
     let cases = [
       { constructor = Constructor "M_right" ;
-        pattern = Var.of_name "x";
+        pattern = Location.wrap @@ Var.of_name "x";
         body = b } ;
       { constructor = Constructor "M_left" ;
-        pattern = Var.of_name "x";
+        pattern = Location.wrap @@ Var.of_name "x";
         body } ] in
     ok @@ matching e m (Match_variant { cases ; tv = to_convert.type_expression })
   | _ -> fail @@ corner_case "from_left_comb conversion"
@@ -210,7 +210,7 @@ let peephole_expression : expression -> (expression , self_ast_typed_error) resu
         let src_kvl = to_sorted_kv_list_c src_cmap in
         let bodies = left_comb_variant_combination e dst_cmap src_kvl in
         let to_cases ((constructor,{ctor_type=_;_}),body) =
-          let pattern = (Var.of_name "x") in
+          let pattern = Location.wrap @@ Var.of_name "x" in
           {constructor ; pattern ; body }
         in
         let cases = Match_variant {
@@ -230,7 +230,7 @@ let peephole_expression : expression -> (expression , self_ast_typed_error) resu
         let src_kvl = to_sorted_kv_list_c src_cmap in
         let bodies = right_comb_variant_combination e dst_cmap src_kvl in
         let to_cases ((constructor,{ctor_type=_;_}),body) =
-          let pattern = (Var.of_name "x") in
+          let pattern = Location.wrap @@ Var.of_name "x" in
           {constructor ; pattern ; body }
         in
         let cases = Match_variant {

src/passes/10-self_ast_typed/tail_recursion.ml

@@ -2,6 +2,8 @@ open Errors
 open Ast_typed
 open Trace
 
+let var_equal = Location.equal_content ~equal:Var.equal
+
 let rec check_recursive_call : expression_variable -> bool -> expression -> (unit, self_ast_typed_error) result = fun n final_path e ->
   match e.expression_content with
   | E_literal _   -> ok ()
@@ -10,7 +12,7 @@ let rec check_recursive_call : expression_variable -> bool -> expression -> (uni
     ok ()
   | E_variable v  -> (
     let%bind _ = Assert.assert_true (recursive_call_is_only_allowed_as_the_last_operation n e.location)
-      (final_path || n <> v) in
+      (final_path || not (var_equal n v)) in
     ok ()
     )
   | E_application {lamb;args} ->

src/passes/11-interpreter/interpreter.ml

@@ -380,7 +380,7 @@ let eval : Ast_typed.program -> (string , _) result =
            ok (V_Failure s)
               (*TODO This TRY-CATCH is here until we properly implement effects*)
        in
-    let pp' = pp^"\n val "^(Var.to_name binder)^" = "^(Ligo_interpreter.PP.pp_value v) in
+    let pp' = pp^"\n val "^(Var.to_name binder.wrap_content)^" = "^(Ligo_interpreter.PP.pp_value v) in
     let top_env' = Env.extend top_env (binder, v) in
     ok @@ (pp',top_env')
     | Ast_typed.Declaration_type _ ->

src/passes/11-spilling/compiler.ml

@@ -406,7 +406,7 @@ and compile_expression (ae:AST.expression) : (expression , spilling_error) resul
           let%bind f' = compile_expression f in
           let%bind input' = compile_type input in
           let%bind output' = compile_type output in
-          let binder = Var.fresh ~name:"iterated" () in
+          let binder = Location.wrap @@ Var.fresh ~name:"iterated" () in
           let application = Mini_c.Combinators.e_application f' output' (Mini_c.Combinators.e_var binder input') in
           ok ((binder , input'), application)
         in
@@ -507,13 +507,13 @@ and compile_expression (ae:AST.expression) : (expression , spilling_error) resul
             | ((`Node (a , b)) , tv) ->
                 let%bind a' =
                   let%bind a_ty = trace_option (corner_case ~loc:__LOC__ "wrongtype") @@ get_t_left tv in
-                  let left_var = Var.fresh ~name:"left" () in
+                  let left_var = Location.wrap @@ Var.fresh ~name:"left" () in
                   let%bind e = aux (((Expression.make (E_variable left_var) a_ty))) a in
                   ok ((left_var , a_ty) , e)
                 in
                 let%bind b' =
                   let%bind b_ty = trace_option (corner_case ~loc:__LOC__ "wrongtype") @@ get_t_right tv in
-                  let right_var = Var.fresh ~name:"right" () in
+                  let right_var = Location.wrap @@ Var.fresh ~name:"right" () in
                   let%bind e = aux (((Expression.make (E_variable right_var) b_ty))) b in
                   ok ((right_var , b_ty) , e)
                 in
@@ -558,7 +558,7 @@ and compile_recursive {fun_name; fun_type; lambda} =
   and replace_callback : AST.expression_variable -> type_expression -> bool -> AST.expression -> (expression , spilling_error) result = fun fun_name loop_type shadowed e ->
     match e.expression_content with
       E_let_in li -> 
-        let shadowed = shadowed || Var.equal li.let_binder fun_name in 
+        let shadowed = shadowed || Var.equal li.let_binder.wrap_content fun_name.wrap_content in 
         let%bind let_result = replace_callback fun_name loop_type shadowed li.let_result in
         let%bind rhs = compile_expression li.rhs in
         let%bind ty  = compile_type e.type_expression in
@@ -568,7 +568,7 @@ and compile_recursive {fun_name; fun_type; lambda} =
         matching fun_name loop_type shadowed m ty |
       E_application {lamb;args} -> (
         match lamb.expression_content,shadowed with
-        E_variable name, false when Var.equal fun_name name -> 
+        E_variable name, false when Var.equal fun_name.wrap_content name.wrap_content -> 
           let%bind expr = compile_expression args in
           ok @@ Expression.make (E_constant {cons_name=C_LOOP_CONTINUE;arguments=[expr]}) loop_type |
         _ -> 
@@ -641,13 +641,13 @@ and compile_recursive {fun_name; fun_type; lambda} =
             | ((`Node (a , b)) , tv) ->
                 let%bind a' =
                   let%bind a_ty = trace_option (corner_case ~loc:__LOC__ "wrongtype") @@ get_t_left tv in
-                  let left_var = Var.fresh ~name:"left" () in
+                  let left_var = Location.wrap @@ Var.fresh ~name:"left" () in
                   let%bind e = aux (((Expression.make (E_variable left_var) a_ty))) a in
                   ok ((left_var , a_ty) , e)
                 in
                 let%bind b' =
                   let%bind b_ty = trace_option (corner_case ~loc:__LOC__ "wrongtype") @@ get_t_right tv in
-                  let right_var = Var.fresh ~name:"right" () in
+                  let right_var = Location.wrap @@ Var.fresh ~name:"right" () in
                   let%bind e = aux (((Expression.make (E_variable right_var) b_ty))) b in
                   ok ((right_var , b_ty) , e)
                 in

src/passes/12-self_mini_c/self_mini_c.ml

@@ -181,7 +181,7 @@ let eta : bool ref -> expression -> expression =
                                                   { content = E_constant {cons_name = C_CDR; arguments = [ e2 ]} ; type_expression = _ }]} ->
     (match (e1.content, e2.content) with
      | E_variable x1, E_variable x2 ->
-       if Var.equal x1 x2
+       if Var.equal x1.wrap_content x2.wrap_content
        then
          (changed := true;
           { e with content = e1.content })

src/passes/12-self_mini_c/subst.ml

@@ -20,8 +20,8 @@ let rec replace : expression -> var_name -> var_name -> expression =
   fun e x y ->
   let replace e = replace e x y in
   let return content = { e with content } in
-  let replace_var v =
+  let replace_var (v:var_name) =
-    if Var.equal v x
+    if Var.equal v.wrap_content x.wrap_content
     then y
     else v in
   match e.content with
@@ -103,16 +103,16 @@ let rec replace : expression -> var_name -> var_name -> expression =
 let rec subst_expression : body:expression -> x:var_name -> expr:expression -> expression =
   fun ~body ~x ~expr ->
   let self body = subst_expression ~body ~x ~expr in
-  let subst_binder y expr' =
+  let subst_binder (y:var_name) expr' =
     (* if x is shadowed, binder doesn't change *)
-    if Var.equal x y
+    if Var.equal x.wrap_content y.wrap_content
     then (y, expr')
     (* else, if no capture, subst in binder *)
     else if not (Free_variables.mem y (Free_variables.expression [] expr))
     then (y, self expr')
     (* else, avoid capture and subst in binder *)
     else
-      let fresh = Var.fresh_like y in
+      let fresh = Location.wrap @@ Var.fresh_like y.wrap_content in
       let new_body = replace expr' y fresh in
       (fresh, self new_body) in
   (* hack to avoid reimplementing subst_binder for 2-ary binder in E_if_cons:
@@ -128,7 +128,7 @@ let rec subst_expression : body:expression -> x:var_name -> expr:expression -> e
   let return_id = body in
   match body.content with
   | E_variable x' ->
-     if x' = x
+     if Location.equal_content ~equal:Var.equal x' x
      then expr
      else return_id
   | E_closure { binder; body } -> (
@@ -202,16 +202,16 @@ let%expect_test _ =
   let dummy_type = Expression.make_t @@ T_base TB_unit in
   let wrap e = Expression.make e dummy_type in
 
-  let show_subst ~body ~x ~expr =
+  let show_subst ~body ~(x:var_name) ~expr =
     Format.printf "(%a)[%a := %a] =@ %a"
       PP.expression body
-      Var.pp x
+      Var.pp x.wrap_content
       PP.expression expr
       PP.expression (subst_expression ~body ~x ~expr) in
 
-  let x = Var.of_name "x" in
+  let x = Location.wrap @@ Var.of_name "x" in
-  let y = Var.of_name "y" in
+  let y = Location.wrap @@ Var.of_name "y" in
-  let z = Var.of_name "z" in
+  let z = Location.wrap @@ Var.of_name "z" in
 
   let var x = wrap (E_variable x) in
   let app f x = wrap (E_application (f, x)) in
@@ -411,7 +411,7 @@ let%expect_test _ =
 
   (* old bug *)
   Var.reset_counter () ;
-  let y0 = Var.fresh ~name:"y" () in
+  let y0 = Location.wrap @@ Var.fresh ~name:"y" () in
   show_subst
     ~body:(lam y (lam y0 (app (var x) (app (var y) (var y0)))))
     ~x:x

src/passes/13-stacking/compiler_environment.ml

@@ -31,8 +31,9 @@ let pack_closure : environment -> selector -> (michelson, stacking_error) result
   let e_lst =
     let e_lst = Environment.to_list e in
     let aux selector (s , _) =
-      match List.mem ~compare:Var.compare s selector with
+      let var_compare = fun (a:var_name) (b:var_name) -> Var.compare a.wrap_content b.wrap_content in
-      | true -> List.remove_element ~compare:Var.compare s selector , true
+      match List.mem ~compare:var_compare s selector with
+      | true -> List.remove_element ~compare:var_compare s selector , true
       | false -> selector , false in
     let e_lst' = List.fold_map_right aux lst e_lst in
     let e_lst'' = List.combine e_lst e_lst' in

src/passes/13-stacking/compiler_program.ml

@@ -226,7 +226,7 @@ and translate_expression (expr:expression) (env:environment) : (michelson , stac
     )
   | E_application (f , arg) -> (
       trace_strong (corner_case ~loc:__LOC__ "Compiling quote application") @@
-      let%bind f = translate_expression f (Environment.add (Var.fresh (), arg.type_expression) env) in
+      let%bind f = translate_expression f (Environment.add (Location.wrap @@ Var.fresh (), arg.type_expression) env) in
       let%bind arg = translate_expression arg env in
       return @@ seq [
         arg ;
@@ -256,7 +256,7 @@ and translate_expression (expr:expression) (env:environment) : (michelson , stac
             PP.expression expr
             Michelson.pp expr_code
             PP.environment env ;
-          let env = Environment.add (Var.fresh (), expr.type_expression) env in
+          let env = Environment.add (Location.wrap @@ Var.fresh (), expr.type_expression) env in
           let code = code @ [expr_code] in
           ok (code, env) in
         bind_fold_right_list aux ([], env) lst in
@@ -401,7 +401,7 @@ and translate_expression (expr:expression) (env:environment) : (michelson , stac
       let%bind collection' =
         translate_expression
           collection
-          (Environment.add (Var.fresh (), initial.type_expression) env) in
+          (Environment.add (Location.wrap @@ Var.fresh (), initial.type_expression) env) in
       let%bind initial' = translate_expression initial env in
       let%bind body' = translate_expression body (Environment.add v env) in
       let code = seq [
@@ -417,7 +417,7 @@ and translate_expression (expr:expression) (env:environment) : (michelson , stac
   | E_record_update (record, path, expr) -> (
     let%bind record' = translate_expression record env in
 
-    let record_var = Var.fresh () in
+    let record_var = Location.wrap @@ Var.fresh () in
     let env' = Environment.add (record_var, record.type_expression) env in
     let%bind expr' = translate_expression expr env' in
     let modify_code =

src/passes/13-stacking/errors.ml

@@ -46,7 +46,7 @@ let rec error_ppformat : display_format:string display_format ->
     match a with
     | `Stacking_get_environment (var,env) ->
       let s = Format.asprintf "failed to get var %a in environment %a"
-        Var.pp var
+        Var.pp var.wrap_content
         Mini_c.PP.environment env in
       Format.pp_print_string f s ;
     | `Stacking_corner_case (loc,msg) ->
@@ -59,7 +59,7 @@ let rec error_ppformat : display_format:string display_format ->
       Format.pp_print_string f s ;
     | `Stacking_expression_tracer (e,ty,err) ->
       Format.fprintf f
-        "@[<hv>compiling expression@%a of type %a@%a]"
+        "@[<hv>compiling expression %a@ of type %a@ %a]"
         Mini_c.PP.expression e 
         Mini_c.PP.type_variable ty
         (error_ppformat ~display_format) err
@@ -101,7 +101,7 @@ let rec error_jsonformat : stacking_error -> J.t = fun a ->
   in
   match a with
   | `Stacking_get_environment (var,env) ->
-    let var' = Format.asprintf "%a" Var.pp var in
+    let var' = Format.asprintf "%a" Var.pp var.wrap_content in
     let env' = Format.asprintf "%a" Mini_c.PP.environment env in
     let content = `Assoc [
       ("message", `String "failed to get var from environment");

src/stages/2-ast_imperative/PP.ml

@@ -26,7 +26,7 @@ let record_sep value sep ppf (m : 'a label_map) =
   fprintf ppf "%a" (list_sep new_pp sep) lst
 
 let expression_variable ppf (ev : expression_variable) : unit =
-  fprintf ppf "%a" Var.pp ev
+  fprintf ppf "%a" Var.pp ev.wrap_content
 
 let rec type_expression' :
         (formatter -> type_expression -> unit)

src/stages/2-ast_imperative/combinators.ml

@@ -100,13 +100,13 @@ let e_binop ?loc name a b  = make_e ?loc @@ E_constant {cons_name = name ; argum
 
 let e_constant ?loc name lst = make_e ?loc @@ E_constant {cons_name=name ; arguments = lst}
 let e_variable ?loc v = make_e ?loc @@ E_variable v
-let e_variable_ez ?loc v = e_variable ?loc @@ Var.of_name v
+let e_variable_ez ?loc v = e_variable ?loc @@ Location.wrap ?loc (Var.of_name v)
 let e_application ?loc a b = make_e ?loc @@ E_application {lamb=a ; args=b}
 let e_lambda ?loc binder input_type output_type result : expression = make_e ?loc @@ E_lambda {binder; input_type; output_type; result}
 let e_recursive ?loc fun_name fun_type lambda = make_e ?loc @@ E_recursive {fun_name; fun_type; lambda}
-let e_recursive_ez ?loc fun_name fun_type lambda = e_recursive ?loc (Var.of_name fun_name) fun_type lambda
+(* let e_recursive_ez ?loc fun_name fun_type lambda = e_recursive ?loc (Var.of_name fun_name) fun_type lambda *)
 let e_let_in ?loc let_binder inline rhs let_result = make_e ?loc @@ E_let_in { let_binder; rhs ; let_result; inline }
-let e_let_in_ez ?loc binder ascr inline rhs let_result = e_let_in ?loc (Var.of_name binder, ascr) inline rhs let_result
+(* let e_let_in_ez ?loc binder ascr inline rhs let_result = e_let_in ?loc (Var.of_name binder, ascr) inline rhs let_result *)
 let e_raw_code ?loc language code = make_e ?loc @@ E_raw_code {language; code}
 
 let e_constructor ?loc s a : expression = make_e ?loc @@ E_constructor { constructor = Constructor s; element = a}
@@ -135,8 +135,8 @@ let e_while ?loc condition body = make_e ?loc @@ E_while {condition; body}
 let e_for ?loc binder start final increment body = make_e ?loc @@ E_for {binder;start;final;increment;body}
 let e_for_each ?loc binder collection collection_type body = make_e ?loc @@ E_for_each {binder;collection;collection_type;body}
 
-let e_for_ez ?loc binder start final increment body = e_for ?loc (Var.of_name binder) start final increment body
+(* let e_for_ez ?loc binder start final increment body = e_for ?loc (Var.of_name binder) start final increment body *)
-let e_for_each_ez ?loc (b,bo) collection collection_type body = e_for_each ?loc (Var.of_name b, Option.map Var.of_name bo) collection collection_type body
+(* let e_for_each_ez ?loc (b,bo) collection collection_type body = e_for_each ?loc (Var.of_name b, Option.map Var.of_name bo) collection collection_type body *)
 
 let e_bool ?loc   b : expression = e_constructor ?loc (string_of_bool b) (e_unit ())
 
@@ -145,13 +145,13 @@ let e_matching_record   ?loc m lst ty_opt expr = e_matching ?loc m @@ Match_reco
 let e_matching_tuple    ?loc m lst ty_opt expr = e_matching ?loc m @@ Match_tuple    (lst,ty_opt, expr)
 let e_matching_variable ?loc m var ty_opt expr = e_matching ?loc m @@ Match_variable (var,ty_opt, expr)
 
-let e_matching_tuple_ez ?loc m lst ty_opt expr =
+(* let e_matching_tuple_ez ?loc m lst ty_opt expr =
   let lst = List.map Var.of_name lst in
-  e_matching_tuple ?loc m lst ty_opt expr
+  e_matching_tuple ?loc m lst ty_opt expr *)
 
-let ez_match_variant (lst : ((string * string) * 'a) list) =
+(* let ez_match_variant (lst : ((string * string) * 'a) list) =
   let lst = List.map (fun ((c,n),a) -> ((Constructor c, Var.of_name n), a) ) lst in
-  Match_variant lst
+  Match_variant lst *)
 
 let e_record ?loc map = make_e ?loc @@ E_record map
 let e_record_ez ?loc (lst : (string * expr) list) : expression =
@@ -181,7 +181,7 @@ let e_typed_set ?loc lst k = e_annotation ?loc (e_set lst) (t_set k)
 
 
 let e_assign ?loc variable access_path expression = make_e ?loc @@ E_assign {variable;access_path;expression} 
-let e_assign_ez ?loc variable access_path expression = e_assign ?loc (Var.of_name variable) access_path expression
+let e_assign_ez ?loc variable access_path expression = e_assign ?loc (Location.wrap ?loc @@ Var.of_name variable) access_path expression
 
 
 let get_e_accessor = fun t ->

src/stages/2-ast_imperative/combinators.mli

@@ -87,21 +87,21 @@ val e_variable_ez : ?loc:Location.t -> string -> expression
 val e_application : ?loc:Location.t -> expression -> expression -> expression
 val e_lambda : ?loc:Location.t -> expression_variable -> type_expression option -> type_expression option -> expression -> expression
 val e_recursive : ?loc:Location.t -> expression_variable -> type_expression -> lambda -> expression
-val e_recursive_ez : ?loc:Location.t -> string -> type_expression -> lambda -> expression
+(* val e_recursive_ez : ?loc:Location.t -> string -> type_expression -> lambda -> expression *)
 val e_let_in : ?loc:Location.t -> ( expression_variable * type_expression option ) -> bool -> expression -> expression -> expression
-val e_let_in_ez : ?loc:Location.t -> string -> type_expression option -> bool -> expression -> expression -> expression
+(* val e_let_in_ez : ?loc:Location.t -> string -> type_expression option -> bool -> expression -> expression -> expression *)
 val e_raw_code : ?loc:Location.t -> string -> expression -> expression
 
 val e_constructor : ?loc:Location.t -> string -> expression -> expression
 val e_matching : ?loc:Location.t -> expression -> matching_expr -> expression
 
-val ez_match_variant : ((string * string ) * expression) list -> matching_expr
+(* val ez_match_variant : ((string * string ) * expression) list -> matching_expr *)
 val e_matching_variant : ?loc:Location.t -> expression -> ((constructor' * expression_variable) * expression) list -> expression
 val e_matching_record  : ?loc:Location.t -> expression -> (label * expression_variable) list -> type_expression list option -> expression -> expression
 val e_matching_tuple   : ?loc:Location.t -> expression -> expression_variable list -> type_expression list option -> expression -> expression
 val e_matching_variable: ?loc:Location.t -> expression -> expression_variable -> type_expression option -> expression -> expression
 
-val e_matching_tuple_ez: ?loc:Location.t -> expression -> string list -> type_expression list option -> expression -> expression
+(* val e_matching_tuple_ez: ?loc:Location.t -> expression -> string list -> type_expression list option -> expression -> expression *)
 
 val e_record     : ?loc:Location.t -> expr label_map -> expression
 val e_record_ez  : ?loc:Location.t -> ( string * expr ) list -> expression
@@ -129,8 +129,8 @@ val e_while  : ?loc:Location.t -> expression -> expression -> expression
 val e_for     : ?loc:Location.t -> expression_variable -> expression -> expression -> expression -> expression -> expression
 val e_for_each : ?loc:Location.t -> expression_variable * expression_variable option -> expression -> collect_type -> expression -> expression
 
-val e_for_ez  : ?loc:Location.t -> string -> expression -> expression -> expression -> expression -> expression
+(* val e_for_ez  : ?loc:Location.t -> string -> expression -> expression -> expression -> expression -> expression
-val e_for_each_ez : ?loc:Location.t -> string * string option -> expression -> collect_type -> expression -> expression
+val e_for_each_ez : ?loc:Location.t -> string * string option -> expression -> collect_type -> expression -> expression *)
 
 val make_option_typed : ?loc:Location.t -> expression -> type_expression option -> expression
 

src/stages/3-ast_sugar/PP.ml

@@ -22,7 +22,7 @@ let record_sep_t value sep ppf (m : 'a label_map) =
 
 
 let expression_variable ppf (ev : expression_variable) : unit =
-  fprintf ppf "%a" Var.pp ev
+  fprintf ppf "%a" Var.pp ev.wrap_content
 
 let rec type_expression' :
         (formatter -> type_expression -> unit)

src/stages/4-ast_core/PP.ml

@@ -87,7 +87,7 @@ and type_operator : (formatter -> type_expression -> unit) -> formatter -> type_
   fprintf ppf "(type_operator: %s)" s
 
 let expression_variable ppf (ev : expression_variable) : unit =
-  fprintf ppf "%a" Var.pp ev
+  fprintf ppf "%a" Var.pp ev.wrap_content
 
 
 let rec expression ppf (e : expression) =

src/stages/4-ast_core/combinators.ml

@@ -54,7 +54,7 @@ let t_contract ?loc ?sugar contract     : type_expression = make_t ?loc ?sugar @
 
 let make_e ?(loc = Location.generated) ?sugar content = {content; sugar; location=loc }
 
-let e_var       ?loc ?sugar n  : expression = make_e ?loc ?sugar @@ E_variable (Var.of_name n)
+let e_var       ?loc ?sugar n  : expression = make_e ?loc ?sugar @@ E_variable (Location.wrap ?loc (Var.of_name n))
 let e_literal   ?loc ?sugar l  : expression = make_e ?loc ?sugar @@ E_literal l
 let e_unit      ?loc ?sugar () : expression = make_e ?loc ?sugar @@ E_literal (Literal_unit)
 let e_int       ?loc ?sugar n  : expression = make_e ?loc ?sugar @@ E_literal (Literal_int n)

src/stages/5-ast_typed/PP.ml

@@ -258,7 +258,7 @@ and type_operator :
 (* end include Stage_common.PP *)
 
 let expression_variable ppf (ev : expression_variable) : unit =
-  fprintf ppf "%a" Var.pp ev
+  fprintf ppf "%a" Var.pp ev.wrap_content
 
 
 let rec expression ppf (e : expression) =

src/stages/5-ast_typed/PP_generic.ml

@@ -64,7 +64,7 @@ module M = struct
       bytes                     = (fun _visitor NoState _bytes          -> fprintf ppf "bytes...") ;
       unit                      = (fun _visitor NoState ()              -> fprintf ppf "()") ;
       packed_internal_operation = (fun _visitor NoState _op             -> fprintf ppf "Operation(...bytes)") ;
-      expression_variable       = (fun _visitor NoState ev              -> fprintf ppf "%a" Var.pp ev) ;
+      expression_variable       = (fun _visitor NoState ev              -> fprintf ppf "%a" Var.pp ev.wrap_content) ;
       constructor'              = (fun _visitor NoState (Constructor c) -> fprintf ppf "Constructor %s" c) ;
       location                  = (fun _visitor NoState loc             -> fprintf ppf "%a" Location.pp loc) ;
       label                     = (fun _visitor NoState (Label lbl)     -> fprintf ppf "Label %s" lbl) ;

src/stages/5-ast_typed/PP_json.ml

@@ -31,7 +31,7 @@ module M = struct
       bytes                     = (fun _visitor NoState bytes           -> `String (Bytes.to_string bytes)) ;
       unit                      = (fun _visitor NoState ()              -> `String "unit" ) ;
       packed_internal_operation = (fun _visitor NoState _op             -> `String "Operation(...bytes)") ;
-      expression_variable       = (fun _visitor NoState ev              -> `Assoc ["exp-var", `String (asprintf "%a" Var.pp ev)] ) ;
+      expression_variable       = (fun _visitor NoState ev              -> `Assoc ["exp-var", `String (asprintf "%a" Var.pp ev.wrap_content)] ) ;
       constructor'              = (fun _visitor NoState (Constructor c) -> `Assoc ["constructor", `String c] ) ;
       location                  = (fun _visitor NoState loc             -> `String (asprintf "%a" Location.pp loc) ) ; (*TODO*)
       label                     = (fun _visitor NoState (Label lbl)     -> `Assoc ["label" , `String lbl] ) ;

src/stages/5-ast_typed/combinators.ml

@@ -335,7 +335,7 @@ let get_a_record_accessor = fun t ->
 let get_declaration_by_name : program -> string -> declaration option = fun p name ->
   let aux : declaration -> bool = fun declaration ->
     match declaration with
-    | Declaration_constant { binder ; expr=_ ; inline=_ } -> binder = Var.of_name name
+    | Declaration_constant { binder ; expr=_ ; inline=_ } -> binder.wrap_content = Var.of_name name
     | Declaration_type _ -> false
   in
   List.find_opt aux @@ List.map Location.unwrap p

src/stages/5-ast_typed/compare_generic.ml

@@ -146,7 +146,7 @@ module M = struct
     | (Bool a, Bool b)                               -> (Pervasives.compare : bool -> bool -> int) a b
     | (Bytes a, Bytes b)                             -> Bytes.compare a b
     | (Constructor' a, Constructor' b)               -> String.compare a b
-    | (Expression_variable a, Expression_variable b) -> Var.compare a b
+    | (Expression_variable a, Expression_variable b) -> Var.compare a.wrap_content b.wrap_content
     | (Int a, Int b)                                 -> Int.compare a b
     | (Label' a, Label' b)                           -> String.compare a b
     | (Ligo_string a, Ligo_string b)                 -> Simple_utils.Ligo_string.compare a b

src/stages/5-ast_typed/environment.ml

@@ -27,7 +27,7 @@ let add_type : type_variable -> type_expression -> t -> t = fun type_variable ty
 (* TODO: generate : these are now messy, clean them up. *)
 let get_opt : expression_variable -> t -> element option = fun k x ->
   Option.bind (fun {expr_var=_ ; env_elt} -> Some env_elt) @@
-    List.find_opt (fun {expr_var ; env_elt=_} -> Var.equal expr_var k) (get_expr_environment x)
+    List.find_opt (fun {expr_var ; env_elt=_} -> Var.equal expr_var.wrap_content k.wrap_content) (get_expr_environment x)
 let get_type_opt : type_variable -> t -> type_expression option = fun k x ->
   Option.bind (fun {type_variable=_ ; type_} -> Some type_) @@
     List.find_opt (fun {type_variable ; type_=_} -> Var.equal type_variable k) (get_type_environment x)

src/stages/5-ast_typed/misc.ml

@@ -3,7 +3,8 @@ open Types
 module Free_variables = struct
 
   type bindings = expression_variable list
-  let mem : expression_variable -> bindings -> bool = List.mem
+  let var_compare = Location.compare_content ~compare:Var.compare
+  let mem : expression_variable -> bindings -> bool = List.mem ~compare:var_compare
   let singleton : expression_variable -> bindings = fun s -> [ s ]
   let union : bindings -> bindings -> bindings = (@)
   let unions : bindings list -> bindings = List.concat
@@ -219,7 +220,7 @@ let get_entry (lst : program) (name : string) : expression option =
   let aux x =
     match Location.unwrap x with
     | Declaration_constant { binder ; expr ; inline=_ } -> (
-      if Var.equal binder (Var.of_name name)
+      if Var.equal binder.wrap_content (Var.of_name name)
       then Some expr
       else None
     )
@@ -229,7 +230,7 @@ let get_entry (lst : program) (name : string) : expression option =
 
 let equal_variables a b : bool =
   match a.expression_content, b.expression_content with
-  | E_variable a, E_variable b -> Var.equal a b
+  | E_variable a, E_variable b -> Var.equal a.wrap_content b.wrap_content
   |  _, _ -> false
 
 let p_constant (p_ctor_tag : constant_tag) (p_ctor_args : p_ctor_args) = {

src/stages/5-ast_typed/misc_smart.ml

@@ -6,7 +6,8 @@ open Misc
 module Captured_variables = struct
 
   type bindings = expression_variable list
-  let mem : expression_variable -> bindings -> bool = List.mem
+  let var_compare = Location.compare_content ~compare:Var.compare
+  let mem : expression_variable -> bindings -> bool = List.mem ~compare:var_compare
   let singleton : expression_variable -> bindings = fun s -> [ s ]
   let union : bindings -> bindings -> bindings = (@)
   let unions : bindings list -> bindings = List.concat

src/stages/6-mini_c/PP.ml

@@ -24,7 +24,7 @@ and annotated ppf : type_expression annotated -> _ = function
   | (None, a) -> type_variable ppf a
 
 and environment_element ppf ((n, tv) : environment_element) =
-  Format.fprintf ppf "%a : %a" Var.pp n type_variable tv
+  Format.fprintf ppf "%a : %a" Var.pp n.wrap_content type_variable tv
 
 and environment ppf (x:environment) =
   fprintf ppf "Env[%a]" (list_sep_d environment_element) x
@@ -94,7 +94,7 @@ and expression ppf (e:expression) =
 and expression_content ppf (e:expression_content) = match e with
   | E_skip -> fprintf ppf "skip"
   | E_closure x -> function_ ppf x
-  | E_variable v -> fprintf ppf "%a" Var.pp v
+  | E_variable v -> fprintf ppf "%a" Var.pp v.wrap_content
   | E_application(a, b) -> fprintf ppf "@[(%a)@(%a)@]" expression a expression b
 
   | E_constant c -> fprintf ppf "@[%a@[<hv 1>(%a)@]@]" constant c.cons_name (list_sep_d expression) c.arguments
@@ -107,19 +107,21 @@ and expression_content ppf (e:expression_content) = match e with
   | E_if_none (c, n, ((name, _) , s)) ->
     fprintf ppf
       "@[match %a with@ @[<hv>| None ->@;<1 2>%a@ | Some %a ->@;<1 2>%a@]@]"
-      expression c expression n Var.pp name expression s
+      expression c expression n Var.pp name.wrap_content expression s
-  | E_if_cons (c, n, (((hd_name, _) , (tl_name, _)) , cons)) -> fprintf ppf "@[%a ?? %a : (%a :: %a) -> %a@]" expression c expression n Var.pp hd_name Var.pp tl_name expression cons
+  | E_if_cons (c, n, (((hd_name, _) , (tl_name, _)) , cons)) ->
+    fprintf ppf "@[%a ?? %a : (%a :: %a) -> %a@]"
+      expression c expression n Var.pp hd_name.wrap_content Var.pp tl_name.wrap_content expression cons
   | E_if_left (c, ((name_l, _) , l), ((name_r, _) , r)) ->
       fprintf ppf
         "@[match %a with@ @[<hv>| Left %a ->@;<1 2>%a@ | Right %a ->@;<1 2>%a@]@]"
-        expression c Var.pp name_l expression l Var.pp name_r expression r
+        expression c Var.pp name_l.wrap_content expression l Var.pp name_r.wrap_content expression r
   | E_sequence (a , b) -> fprintf ppf "@[%a ;; %a@]" expression a expression b
   | E_let_in ((name , _) , inline, expr , body) ->
-      fprintf ppf "@[let %a =@;<1 2>%a%a in@ %a@]" Var.pp name expression expr option_inline inline expression body
+      fprintf ppf "@[let %a =@;<1 2>%a%a in@ %a@]" Var.pp name.wrap_content expression expr option_inline inline expression body
   | E_iterator (b , ((name , _) , body) , expr) ->
-      fprintf ppf "@[for_%a %a of %a do ( %a )@]" constant b Var.pp name expression expr expression body
+      fprintf ppf "@[for_%a %a of %a do ( %a )@]" constant b Var.pp name.wrap_content expression expr expression body
   | E_fold (((name , _) , body) , collection , initial) ->
-      fprintf ppf "@[fold %a on %a with %a do ( %a )@]" expression collection expression initial Var.pp name expression body
+      fprintf ppf "@[fold %a on %a with %a do ( %a )@]" expression collection expression initial Var.pp name.wrap_content expression body
 
   | E_record_update (r, path,update) ->
       fprintf ppf "@[{ %a@;<1 2>with@;<1 2>{ %a = %a } }@]" expression r (list_sep lr (const ".")) path expression update
@@ -135,7 +137,7 @@ and expression_with_type : _ -> expression -> _  = fun ppf e ->
 
 and function_ ppf ({binder ; body}:anon_function) =
   fprintf ppf "@[fun %a ->@ (%a)@]"
-    Var.pp binder
+    Var.pp binder.wrap_content
     expression body
 
 and option_inline ppf inline = 
@@ -144,7 +146,7 @@ and option_inline ppf inline =
   else
     fprintf ppf ""
 
-and declaration ppf ((n,i, e):assignment) = fprintf ppf "@[let %a =@;<1 2>%a%a@]" Var.pp n expression e option_inline i
+and declaration ppf ((n,i, e):assignment) = fprintf ppf "@[let %a =@;<1 2>%a%a@]" Var.pp n.wrap_content expression e option_inline i
 
 and tl_statement ppf (ass, _) = declaration ppf ass
 
@@ -278,11 +280,13 @@ let%expect_test _ =
   let pp = expression_content Format.std_formatter in
   let dummy_type = {type_content=T_base TB_unit;location=Location.generated} in
   let wrap e = { content = e ; type_expression = dummy_type ; location = Location.generated} in
-  pp @@ E_closure { binder = Var.of_name "y" ; body = wrap (E_variable (Var.of_name "y")) } ;
+  let y = Location.wrap ~loc:(Location.generated) (Var.of_name "y") in
+  let z = Location.wrap ~loc:(Location.generated) (Var.of_name "z") in
+  pp @@ E_closure { binder = y ; body = wrap (E_variable y) } ;
   [%expect{|
     fun y -> (y)
   |}] ;
-  pp @@ E_closure { binder = Var.of_name "z" ; body = wrap (E_variable (Var.of_name "z")) } ;
+  pp @@ E_closure { binder = z ; body = wrap (E_variable z) } ;
   [%expect{|
     fun z -> (z)
   |}]

src/stages/6-mini_c/combinators_smart.ml

@@ -3,4 +3,4 @@ open Combinators
 
 let basic_int_quote_env : environment =
   let e = Environment.empty in
-  Environment.add (Var.of_name "input", t_int ()) e
+  Environment.add (Location.wrap @@ Var.of_name "input", t_int ()) e

src/stages/6-mini_c/environment.ml

@@ -18,15 +18,18 @@ module Environment (* : ENVIRONMENT *) = struct
   type element = environment_element
   type t = environment
 
+  let compare_var : expression_variable -> expression_variable -> int =
+    fun a b -> Var.compare a.wrap_content b.wrap_content
+
   let empty : t = []
   let add : element -> t -> t  = List.cons
   let concat : t list -> t  = List.concat
-  let get_opt : expression_variable -> t -> type_expression option  = List.assoc_opt ~compare:Var.compare
+  let get_opt : expression_variable -> t -> type_expression option = List.assoc_opt ~compare:compare_var
   let has : expression_variable -> t -> bool = fun s t ->
     match get_opt s t with
     | None -> false
     | Some _ -> true
-  let get_i : expression_variable -> t -> (type_expression * int) = List.assoc_i ~compare:Var.compare
+  let get_i : expression_variable -> t -> (type_expression * int) = List.assoc_i ~compare:compare_var
   let of_list : element list -> t = fun x -> x
   let to_list : t -> element list = fun x -> x
   let get_names : t -> expression_variable list = List.map fst
@@ -36,8 +39,8 @@ module Environment (* : ENVIRONMENT *) = struct
     let e_lst =
       let e_lst = to_list env in
       let aux selector (s , _) =
-        match List.mem ~compare:Var.compare s selector with
+        match List.mem ~compare:compare_var s selector with
-        | true -> List.remove_element ~compare:Var.compare s selector , keep
+        | true -> List.remove_element ~compare:compare_var s selector , keep
         | false -> selector , not keep in
       let e_lst' =
         if rev = keep

src/stages/6-mini_c/misc.ml

@@ -4,11 +4,13 @@ open Combinators
 module Free_variables = struct
 
   type bindings = expression_variable list
-  let mem : expression_variable -> bindings -> bool = List.mem
+  let var_equal = Location.equal_content ~equal:Var.equal
+  let var_compare = Location.compare_content ~compare:Var.compare
+  let mem : expression_variable -> bindings -> bool = List.mem ~compare:var_compare
   let singleton : expression_variable -> bindings = fun s -> [ s ]
   let mem_count : expression_variable -> bindings -> int =
     fun x fvs ->
-    List.length (List.filter (Var.equal x) fvs)
+    List.length (List.filter (var_equal x) fvs)
   let union : bindings -> bindings -> bindings = (@)
   let unions : bindings list -> bindings = List.concat
   let empty : bindings = []
@@ -98,8 +100,8 @@ end
 let get_entry (lst : program) (name : string) : (expression * int) option =
   let entry_expression =
     let aux x =
-      let (((decl_name , _, decl_expr) , _)) = x in
+      let ((((decl_name:expression_variable) , _, decl_expr) , _)) = x in
-      if (Var.equal decl_name (Var.of_name name))
+      if (Var.equal decl_name.wrap_content (Var.of_name name))
       then Some decl_expr
       else None
     in
@@ -109,8 +111,8 @@ let get_entry (lst : program) (name : string) : (expression * int) option =
     | Some exp ->
       let entry_index =
         let aux x =
-          let (((decl_name , _, _) , _)) = x in
+          let ((((decl_name:expression_variable) , _, _) , _)) = x in
-          Var.equal decl_name (Var.of_name name)
+          Var.equal decl_name.wrap_content (Var.of_name name)
         in
         (List.length lst) - (List.find_index aux (List.rev lst)) - 1
       in

src/stages/common/types.ml

@@ -1,5 +1,5 @@
 type expression_
-and expression_variable = expression_ Var.t
+and expression_variable = expression_ Var.t Location.wrap
 type type_
 and type_variable = type_ Var.t
 

src/stages/ligo_interpreter/PP.ml

@@ -34,7 +34,7 @@ let rec pp_value : value -> string = function
 let pp_env : env -> unit = fun env ->
   let () = Format.printf "{ #elements : %i\n" @@ Env.cardinal env in
   let () = Env.iter (fun var v ->
-    Format.printf "\t%a -> %s\n" Var.pp var (pp_value v))
+    Format.printf "\t%a -> %s\n" Var.pp var.wrap_content (pp_value v))
   env in
   let () = Format.printf "\n}\n" in
   ()

src/stages/ligo_interpreter/types.ml

@@ -4,7 +4,7 @@ include Ast_typed.Types
 module Env = Map.Make(
   struct
     type t = expression_variable
-    let compare a b = Var.compare a b
+    let compare (a:expression_variable) (b:expression_variable) = Var.compare a.wrap_content b.wrap_content
   end
 )
 

src/test/hash_lock_tests.ml

@@ -45,7 +45,7 @@ let (first_committer , first_contract) =
 
 let empty_op_list =
   (e_typed_list [] (t_operation ()))
-let empty_message = e_lambda (Var.of_name "arguments")
+let empty_message = e_lambda (Location.wrap @@ Var.of_name "arguments")
   (Some (t_unit ())) (Some (t_list (t_operation ())))
   empty_op_list
 

src/test/multisig_tests.ml

@@ -45,7 +45,7 @@ let init_storage threshold counter pkeys =
 
 let empty_op_list = 
   (e_typed_list [] (t_operation ()))
-let empty_message = e_lambda (Var.of_name "arguments")
+let empty_message = e_lambda (Location.wrap @@ Var.of_name "arguments")
   (Some (t_unit ())) (Some (t_list (t_operation ())))
   empty_op_list
 let chain_id_zero = e_chain_id @@ Tezos_crypto.Base58.simple_encode

src/test/multisig_v2_tests.ml

@@ -28,12 +28,12 @@ open Ast_imperative
 
 let empty_op_list = 
   (e_typed_list [] (t_operation ()))
-let empty_message = e_lambda (Var.of_name "arguments")
+let empty_message = e_lambda (Location.wrap @@ Var.of_name "arguments")
   (Some (t_bytes ())) (Some (t_list (t_operation ())))
   empty_op_list
-let empty_message2 = e_lambda (Var.of_name "arguments")
+let empty_message2 = e_lambda (Location.wrap @@ Var.of_name "arguments")
   (Some (t_bytes ())) (Some (t_list (t_operation ())))
- ( e_let_in ((Var.of_name "foo"),Some (t_unit ())) false (e_unit ()) empty_op_list)
+ ( e_let_in ((Location.wrap @@ Var.of_name "foo"),Some (t_unit ())) false (e_unit ()) empty_op_list)
 
 let send_param msg = e_constructor "Send" msg
 let withdraw_param = e_constructor "Withdraw" empty_message

src/test/pledge_tests.ml

@@ -39,7 +39,7 @@ let (stranger_addr , stranger_contract) =
 
 let empty_op_list =
   (e_typed_list [] (t_operation ()))
-let empty_message = e_lambda (Var.of_name "arguments")
+let empty_message = e_lambda (Location.wrap @@ Var.of_name "arguments")
   (Some (t_unit ())) (Some (t_list (t_operation ())))
   empty_op_list
 

src/test/replaceable_id_tests.ml

@@ -28,7 +28,7 @@ open Ast_imperative
 
 let empty_op_list = 
   (e_typed_list [] (t_operation ()))
-let empty_message = e_lambda (Var.of_name "arguments")
+let empty_message = e_lambda (Location.wrap @@ Var.of_name "arguments")
   (Some (t_unit ())) (Some (t_list (t_operation ())))
   empty_op_list
 

src/test/time_lock_repeat_tests.ml

@@ -28,7 +28,7 @@ let compile_main () =
 
 let empty_op_list =
   (e_typed_list [] (t_operation ()))
-let empty_message = e_lambda (Var.of_name "arguments")
+let empty_message = e_lambda (Location.wrap @@ Var.of_name "arguments")
   (Some (t_unit ())) (Some (t_list (t_operation ())))
   empty_op_list
 

src/test/time_lock_tests.ml

@@ -29,7 +29,7 @@ open Ast_imperative
 
 let empty_op_list =
   (e_typed_list [] (t_operation ()))
-let empty_message = e_lambda (Var.of_name "arguments")
+let empty_message = e_lambda (Location.wrap @@ Var.of_name "arguments")
   (Some (t_unit ())) (Some (t_list (t_operation ())))
   empty_op_list
 

src/test/typer_tests.ml

@@ -47,7 +47,7 @@ module TestExpressions = struct
 
   let lambda () : (unit, _) result =
     test_expression
-      I.(e_lambda (Var.of_name "x") (Some (t_int ())) (Some (t_int ())) (e_var "x"))
+      I.(e_lambda (Location.wrap @@ Var.of_name "x") (Some (t_int ())) (Some (t_int ())) (e_var "x"))
       O.(t_function (t_int ()) (t_int ()) ())
 
   let tuple () : (unit, _) result =

vendors/ligo-utils/simple-utils/location.ml

@@ -46,6 +46,12 @@ let compare_wrap ~compare:compare_content { wrap_content = wca ; location = la }
   | 0 -> compare la lb
   | c -> c
 
+let compare_content ~compare:compare_content wa wb =
+  compare_content wa.wrap_content wb.wrap_content
+
+let equal_content ~equal:equal_content wa wb =
+  equal_content wa.wrap_content wb.wrap_content
+
 let wrap ?(loc = generated) wrap_content = { wrap_content ; location = loc }
 let get_location x = x.location
 let unwrap { wrap_content ; _ } = wrap_content