Commit ff284cc0 authored by Alain Mebsout's avatar Alain Mebsout Committed by Benjamin Canou

Michelson: field annotations on PAIR macros

parent b51dae6d
parameter unit;
storage unit;
code { UNIT; UNIT; UNIT; UNIT; UNIT; PAPAPAPAIR @name; DROP;
CDR; NIL operation; PAIR}
code { UNIT; UNIT; UNIT; UNIT; UNIT;
PAPAPAPAIR @name %1 %2 %3 %4 %5;
CDDDAR %4 @fourth;
DROP; CDR; NIL operation; PAIR}
......@@ -2,7 +2,7 @@ parameter unit;
storage unit;
code { UNIT @4; UNIT @3; UNIT @2; UNIT @1;
PAIR; UNPAIR @x1 @x2;
PPAIPAIR; UNPPAIPAIR @uno @due @tres @quatro;
PAPAPAIR; UNPAPAPAIR @un @deux @trois @quatre;
PAPPAIIR; UNPAPPAIIR @one @two @three @four;
PPAIPAIR @p1 %x1 %x2 %x3 %x4; UNPPAIPAIR @uno @due @tre @quattro;
PAPAPAIR @p2 %x1 %x2 %x3 %x4; UNPAPAPAIR @un @deux @trois @quatre;
PAPPAIIR @p3 %x1 %x2 %x3 %x4; UNPAPPAIIR @one @two @three @four;
DROP; DROP; DROP; DROP; CAR; NIL operation; PAIR }
\ No newline at end of file
......@@ -59,6 +59,14 @@ let extract_first_field_annot annot =
in
extract_first_field_annot [] annot
let extract_field_annots annot =
List.partition (fun a ->
match a.[0] with
| '%' -> true
| _ -> false
| exception Invalid_argument _ -> false
) annot
let expand_set_caddadr original =
match original with
| Prim (loc, str, args, annot) ->
......@@ -316,6 +324,25 @@ let unparse_pair_item ast =
| I -> "I" :: acc in
List.rev ("R" :: unparse ast []) |> String.concat ""
let pappaiir_annots_pos ast annot =
let rec find_annots_pos p_pos ast annots acc =
match ast, annots with
| _, [] -> annots, acc
| P (i, left, right), _ ->
let annots, acc = find_annots_pos i left annots acc in
find_annots_pos i right annots acc
| A, a :: annots ->
let pos = match IntMap.find_opt p_pos acc with
| None -> [ a ], []
| Some (_, cdr) -> [ a ], cdr in
annots, IntMap.add p_pos pos acc
| I, a :: annots ->
let pos = match IntMap.find_opt p_pos acc with
| None -> [], [ a ]
| Some (car, _) -> car, [ a ] in
annots, IntMap.add p_pos pos acc in
snd (find_annots_pos 0 ast annot IntMap.empty)
let expand_pappaiir original =
match original with
| Prim (loc, str, args, annot) ->
......@@ -326,17 +353,28 @@ let expand_pappaiir original =
&& check_letters str 1 (len - 2)
(function 'P' | 'A' | 'I' -> true | _ -> false) then
try
let field_annots, annot = extract_field_annots annot in
let ast = parse_pair_substr str ~len 0 in
let field_annots_pos = pappaiir_annots_pos ast field_annots in
let rec parse p (depth, acc) =
match p with
| P (i, left, right) ->
let annot = if i = 0 then annot else [] in
let annot =
match i, IntMap.find_opt i field_annots_pos with
| 0, None -> annot
| _, None -> []
(* XXX Hackish, cannot annotate cdr only with PAIR *)
| 0, Some ([], cdr_annot) -> "%" :: cdr_annot @ annot
| _, Some ([], cdr_annot) -> "%" :: cdr_annot
| 0, Some (car_annot, cdr_annot) -> car_annot @ cdr_annot @ annot
| _, Some (car_annot, cdr_annot) -> car_annot @ cdr_annot
in
let acc = dip ~loc depth (Prim (loc, "PAIR", [], annot)) :: acc in
(depth, acc)
|> parse left
|> parse right
| A | I -> (depth + 1, acc)
in
let ast = parse_pair_substr str ~len 0 in
let _, expanded = parse ast (0, []) in
begin match args with
| [] -> ok ()
......@@ -363,24 +401,8 @@ let expand_unpappaiir original =
Prim (loc, "CAR", [], car_annot) ;
dip ~loc 1 (Prim (loc, "CDR", [], cdr_annot)) ;
]) in
let rec find_annots_pos p_pos ast annots acc =
match ast, annots with
| _, [] -> annots, acc
| P (i, left, right), _ ->
let annots, acc = find_annots_pos i left annots acc in
find_annots_pos i right annots acc
| A, a :: annots ->
let pos = match IntMap.find_opt p_pos acc with
| None -> [ a ], []
| Some (_, cdr) -> [ a ], cdr in
annots, IntMap.add p_pos pos acc
| I, a :: annots ->
let pos = match IntMap.find_opt p_pos acc with
| None -> [], [ a ]
| Some (car, _) -> car, [ a ] in
annots, IntMap.add p_pos pos acc in
let ast = parse_pair_substr str ~len 2 in
let _, annots_pos = find_annots_pos 0 ast annot IntMap.empty in
let annots_pos = pappaiir_annots_pos ast annot in
let rec parse p (depth, acc) =
match p with
| P (i, left, right) ->
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment