From 79af0abab33d13efe82cf78820e6c09441fda037 Mon Sep 17 00:00:00 2001
From: Galfour <gabriel.alfour@gmail.com>
Date: Tue, 28 May 2019 17:02:40 +0000
Subject: [PATCH] propagate source-code locations to ast_typed

---
 src/ast_typed/combinators.ml                |  8 +++++++-
 src/ast_typed/types.ml                      | 11 ++++++-----
 src/typer/typer.ml                          |  3 ++-
 vendors/ligo-utils/simple-utils/location.ml |  1 +
 4 files changed, 16 insertions(+), 7 deletions(-)

diff --git a/src/ast_typed/combinators.ml b/src/ast_typed/combinators.ml
index ce3c6902c..f5859806e 100644
--- a/src/ast_typed/combinators.ml
+++ b/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 }
 
diff --git a/src/ast_typed/types.ml b/src/ast_typed/types.ml
index 9dbd2fc64..a1bfd46d3 100644
--- a/src/ast_typed/types.ml
+++ b/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"
 
diff --git a/src/typer/typer.ml b/src/typer/typer.ml
index 5d6367901..6e55604cc 100644
--- a/src/typer/typer.ml
+++ b/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
diff --git a/vendors/ligo-utils/simple-utils/location.ml b/vendors/ligo-utils/simple-utils/location.ml
index a710e1185..27ecec4f3 100644
--- a/vendors/ligo-utils/simple-utils/location.ml
+++ b/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