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

add srcloc in mini-c

Browse Source
This commit is contained in:
Pierre-Emmanuel Wulfman 2020-04-20 18:55:04 +02:00
parent 2db55ae965
commit 551bf176fe
6 changed files with 46 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
src/passes/10-transpiler/transpiler.ml
View File

@ -234,7 +234,7 @@ let transpile_constant' : AST.constant' -> constant' = function
| C_CONVERT_FROM_RIGHT_COMB -> C_CONVERT_FROM_RIGHT_COMB
let rec transpile_type (t:AST.type_expression) : type_expression result =
let return tc = ok @@ Expression.make_t @@ tc in
let return tc = ok @@ Expression.make_t ~loc:t.location @@ tc in
match t.type_content with
| T_variable (name) when Var.equal name Stage_common.Constant.t_bool -> return (T_base TB_bool)
| t when (compare t (t_bool ()).type_content) = 0-> return (T_base TB_bool)
@ -392,7 +392,7 @@ and tree_of_sum : AST.type_expression -> (AST.constructor' * AST.type_expression
and transpile_annotated_expression (ae:AST.expression) : expression result =
let%bind tv = transpile_type ae.type_expression in
let return ?(tv = tv) expr = ok @@ Combinators.Expression.make_tpl (expr, tv) in
let return ?(tv = tv) expr = ok @@ Combinators.Expression.make_tpl ~loc:ae.location (expr, tv) in
let info =
let title () = "translating expression" in
let content () = Format.asprintf "%a" Location.pp ae.location in
@ -474,10 +474,12 @@ and transpile_annotated_expression (ae:AST.expression) : expression result =
let aux = fun pred (ty, lr) ->
let c = match lr with
| `Left -> C_CAR
| `Right -> C_CDR in
Combinators.Expression.make_tpl (E_constant {cons_name=c;arguments=[pred]} , ty) in
| `Right -> C_CDR
in
return ~tv:ty @@ E_constant {cons_name=c;arguments=[pred]}
in
let%bind record' = transpile_annotated_expression record in
let expr = List.fold_left aux record' path in
let%bind expr = bind_fold_list aux record' path in
ok expr
| E_record_update {record; path; update} ->
let rec aux res (r,p,up) =
@ -654,14 +656,14 @@ and transpile_lambda l (input_type , output_type) =
let tv = Combinators.t_function input output in
let binder = binder in
let closure = E_closure { binder; body = result'} in
ok @@ Combinators.Expression.make_tpl (closure , tv)
ok @@ Combinators.Expression.make_tpl ~loc:result.location (closure , tv)
and transpile_recursive {fun_name; fun_type; lambda} =
let rec map_lambda : AST.expression_variable -> type_expression -> AST.expression -> (expression * expression_variable list) result = fun fun_name loop_type e ->
match e.expression_content with
E_lambda {binder;result} ->
let%bind (body,l) = map_lambda fun_name loop_type result in
ok @@ (Expression.make (E_closure {binder;body}) loop_type, binder::l)
ok @@ (Expression.make ~loc:e.location (E_closure {binder;body}) loop_type, binder::l)
| _ ->
let%bind res = replace_callback fun_name loop_type false e in
ok @@ (res, [])

4
src/stages/5-mini_c/PP.ml
View File

@ -259,8 +259,8 @@ let%expect_test _ =
let%expect_test _ =
let pp = expression_content Format.std_formatter in
let dummy_type = {type_content=T_base TB_unit} in
let wrap e = { content = e ; type_expression = dummy_type} 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")) } ;
[%expect{|
fun y -> (y)

33
src/stages/5-mini_c/combinators.ml
View File

@ -8,18 +8,21 @@ module Expression = struct
let get_content : t -> t' = fun e -> e.content
let get_type : t -> type_expression = fun e -> e.type_expression
let make_t = fun tc -> {
let make_t ?(loc=Location.generated) = fun tc -> {
type_content = tc;
location = loc;
}
let make = fun e' t -> {
let make ?(loc=Location.generated) = fun e' t -> {
content = e' ;
type_expression = t ;
location = loc;
}
let make_tpl = fun (e' , t) -> {
let make_tpl ?(loc=Location.generated) = fun (e' , t) -> {
content = e' ;
type_expression = t ;
location = loc;
}
let pair : t -> t -> t' = fun a b -> E_constant { cons_name = C_PAIR; arguments = [ a ; b ]}
@ -164,24 +167,24 @@ let get_operation (v:value) = match v with
| _ -> simple_fail "not an operation"
let t_int () : type_expression = Expression.make_t @@ T_base TB_int
let t_unit () : type_expression = Expression.make_t @@ T_base TB_unit
let t_nat () : type_expression = Expression.make_t @@ T_base TB_nat
let t_int ?loc () : type_expression = Expression.make_t ?loc @@ T_base TB_int
let t_unit ?loc () : type_expression = Expression.make_t ?loc @@ T_base TB_unit
let t_nat ?loc () : type_expression = Expression.make_t ?loc @@ T_base TB_nat
let t_function x y : type_expression = Expression.make_t @@ T_function ( x , y )
let t_pair x y : type_expression = Expression.make_t @@ T_pair ( x , y )
let t_union x y : type_expression = Expression.make_t @@ T_or ( x , y )
let t_function ?loc x y : type_expression = Expression.make_t ?loc @@ T_function ( x , y )
let t_pair ?loc x y : type_expression = Expression.make_t ?loc @@ T_pair ( x , y )
let t_union ?loc x y : type_expression = Expression.make_t ?loc @@ T_or ( x , y )
let e_int expr : expression = Expression.make_tpl (expr, t_int ())
let e_unit : expression = Expression.make_tpl (E_literal D_unit, t_unit ())
let e_skip : expression = Expression.make_tpl (E_skip, t_unit ())
let e_var_int name : expression = e_int (E_variable name)
let e_let_in v tv inline expr body : expression = Expression.(make_tpl (
let e_int ?loc expr : expression = Expression.make_tpl ?loc (expr, t_int ())
let e_unit ?loc () : expression = Expression.make_tpl ?loc (E_literal D_unit, t_unit ())
let e_skip ?loc () : expression = Expression.make_tpl ?loc (E_skip, t_unit ())
let e_var_int ?loc name : expression = e_int ?loc (E_variable name)
let e_let_in ?loc v tv inline expr body : expression = Expression.(make_tpl ?loc(
E_let_in ((v , tv) , inline, expr , body) ,
get_type body
))
let ez_e_sequence a b : expression = Expression.(make_tpl (E_sequence (make_tpl (a , t_unit ()) , b) , get_type b))
let ez_e_sequence ?loc a b : expression = Expression.(make_tpl (E_sequence (make_tpl ?loc (a , t_unit ()) , b) , get_type b))
let d_unit : value = D_unit

28
src/stages/5-mini_c/combinators.mli
View File

@ -10,9 +10,9 @@ module Expression : sig
(*
val is_toplevel : t -> bool
*)
val make_t : type_content -> type_expression
val make : t' -> type_expression -> t
val make_tpl : t' * type_expression -> t
val make_t : ?loc:Location.t -> type_content -> type_expression
val make : ?loc:Location.t -> t' -> type_expression -> t
val make_tpl : ?loc:Location.t -> t' * type_expression -> t
val pair : t -> t -> t'
end
@ -53,24 +53,24 @@ val get_t_contract : type_expression -> type_expression result
val get_t_operation : type_expression -> type_expression result
val get_operation : value -> Memory_proto_alpha.Protocol.Alpha_context.packed_internal_operation result
val t_int : unit -> type_expression
val t_unit : unit -> type_expression
val t_nat : unit -> type_expression
val t_function : type_expression -> type_expression -> type_expression
val t_pair : type_expression annotated -> type_expression annotated -> type_expression
val t_union : type_expression annotated -> type_expression annotated -> type_expression
val t_int : ?loc:Location.t -> unit -> type_expression
val t_unit : ?loc:Location.t -> unit -> type_expression
val t_nat : ?loc:Location.t -> unit -> type_expression
val t_function : ?loc:Location.t -> type_expression -> type_expression -> type_expression
val t_pair : ?loc:Location.t -> type_expression annotated -> type_expression annotated -> type_expression
val t_union : ?loc:Location.t -> type_expression annotated -> type_expression annotated -> type_expression
(*
val quote : string -> type_value -> type_value -> Expression.t -> anon_function
val e_int : Expression.t' -> Expression.t
*)
val e_unit : Expression.t
val e_skip : Expression.t
val e_var_int : expression_variable -> Expression.t
val e_let_in : expression_variable -> type_expression -> inline -> Expression.t -> Expression.t -> Expression.t
val e_unit : ?loc:Location.t -> unit -> Expression.t
val e_skip : ?loc:Location.t -> unit -> Expression.t
val e_var_int : ?loc:Location.t -> expression_variable -> Expression.t
val e_let_in : ?loc:Location.t -> expression_variable -> type_expression -> inline -> Expression.t -> Expression.t -> Expression.t
val ez_e_sequence : Expression.t' -> Expression.t -> expression
val ez_e_sequence : ?loc:Location.t -> Expression.t' -> Expression.t -> expression
(*
val ez_e_return : Expression.t -> Expression.t
*)

1
src/stages/5-mini_c/misc.ml
View File

@ -155,6 +155,7 @@ let aggregate_entry (lst : program) (form : form_t) : expression result =
let e' = {
content = E_closure l' ;
type_expression = entry_expression.type_expression ;
location = entry_expression.location;
} in
ok e'
)

2
src/stages/5-mini_c/types.ml
View File

@ -16,6 +16,7 @@ type type_content =
and type_expression = {
type_content : type_content;
location : Location.t;
}
and type_base =
@ -94,6 +95,7 @@ and expression_content =
and expression = {
content : expression_content ;
type_expression : type_expression ;
location : Location.t;
}
and constant = {