balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

propagate source-code locations to ast_typed

Browse Source
This commit is contained in:
Galfour 2019-05-28 17:02:40 +00:00
parent 5b42d72e41
commit 79af0abab3
4 changed files with 16 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
src/ast_typed/combinators.ml
View File

@ -2,7 +2,13 @@ open Trace
open Types open Types
let make_t type_value' simplified = { type_value' ; simplified } 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_e name a_e = { name ; annotated_expression = a_e }
let make_n_t type_name type_value = { type_name ; type_value } let make_n_t type_name type_value = { type_name ; type_value }

11
src/ast_typed/types.ml
View File

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

3
src/typer/typer.ml
View File

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

1
vendors/ligo-utils/simple-utils/location.ml vendored
View File

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