replace field name 'decl_position' by 'field_decl_pos'
This commit is contained in:
parent
1f6bc4fc6b
commit
fb2f3e89e7
@ -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
|
||||
|
@ -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
|
||||
|
@ -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)
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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'
|
||||
|
@ -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
|
||||
|
@ -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) =
|
||||
|
@ -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))
|
||||
|
||||
|
@ -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 =
|
||||
|
@ -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
|
||||
|
||||
|
@ -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 =
|
||||
|
@ -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
|
||||
|
@ -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)
|
||||
|
||||
|
||||
|
@ -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 = {
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user