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

remove Map and BIG_Map

Browse Source
This commit is contained in:
Pierre-Emmanuel Wulfman 2020-03-19 16:55:13 +01:00
parent a39c900b72
commit 330c48e66a
32 changed files with 92 additions and 410 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
src/passes/10-interpreter/interpreter.ml
View File

@ -291,11 +291,6 @@ and eval : Ast_typed.expression -> env -> value result
let%bind rhs' = eval rhs env in
eval let_result (Env.extend env (let_binder,rhs'))
)
| E_map kvlist | E_big_map kvlist ->
let%bind kvlist' = bind_map_list
(fun kv -> bind_map_pair (fun (el:Ast_typed.expression) -> eval el env) kv)
kvlist in
ok @@ V_Map kvlist'
| E_literal l ->
eval_literal l
| E_variable var ->

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

@ -390,34 +390,6 @@ and transpile_annotated_expression (ae:AST.expression) : expression result =
transpile_lambda l io
| E_recursive r ->
transpile_recursive r
| E_map m -> (
let%bind (src, dst) =
trace_strong (corner_case ~loc:__LOC__ "not a map") @@
Mini_c.Combinators.get_t_map tv in
let aux : expression result -> (AST.expression * AST.expression) -> expression result = fun prev (k, v) ->
let%bind prev' = prev in
let%bind (k', v') =
let v' = e_a_some v ae.environment in
bind_map_pair (transpile_annotated_expression) (k , v') in
return @@ E_constant {cons_name=C_UPDATE;arguments=[k' ; v' ; prev']}
in
let init = return @@ E_make_empty_map (src, dst) in
List.fold_left aux init m
)
| E_big_map m -> (
let%bind (src, dst) =
trace_strong (corner_case ~loc:__LOC__ "not a map") @@
Mini_c.Combinators.get_t_big_map tv in
let aux : expression result -> (AST.expression * AST.expression) -> expression result = fun prev (k, v) ->
let%bind prev' = prev in
let%bind (k', v') =
let v' = e_a_some v ae.environment in
bind_map_pair (transpile_annotated_expression) (k , v') in
return @@ E_constant {cons_name=C_UPDATE;arguments=[k' ; v' ; prev']}
in
let init = return @@ E_make_empty_big_map (src, dst) in
List.fold_left aux init m
)
| E_matching {matchee=expr; cases=m} -> (
let%bind expr' = transpile_annotated_expression expr in
match m with

26
src/passes/10-transpiler/untranspiler.ml
View File

@ -151,28 +151,38 @@ let rec untranspile (v : value) (t : AST.type_expression) : AST.expression resul
ok (e_a_empty_some s')
)
| TC_map (k_ty,v_ty)-> (
let%bind lst =
let%bind map =
trace_strong (wrong_mini_c_value "map" v) @@
get_map v in
let%bind lst' =
let%bind map' =
let aux = fun (k, v) ->
let%bind k' = untranspile k k_ty in
let%bind v' = untranspile v v_ty in
ok (k', v') in
bind_map_list aux lst in
return (E_map lst')
bind_map_list aux map in
let aux = fun prev (k, v) ->
let (k', v') = (k , v ) in
return @@ E_constant {cons_name=C_MAP_ADD;arguments=[k' ; v' ; prev]}
in
let%bind init = return @@ E_constant {cons_name=C_MAP_EMPTY;arguments=[]} in
bind_fold_list aux init map'
)
| TC_big_map (k_ty, v_ty) -> (
let%bind lst =
let%bind map =
trace_strong (wrong_mini_c_value "big_map" v) @@
get_big_map v in
let%bind lst' =
let%bind map' =
let aux = fun (k, v) ->
let%bind k' = untranspile k k_ty in
let%bind v' = untranspile v v_ty in
ok (k', v') in
bind_map_list aux lst in
return (E_big_map lst')
bind_map_list aux map in
let map' = List.sort_uniq compare map' in
let aux = fun prev (k, v) ->
return @@ E_constant {cons_name=C_MAP_ADD;arguments=[k ; v ; prev]}
in
let%bind init = return @@ E_constant {cons_name=C_MAP_EMPTY;arguments=[]} in
bind_fold_list aux init map'
)
| TC_list ty -> (
let%bind lst =

5
src/passes/11-self_mini_c/helpers.ml
View File

@ -25,8 +25,6 @@ let rec fold_expression : 'a folder -> 'a -> expression -> 'a result = fun f ini
let%bind init' = f init e in
match e.content with
| E_variable _ | E_skip | E_make_none _
| E_make_empty_map _
| E_make_empty_big_map _
| E_literal _ -> ok init'
| E_constant (c) -> (
let%bind res = bind_fold_list self init' c.arguments in
@ -90,8 +88,7 @@ let rec map_expression : mapper -> expression -> expression result = fun f e ->
let return content = ok { e' with content } in
match e'.content with
| E_variable _ | E_literal _ | E_skip | E_make_none _
| E_make_empty_map _
| E_make_empty_big_map _ as em -> return em
as em -> return em
| E_constant (c) -> (
let%bind lst = bind_map_list self c.arguments in
return @@ E_constant {cons_name = c.cons_name; arguments = lst}

2
src/passes/11-self_mini_c/self_mini_c.ml
View File

@ -47,8 +47,6 @@ let rec is_pure : expression -> bool = fun e ->
| E_closure _
| E_skip
| E_variable _
| E_make_empty_map _
| E_make_empty_big_map _
| E_make_none _
-> true

5
src/passes/11-self_mini_c/subst.ml
View File

@ -40,8 +40,6 @@ let rec replace : expression -> var_name -> var_name -> expression =
| E_variable z ->
let z = replace_var z in
return @@ E_variable z
| E_make_empty_map _ -> e
| E_make_empty_big_map _ -> e
| E_make_none _ -> e
| E_iterator (name, ((v, tv), body), expr) ->
let body = replace body in
@ -173,8 +171,7 @@ let rec subst_expression : body:expression -> x:var_name -> expr:expression -> e
)
(* All that follows is boilerplate *)
| E_literal _ | E_skip | E_make_none _
| E_make_empty_map (_,_)
| E_make_empty_big_map _ as em -> return em
as em -> return em
| E_constant (c) -> (
let lst = List.map self c.arguments in
return @@ E_constant {cons_name = c.cons_name; arguments = lst }

16
src/passes/12-compiler/compiler_program.ml
View File

@ -76,6 +76,16 @@ let rec get_operator : constant' -> type_value -> expression list -> predicate r
let%bind m_ty = Compiler_type.type_ ty' in
ok @@ simple_constant @@ i_empty_set m_ty
)
| C_MAP_EMPTY -> (
let%bind sd = Mini_c.get_t_map ty in
let%bind (src, dst) = bind_map_pair Compiler_type.type_ sd in
ok @@ simple_constant @@ i_empty_map src dst
)
| C_BIG_MAP_EMPTY -> (
let%bind sd = Mini_c.get_t_big_map ty in
let%bind (src, dst) = bind_map_pair Compiler_type.type_ sd in
ok @@ simple_constant @@ i_empty_big_map src dst
)
| C_BYTES_UNPACK -> (
let%bind ty' = Mini_c.get_t_option ty in
let%bind m_ty = Compiler_type.type_ ty' in
@ -302,12 +312,6 @@ and translate_expression (expr:expression) (env:environment) : michelson result
error title content in
trace error @@
return code
| E_make_empty_map sd ->
let%bind (src, dst) = bind_map_pair Compiler_type.type_ sd in
return @@ i_empty_map src dst
| E_make_empty_big_map sd ->
let%bind (src, dst) = bind_map_pair Compiler_type.type_ sd in
return @@ i_empty_big_map src dst
| E_make_none o ->
let%bind o' = Compiler_type.type_ o in
return @@ i_none o'

38
src/passes/6-sugar_to_core/sugar_to_core.ml
View File

@ -108,18 +108,24 @@ let rec compile_expression : I.expression -> O.expression result =
let%bind record = compile_expression record in
let%bind update = compile_expression update in
return @@ O.E_record_update {record;path;update}
| I.E_map map ->
let%bind map = bind_map_list (
bind_map_pair compile_expression
) map
| I.E_map map -> (
let map = List.sort_uniq compare map in
let aux = fun prev (k, v) ->
let%bind (k', v') = bind_map_pair (compile_expression) (k, v) in
return @@ E_constant {cons_name=C_MAP_ADD;arguments=[k' ; v' ; prev]}
in
return @@ O.E_map map
| I.E_big_map big_map ->
let%bind big_map = bind_map_list (
bind_map_pair compile_expression
) big_map
let%bind init = return @@ E_constant {cons_name=C_MAP_EMPTY;arguments=[]} in
bind_fold_list aux init map
)
| I.E_big_map big_map -> (
let map = List.sort_uniq compare big_map in
let aux = fun prev (k, v) ->
let%bind (k', v') = bind_map_pair (compile_expression) (k, v) in
return @@ E_constant {cons_name=C_BIG_MAP_ADD;arguments=[k' ; v' ; prev]}
in
return @@ O.E_big_map big_map
let%bind init = return @@ E_constant {cons_name=C_BIG_MAP_EMPTY;arguments=[]} in
bind_fold_list aux init map
)
| I.E_list lst ->
let%bind lst' = bind_map_list (compile_expression) lst in
let aux = fun prev cur ->
@ -309,18 +315,6 @@ let rec uncompile_expression : O.expression -> I.expression result =
let%bind record = uncompile_expression record in
let%bind update = uncompile_expression update in
return @@ I.E_record_update {record;path;update}
| O.E_map map ->
let%bind map = bind_map_list (
bind_map_pair uncompile_expression
) map
in
return @@ I.E_map map
| O.E_big_map big_map ->
let%bind big_map = bind_map_list (
bind_map_pair uncompile_expression
) big_map
in
return @@ I.E_big_map big_map
| O.E_ascription {anno_expr; type_annotation} ->
let%bind anno_expr = uncompile_expression anno_expr in
let%bind type_annotation = uncompile_type_expression type_annotation in

130
src/passes/8-typer-new/typer.ml
View File

@ -163,7 +163,6 @@ end
open Errors
let swap (a,b) = ok (b,a)
(*
let rec type_program (p:I.program) : O.program result =
let aux (e, acc:(environment * O.declaration Location.wrap list)) (d:I.declaration Location.wrap) =
@ -503,129 +502,6 @@ and type_expression : environment -> Solver.state -> ?tv_opt:O.type_expression -
return_wrapped (E_record_update {record; path; update}) state (Wrap.record wrapped)
(* Data-structure *)
(*
| E_list lst ->
let%bind lst' = bind_map_list (type_expression e) lst in
let%bind tv =
let aux opt c =
match opt with
| None -> ok (Some c)
| Some c' ->
let%bind _eq = Ast_typed.assert_type_value_eq (c, c') in
ok (Some c') in
let%bind init = match tv_opt with
| None -> ok None
| Some ty ->
let%bind ty' = get_t_list ty in
ok (Some ty') in
let%bind ty =
let%bind opt = bind_fold_list aux init
@@ List.map get_type_annotation lst' in
trace_option (needs_annotation ae "empty list") opt in
ok (t_list ty ())
in
return (E_list lst') tv
| E_set lst ->
let%bind lst' = bind_map_list (type_expression e) lst in
let%bind tv =
let aux opt c =
match opt with
| None -> ok (Some c)
| Some c' ->
let%bind _eq = Ast_typed.assert_type_value_eq (c, c') in
ok (Some c') in
let%bind init = match tv_opt with
| None -> ok None
| Some ty ->
let%bind ty' = get_t_set ty in
ok (Some ty') in
let%bind ty =
let%bind opt = bind_fold_list aux init
@@ List.map get_type_annotation lst' in
trace_option (needs_annotation ae "empty set") opt in
ok (t_set ty ())
in
return (E_set lst') tv
| E_map lst ->
let%bind lst' = bind_map_list (bind_map_pair (type_expression e)) lst in
let%bind tv =
let aux opt c =
match opt with
| None -> ok (Some c)
| Some c' ->
let%bind _eq = Ast_typed.assert_type_value_eq (c, c') in
ok (Some c') in
let%bind key_type =
let%bind sub =
bind_fold_list aux None
@@ List.map get_type_annotation
@@ List.map fst lst' in
let%bind annot = bind_map_option get_t_map_key tv_opt in
trace (simple_info "empty map expression without a type annotation") @@
O.merge_annotation annot sub (needs_annotation ae "this map literal")
in
let%bind value_type =
let%bind sub =
bind_fold_list aux None
@@ List.map get_type_annotation
@@ List.map snd lst' in
let%bind annot = bind_map_option get_t_map_value tv_opt in
trace (simple_info "empty map expression without a type annotation") @@
O.merge_annotation annot sub (needs_annotation ae "this map literal")
in
ok (t_map key_type value_type ())
in
return (E_map lst') tv
*)
| E_map map ->
let aux' state' elt = type_expression e state' elt >>? swap in
let aux = fun state' elt -> bind_fold_map_pair aux' state' elt in
let%bind (state', map') =
bind_fold_map_list aux state map in
let aux (x, y) = O.(x.type_expression , y.type_expression) in
let wrapped = Wrap.map (List.map aux map') in
return_wrapped (E_map map') state' wrapped
(* | E_big_map lst ->
* let%bind lst' = bind_map_list (bind_map_pair (type_expression e)) lst in
* let%bind tv =
* let aux opt c =
* match opt with
* | None -> ok (Some c)
* | Some c' ->
* let%bind _eq = Ast_typed.assert_type_value_eq (c, c') in
* ok (Some c') in
* let%bind key_type =
* let%bind sub =
* bind_fold_list aux None
* @@ List.map get_type_annotation
* @@ List.map fst lst' in
* let%bind annot = bind_map_option get_t_big_map_key tv_opt in
* trace (simple_info "empty map expression without a type annotation") @@
* O.merge_annotation annot sub (needs_annotation ae "this map literal")
* in
* let%bind value_type =
* let%bind sub =
* bind_fold_list aux None
* @@ List.map get_type_annotation
* @@ List.map snd lst' in
* let%bind annot = bind_map_option get_t_big_map_value tv_opt in
* trace (simple_info "empty map expression without a type annotation") @@
* O.merge_annotation annot sub (needs_annotation ae "this map literal")
* in
* ok (t_big_map key_type value_type ())
* in
* return (E_big_map lst') tv *)
| E_big_map big_map ->
let aux' state' elt = type_expression e state' elt >>? swap in
let aux = fun state' elt -> bind_fold_map_pair aux' state' elt in
let%bind (state', big_map') =
bind_fold_map_list aux state big_map in
let aux (x, y) = O.(x.type_expression , y.type_expression) in
let wrapped = Wrap.big_map (List.map aux big_map') in
return_wrapped (E_big_map big_map') state' wrapped
(* | E_lambda {
* binder ;
* input_type ;
@ -1042,12 +918,6 @@ let rec untype_expression (e:O.expression) : (I.expression) result =
let%bind e = untype_expression update in
let Label l = path in
return (e_update r' l e)
| E_map m ->
let%bind m' = bind_map_list (bind_map_pair untype_expression) m in
return (e_map m')
| E_big_map m ->
let%bind m' = bind_map_list (bind_map_pair untype_expression) m in
return (e_big_map m')
| E_matching {matchee;cases} ->
let%bind ae' = untype_expression matchee in
let%bind m' = untype_matching untype_expression cases in

94
src/passes/8-typer-old/typer.ml
View File

@ -511,66 +511,6 @@ and type_expression' : environment -> ?tv_opt:O.type_expression -> I.expression
let%bind () = O.assert_type_expression_eq (tv, get_type_expression update) in
return (E_record_update {record; path; update}) wrapped
(* Data-structure *)
| E_map lst ->
let%bind lst' = bind_map_list (bind_map_pair (type_expression' e)) lst in
let%bind tv =
let aux opt c =
match opt with
| None -> ok (Some c)
| Some c' ->
let%bind _eq = Ast_typed.assert_type_expression_eq (c, c') in
ok (Some c') in
let%bind key_type =
let%bind sub =
bind_fold_list aux None
@@ List.map get_type_expression
@@ List.map fst lst' in
let%bind annot = bind_map_option get_t_map_key tv_opt in
trace (simple_info "empty map expression without a type annotation") @@
O.merge_annotation annot sub (needs_annotation ae "this map literal")
in
let%bind value_type =
let%bind sub =
bind_fold_list aux None
@@ List.map get_type_expression
@@ List.map snd lst' in
let%bind annot = bind_map_option get_t_map_value tv_opt in
trace (simple_info "empty map expression without a type annotation") @@
O.merge_annotation annot sub (needs_annotation ae "this map literal")
in
ok (t_map key_type value_type ())
in
return (E_map lst') tv
| E_big_map lst ->
let%bind lst' = bind_map_list (bind_map_pair (type_expression' e)) lst in
let%bind tv =
let aux opt c =
match opt with
| None -> ok (Some c)
| Some c' ->
let%bind _eq = Ast_typed.assert_type_expression_eq (c, c') in
ok (Some c') in
let%bind key_type =
let%bind sub =
bind_fold_list aux None
@@ List.map get_type_expression
@@ List.map fst lst' in
let%bind annot = bind_map_option get_t_big_map_key tv_opt in
trace (simple_info "empty map expression without a type annotation") @@
O.merge_annotation annot sub (needs_annotation ae "this map literal")
in
let%bind value_type =
let%bind sub =
bind_fold_list aux None
@@ List.map get_type_expression
@@ List.map snd lst' in
let%bind annot = bind_map_option get_t_big_map_value tv_opt in
trace (simple_info "empty map expression without a type annotation") @@
O.merge_annotation annot sub (needs_annotation ae "this map literal")
in
ok (t_big_map key_type value_type ())
in
return (E_big_map lst') tv
| E_lambda lambda ->
let%bind (lambda, lambda_type) = type_lambda e lambda in
return (E_lambda lambda ) lambda_type
@ -655,6 +595,34 @@ and type_expression' : environment -> ?tv_opt:O.type_expression -> I.expression
let tv_lst = [tv_key;tv_set] in
let%bind (name', tv) = type_constant cst tv_lst tv_opt in
return (E_constant {cons_name=name';arguments=[key';set']}) tv
| E_constant {cons_name=C_MAP_ADD as cst; arguments=[key;value;map]} ->
let%bind key' = type_expression' e key in
let%bind val' = type_expression' e value in
let tv_key = get_type_expression key' in
let tv_val = get_type_expression val' in
let tv = match tv_opt with
Some (tv) -> tv
| None -> t_map tv_key tv_val ()
in
let%bind map' = type_expression' e ~tv_opt:tv map in
let tv_map = get_type_expression map' in
let tv_lst = [tv_key;tv_val;tv_map] in
let%bind (name', tv) = type_constant cst tv_lst tv_opt in
return (E_constant {cons_name=name';arguments=[key';val';map']}) tv
| E_constant {cons_name=C_BIG_MAP_ADD as cst; arguments=[key;value;map]} ->
let%bind key' = type_expression' e key in
let%bind val' = type_expression' e value in
let tv_key = get_type_expression key' in
let tv_val = get_type_expression val' in
let tv = match tv_opt with
Some (tv) -> tv
| None -> t_big_map tv_key tv_val ()
in
let%bind map' = type_expression' e ~tv_opt:tv map in
let tv_map = get_type_expression map' in
let tv_lst = [tv_key;tv_val;tv_map] in
let%bind (name', tv) = type_constant cst tv_lst tv_opt in
return (E_constant {cons_name=name';arguments=[key';val';map']}) tv
| E_constant {cons_name;arguments} ->
let%bind lst' = bind_list @@ List.map (type_expression' e) arguments in
let tv_lst = List.map get_type_expression lst' in
@ -838,12 +806,6 @@ let rec untype_expression (e:O.expression) : (I.expression) result =
let%bind e = untype_expression e in
let Label l = l in
return (e_update r' l e)
| E_map m ->
let%bind m' = bind_map_list (bind_map_pair untype_expression) m in
return (e_map m')
| E_big_map m ->
let%bind m' = bind_map_list (bind_map_pair untype_expression) m in
return (e_big_map m')
| E_matching {matchee;cases} ->
let%bind ae' = untype_expression matchee in
let%bind m' = untype_matching untype_expression cases in

20
src/passes/9-self_ast_typed/helpers.ml
View File

@ -12,10 +12,6 @@ let rec fold_expression : 'a folder -> 'a -> expression -> 'a result = fun f ini
let%bind res = bind_fold_list self init' lst in
ok res
)
| E_map lst | E_big_map lst -> (
let%bind res = bind_fold_list (bind_fold_pair self) init' lst in
ok res
)
| E_application {lamb; args} -> (
let ab = (lamb, args) in
let%bind res = bind_fold_pair self init' ab in
@ -90,14 +86,6 @@ let rec map_expression : mapper -> expression -> expression result = fun f e ->
let%bind e' = f e in
let return expression_content = ok { e' with expression_content } in
match e'.expression_content with
| E_map lst -> (
let%bind lst' = bind_map_list (bind_map_pair self) lst in
return @@ E_map lst'
)
| E_big_map lst -> (
let%bind lst' = bind_map_list (bind_map_pair self) lst in
return @@ E_big_map lst'
)
| E_matching {matchee=e;cases} -> (
let%bind e' = self e in
let%bind cases' = map_cases f cases in
@ -193,14 +181,6 @@ let rec fold_map_expression : 'a fold_mapper -> 'a -> expression -> ('a * expres
else
let return expression_content = { e' with expression_content } in
match e'.expression_content with
| E_map lst -> (
let%bind (res, lst') = bind_fold_map_list (bind_fold_map_pair self) init' lst in
ok (res, return @@ E_map lst')
)
| E_big_map lst -> (
let%bind (res, lst') = bind_fold_map_list (bind_fold_map_pair self) init' lst in
ok (res, return @@ E_big_map lst')
)
| E_matching {matchee=e;cases} -> (
let%bind (res, e') = self init' e in
let%bind (res,cases') = fold_map_cases f res cases in

8
src/passes/9-self_ast_typed/tail_recursion.ml
View File

@ -56,14 +56,6 @@ let rec check_recursive_call : expression_variable -> bool -> expression -> unit
let%bind _ = check_recursive_call n false record in
let%bind _ = check_recursive_call n false update in
ok ()
| E_map eel | E_big_map eel->
let aux (e1,e2) =
let%bind _ = check_recursive_call n false e1 in
let%bind _ = check_recursive_call n false e2 in
ok ()
in
let%bind _ = bind_map_list aux eel in
ok ()
and check_recursive_call_in_matching = fun n final_path c ->
match c with

6
src/passes/operators/operators.ml
View File

@ -621,6 +621,11 @@ module Typer = struct
let%bind () = assert_type_expression_eq (src , k) in
ok m
let map_empty = typer_0 "MAP_EMPTY" @@ fun tv_opt ->
match tv_opt with
| None -> simple_fail "untyped MAP_EMPTY"
| Some t -> ok t
let map_add : typer = typer_3 "MAP_ADD" @@ fun k v m ->
let%bind (src, dst) = bind_map_or (get_t_map , get_t_big_map) m in
let%bind () = assert_type_expression_eq (src, k) in
@ -1165,6 +1170,7 @@ module Typer = struct
| C_LIST_MAP -> ok @@ list_map ;
| C_LIST_FOLD -> ok @@ list_fold ;
(* MAP *)
| C_MAP_EMPTY -> ok @@ map_empty ;
| C_MAP_ADD -> ok @@ map_add ;
| C_MAP_REMOVE -> ok @@ map_remove ;
| C_MAP_UPDATE -> ok @@ map_update ;

4
src/stages/3-ast_core/PP.ml
View File

@ -31,10 +31,6 @@ and expression_content ppf (ec : expression_content) =
fprintf ppf "%a.%a" expression ra.record label ra.label
| E_record_update {record; path; update} ->
fprintf ppf "{ %a with { %a = %a } }" expression record label path expression update
| E_map m ->
fprintf ppf "map[%a]" (list_sep_d assoc_expression) m
| E_big_map m ->
fprintf ppf "big_map[%a]" (list_sep_d assoc_expression) m
| E_lambda {binder; input_type; output_type; result} ->
fprintf ppf "lambda (%a:%a) : %a return %a"
expression_variable binder

18
src/stages/3-ast_core/combinators.ml
View File

@ -107,12 +107,10 @@ let e_bytes_raw ?loc (b: bytes) : expression =
make_expr ?loc @@ E_literal (Literal_bytes b)
let e_bytes_string ?loc (s: string) : expression =
make_expr ?loc @@ E_literal (Literal_bytes (Hex.to_bytes (Hex.of_string s)))
let e_big_map ?loc lst : expression = make_expr ?loc @@ E_big_map lst
let e_some ?loc s : expression = make_expr ?loc @@ E_constant {cons_name = C_SOME; arguments = [s]}
let e_none ?loc () : expression = make_expr ?loc @@ E_constant {cons_name = C_NONE; arguments = []}
let e_string_cat ?loc sl sr : expression = make_expr ?loc @@ E_constant {cons_name = C_CONCAT; arguments = [sl ; sr ]}
let e_map_add ?loc k v old : expression = make_expr ?loc @@ E_constant {cons_name = C_MAP_ADD; arguments = [k ; v ; old]}
let e_map ?loc lst : expression = make_expr ?loc @@ E_map lst
let e_constructor ?loc s a : expression = make_expr ?loc @@ E_constructor { constructor = Constructor s; element = a}
let e_matching ?loc a b : expression = make_expr ?loc @@ E_matching {matchee=a;cases=b}
let e_matching_bool ?loc a b c : expression = e_matching ?loc a (Match_bool {match_true = b ; match_false = c})
@ -158,10 +156,6 @@ let e_typed_none ?loc t_opt =
let type_annotation = t_option t_opt in
e_annotation ?loc (e_none ?loc ()) type_annotation
let e_typed_map ?loc lst k v = e_annotation ?loc (e_map lst) (t_map k v)
let e_typed_big_map ?loc lst k v = e_annotation ?loc (e_big_map lst) (t_big_map k v)
let e_lambda ?loc (binder : expression_variable)
(input_type : type_expression option)
(output_type : type_expression option)
@ -255,6 +249,12 @@ let extract_record : expression -> (label * expression) list result = fun e ->
| _ -> fail @@ bad_kind "record" e.location
let extract_map : expression -> (expression * expression) list result = fun e ->
match e.expression_content with
| E_map lst -> ok lst
| _ -> fail @@ bad_kind "map" e.location
let rec aux e =
match e.expression_content with
E_constant {cons_name=C_UPDATE; arguments=[k;v;map]} ->
let%bind map = aux map in
ok @@ (k,v)::map
| E_constant {cons_name=C_MAP_EMPTY; arguments=[]} -> ok @@ []
| _ -> fail @@ bad_kind "map" e.location
in
aux e

5
src/stages/3-ast_core/combinators.mli
View File

@ -65,7 +65,6 @@ val e'_bytes : string -> expression_content result
val e_bytes_hex : ?loc:Location.t -> string -> expression result
val e_bytes_raw : ?loc:Location.t -> bytes -> expression
val e_bytes_string : ?loc:Location.t -> string -> expression
val e_big_map : ?loc:Location.t -> ( expr * expr ) list -> expression
val e_record_ez : ?loc:Location.t -> ( string * expr ) list -> expression
val e_tuple : ?loc:Location.t -> expression list -> expression
@ -73,7 +72,6 @@ val e_some : ?loc:Location.t -> expression -> expression
val e_none : ?loc:Location.t -> unit -> expression
val e_string_cat : ?loc:Location.t -> expression -> expression -> expression
val e_map_add : ?loc:Location.t -> expression -> expression -> expression -> expression
val e_map : ?loc:Location.t -> ( expression * expression ) list -> expression
val e_pair : ?loc:Location.t -> expression -> expression -> expression
val e_constructor : ?loc:Location.t -> string -> expression -> expression
val e_matching : ?loc:Location.t -> expression -> matching_expr -> expression
@ -94,9 +92,6 @@ val make_option_typed : ?loc:Location.t -> expression -> type_expression option
val e_typed_none : ?loc:Location.t -> type_expression -> expression
val e_typed_map : ?loc:Location.t -> ( expression * expression ) list -> type_expression -> type_expression -> expression
val e_typed_big_map : ?loc:Location.t -> ( expression * expression ) list -> type_expression -> type_expression -> expression
val e_lambda : ?loc:Location.t -> expression_variable -> type_expression option -> type_expression option -> expression -> expression
val e_recursive : ?loc:Location.t -> expression_variable -> type_expression -> lambda -> expression
val e_record : ?loc:Location.t -> expr Map.String.t -> expression

30
src/stages/3-ast_core/misc.ml
View File

@ -88,19 +88,6 @@ let rec assert_value_eq (a, b: (expression * expression )) : unit result =
assert_literal_eq (a, b)
| E_literal _ , _ ->
simple_fail "comparing a literal with not a literal"
| E_constant {cons_name=C_SET_LITERAL;arguments=lsta},
E_constant {cons_name=C_SET_LITERAL;arguments=lstb} -> (
let lsta' = List.sort (compare) lsta in
let lstb' = List.sort (compare) lstb in
let%bind lst =
generic_try (simple_error "set of different lengths")
(fun () -> List.combine lsta' lstb') in
let%bind _all = bind_map_list assert_value_eq lst in
ok ()
)
| E_constant {cons_name=C_SET_LITERAL;_}, _ ->
simple_fail "comparing set with other expression"
| E_constant (ca) , E_constant (cb) when ca.cons_name = cb.cons_name -> (
let%bind lst =
generic_try (simple_error "constants with different number of elements")
@ -152,23 +139,6 @@ let rec assert_value_eq (a, b: (expression * expression )) : unit result =
ok ()
| E_record_update _, _ ->
simple_fail "comparing record update with other expression"
| (E_map lsta, E_map lstb | E_big_map lsta, E_big_map lstb) -> (
let%bind lst = generic_try (simple_error "maps of different lengths")
(fun () ->
let lsta' = List.sort compare lsta in
let lstb' = List.sort compare lstb in
List.combine lsta' lstb') in
let aux = fun ((ka, va), (kb, vb)) ->
let%bind _ = assert_value_eq (ka, kb) in
let%bind _ = assert_value_eq (va, vb) in
ok () in
let%bind _all = bind_map_list aux lst in
ok ()
)
| (E_map _ | E_big_map _), _ ->
simple_fail "comparing map with other expression"
| (E_ascription a , _b') -> assert_value_eq (a.anno_expr , b)
| (_a' , E_ascription b) -> assert_value_eq (a , b.anno_expr)
| (E_variable _, _) | (E_lambda _, _)

4
src/stages/3-ast_core/types.ml
View File

@ -43,10 +43,6 @@ and expression_content =
| E_record of expression label_map
| E_record_accessor of accessor
| E_record_update of update
(* Data Structures *)
(* TODO : move to constant*)
| E_map of (expression * expression) list (*move to operator *)
| E_big_map of (expression * expression) list (*move to operator *)
(* Advanced *)
| E_ascription of ascription

4
src/stages/4-ast_typed/PP.ml
View File

@ -32,10 +32,6 @@ and expression_content ppf (ec: expression_content) =
fprintf ppf "%a.%a" expression ra.record label ra.label
| E_record_update {record; path; update} ->
fprintf ppf "{ %a with { %a = %a } }" expression record label path expression update
| E_map m ->
fprintf ppf "map[%a]" (list_sep_d assoc_expression) m
| E_big_map m ->
fprintf ppf "big_map[%a]" (list_sep_d assoc_expression) m
| E_lambda {binder; result} ->
fprintf ppf "lambda (%a) return %a" expression_variable binder
expression result

3
src/stages/4-ast_typed/combinators.ml
View File

@ -276,8 +276,6 @@ let ez_e_record (lst : (label * expression) list) : expression_content =
let e_some s : expression_content = E_constant {cons_name=C_SOME;arguments=[s]}
let e_none (): expression_content = E_constant {cons_name=C_NONE; arguments=[]}
let e_map lst : expression_content = E_map lst
let e_unit () : expression_content = E_literal (Literal_unit)
let e_int n : expression_content = E_literal (Literal_int n)
let e_nat n : expression_content = E_literal (Literal_nat n)
@ -313,7 +311,6 @@ let e_a_record r = make_a_e (e_record r) (t_record (LMap.map get_type_expression
let e_a_application a b = make_a_e (e_application a b) (get_type_expression b)
let e_a_variable v ty = make_a_e (e_variable v) ty
let ez_e_a_record r = make_a_e (ez_e_record r) (ez_t_record (List.map (fun (x, y) -> x, y.type_expression) r) ())
let e_a_map lst k v = make_a_e (e_map lst) (t_map k v ())
let e_a_let_in binder expr body attributes = make_a_e (e_let_in binder expr body attributes) (get_type_expression body)

2
src/stages/4-ast_typed/combinators.mli
View File

@ -109,7 +109,6 @@ val ez_e_record : ( string * expression ) list -> expression
*)
val e_some : expression -> expression_content
val e_none : unit -> expression_content
val e_map : ( expression * expression ) list -> expression_content
val e_unit : unit -> expression_content
val e_int : int -> expression_content
val e_nat : int -> expression_content
@ -145,7 +144,6 @@ val e_a_record : expression label_map -> full_environment -> expression
val e_a_application : expression -> expression -> full_environment -> expression
val e_a_variable : expression_variable -> type_expression -> full_environment -> expression
val ez_e_a_record : ( label * expression ) list -> full_environment -> expression
val e_a_map : ( expression * expression ) list -> type_expression -> type_expression -> full_environment -> expression
val e_a_let_in : expression_variable -> bool -> expression -> expression -> full_environment -> expression
val get_a_int : expression -> int result

1
src/stages/4-ast_typed/combinators_environment.ml
View File

@ -14,7 +14,6 @@ let e_a_empty_pair a b = e_a_pair a b Environment.full_empty
let e_a_empty_some s = e_a_some s Environment.full_empty
let e_a_empty_none t = e_a_none t Environment.full_empty
let e_a_empty_record r = e_a_record r Environment.full_empty
let e_a_empty_map lst k v = e_a_map lst k v Environment.full_empty
let ez_e_a_empty_record r = ez_e_a_record r Environment.full_empty
let e_a_empty_lambda l i o = e_a_lambda l i o Environment.full_empty

1
src/stages/4-ast_typed/combinators_environment.mli
View File

@ -13,7 +13,6 @@ val e_a_empty_pair : expression -> expression -> expression
val e_a_empty_some : expression -> expression
val e_a_empty_none : type_expression -> expression
val e_a_empty_record : expression label_map -> expression
val e_a_empty_map : (expression * expression ) list -> type_expression -> type_expression -> expression
val ez_e_a_empty_record : ( label * expression ) list -> expression
val e_a_empty_lambda : lambda -> type_expression -> type_expression -> expression

17
src/stages/4-ast_typed/misc.ml
View File

@ -211,7 +211,6 @@ module Free_variables = struct
| E_record m -> unions @@ List.map self @@ LMap.to_list m
| E_record_accessor {record;_} -> self record
| E_record_update {record; update;_} -> union (self record) @@ self update
| (E_map m | E_big_map m) -> unions @@ List.map self @@ List.concat @@ List.map (fun (a, b) -> [ a ; b ]) m
| E_matching {matchee; cases;_} -> union (self matchee) (matching_expression b cases)
| E_let_in { let_binder; rhs; let_result; _} ->
let b' = union (singleton let_binder) b in
@ -494,22 +493,6 @@ let rec assert_value_eq (a, b: (expression*expression)) : unit result =
| E_record _, _ ->
fail @@ (different_values_because_different_types "record vs. non-record" a b)
| (E_map lsta, E_map lstb | E_big_map lsta, E_big_map lstb) -> (
let%bind lst = generic_try (different_size_values "maps of different lengths" a b)
(fun () ->
let lsta' = List.sort compare lsta in
let lstb' = List.sort compare lstb in
List.combine lsta' lstb') in
let aux = fun ((ka, va), (kb, vb)) ->
let%bind _ = assert_value_eq (ka, kb) in
let%bind _ = assert_value_eq (va, vb) in
ok () in
let%bind _all = bind_map_list aux lst in
ok ()
)
| (E_map _ | E_big_map _), _ ->
fail @@ different_values_because_different_types "map vs. non-map" a b
| (E_literal _, _) | (E_variable _, _) | (E_application _, _)
| (E_lambda _, _) | (E_let_in _, _) | (E_recursive _, _)
| (E_record_accessor _, _) | (E_record_update _,_)

3
src/stages/4-ast_typed/misc_smart.ml
View File

@ -75,9 +75,6 @@ module Captured_variables = struct
let%bind r = self record in
let%bind e = self update in
ok @@ union r e
| (E_map m | E_big_map m) ->
let%bind lst' = bind_map_list self @@ List.concat @@ List.map (fun (a, b) -> [ a ; b ]) m in
ok @@ unions lst'
| E_matching {matchee;cases;_} ->
let%bind a' = self matchee in
let%bind cs' = matching_expression b cases in

4
src/stages/4-ast_typed/types.ml
View File

@ -49,10 +49,6 @@ and expression_content =
| E_record of expression label_map
| E_record_accessor of accessor
| E_record_update of update
(* Data Structures *)
(* TODO : move to constant*)
| E_map of (expression * expression) list (*move to operator *)
| E_big_map of (expression * expression) list (*move to operator *)
and constant =
{ cons_name: constant'

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

@ -86,8 +86,6 @@ and expression' ppf (e:expression') = match e with
| E_constant c -> fprintf ppf "%a %a" constant c.cons_name (pp_print_list ~pp_sep:space_sep expression) c.arguments
| E_literal v -> fprintf ppf "L(%a)" value v
| E_make_empty_map _ -> fprintf ppf "map[]"
| E_make_empty_big_map _ -> fprintf ppf "big_map[]"
| E_make_none _ -> fprintf ppf "none"
| E_if_bool (c, a, b) -> fprintf ppf "%a ? %a : %a" expression c expression a expression b
| E_if_none (c, n, ((name, _) , s)) -> fprintf ppf "%a ?? %a : %a -> %a" expression c expression n Var.pp name expression s
@ -219,6 +217,7 @@ and constant ppf : constant' -> unit = function
| C_MAP_FIND_OPT -> fprintf ppf "MAP_FIND_OP"
(* Big Maps *)
| C_BIG_MAP -> fprintf ppf "BIG_MAP"
| C_BIG_MAP_ADD -> fprintf ppf "BIG_MAP_ADD"
| C_BIG_MAP_EMPTY -> fprintf ppf "BIG_MAP_EMPTY"
| C_BIG_MAP_LITERAL -> fprintf ppf "BIG_MAP_LITERAL"
(* Crypto *)

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

@ -44,8 +44,6 @@ module Free_variables = struct
| E_constant (c) -> unions @@ List.map self c.arguments
| E_application (f, x) -> unions @@ [ self f ; self x ]
| E_variable n -> var_name b n
| E_make_empty_map _ -> empty
| E_make_empty_big_map _ -> empty
| E_make_none _ -> empty
| E_iterator (_, ((v, _), body), expr) ->
unions [ expression (union (singleton v) b) body ;

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

@ -59,8 +59,6 @@ and expression' =
| E_constant of constant
| E_application of (expression * expression)
| E_variable of var_name
| E_make_empty_map of (type_value * type_value)
| E_make_empty_big_map of (type_value * type_value)
| E_make_none of type_value
| E_iterator of constant' * ((var_name * type_value) * expression) * expression
| E_fold of (((var_name * type_value) * expression) * expression * expression)

1
src/stages/common/PP.ml
View File

@ -127,6 +127,7 @@ let constant ppf : constant' -> unit = function
| C_MAP_FIND_OPT -> fprintf ppf "MAP_FIND_OP"
(* Big Maps *)
| C_BIG_MAP -> fprintf ppf "BIG_MAP"
| C_BIG_MAP_ADD -> fprintf ppf "BIG_MAP_ADD"
| C_BIG_MAP_EMPTY -> fprintf ppf "BIG_MAP_EMPTY"
| C_BIG_MAP_LITERAL -> fprintf ppf "BIG_MAP_LITERAL"
(* Crypto *)

1
src/stages/common/types.ml
View File

@ -269,6 +269,7 @@ and constant' =
| C_MAP_FIND_OPT
(* Big Maps *)
| C_BIG_MAP
| C_BIG_MAP_ADD
| C_BIG_MAP_EMPTY
| C_BIG_MAP_LITERAL
(* Crypto *)

14
src/stages/typesystem/misc.ml
View File

@ -190,20 +190,6 @@ module Substitution = struct
let%bind record = s_expression ~substs record in
let%bind update = s_expression ~substs update in
ok @@ T.E_record_update {record;path;update}
| T.E_map val_val_list ->
let%bind val_val_list = bind_map_list (fun (val1 , val2) ->
let%bind val1 = s_expression ~substs val1 in
let%bind val2 = s_expression ~substs val2 in
ok @@ (val1 , val2)
) val_val_list in
ok @@ T.E_map val_val_list
| T.E_big_map val_val_list ->
let%bind val_val_list = bind_map_list (fun (val1 , val2) ->
let%bind val1 = s_expression ~substs val1 in
let%bind val2 = s_expression ~substs val2 in
ok @@ (val1 , val2)
) val_val_list in
ok @@ T.E_big_map val_val_list
| T.E_matching {matchee;cases} ->
let%bind matchee = s_expression ~substs matchee in
let%bind cases = s_matching_expr ~substs cases in