replace field name 'decl_position' by 'field_decl_pos'

This commit is contained in:
Lesenechal Remi 2020-04-28 16:58:47 +02:00
parent 1f6bc4fc6b
commit fb2f3e89e7
16 changed files with 41 additions and 41 deletions

View File

@ -303,7 +303,7 @@ and compile_type_expression : Raw.type_expr -> type_expression result = fun te -
@@ List.mapi order
@@ List.map apply
@@ npseq_to_list r.ne_elements in
let m = List.fold_left (fun m ((x,i), y) -> LMap.add (Label x) {field_type=y;decl_position=i} m) LMap.empty lst in
let m = List.fold_left (fun m ((x,i), y) -> LMap.add (Label x) {field_type=y;field_decl_pos=i} m) LMap.empty lst in
ok @@ make_t ~loc @@ T_record m
| TSum s ->
let (s,loc) = r_split s in

View File

@ -234,7 +234,7 @@ let rec compile_type_expression (t:Raw.type_expr) : type_expression result =
@@ List.mapi order
@@ List.map apply
@@ npseq_to_list r.ne_elements in
let m = List.fold_left (fun m ((x,i), y) -> LMap.add (Label x) {field_type=y;decl_position=i} m) LMap.empty lst in
let m = List.fold_left (fun m ((x,i), y) -> LMap.add (Label x) {field_type=y;field_decl_pos=i} m) LMap.empty lst in
ok @@ make_t ~loc @@ T_record m
| TSum s ->
let (s,loc) = r_split s in

View File

@ -145,9 +145,9 @@ let rec compile_type_expression : I.type_expression -> O.type_expression result
| I.T_record record ->
let record = I.LMap.to_kv_list record in
let%bind record =
bind_map_list (fun (k, ({field_type = v; decl_position ; _}:I.field_content)) ->
bind_map_list (fun (k, ({field_type = v; field_decl_pos ; _}:I.field_content)) ->
let%bind v = compile_type_expression v in
let content : O.field_content = {field_type = v; michelson_annotation = None ; decl_position} in
let content : O.field_content = {field_type = v; michelson_annotation = None ; field_decl_pos} in
ok @@ (k,content)
) record
in
@ -171,8 +171,8 @@ let rec compile_type_expression : I.type_expression -> O.type_expression result
| I.T_operator (TC_michelson_pair (l,l_ann,r,r_ann)) ->
let%bind (l,r) = bind_map_pair compile_type_expression (l,r) in
let sum : (O.label * O.field_content) list = [
(O.Label "0" , {field_type = l ; michelson_annotation = Some l_ann ; decl_position = 0});
(O.Label "1", {field_type = r ; michelson_annotation = Some r_ann ; decl_position = 0}); ]
(O.Label "0" , {field_type = l ; michelson_annotation = Some l_ann ; field_decl_pos = 0});
(O.Label "1", {field_type = r ; michelson_annotation = Some r_ann ; field_decl_pos = 0}); ]
in
return @@ O.T_record (O.LMap.of_list sum)
| I.T_operator type_operator ->
@ -606,9 +606,9 @@ let rec uncompile_type_expression : O.type_expression -> I.type_expression resul
let record = I.LMap.to_kv_list record in
let%bind record =
bind_map_list (fun (k,v) ->
let {field_type;decl_position} : O.field_content = v in
let {field_type;field_decl_pos} : O.field_content = v in
let%bind v = uncompile_type_expression field_type in
ok @@ (k,({field_type=v;decl_position}:I.field_content))
ok @@ (k,({field_type=v;field_decl_pos}:I.field_content))
) record
in
return @@ I.T_record (O.LMap.of_list record)

View File

