propagate source-code locations to ast_typed

src/ast_typed/combinators.ml

@@ -2,7 +2,13 @@ open Trace
 open Types
 
 let make_t type_value' simplified = { type_value' ; simplified }
-let make_a_e expression type_annotation environment = { expression ; type_annotation ; dummy_field = () ; environment }
+let make_a_e ?(location = Location.generated) expression type_annotation environment = {
+  expression ;
+  type_annotation ;
+  dummy_field = () ;
+  environment ;
+  location ;
+}
 let make_n_e name a_e = { name ; annotated_expression = a_e }
 let make_n_t type_name type_value = { type_name ; type_value }
 

src/ast_typed/types.ml

@@ -34,10 +34,11 @@ and small_environment = (environment * type_environment)
 and full_environment = small_environment List.Ne.t
 
 and annotated_expression = {
-  expression: expression ;
-  type_annotation: tv ;
-  environment: full_environment ;
-  dummy_field: unit ;
+  expression : expression ;
+  type_annotation : tv ;
+  environment : full_environment ;
+  location : Location.t ;
+  dummy_field : unit ;
 }
 
 and named_expression = {
@@ -162,6 +163,6 @@ let get_entry (p:program) (entry : string) : annotated_expression result =
 let get_functional_entry (p:program) (entry : string) : (lambda * type_value) result =
   let%bind entry = get_entry p entry in
   match entry.expression with
-  | E_lambda l -> ok (l, entry.type_annotation)
+  | E_lambda l -> ok (l , entry.type_annotation)
   | _ -> simple_fail "given entry point is not functional"
 

src/typer/typer.ml

@@ -204,7 +204,8 @@ and type_expression : environment -> ?tv_opt:O.type_value -> I.expression -> O.a
       match tv_opt with
       | None -> ok ()
       | Some tv' -> O.assert_type_value_eq (tv' , tv) in
-    ok @@ make_a_e expr tv e in
+    let location = Location.get_location ae in
+    ok @@ make_a_e ~location expr tv e in
   let main_error =
     let title () = "typing expression" in
     let content () = Format.asprintf "Expression: %a\nLog: %s\n" I.PP.expression ae (L.get()) in

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

@@ -30,6 +30,7 @@ type 'a wrap = {
 }
 
 let wrap ?(loc = generated) wrap_content = { wrap_content ; location = loc }
+let get_location x = x.location
 let unwrap { wrap_content ; _ } = wrap_content
 let map f x = { x with wrap_content = f x.wrap_content }
 let pp_wrap f ppf { wrap_content ; _ } = Format.fprintf ppf "%a" f wrap_content