@ -21,9 +21,9 @@ let rec idle_type_expression : I.type_expression -> O.type_expression result =
let record = I.LMap.to_kv_list record in
let%bind record =
bind_map_list (fun (k,v) ->
let {field_type ; michelson_annotation ; decl_position} : I.field_content = v in
let {field_type ; michelson_annotation ; field_decl_pos} : I.field_content = v in
let%bind field_type = idle_type_expression field_type in
let v' : O.field_content = {field_type ; field_annotation=michelson_annotation ; decl_position} in
let v' : O.field_content = {field_type ; field_annotation=michelson_annotation ; field_decl_pos} in
ok @@ (k,v')
) record
in
@ -31,7 +31,7 @@ let rec idle_type_expression : I.type_expression -> O.type_expression result =
| I.T_tuple tuple ->
let aux (i,acc) el =
let%bind el = idle_type_expression el in
ok @@ (i+1,(O.Label (string_of_int i), ({field_type=el;field_annotation=None;decl_position=0}:O.field_content))::acc) in
ok @@ (i+1,(O.Label (string_of_int i), ({field_type=el;field_annotation=None;field_decl_pos=0}:O.field_content))::acc) in
let%bind (_, lst ) = bind_fold_list aux (0,[]) tuple in
let record = O.LMap.of_list lst in
return @@ O.T_record record
@ -255,9 +255,9 @@ let rec uncompile_type_expression : O.type_expression -> I.type_expression resul
let record = I.LMap.to_kv_list record in
let%bind record =
bind_map_list (fun (k,v) ->
let {field_type;field_annotation;decl_position} : O.field_content = v in
let {field_type;field_annotation;field_decl_pos} : O.field_content = v in
let%bind field_type = uncompile_type_expression field_type in
let v' : I.field_content = {field_type ; michelson_annotation=field_annotation ; decl_position} in
let v' : I.field_content = {field_type ; michelson_annotation=field_annotation ; field_decl_pos} in
ok @@ (k,v')
) record
in

View File

@ -142,9 +142,9 @@ and evaluate_type (e:environment) (t:I.type_expression) : O.type_expression resu
| T_record m ->
let aux k v prev =
let%bind prev' = prev in
let {field_type ; field_annotation ; decl_position} : I.field_content = v in
let {field_type ; field_annotation ; field_decl_pos} : I.field_content = v in
let%bind field_type = evaluate_type e field_type in
ok @@ O.LMap.add (convert_label k) ({field_type ; michelson_annotation=field_annotation ; decl_position}:O.field_content) prev'
ok @@ O.LMap.add (convert_label k) ({field_type ; michelson_annotation=field_annotation ; field_decl_pos}:O.field_content) prev'
in
let%bind m = I.LMap.fold aux m (ok O.LMap.empty) in
return (T_record m)
@ -303,7 +303,7 @@ and type_expression : environment -> O.typer_state -> ?tv_opt:O.type_expression
ok (O.LMap.add (convert_label k) expr' acc , state')
in
let%bind (m' , state') = Stage_common.Helpers.bind_fold_lmap aux (ok (O.LMap.empty , state)) m in
let wrapped = Wrap.record (O.LMap.map (fun e -> ({field_type = get_type_expression e ; michelson_annotation = None ; decl_position = 0}: O.field_content)) m') in
let wrapped = Wrap.record (O.LMap.map (fun e -> ({field_type = get_type_expression e ; michelson_annotation = None ; field_decl_pos = 0}: O.field_content)) m') in
return_wrapped (E_record m') state' wrapped
| E_record_update {record; path; update} ->
let%bind (record, state) = type_expression e state record in

View File

@ -160,10 +160,10 @@ let rec untype_type_expression (t:O.type_expression) : (I.type_expression) resul
let%bind x' = O.CMap.fold aux x (ok I.CMap.empty) in
ok @@ I.T_sum x'
| O.T_record x ->
let aux k ({field_type ; michelson_annotation ; decl_position} : O.field_content) acc =
let aux k ({field_type ; michelson_annotation ; field_decl_pos} : O.field_content) acc =
let%bind acc = acc in
let%bind field_type = untype_type_expression field_type in
let v' = ({field_type ; field_annotation=michelson_annotation ; decl_position} : I.field_content) in
let v' = ({field_type ; field_annotation=michelson_annotation ; field_decl_pos} : I.field_content) in
ok @@ I.LMap.add (unconvert_label k) v' acc in
let%bind x' = O.LMap.fold aux x (ok I.LMap.empty) in
ok @@ I.T_record x'

View File

@ -620,10 +620,10 @@ and evaluate_type (e:environment) (t:I.type_expression) : O.type_expression resu
let%bind m = I.CMap.fold aux m (ok O.CMap.empty) in
return (T_sum m)
| T_record m ->
let aux k ({field_type;field_annotation;decl_position}: I.field_content) prev =
let aux k ({field_type;field_annotation;field_decl_pos}: I.field_content) prev =
let%bind prev' = prev in
let%bind field_type = evaluate_type e field_type in
let v' = ({field_type;michelson_annotation=field_annotation;decl_position} : O.field_content) in
let v' = ({field_type;michelson_annotation=field_annotation;field_decl_pos} : O.field_content) in
ok @@ O.LMap.add (convert_label k) v' prev'
in
let%bind m = I.LMap.fold aux m (ok O.LMap.empty) in
@ -790,7 +790,7 @@ and type_expression' : environment -> ?tv_opt:O.type_expression -> I.expression
(* let () = match tv_opt with
Some _ -> Format.printf "YES"
| None -> Format.printf "NO" in *)
let lmap = O.LMap.map (fun e -> ({field_type = get_type_expression e; michelson_annotation = None; decl_position=0}:O.field_content)) m' in
let lmap = O.LMap.map (fun e -> ({field_type = get_type_expression e; michelson_annotation = None; field_decl_pos=0}:O.field_content)) m' in
return (E_record m') (t_record lmap ())
| E_record_update {record; path; update} ->
let path = convert_label path in

View File

@ -2,7 +2,7 @@ open Ast_typed
open Trace
let to_sorted_kv_list lmap =
List.sort (fun (_,{decl_position=a;_}) (_,{decl_position=b;}) -> Int.compare a b) @@
List.sort (fun (_,{field_decl_pos=a;_}) (_,{field_decl_pos=b;}) -> Int.compare a b) @@
LMap.to_kv_list lmap
let accessor (record:expression) (path:label) (t:type_expression) =

View File

@ -141,7 +141,7 @@ module Typer = struct
let%bind () = Assert.assert_true_err
(simple_error "converted record must have at least two elements")
(List.length kvl >=2) in
let all_undefined = List.for_all (fun (_,{decl_position;_}) -> decl_position = 0) kvl in
let all_undefined = List.for_all (fun (_,{field_decl_pos;_}) -> field_decl_pos = 0) kvl in
let%bind () = Assert.assert_true_err
(simple_error "can't retrieve declaration order in the converted record, you need to annotate it")
(not all_undefined) in
@ -155,7 +155,7 @@ module Typer = struct
type_content = t ;
type_meta = None ;
location = Location.generated ; } in
{field_type ; michelson_annotation = Some "" ; decl_position = 0}
{field_type ; michelson_annotation = Some "" ; field_decl_pos = 0}
let rec to_right_comb_t l new_map =
match l with
@ -184,11 +184,11 @@ module Typer = struct
let to_left_comb_t = to_left_comb_t' true
let convert_type_to_right_comb l =
let l' = List.sort (fun (_,{decl_position=a;_}) (_,{decl_position=b;_}) -> Int.compare a b) l in
let l' = List.sort (fun (_,{field_decl_pos=a;_}) (_,{field_decl_pos=b;_}) -> Int.compare a b) l in
T_record (to_right_comb_t l' LMap.empty)
let convert_type_to_left_comb l =
let l' = List.sort (fun (_,{decl_position=a;_}) (_,{decl_position=b;_}) -> Int.compare a b) l in
let l' = List.sort (fun (_,{field_decl_pos=a;_}) (_,{field_decl_pos=b;_}) -> Int.compare a b) l in
T_record (to_left_comb_t l' LMap.empty)
let rec from_right_comb (l:field_content label_map) (size:int) : (field_content list) result =
@ -214,14 +214,14 @@ module Typer = struct
let convert_from_right_comb (src: field_content label_map) (dst: field_content label_map) : type_content result =
let%bind fields = from_right_comb src (LMap.cardinal dst) in
let labels = List.map (fun (l,_) -> l) @@
List.sort (fun (_,{decl_position=a;_}) (_,{decl_position=b;_}) -> Int.compare a b ) @@
List.sort (fun (_,{field_decl_pos=a;_}) (_,{field_decl_pos=b;_}) -> Int.compare a b ) @@
LMap.to_kv_list dst in
ok @@ (T_record (LMap.of_list @@ List.combine labels fields))
let convert_from_left_comb (src: field_content label_map) (dst: field_content label_map) : type_content result =
let%bind fields = from_left_comb src (LMap.cardinal dst) in
let labels = List.map (fun (l,_) -> l) @@
List.sort (fun (_,{decl_position=a;_}) (_,{decl_position=b;_}) -> Int.compare a b ) @@
List.sort (fun (_,{field_decl_pos=a;_}) (_,{field_decl_pos=b;_}) -> Int.compare a b ) @@
LMap.to_kv_list dst in
ok @@ (T_record (LMap.of_list @@ List.combine labels fields))

View File

@ -38,7 +38,7 @@ let t_option ?loc o : type_expression = make_t ?loc @@ T_operator (TC_opti
let t_list ?loc t : type_expression = make_t ?loc @@ T_operator (TC_list t)
let t_variable ?loc n : type_expression = make_t ?loc @@ T_variable (Var.of_name n)
let t_record_ez ?loc lst =
let lst = List.mapi (fun i (k, v) -> (Label k, {field_type=v;decl_position=i})) lst in
let lst = List.mapi (fun i (k, v) -> (Label k, {field_type=v;field_decl_pos=i})) lst in
let m = LMap.of_list lst in
make_t ?loc @@ T_record m
let t_record ?loc m : type_expression =

View File

@ -15,7 +15,7 @@ type type_content =
and arrow = {type1: type_expression; type2: type_expression}
and field_content = {field_type :type_expression ; decl_position : int}
and field_content = {field_type :type_expression ; field_decl_pos : int}
and michelson_prct_annotation = string

View File

@ -52,8 +52,8 @@ let t_record ?loc m : type_expression =
t_record_ez ?loc lst
let t_pair ?loc (a , b) : type_expression = t_record_ez ?loc [
("0",{field_type=a ; michelson_annotation=None ; decl_position=0}) ;
("1",{field_type=b ; michelson_annotation=None ; decl_position=0})]
("0",{field_type=a ; michelson_annotation=None ; field_decl_pos=0}) ;
("1",{field_type=b ; michelson_annotation=None ; field_decl_pos=0})]
let t_tuple ?loc lst : type_expression = t_record_ez ?loc (tuple_to_record lst)
let ez_t_sum ?loc (lst:((string * ctor_content) list)) : type_expression =

View File

@ -21,7 +21,7 @@ and arrow = {type1: type_expression; type2: type_expression}
and ctor_content = {ctor_type : type_expression ; michelson_annotation : string option}
and field_content = {field_type : type_expression ; michelson_annotation : string option ; decl_position : int}
and field_content = {field_type : type_expression ; michelson_annotation : string option ; field_decl_pos : int}
and type_operator =
| TC_contract of type_expression

View File

@ -54,7 +54,7 @@ let t_contract t ?loc ?s () : type_expression = make_t ?loc (T_operator (TC_cont
let t_record m ?loc ?s () : type_expression = make_t ?loc (T_record m) s
let make_t_ez_record ?loc (lst:(string * type_expression) list) : type_expression =
let lst = List.mapi (fun i (x,y) -> (Label x, {field_type=y;michelson_annotation=None;decl_position=i}) ) lst in
let lst = List.mapi (fun i (x,y) -> (Label x, {field_type=y;michelson_annotation=None;field_decl_pos=i}) ) lst in
let map = LMap.of_list lst in
make_t ?loc (T_record map) None
let ez_t_record lst ?loc ?s () : type_expression =
@ -62,8 +62,8 @@ let ez_t_record lst ?loc ?s () : type_expression =
t_record m ?loc ?s ()
let t_pair a b ?loc ?s () : type_expression =
ez_t_record [
(Label "0",{field_type=a;michelson_annotation=None ; decl_position = 0}) ;
(Label "1",{field_type=b;michelson_annotation=None ; decl_position = 0}) ] ?loc ?s ()
(Label "0",{field_type=a;michelson_annotation=None ; field_decl_pos = 0}) ;
(Label "1",{field_type=b;michelson_annotation=None ; field_decl_pos = 0}) ] ?loc ?s ()
let t_map ?loc k v ?s () = make_t ?loc (T_operator (TC_map { k ; v })) s
let t_big_map ?loc k v ?s () = make_t ?loc (T_operator (TC_big_map { k ; v })) s
@ -187,7 +187,7 @@ let get_t_function_full (t:type_expression) : (type_expression * type_expression
| _ -> ([],t)
in
let (input,output) = aux 0 t in
let input = List.map (fun (l,t) -> (l,{field_type = t ; michelson_annotation = None ; decl_position = 0})) input in
let input = List.map (fun (l,t) -> (l,{field_type = t ; michelson_annotation = None ; field_decl_pos = 0})) input in
ok @@ (t_record (LMap.of_list input) (),output)
let get_t_sum (t:type_expression) : ctor_content constructor_map result = match t.type_content with
@ -332,11 +332,11 @@ let e_a_record r = make_e (e_record r) (t_record
(LMap.map
(fun t ->
let field_type = get_type_expression t in
{field_type ; michelson_annotation=None ; decl_position = 0} )
{field_type ; michelson_annotation=None ; field_decl_pos = 0} )
r ) () )
let e_a_application a b = make_e (e_application a b) (get_type_expression b)
let e_a_variable v ty = make_e (e_variable v) ty
let ez_e_a_record r = make_e (ez_e_record r) (ez_t_record (List.mapi (fun i (x, y) -> x, {field_type = y.type_expression ; michelson_annotation = None ; decl_position = i}) r) ())
let ez_e_a_record r = make_e (ez_e_record r) (ez_t_record (List.mapi (fun i (x, y) -> x, {field_type = y.type_expression ; michelson_annotation = None ; field_decl_pos = i}) r) ())
let e_a_let_in binder expr body attributes = make_e (e_let_in binder expr body attributes) (get_type_expression body)

View File

@ -45,7 +45,7 @@ and ctor_content = {
and field_content = {
field_type : type_expression;
michelson_annotation : annot_option;
decl_position : int;
field_decl_pos : int;
}
and type_map_args = {

View File

@ -49,7 +49,7 @@ module Ast_generic_type (PARAMETER : AST_PARAMETER_TYPE) = struct
and ctor_content = {ctor_type : type_expression ; michelson_annotation : string option}
and field_content = {field_type : type_expression ; field_annotation : string option ; decl_position : int}
and field_content = {field_type : type_expression ; field_annotation : string option ; field_decl_pos : int}
and type_operator =
| TC_contract of type_expression