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

Merge branch 'srcloc_for_types' into 'dev'

Browse Source 
Add srcloc for Types

See merge request ligolang/ligo!562
This commit is contained in:
Pierre-Emmanuel Wulfman 2020-04-15 16:41:27 +00:00
commit 7a18cbd8fc
40 changed files with 414 additions and 407 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/bin/expect_tests/contract_tests.ml
View File

@ -1143,7 +1143,7 @@ ligo: in file "create_contract_var.mligo", line 6, character 35 to line 10, char
run_ligo_bad [ "compile-contract" ; bad_contract "create_contract_no_inline.mligo" ; "main" ] ;
[%expect {|
ligo: unbound type variable: {"variable":"return","in":"- E[foo -> int]\tT[] ]","did_you_mean":"no suggestion"}
ligo: in file "create_contract_no_inline.mligo", line 3, characters 40-46. unbound type variable: {"variable":"return","location":"in file \"create_contract_no_inline.mligo\", line 3, characters 40-46","in":"- E[foo -> int]\tT[] ]","did_you_mean":"no suggestion"}
If you're not sure how to fix this error, you can

2
src/bin/expect_tests/typer_error_tests.ml
View File

@ -119,7 +119,7 @@ let%expect_test _ =
run_ligo_bad [ "compile-contract" ; "../../test/contracts/negative/error_typer_5.mligo" ; "main" ] ;
[%expect {|
ligo: unbound type variable: {"variable":"boolean","in":"- E[]\tT[] ]","did_you_mean":"bool"}
ligo: in file "error_typer_5.mligo", line 1, characters 10-17. unbound type variable: {"variable":"boolean","location":"in file \"error_typer_5.mligo\", line 1, characters 10-17","in":"- E[]\tT[] ]","did_you_mean":"bool"}
If you're not sure how to fix this error, you can

29
src/passes/2-concrete_to_imperative/cameligo.ml
View File

@ -218,33 +218,37 @@ and compile_type_expression : Raw.type_expr -> type_expression result = fun te -
match te with
TPar x -> compile_type_expression x.value.inside
| TVar v -> (
match type_constants v.value with
| Ok (s,_) -> ok @@ make_t @@ T_constant s
| Error _ -> ok @@ make_t @@ T_variable (Var.of_name v.value)
let (v, loc) = r_split v in
match type_constants v with
| Ok (s,_) -> ok @@ make_t ~loc @@ T_constant s
| Error _ -> ok @@ make_t ~loc @@ T_variable (Var.of_name v)
)
| TFun x -> (
let (x,loc) = r_split x in
let%bind (type1 , type2) =
let (a , _ , b) = x.value in
let (a , _ , b) = x in
let%bind a = compile_type_expression a in
let%bind b = compile_type_expression b in
ok (a , b)
in
ok @@ make_t @@ T_arrow {type1;type2}
ok @@ make_t ~loc @@ T_arrow {type1;type2}
)
| TApp x -> (
let (name, tuple) = x.value in
let (x,loc) = r_split x in
let (name, tuple) = x in
let lst = npseq_to_list tuple.value.inside in
let%bind lst' = bind_map_list compile_type_expression lst in
let%bind cst =
trace (unknown_predefined_type name) @@
type_operators name.value in
t_operator cst lst'
t_operator ~loc cst lst'
)
| TProd p -> (
let%bind tpl = compile_list_type_expression @@ npseq_to_list p.value in
ok tpl
)
| TRecord r ->
let (r, loc) = r_split r in
let aux = fun (x, y) -> let%bind y = compile_type_expression y in ok (x, y) in
let apply (x:Raw.field_decl Raw.reg) =
(x.value.field_name.value, x.value.field_type) in
@ -252,10 +256,11 @@ and compile_type_expression : Raw.type_expr -> type_expression result = fun te -
bind_list
@@ List.map aux
@@ List.map apply
@@ npseq_to_list r.value.ne_elements in
@@ npseq_to_list r.ne_elements in
let m = List.fold_left (fun m (x, y) -> LMap.add (Label x) y m) LMap.empty lst in
ok @@ make_t @@ T_record m
ok @@ make_t ~loc @@ T_record m
| TSum s ->
let (s,loc) = r_split s in
let aux (v:Raw.variant Raw.reg) =
let args =
match v.value.arg with
@ -266,13 +271,13 @@ and compile_type_expression : Raw.type_expr -> type_expression result = fun te -
ok (v.value.constr.value, te) in
let%bind lst = bind_list
@@ List.map aux
@@ npseq_to_list s.value in
@@ npseq_to_list s in
let m = List.fold_left (fun m (x, y) -> CMap.add (Constructor x) y m) CMap.empty lst in
ok @@ make_t @@ T_sum m
ok @@ make_t ~loc @@ T_sum m
and compile_list_type_expression (lst:Raw.type_expr list) : type_expression result =
match lst with
| [] -> ok @@ t_unit
| [] -> ok @@ t_unit ()
| [hd] -> compile_type_expression hd
| lst ->
let%bind lst = bind_map_list compile_type_expression lst in

29
src/passes/2-concrete_to_imperative/pascaligo.ml
View File

@ -147,30 +147,34 @@ let rec compile_type_expression (t:Raw.type_expr) : type_expression result =
match t with
TPar x -> compile_type_expression x.value.inside
| TVar v -> (
match type_constants v.value with
| Ok (s,_) -> ok @@ make_t @@ T_constant s
| Error _ -> ok @@ make_t @@ T_variable (Var.of_name v.value)
let (v,loc) = r_split v in
match type_constants v with
| Ok (s,_) -> ok @@ make_t ~loc @@ T_constant s
| Error _ -> ok @@ make_t ~loc @@ T_variable (Var.of_name v)
)
| TFun x -> (
let (x,loc) = r_split x in
let%bind (a , b) =
let (a , _ , b) = x.value in
let (a , _ , b) = x in
bind_map_pair compile_type_expression (a , b) in
ok @@ make_t @@ T_arrow {type1=a;type2=b}
ok @@ make_t ~loc @@ T_arrow {type1=a;type2=b}
)
| TApp x ->
let (name, tuple) = x.value in
let (x, loc) = r_split x in
let (name, tuple) = x in
let lst = npseq_to_list tuple.value.inside in
let%bind lst =
bind_list @@ List.map compile_type_expression lst in (** TODO: fix constant and operator*)
let%bind cst =
trace (unknown_predefined_type name) @@
type_operators name.value in
t_operator cst lst
t_operator ~loc cst lst
| TProd p ->
let%bind tpl = compile_list_type_expression
@@ npseq_to_list p.value in
ok tpl
| TRecord r ->
let (r,loc ) = r_split r in
let aux = fun (x, y) ->
let%bind y = compile_type_expression y in
ok (x, y)
@ -180,10 +184,11 @@ let rec compile_type_expression (t:Raw.type_expr) : type_expression result =
let%bind lst = bind_list
@@ List.map aux
@@ List.map apply
@@ npseq_to_list r.value.ne_elements in
@@ npseq_to_list r.ne_elements in
let m = List.fold_left (fun m (x, y) -> LMap.add (Label x) y m) LMap.empty lst in
ok @@ make_t @@ T_record m
ok @@ make_t ~loc @@ T_record m
| TSum s ->
let (s,loc) = r_split s in
let aux (v:Raw.variant Raw.reg) =
let args =
match v.value.arg with
@ -195,13 +200,13 @@ let rec compile_type_expression (t:Raw.type_expr) : type_expression result =
in
let%bind lst = bind_list
@@ List.map aux
@@ npseq_to_list s.value in
@@ npseq_to_list s in
let m = List.fold_left (fun m (x, y) -> CMap.add (Constructor x) y m) CMap.empty lst in
ok @@ make_t @@ T_sum m
ok @@ make_t ~loc @@ T_sum m
and compile_list_type_expression (lst:Raw.type_expr list) : type_expression result =
match lst with
| [] -> ok @@ t_unit
| [] -> ok @@ t_unit ()
| [hd] -> compile_type_expression hd
| lst ->
let%bind lst = bind_list @@ List.map compile_type_expression lst in

2
src/passes/3-self_ast_imperative/entrypoints_length_limit.ml
View File

@ -11,7 +11,7 @@ end
open Errors
let peephole_type_expression : type_expression -> type_expression result = fun e ->
let return type_content = ok {type_content } in
let return type_content = ok {type_content; location=e.location } in
match e.type_content with
| T_sum cmap ->
let%bind _uu = bind_map_cmapi

2
src/passes/3-self_ast_imperative/helpers.ml
View File

@ -252,7 +252,7 @@ let rec map_expression : exp_mapper -> expression -> expression result = fun f e
and map_type_expression : ty_exp_mapper -> type_expression -> type_expression result = fun f te ->
let self = map_type_expression f in
let%bind te' = f te in
let return type_content = ok { type_content } in
let return type_content = ok { type_content; location=te.location } in
match te'.type_content with
| T_sum temap ->
let%bind temap' = bind_map_cmap self temap in

2
src/passes/3-self_ast_imperative/michelson_or.ml
View File

@ -2,7 +2,7 @@ open Ast_imperative
open Trace
let peephole_type_expression : type_expression -> type_expression result = fun e ->
let return type_content = ok { type_content } in
let return type_content = ok { type_content; location=e.location } in
match e.type_content with
| T_operator (TC_michelson_or (l_ty,r_ty)) ->
return @@ T_sum (CMap.of_list [ (Constructor "M_left", l_ty) ; (Constructor "M_right", r_ty) ])

10
src/passes/4-imperative_to_sugar/imperative_to_sugar.ml
View File

@ -103,7 +103,7 @@ and restore_mutable_variable (expr : O.expression->O.expression_content) (free_v
let rec compile_type_expression : I.type_expression -> O.type_expression result =
fun te ->
let return te = ok @@ O.make_t te in
let return tc = ok @@ O.make_t ~loc:te.location tc in
match te.type_content with
| I.T_sum sum ->
let sum = I.CMap.to_kv_list sum in
@ -458,12 +458,12 @@ and compile_while I.{condition;body} =
and compile_for I.{binder;start;final;increment;body} =
let env_rec = Var.fresh () in
(*Make the cond and the step *)
let cond = I.e_annotation (I.e_constant C_LE [I.e_variable binder ; final]) I.t_bool in
let cond = I.e_annotation (I.e_constant C_LE [I.e_variable binder ; final]) (I.t_bool ()) in
let%bind cond = compile_expression cond in
let%bind step = compile_expression increment in
let continue_expr = O.e_constant C_FOLD_CONTINUE [(O.e_variable env_rec)] in
let ctrl =
O.e_let_in (binder,Some O.t_int) false false (O.e_constant C_ADD [ O.e_variable binder ; step ]) @@
O.e_let_in (binder,Some (O.t_int ())) false false (O.e_constant C_ADD [ O.e_variable binder ; step ]) @@
O.e_let_in (env_rec, None) false false (O.e_record_update (O.e_variable env_rec) (Label "1") @@ O.e_variable binder)@@
continue_expr
in
@ -482,7 +482,7 @@ and compile_for I.{binder;start;final;increment;body} =
(*Prep the lambda for the fold*)
let stop_expr = O.e_constant C_FOLD_STOP [O.e_variable env_rec] in
let aux_func = O.e_lambda env_rec None None @@
O.e_let_in (binder,Some O.t_int) false false (O.e_record_accessor (O.e_variable env_rec) (Label "1")) @@
O.e_let_in (binder,Some (O.t_int ())) false false (O.e_record_accessor (O.e_variable env_rec) (Label "1")) @@
O.e_cond cond (restore for_body) (stop_expr) in
(* Make the fold_while en precharge the vakye *)
@ -492,7 +492,7 @@ and compile_for I.{binder;start;final;increment;body} =
let%bind start = compile_expression start in
let let_binder = (env_rec,None) in
let return_expr = fun expr ->
O.E_let_in {let_binder=(binder, Some O.t_int);mut=false; inline=false;rhs=start;let_result=
O.E_let_in {let_binder=(binder, Some (O.t_int ()));mut=false; inline=false;rhs=start;let_result=
O.e_let_in let_binder false false init_rec @@
O.e_let_in let_binder false false loop @@
O.e_let_in let_binder false false (O.e_record_accessor (O.e_variable env_rec) (Label "0")) @@

2
src/passes/5-self_ast_sugar/helpers.ml
View File

@ -221,7 +221,7 @@ let rec map_expression : exp_mapper -> expression -> expression result = fun f e
and map_type_expression : ty_exp_mapper -> type_expression -> type_expression result = fun f te ->
let self = map_type_expression f in
let%bind te' = f te in
let return type_content = ok { type_content } in
let return type_content = ok { type_content; location=te.location } in
match te'.type_content with
| T_sum temap ->
let%bind temap' = bind_map_cmap self temap in

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

@ -4,7 +4,7 @@ open Trace
let rec idle_type_expression : I.type_expression -> O.type_expression result =
fun te ->
let return te = ok @@ O.make_t te in
let return tc = ok @@ O.make_t ~loc:te.location tc in
match te.type_content with
| I.T_sum sum ->
let sum = I.CMap.to_kv_list sum in
@ -165,7 +165,7 @@ let rec compile_expression : I.expression -> O.expression result =
| I.E_sequence {expr1; expr2} ->
let%bind expr1 = compile_expression expr1 in
let%bind expr2 = compile_expression expr2 in
return @@ O.E_let_in {let_binder=(Var.of_name "_", Some O.t_unit); rhs=expr1;let_result=expr2; inline=false}
return @@ O.E_let_in {let_binder=(Var.of_name "_", Some (O.t_unit ())); rhs=expr1;let_result=expr2; inline=false}
| I.E_skip -> ok @@ O.e_unit ~loc:e.location ()
| I.E_tuple t ->
let aux (i,acc) el =
@ -317,7 +317,7 @@ let rec uncompile_expression : O.expression -> I.expression result =
let%bind fun_type = uncompile_type_expression fun_type in
let%bind lambda = uncompile_lambda lambda in
return @@ I.E_recursive {fun_name;fun_type;lambda}
| O.E_let_in {let_binder;inline=false;rhs=expr1;let_result=expr2} when let_binder = (Var.of_name "_", Some O.t_unit) ->
| O.E_let_in {let_binder;inline=false;rhs=expr1;let_result=expr2} when let_binder = (Var.of_name "_", Some (O.t_unit ())) ->
let%bind expr1 = uncompile_expression expr1 in
let%bind expr2 = uncompile_expression expr2 in
return @@ I.E_sequence {expr1;expr2}

5
src/passes/8-typer-new/errors.ml
View File

@ -4,13 +4,12 @@ module O = Ast_typed
module Environment = O.Environment
type environment = Environment.t
let unbound_type_variable (e:environment) (tv:I.type_variable) () =
let unbound_type_variable (e:environment) (tv:I.type_variable) (loc:Location.t) () =
let title = (thunk "unbound type variable") in
let message () = "" in
let data = [
("variable" , fun () -> Format.asprintf "%a" I.PP.type_variable tv) ;
(* TODO: types don't have srclocs for now. *)
(* ("location" , fun () -> Format.asprintf "%a" Location.pp (n.location)) ; *)
("location" , fun () -> Format.asprintf "%a" Location.pp loc) ;
("in" , fun () -> Format.asprintf "%a" Environment.PP.full_environment e)
] in
error ~data title message ()

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

@ -129,7 +129,7 @@ and type_match : environment -> Solver.state -> O.type_expression -> I.matching_
type_value at the leaves
*)
and evaluate_type (e:environment) (t:I.type_expression) : O.type_expression result =
let return tv' = ok (make_t tv' (Some t)) in
let return tv' = ok (make_t ~loc:t.location tv' (Some t)) in
match t.type_content with
| T_arrow {type1;type2} ->
let%bind type1 = evaluate_type e type1 in
@ -153,7 +153,7 @@ and evaluate_type (e:environment) (t:I.type_expression) : O.type_expression resu
return (T_record m)
| T_variable name ->
let%bind tv =
trace_option (unbound_type_variable e name)
trace_option (unbound_type_variable e name t.location)
@@ Environment.get_type_opt (name) e in
ok tv
| T_constant cst ->
@ -473,7 +473,7 @@ let type_and_subst_xyz (env_state_node : environment * Solver.state * 'a) (apply
(Solver.TypeVariableMap.find_opt root assignments) in
let Solver.{ tv ; c_tag ; tv_list } = assignment in
let () = ignore tv (* I think there is an issue where the tv is stored twice (as a key and in the element itself) *) in
let%bind (expr : O.type_content) = Typesystem.Core.type_expression'_of_simple_c_constant (c_tag , (List.map (fun s -> O.{ type_content = T_variable s ; type_meta = None }) tv_list)) in
let%bind (expr : O.type_content) = Typesystem.Core.type_expression'_of_simple_c_constant (c_tag , (List.map (fun s -> O.t_variable s ()) tv_list)) in
ok @@ expr
in
let p = apply_substs ~substs program in

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

@ -11,7 +11,7 @@ module Solver = Typer_new.Solver
type environment = Environment.t
module Errors = struct
let unbound_type_variable (e:environment) (tv:I.type_variable) () =
let unbound_type_variable (e:environment) (tv:I.type_variable) (loc:Location.t) () =
let name = Var.to_name tv in
let suggestion = match name with
| "integer" -> "int"
@ -22,8 +22,7 @@ module Errors = struct
let message () = "" in
let data = [
("variable" , fun () -> Format.asprintf "%a" I.PP.type_variable tv) ;
(* TODO: types don't have srclocs for now. *)
(* ("location" , fun () -> Format.asprintf "%a" Location.pp (n.location)) ; *)
("location" , fun () -> Format.asprintf "%a" Location.pp loc) ;
("in" , fun () -> Format.asprintf "%a" Environment.PP.full_environment e) ;
("did_you_mean" , fun () -> suggestion)
] in
@ -590,7 +589,7 @@ and type_match : (environment -> I.expression -> O.expression result) -> environ
ok (O.Match_variant { cases ; tv })
and evaluate_type (e:environment) (t:I.type_expression) : O.type_expression result =
let return tv' = ok (make_t tv' (Some t)) in
let return tv' = ok (make_t ~loc:t.location tv' (Some t)) in
match t.type_content with
| T_arrow {type1;type2} ->
let%bind type1 = evaluate_type e type1 in
@ -620,7 +619,7 @@ and evaluate_type (e:environment) (t:I.type_expression) : O.type_expression resu
return (T_record m)
| T_variable name ->
let%bind tv =
trace_option (unbound_type_variable e name)
trace_option (unbound_type_variable e name t.location)
@@ Environment.get_type_opt (name) e in
ok tv
| T_constant cst ->

2
src/passes/9-self_ast_typed/contract_passes.ml
View File

@ -41,7 +41,7 @@ module Errors = struct
end
let check_entrypoint_annotation_format ep exp =
let check_entrypoint_annotation_format ep (exp: expression) =
match String.split_on_char '%' ep with
| [ "" ; ep'] ->
let cap = String.capitalize_ascii ep' in

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

@ -270,7 +270,7 @@ and fold_map_program : 'a . 'a fold_mapper -> 'a -> program -> ('a * program) re
bind_fold_list aux (init,[]) p
module Errors = struct
let bad_contract_io entrypoint e () =
let bad_contract_io entrypoint (e:expression) () =
let title = thunk "badly typed contract" in
let message () = Format.asprintf "unexpected entrypoint type" in
let data = [
@ -280,7 +280,7 @@ module Errors = struct
] in
error ~data title message ()
let expected_list_operation entrypoint got e () =
let expected_list_operation entrypoint got (e:expression) () =
let title = thunk "bad return type" in
let message () = Format.asprintf "expected %a, got %a"
Ast_typed.PP.type_expression {got with type_content= T_operator (TC_list {got with type_content=T_constant TC_operation})}
@ -292,7 +292,7 @@ module Errors = struct
] in
error ~data title message ()
let expected_same entrypoint t1 t2 e () =
let expected_same entrypoint t1 t2 (e:expression) () =
let title = thunk "badly typed contract" in
let message () = Format.asprintf "expected {%a} and {%a} to be the same in the entrypoint type"
Ast_typed.PP.type_expression t1

81
src/stages/1-ast_imperative/combinators.ml
View File

@ -19,60 +19,59 @@ module Errors = struct
end
open Errors
let make_t type_content = {type_content}
let make_t ?(loc = Location.generated) type_content = {type_content; location=loc}
let t_bool : type_expression = make_t @@ T_constant (TC_bool)
let t_string : type_expression = make_t @@ T_constant (TC_string)
let t_bytes : type_expression = make_t @@ T_constant (TC_bytes)
let t_int : type_expression = make_t @@ T_constant (TC_int)
let t_operation : type_expression = make_t @@ T_constant (TC_operation)
let t_nat : type_expression = make_t @@ T_constant (TC_nat)
let t_tez : type_expression = make_t @@ T_constant (TC_mutez)
let t_unit : type_expression = make_t @@ T_constant (TC_unit)
let t_address : type_expression = make_t @@ T_constant (TC_address)
let t_signature : type_expression = make_t @@ T_constant (TC_signature)
let t_key : type_expression = make_t @@ T_constant (TC_key)
let t_key_hash : type_expression = make_t @@ T_constant (TC_key_hash)
let t_timestamp : type_expression = make_t @@ T_constant (TC_timestamp)
let t_option o : type_expression = make_t @@ T_operator (TC_option o)
let t_list t : type_expression = make_t @@ T_operator (TC_list t)
let t_variable n : type_expression = make_t @@ T_variable (Var.of_name n)
let t_record_ez lst =
let t_bool ?loc () : type_expression = make_t ?loc @@ T_constant (TC_bool)
let t_string ?loc () : type_expression = make_t ?loc @@ T_constant (TC_string)
let t_bytes ?loc () : type_expression = make_t ?loc @@ T_constant (TC_bytes)
let t_int ?loc () : type_expression = make_t ?loc @@ T_constant (TC_int)
let t_operation ?loc () : type_expression = make_t ?loc @@ T_constant (TC_operation)
let t_nat ?loc () : type_expression = make_t ?loc @@ T_constant (TC_nat)
let t_tez ?loc () : type_expression = make_t ?loc @@ T_constant (TC_mutez)
let t_unit ?loc () : type_expression = make_t ?loc @@ T_constant (TC_unit)
let t_address ?loc () : type_expression = make_t ?loc @@ T_constant (TC_address)
let t_signature ?loc () : type_expression = make_t ?loc @@ T_constant (TC_signature)
let t_key ?loc () : type_expression = make_t ?loc @@ T_constant (TC_key)
let t_key_hash ?loc () : type_expression = make_t ?loc @@ T_constant (TC_key_hash)
let t_timestamp ?loc () : type_expression = make_t ?loc @@ T_constant (TC_timestamp)
let t_option ?loc o : type_expression = make_t ?loc @@ T_operator (TC_option o)
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.map (fun (k, v) -> (Label k, v)) lst in
let m = LMap.of_list lst in
make_t @@ T_record m
let t_record m : type_expression =
make_t ?loc @@ T_record m
let t_record ?loc m : type_expression =
let lst = Map.String.to_kv_list m in
t_record_ez lst
t_record_ez ?loc lst
let t_tuple lst : type_expression = make_t @@ T_tuple lst
let t_pair (a , b) : type_expression = t_tuple [a; b]
let t_tuple ?loc lst : type_expression = make_t ?loc @@ T_tuple lst
let t_pair ?loc (a , b) : type_expression = t_tuple ?loc [a; b]
let ez_t_sum (lst:(string * type_expression) list) : type_expression =
let ez_t_sum ?loc (lst:(string * type_expression) list) : type_expression =
let aux prev (k, v) = CMap.add (Constructor k) v prev in
let map = List.fold_left aux CMap.empty lst in
make_t @@ T_sum map
let t_sum m : type_expression =
make_t ?loc @@ T_sum map
let t_sum ?loc m : type_expression =
let lst = Map.String.to_kv_list m in
ez_t_sum lst
ez_t_sum ?loc lst
let t_function type1 type2 : type_expression = make_t @@ T_arrow {type1; type2}
let t_map key value : type_expression = make_t @@ T_operator (TC_map (key, value))
let t_big_map key value : type_expression = make_t @@ T_operator (TC_big_map (key , value))
let t_michelson_or l r : type_expression = make_t @@ T_operator (TC_michelson_or (l , r))
let t_set key : type_expression = make_t @@ T_operator (TC_set key)
let t_contract contract : type_expression = make_t @@ T_operator (TC_contract contract)
let t_function ?loc type1 type2 : type_expression = make_t ?loc @@ T_arrow {type1; type2}
let t_map ?loc key value : type_expression = make_t ?loc @@ T_operator (TC_map (key, value))
let t_big_map ?loc key value : type_expression = make_t ?loc @@ T_operator (TC_big_map (key , value))
let t_michelson_or ?loc l r : type_expression = make_t ?loc @@ T_operator (TC_michelson_or (l , r))
let t_set ?loc key : type_expression = make_t ?loc @@ T_operator (TC_set key)
let t_contract ?loc contract : type_expression = make_t ?loc @@ T_operator (TC_contract contract)
(* TODO find a better way than using list*)
let t_operator op lst: type_expression result =
let t_operator ?loc op lst: type_expression result =
match op,lst with
| TC_set _ , [t] -> ok @@ t_set t
| TC_list _ , [t] -> ok @@ t_list t
| TC_option _ , [t] -> ok @@ t_option t
| TC_map (_,_) , [kt;vt] -> ok @@ t_map kt vt
| TC_big_map (_,_) , [kt;vt] -> ok @@ t_big_map kt vt
| TC_michelson_or (_,_) , [l;r] -> ok @@ t_michelson_or l r
| TC_set _ , [t] -> ok @@ t_set ?loc t
| TC_list _ , [t] -> ok @@ t_list ?loc t
| TC_option _ , [t] -> ok @@ t_option ?loc t
| TC_map (_,_) , [kt;vt] -> ok @@ t_map ?loc kt vt
| TC_big_map (_,_) , [kt;vt] -> ok @@ t_big_map ?loc kt vt
| TC_michelson_or (_,_) , [l;r] -> ok @@ t_michelson_or ?loc l r
| TC_contract _ , [t] -> ok @@ t_contract t
| _ , _ -> fail @@ bad_type_operator op

52
src/stages/1-ast_imperative/combinators.mli
View File

@ -9,42 +9,42 @@ module Errors : sig
val bad_kind : name -> Location.t -> unit -> error
end
*)
val make_t : type_content -> type_expression
val t_bool : type_expression
val t_string : type_expression
val t_bytes : type_expression
val t_int : type_expression
val t_operation : type_expression
val t_nat : type_expression
val t_tez : type_expression
val t_unit : type_expression
val t_address : type_expression
val t_key : type_expression
val t_key_hash : type_expression
val t_timestamp : type_expression
val t_signature : type_expression
val make_t : ?loc:Location.t -> type_content -> type_expression
val t_bool : ?loc:Location.t -> unit -> type_expression
val t_string : ?loc:Location.t -> unit -> type_expression
val t_bytes : ?loc:Location.t -> unit -> type_expression
val t_int : ?loc:Location.t -> unit -> type_expression
val t_operation : ?loc:Location.t -> unit -> type_expression
val t_nat : ?loc:Location.t -> unit -> type_expression
val t_tez : ?loc:Location.t -> unit -> type_expression
val t_unit : ?loc:Location.t -> unit -> type_expression
val t_address : ?loc:Location.t -> unit -> type_expression
val t_key : ?loc:Location.t -> unit -> type_expression
val t_key_hash : ?loc:Location.t -> unit -> type_expression
val t_timestamp : ?loc:Location.t -> unit -> type_expression
val t_signature : ?loc:Location.t -> unit -> type_expression
(*
val t_option : type_expression -> type_expression
*)
val t_list : type_expression -> type_expression
val t_variable : string -> type_expression
val t_list : ?loc:Location.t -> type_expression -> type_expression
val t_variable : ?loc:Location.t -> string -> type_expression
(*
val t_record : te_map -> type_expression
*)
val t_pair : ( type_expression * type_expression ) -> type_expression
val t_tuple : type_expression list -> type_expression
val t_pair : ?loc:Location.t -> ( type_expression * type_expression ) -> type_expression
val t_tuple : ?loc:Location.t -> type_expression list -> type_expression
val t_record : type_expression Map.String.t -> type_expression
val t_record_ez : (string * type_expression) list -> type_expression
val t_record : ?loc:Location.t -> type_expression Map.String.t -> type_expression
val t_record_ez : ?loc:Location.t -> (string * type_expression) list -> type_expression
val t_sum : type_expression Map.String.t -> type_expression
val ez_t_sum : ( string * type_expression ) list -> type_expression
val t_sum : ?loc:Location.t -> type_expression Map.String.t -> type_expression
val ez_t_sum : ?loc:Location.t -> ( string * type_expression ) list -> type_expression
val t_function : type_expression -> type_expression -> type_expression
val t_map : type_expression -> type_expression -> type_expression
val t_function : ?loc:Location.t -> type_expression -> type_expression -> type_expression
val t_map : ?loc:Location.t -> type_expression -> type_expression -> type_expression
val t_operator : type_operator -> type_expression list -> type_expression result
val t_set : type_expression -> type_expression
val t_operator : ?loc:Location.t -> type_operator -> type_expression list -> type_expression result
val t_set : ?loc:Location.t -> type_expression -> type_expression
val make_e : ?loc:Location.t -> expression_content -> expression

2
src/stages/1-ast_imperative/types.ml
View File

@ -25,7 +25,7 @@ and type_operator =
| TC_michelson_or of type_expression * type_expression
| TC_arrow of type_expression * type_expression
and type_expression = {type_content: type_content}
and type_expression = {type_content: type_content; location: Location.t}
type program = declaration Location.wrap list

78
src/stages/2-ast_sugar/combinators.ml
View File

@ -19,7 +19,7 @@ module Errors = struct
end
open Errors
let make_t type_content = {type_content}
let make_t ?(loc = Location.generated) type_content = {type_content; location=loc}
let tuple_to_record lst =
@ -27,56 +27,56 @@ let tuple_to_record lst =
let (_, lst ) = List.fold_left aux (0,[]) lst in
lst
let t_bool : type_expression = make_t @@ T_constant (TC_bool)
let t_string : type_expression = make_t @@ T_constant (TC_string)
let t_bytes : type_expression = make_t @@ T_constant (TC_bytes)
let t_int : type_expression = make_t @@ T_constant (TC_int)
let t_operation : type_expression = make_t @@ T_constant (TC_operation)
let t_nat : type_expression = make_t @@ T_constant (TC_nat)
let t_tez : type_expression = make_t @@ T_constant (TC_mutez)
let t_unit : type_expression = make_t @@ T_constant (TC_unit)
let t_address : type_expression = make_t @@ T_constant (TC_address)
let t_signature : type_expression = make_t @@ T_constant (TC_signature)
let t_key : type_expression = make_t @@ T_constant (TC_key)
let t_key_hash : type_expression = make_t @@ T_constant (TC_key_hash)
let t_timestamp : type_expression = make_t @@ T_constant (TC_timestamp)
let t_option o : type_expression = make_t @@ T_operator (TC_option o)
let t_list t : type_expression = make_t @@ T_operator (TC_list t)
let t_variable n : type_expression = make_t @@ T_variable (Var.of_name n)
let t_record_ez lst =
let t_bool ?loc () : type_expression = make_t ?loc @@ T_constant (TC_bool)
let t_string ?loc () : type_expression = make_t ?loc @@ T_constant (TC_string)
let t_bytes ?loc () : type_expression = make_t ?loc @@ T_constant (TC_bytes)
let t_int ?loc () : type_expression = make_t ?loc @@ T_constant (TC_int)
let t_operation ?loc () : type_expression = make_t ?loc @@ T_constant (TC_operation)
let t_nat ?loc () : type_expression = make_t ?loc @@ T_constant (TC_nat)
let t_tez ?loc () : type_expression = make_t ?loc @@ T_constant (TC_mutez)
let t_unit ?loc () : type_expression = make_t ?loc @@ T_constant (TC_unit)
let t_address ?loc () : type_expression = make_t ?loc @@ T_constant (TC_address)
let t_signature ?loc () : type_expression = make_t ?loc @@ T_constant (TC_signature)
let t_key ?loc () : type_expression = make_t ?loc @@ T_constant (TC_key)
let t_key_hash ?loc () : type_expression = make_t ?loc @@ T_constant (TC_key_hash)
let t_timestamp ?loc () : type_expression = make_t ?loc @@ T_constant (TC_timestamp)
let t_option ?loc o : type_expression = make_t ?loc @@ T_operator (TC_option o)
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.map (fun (k, v) -> (Label k, v)) lst in
let m = LMap.of_list lst in
make_t @@ T_record m
let t_record m : type_expression =
make_t ?loc @@ T_record m
let t_record ?loc m : type_expression =
let lst = Map.String.to_kv_list m in
t_record_ez lst
t_record_ez ?loc lst
let t_pair (a , b) : type_expression = t_record_ez [("0",a) ; ("1",b)]
let t_tuple lst : type_expression = t_record_ez (tuple_to_record lst)
let t_pair ?loc (a , b) : type_expression = t_record_ez ?loc [("0",a) ; ("1",b)]
let t_tuple ?loc lst : type_expression = t_record_ez ?loc (tuple_to_record lst)
let ez_t_sum (lst:(string * type_expression) list) : type_expression =
let ez_t_sum ?loc (lst:(string * type_expression) list) : type_expression =
let aux prev (k, v) = CMap.add (Constructor k) v prev in
let map = List.fold_left aux CMap.empty lst in
make_t @@ T_sum map
let t_sum m : type_expression =
make_t ?loc @@ T_sum map
let t_sum ?loc m : type_expression =
let lst = Map.String.to_kv_list m in
ez_t_sum lst
ez_t_sum ?loc lst
let t_function type1 type2 : type_expression = make_t @@ T_arrow {type1; type2}
let t_map key value : type_expression = make_t @@ T_operator (TC_map (key, value))
let t_big_map key value : type_expression = make_t @@ T_operator (TC_big_map (key , value))
let t_set key : type_expression = make_t @@ T_operator (TC_set key)
let t_contract contract : type_expression = make_t @@ T_operator (TC_contract contract)
let t_function ?loc type1 type2 : type_expression = make_t ?loc @@ T_arrow {type1; type2}
let t_map ?loc key value : type_expression = make_t ?loc @@ T_operator (TC_map (key, value))
let t_big_map ?loc key value : type_expression = make_t ?loc @@ T_operator (TC_big_map (key , value))
let t_set ?loc key : type_expression = make_t ?loc @@ T_operator (TC_set key)
let t_contract ?loc contract : type_expression = make_t ?loc @@ T_operator (TC_contract contract)
(* TODO find a better way than using list*)
let t_operator op lst: type_expression result =
let t_operator ?loc op lst: type_expression result =
match op,lst with
| TC_set _ , [t] -> ok @@ t_set t
| TC_list _ , [t] -> ok @@ t_list t
| TC_option _ , [t] -> ok @@ t_option t
| TC_map (_,_) , [kt;vt] -> ok @@ t_map kt vt
| TC_big_map (_,_) , [kt;vt] -> ok @@ t_big_map kt vt
| TC_contract _ , [t] -> ok @@ t_contract t
| TC_set _ , [t] -> ok @@ t_set ?loc t
| TC_list _ , [t] -> ok @@ t_list ?loc t
| TC_option _ , [t] -> ok @@ t_option ?loc t
| TC_map (_,_) , [kt;vt] -> ok @@ t_map ?loc kt vt
| TC_big_map (_,_) , [kt;vt] -> ok @@ t_big_map ?loc kt vt
| TC_contract _ , [t] -> ok @@ t_contract ?loc t
| _ , _ -> fail @@ bad_type_operator op
let make_e ?(loc = Location.generated) expression_content =

52
src/stages/2-ast_sugar/combinators.mli
View File

@ -9,42 +9,42 @@ module Errors : sig
val bad_kind : name -> Location.t -> unit -> error
end
*)
val make_t : type_content -> type_expression
val t_bool : type_expression
val t_string : type_expression
val t_bytes : type_expression
val t_int : type_expression
val t_operation : type_expression
val t_nat : type_expression
val t_tez : type_expression
val t_unit : type_expression
val t_address : type_expression
val t_key : type_expression
val t_key_hash : type_expression
val t_timestamp : type_expression
val t_signature : type_expression
val make_t : ?loc:Location.t -> type_content -> type_expression
val t_bool : ?loc:Location.t -> unit -> type_expression
val t_string : ?loc:Location.t -> unit -> type_expression
val t_bytes : ?loc:Location.t -> unit -> type_expression
val t_int : ?loc:Location.t -> unit -> type_expression
val t_operation : ?loc:Location.t -> unit -> type_expression
val t_nat : ?loc:Location.t -> unit -> type_expression
val t_tez : ?loc:Location.t -> unit -> type_expression
val t_unit : ?loc:Location.t -> unit -> type_expression
val t_address : ?loc:Location.t -> unit -> type_expression
val t_key : ?loc:Location.t -> unit -> type_expression
val t_key_hash : ?loc:Location.t -> unit -> type_expression
val t_timestamp : ?loc:Location.t -> unit -> type_expression
val t_signature : ?loc:Location.t -> unit -> type_expression
(*
val t_option : type_expression -> type_expression
*)
val t_list : type_expression -> type_expression
val t_variable : string -> type_expression
val t_list : ?loc:Location.t -> type_expression -> type_expression
val t_variable : ?loc:Location.t -> string -> type_expression
(*
val t_record : te_map -> type_expression
*)
val t_pair : ( type_expression * type_expression ) -> type_expression
val t_tuple : type_expression list -> type_expression
val t_pair : ?loc:Location.t -> ( type_expression * type_expression ) -> type_expression
val t_tuple : ?loc:Location.t -> type_expression list -> type_expression
val t_record : type_expression Map.String.t -> type_expression
val t_record_ez : (string * type_expression) list -> type_expression
val t_record : ?loc:Location.t -> type_expression Map.String.t -> type_expression
val t_record_ez : ?loc:Location.t -> (string * type_expression) list -> type_expression
val t_sum : type_expression Map.String.t -> type_expression
val ez_t_sum : ( string * type_expression ) list -> type_expression
val t_sum : ?loc:Location.t -> type_expression Map.String.t -> type_expression
val ez_t_sum : ?loc:Location.t -> ( string * type_expression ) list -> type_expression
val t_function : type_expression -> type_expression -> type_expression
val t_map : type_expression -> type_expression -> type_expression
val t_function : ?loc:Location.t -> type_expression -> type_expression -> type_expression
val t_map : ?loc:Location.t -> type_expression -> type_expression -> type_expression
val t_operator : type_operator -> type_expression list -> type_expression result
val t_set : type_expression -> type_expression
val t_operator : ?loc:Location.t -> type_operator -> type_expression list -> type_expression result
val t_set : ?loc:Location.t -> type_expression -> type_expression
val make_e : ?loc:Location.t -> expression_content -> expression
val e_literal : ?loc:Location.t -> literal -> expression

2
src/stages/2-ast_sugar/types.ml
View File

@ -25,7 +25,7 @@ and type_operator =
| TC_big_map of type_expression * type_expression
| TC_arrow of type_expression * type_expression
and type_expression = {type_content: type_content}
and type_expression = {type_content: type_content; location: Location.t}
type program = declaration Location.wrap list

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

@ -19,7 +19,7 @@ module Errors = struct
end
open Errors
let make_t type_content = {type_content; type_meta = ()}
let make_t ?(loc = Location.generated) type_content = {type_content; location=loc; type_meta = ()}
let tuple_to_record lst =
@ -27,56 +27,56 @@ let tuple_to_record lst =
let (_, lst ) = List.fold_left aux (0,[]) lst in
lst
let t_bool : type_expression = make_t @@ T_constant (TC_bool)
let t_string : type_expression = make_t @@ T_constant (TC_string)
let t_bytes : type_expression = make_t @@ T_constant (TC_bytes)
let t_int : type_expression = make_t @@ T_constant (TC_int)
let t_operation : type_expression = make_t @@ T_constant (TC_operation)
let t_nat : type_expression = make_t @@ T_constant (TC_nat)
let t_tez : type_expression = make_t @@ T_constant (TC_mutez)
let t_unit : type_expression = make_t @@ T_constant (TC_unit)
let t_address : type_expression = make_t @@ T_constant (TC_address)
let t_signature : type_expression = make_t @@ T_constant (TC_signature)
let t_key : type_expression = make_t @@ T_constant (TC_key)
let t_key_hash : type_expression = make_t @@ T_constant (TC_key_hash)
let t_timestamp : type_expression = make_t @@ T_constant (TC_timestamp)
let t_option o : type_expression = make_t @@ T_operator (TC_option o)
let t_list t : type_expression = make_t @@ T_operator (TC_list t)
let t_variable n : type_expression = make_t @@ T_variable (Var.of_name n)
let t_record_ez lst =
let t_bool ?loc () : type_expression = make_t ?loc @@ T_constant (TC_bool)
let t_string ?loc () : type_expression = make_t ?loc @@ T_constant (TC_string)
let t_bytes ?loc () : type_expression = make_t ?loc @@ T_constant (TC_bytes)
let t_int ?loc () : type_expression = make_t ?loc @@ T_constant (TC_int)
let t_operation ?loc () : type_expression = make_t ?loc @@ T_constant (TC_operation)
let t_nat ?loc () : type_expression = make_t ?loc @@ T_constant (TC_nat)
let t_tez ?loc () : type_expression = make_t ?loc @@ T_constant (TC_mutez)
let t_unit ?loc () : type_expression = make_t ?loc @@ T_constant (TC_unit)
let t_address ?loc () : type_expression = make_t ?loc @@ T_constant (TC_address)
let t_signature ?loc () : type_expression = make_t ?loc @@ T_constant (TC_signature)
let t_key ?loc () : type_expression = make_t ?loc @@ T_constant (TC_key)
let t_key_hash ?loc () : type_expression = make_t ?loc @@ T_constant (TC_key_hash)
let t_timestamp ?loc () : type_expression = make_t ?loc @@ T_constant (TC_timestamp)
let t_option ?loc o : type_expression = make_t ?loc @@ T_operator (TC_option o)
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.map (fun (k, v) -> (Label k, v)) lst in
let m = LMap.of_list lst in
make_t @@ T_record m
let t_record m : type_expression =
make_t ?loc @@ T_record m
let t_record ?loc m : type_expression =
let lst = Map.String.to_kv_list m in
t_record_ez lst
t_record_ez ?loc lst
let t_pair (a , b) : type_expression = t_record_ez [("0",a) ; ("1",b)]
let t_tuple lst : type_expression = t_record_ez (tuple_to_record lst)
let t_pair ?loc (a , b) : type_expression = t_record_ez ?loc [("0",a) ; ("1",b)]
let t_tuple ?loc lst : type_expression = t_record_ez ?loc (tuple_to_record lst)
let ez_t_sum (lst:(string * type_expression) list) : type_expression =
let ez_t_sum ?loc (lst:(string * type_expression) list) : type_expression =
let aux prev (k, v) = CMap.add (Constructor k) v prev in
let map = List.fold_left aux CMap.empty lst in
make_t @@ T_sum map
let t_sum m : type_expression =
make_t ?loc @@ T_sum map
let t_sum ?loc m : type_expression =
let lst = Map.String.to_kv_list m in
ez_t_sum lst
ez_t_sum ?loc lst
let t_function type1 type2 : type_expression = make_t @@ T_arrow {type1; type2}
let t_map key value : type_expression = make_t @@ T_operator (TC_map (key, value))
let t_big_map key value : type_expression = make_t @@ T_operator (TC_big_map (key , value))
let t_set key : type_expression = make_t @@ T_operator (TC_set key)
let t_contract contract : type_expression = make_t @@ T_operator (TC_contract contract)
let t_function ?loc type1 type2 : type_expression = make_t ?loc @@ T_arrow {type1; type2}
let t_map ?loc key value : type_expression = make_t ?loc @@ T_operator (TC_map (key, value))
let t_big_map ?loc key value : type_expression = make_t ?loc @@ T_operator (TC_big_map (key , value))
let t_set ?loc key : type_expression = make_t ?loc @@ T_operator (TC_set key)
let t_contract ?loc contract : type_expression = make_t ?loc @@ T_operator (TC_contract contract)
(* TODO find a better way than using list*)
let t_operator op lst: type_expression result =
let t_operator ?loc op lst: type_expression result =
match op,lst with
| TC_set _ , [t] -> ok @@ t_set t
| TC_list _ , [t] -> ok @@ t_list t
| TC_option _ , [t] -> ok @@ t_option t
| TC_map (_,_) , [kt;vt] -> ok @@ t_map kt vt
| TC_big_map (_,_) , [kt;vt] -> ok @@ t_big_map kt vt
| TC_contract _ , [t] -> ok @@ t_contract t
| TC_set _ , [t] -> ok @@ t_set ?loc t
| TC_list _ , [t] -> ok @@ t_list ?loc t
| TC_option _ , [t] -> ok @@ t_option ?loc t
| TC_map (_,_) , [kt;vt] -> ok @@ t_map kt ?loc vt
| TC_big_map (_,_) , [kt;vt] -> ok @@ t_big_map ?loc kt vt
| TC_contract _ , [t] -> ok @@ t_contract ?loc t
| _ , _ -> fail @@ bad_type_operator op
let make_e ?(loc = Location.generated) expression_content = { expression_content; location=loc }

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

@ -9,42 +9,42 @@ module Errors : sig
val bad_kind : name -> Location.t -> unit -> error
end
*)
val make_t : type_content -> type_expression
val t_bool : type_expression
val t_string : type_expression
val t_bytes : type_expression
val t_int : type_expression
val t_operation : type_expression
val t_nat : type_expression
val t_tez : type_expression
val t_unit : type_expression
val t_address : type_expression
val t_key : type_expression
val t_key_hash : type_expression
val t_timestamp : type_expression
val t_signature : type_expression
val make_t : ?loc:Location.t -> type_content -> type_expression
val t_bool : ?loc:Location.t -> unit -> type_expression
val t_string : ?loc:Location.t -> unit -> type_expression
val t_bytes : ?loc:Location.t -> unit -> type_expression
val t_int : ?loc:Location.t -> unit -> type_expression
val t_operation : ?loc:Location.t -> unit -> type_expression
val t_nat : ?loc:Location.t -> unit -> type_expression
val t_tez : ?loc:Location.t -> unit -> type_expression
val t_unit : ?loc:Location.t -> unit -> type_expression
val t_address : ?loc:Location.t -> unit -> type_expression
val t_key : ?loc:Location.t -> unit -> type_expression
val t_key_hash : ?loc:Location.t -> unit -> type_expression
val t_timestamp : ?loc:Location.t -> unit -> type_expression
val t_signature : ?loc:Location.t -> unit -> type_expression
(*
val t_option : type_expression -> type_expression
*)
val t_list : type_expression -> type_expression
val t_variable : string -> type_expression
val t_list : ?loc:Location.t -> type_expression -> type_expression
val t_variable : ?loc:Location.t -> string -> type_expression
(*
val t_record : te_map -> type_expression
*)
val t_pair : ( type_expression * type_expression ) -> type_expression
val t_tuple : type_expression list -> type_expression
val t_pair : ?loc:Location.t -> ( type_expression * type_expression ) -> type_expression
val t_tuple : ?loc:Location.t -> type_expression list -> type_expression
val t_record : type_expression Map.String.t -> type_expression
val t_record_ez : (string * type_expression) list -> type_expression
val t_record : ?loc:Location.t -> type_expression Map.String.t -> type_expression
val t_record_ez : ?loc:Location.t -> (string * type_expression) list -> type_expression
val t_sum : type_expression Map.String.t -> type_expression
val ez_t_sum : ( string * type_expression ) list -> type_expression
val t_sum : ?loc:Location.t -> type_expression Map.String.t -> type_expression
val ez_t_sum : ?loc:Location.t -> ( string * type_expression ) list -> type_expression
val t_function : type_expression -> type_expression -> type_expression
val t_map : type_expression -> type_expression -> type_expression
val t_function : ?loc:Location.t -> type_expression -> type_expression -> type_expression
val t_map : ?loc:Location.t -> type_expression -> type_expression -> type_expression
val t_operator : type_operator -> type_expression list -> type_expression result
val t_set : type_expression -> type_expression
val t_operator : ?loc:Location.t -> type_operator -> type_expression list -> type_expression result
val t_set : ?loc:Location.t -> type_expression -> type_expression
val make_e : ?loc:Location.t -> expression_content -> expression
val e_var : ?loc:Location.t -> string -> expression

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

@ -23,7 +23,7 @@ module Errors = struct
error (thunk "No declaration with the given name") message
end
let make_t type_content core = { type_content ; type_meta=core }
let make_t ?(loc = Location.generated) type_content core = {type_content; location=loc; type_meta = core}
let make_e ?(location = Location.generated) expression_content type_expression environment = {
expression_content ;
type_expression ;
@ -32,48 +32,48 @@ let make_e ?(location = Location.generated) expression_content type_expression e
}
let make_n_t type_name type_value = { type_name ; type_value }
let t_signature ?s () : type_expression = make_t (T_constant TC_signature) s
let t_chain_id ?s () : type_expression = make_t (T_constant TC_chain_id) s
let t_bool ?s () : type_expression = make_t (T_constant TC_bool) s
let t_string ?s () : type_expression = make_t (T_constant TC_string) s
let t_bytes ?s () : type_expression = make_t (T_constant TC_bytes) s
let t_key ?s () : type_expression = make_t (T_constant TC_key) s
let t_key_hash ?s () : type_expression = make_t (T_constant TC_key_hash) s
let t_int ?s () : type_expression = make_t (T_constant TC_int) s
let t_address ?s () : type_expression = make_t (T_constant TC_address) s
let t_operation ?s () : type_expression = make_t (T_constant TC_operation) s
let t_nat ?s () : type_expression = make_t (T_constant TC_nat) s
let t_mutez ?s () : type_expression = make_t (T_constant TC_mutez) s
let t_timestamp ?s () : type_expression = make_t (T_constant TC_timestamp) s
let t_unit ?s () : type_expression = make_t (T_constant TC_unit) s
let t_option o ?s () : type_expression = make_t (T_operator (TC_option o)) s
let t_variable t ?s () : type_expression = make_t (T_variable t) s
let t_list t ?s () : type_expression = make_t (T_operator (TC_list t)) s
let t_set t ?s () : type_expression = make_t (T_operator (TC_set t)) s
let t_contract t ?s () : type_expression = make_t (T_operator (TC_contract t)) s
let t_signature ?loc ?s () : type_expression = make_t ?loc (T_constant TC_signature) s
let t_chain_id ?loc ?s () : type_expression = make_t ?loc (T_constant TC_chain_id) s
let t_bool ?loc ?s () : type_expression = make_t ?loc (T_constant TC_bool) s
let t_string ?loc ?s () : type_expression = make_t ?loc (T_constant TC_string) s
let t_bytes ?loc ?s () : type_expression = make_t ?loc (T_constant TC_bytes) s
let t_key ?loc ?s () : type_expression = make_t ?loc (T_constant TC_key) s
let t_key_hash ?loc ?s () : type_expression = make_t ?loc (T_constant TC_key_hash) s
let t_int ?loc ?s () : type_expression = make_t ?loc (T_constant TC_int) s
let t_address ?loc ?s () : type_expression = make_t ?loc (T_constant TC_address) s
let t_operation ?loc ?s () : type_expression = make_t ?loc (T_constant TC_operation) s
let t_nat ?loc ?s () : type_expression = make_t ?loc (T_constant TC_nat) s
let t_mutez ?loc ?s () : type_expression = make_t ?loc (T_constant TC_mutez) s
let t_timestamp ?loc ?s () : type_expression = make_t ?loc (T_constant TC_timestamp) s
let t_unit ?loc ?s () : type_expression = make_t ?loc (T_constant TC_unit) s
let t_option o ?loc ?s () : type_expression = make_t ?loc (T_operator (TC_option o)) s
let t_variable t ?loc ?s () : type_expression = make_t ?loc (T_variable t) s
let t_list t ?loc ?s () : type_expression = make_t ?loc (T_operator (TC_list t)) s
let t_set t ?loc ?s () : type_expression = make_t ?loc (T_operator (TC_set t)) s
let t_contract t ?loc ?s () : type_expression = make_t ?loc (T_operator (TC_contract t)) s
let t_record m ?s () : type_expression = make_t (T_record m) s
let make_t_ez_record (lst:(string * type_expression) list) : type_expression =
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.map (fun (x,y) -> (Label x, y) ) lst in
let map = LMap.of_list lst in
make_t (T_record map) None
let ez_t_record lst ?s () : type_expression =
make_t ?loc (T_record map) None
let ez_t_record lst ?loc ?s () : type_expression =
let m = LMap.of_list lst in
t_record m ?s ()
let t_pair a b ?s () : type_expression = ez_t_record [(Label "0",a) ; (Label "1",b)] ?s ()
t_record m ?loc ?s ()
let t_pair a b ?loc ?s () : type_expression = ez_t_record [(Label "0",a) ; (Label "1",b)] ?loc ?s ()
let t_map k v ?s () = make_t (T_operator (TC_map { k ; v })) s
let t_big_map k v ?s () = make_t (T_operator (TC_big_map { k ; v })) s
let t_map_or_big_map k v ?s () = make_t (T_operator (TC_map_or_big_map { k ; v })) 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
let t_map_or_big_map ?loc k v ?s () = make_t ?loc (T_operator (TC_map_or_big_map { k ; v })) s
let t_sum m ?s () : type_expression = make_t (T_sum m) s
let make_t_ez_sum (lst:(constructor' * type_expression) list) : type_expression =
let t_sum m ?loc ?s () : type_expression = make_t ?loc (T_sum m) s
let make_t_ez_sum ?loc (lst:(constructor' * type_expression) list) : type_expression =
let aux prev (k, v) = CMap.add k v prev in
let map = List.fold_left aux CMap.empty lst in
make_t (T_sum map) None
make_t ?loc (T_sum map) None
let t_function param result ?s () : type_expression = make_t (T_arrow {type1=param; type2=result}) s
let t_shallow_closure param result ?s () : type_expression = make_t (T_arrow {type1=param; type2=result}) s
let t_function param result ?loc ?s () : type_expression = make_t ?loc (T_arrow {type1=param; type2=result}) s
let t_shallow_closure param result ?loc ?s () : type_expression = make_t ?loc (T_arrow {type1=param; type2=result}) s
let get_type_expression (x:expression) = x.type_expression
let get_type' (x:type_expression) = x.type_content

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

@ -2,40 +2,40 @@ open Trace
open Types
val make_n_t : type_variable -> type_expression -> named_type_content
val make_t : type_content -> S.type_expression option -> type_expression
val make_t : ?loc:Location.t -> type_content -> S.type_expression option -> type_expression
val make_e : ?location:Location.t -> expression_content -> type_expression -> full_environment -> expression
val t_bool : ?s:S.type_expression -> unit -> type_expression
val t_string : ?s:S.type_expression -> unit -> type_expression
val t_bytes : ?s:S.type_expression -> unit -> type_expression
val t_key : ?s:S.type_expression -> unit -> type_expression
val t_key_hash : ?s:S.type_expression -> unit -> type_expression
val t_operation : ?s:S.type_expression -> unit -> type_expression
val t_timestamp : ?s:S.type_expression -> unit -> type_expression
val t_set : type_expression -> ?s:S.type_expression -> unit -> type_expression
val t_contract : type_expression -> ?s:S.type_expression -> unit -> type_expression
val t_int : ?s:S.type_expression -> unit -> type_expression
val t_nat : ?s:S.type_expression -> unit -> type_expression
val t_mutez : ?s:S.type_expression -> unit -> type_expression
val t_address : ?s:S.type_expression -> unit -> type_expression
val t_chain_id : ?s:S.type_expression -> unit -> type_expression
val t_signature : ?s:S.type_expression -> unit -> type_expression
val t_unit : ?s:S.type_expression -> unit -> type_expression
val t_option : type_expression -> ?s:S.type_expression -> unit -> type_expression
val t_pair : type_expression -> type_expression -> ?s:S.type_expression -> unit -> type_expression
val t_list : type_expression -> ?s:S.type_expression -> unit -> type_expression
val t_variable : type_variable -> ?s:S.type_expression -> unit -> type_expression
val t_record : type_expression label_map -> ?s:S.type_expression -> unit -> type_expression
val make_t_ez_record : (string* type_expression) list -> type_expression
val ez_t_record : ( label * type_expression ) list -> ?s:S.type_expression -> unit -> type_expression
val t_bool : ?loc:Location.t -> ?s:S.type_expression -> unit -> type_expression
val t_string : ?loc:Location.t -> ?s:S.type_expression -> unit -> type_expression
val t_bytes : ?loc:Location.t -> ?s:S.type_expression -> unit -> type_expression
val t_key : ?loc:Location.t -> ?s:S.type_expression -> unit -> type_expression
val t_key_hash : ?loc:Location.t -> ?s:S.type_expression -> unit -> type_expression
val t_operation : ?loc:Location.t -> ?s:S.type_expression -> unit -> type_expression
val t_timestamp : ?loc:Location.t -> ?s:S.type_expression -> unit -> type_expression
val t_set : type_expression -> ?loc:Location.t -> ?s:S.type_expression -> unit -> type_expression
val t_contract : type_expression -> ?loc:Location.t -> ?s:S.type_expression -> unit -> type_expression
val t_int : ?loc:Location.t -> ?s:S.type_expression -> unit -> type_expression
val t_nat : ?loc:Location.t -> ?s:S.type_expression -> unit -> type_expression
val t_mutez : ?loc:Location.t -> ?s:S.type_expression -> unit -> type_expression
val t_address : ?loc:Location.t -> ?s:S.type_expression -> unit -> type_expression
val t_chain_id : ?loc:Location.t -> ?s:S.type_expression -> unit -> type_expression
val t_signature : ?loc:Location.t -> ?s:S.type_expression -> unit -> type_expression
val t_unit : ?loc:Location.t -> ?s:S.type_expression -> unit -> type_expression
val t_option : type_expression -> ?loc:Location.t -> ?s:S.type_expression -> unit -> type_expression
val t_pair : type_expression -> type_expression -> ?loc:Location.t -> ?s:S.type_expression -> unit -> type_expression
val t_list : type_expression -> ?loc:Location.t -> ?s:S.type_expression -> unit -> type_expression
val t_variable : type_variable -> ?loc:Location.t -> ?s:S.type_expression -> unit -> type_expression
val t_record : type_expression label_map -> ?loc:Location.t -> ?s:S.type_expression -> unit -> type_expression
val make_t_ez_record : ?loc:Location.t -> (string* type_expression) list -> type_expression
val ez_t_record : ( label * type_expression ) list -> ?loc:Location.t -> ?s:S.type_expression -> unit -> type_expression
val t_map : type_expression -> type_expression -> ?s:S.type_expression -> unit -> type_expression
val t_big_map : type_expression -> type_expression -> ?s:S.type_expression -> unit -> type_expression
val t_map_or_big_map : type_expression -> type_expression -> ?s:S.type_expression -> unit -> type_expression
val t_sum : type_expression constructor_map -> ?s:S.type_expression -> unit -> type_expression
val make_t_ez_sum : ( constructor' * type_expression ) list -> type_expression
val t_function : type_expression -> type_expression -> ?s:S.type_expression -> unit -> type_expression
val t_shallow_closure : type_expression -> type_expression -> ?s:S.type_expression -> unit -> type_expression
val t_map : ?loc:Location.t -> type_expression -> type_expression -> ?s:S.type_expression -> unit -> type_expression
val t_big_map : ?loc:Location.t -> type_expression -> type_expression -> ?s:S.type_expression -> unit -> type_expression
val t_map_or_big_map : ?loc:Location.t -> type_expression -> type_expression -> ?s:S.type_expression -> unit -> type_expression
val t_sum : type_expression constructor_map -> ?loc:Location.t -> ?s:S.type_expression -> unit -> type_expression
val make_t_ez_sum : ?loc:Location.t -> ( constructor' * type_expression ) list -> type_expression
val t_function : type_expression -> type_expression -> ?loc:Location.t -> ?s:S.type_expression -> unit -> type_expression
val t_shallow_closure : type_expression -> type_expression -> ?loc:Location.t -> ?s:S.type_expression -> unit -> type_expression
val get_type_expression : expression -> type_expression
val get_type' : type_expression -> type_content
val get_environment : expression -> full_environment

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

@ -61,6 +61,7 @@ and type_operator =
and type_expression = {
type_content: type_content;
type_meta: type_meta;
location: location;
}
type literal =
@ -413,4 +414,3 @@ and named_type_content = {
type_name : type_variable;
type_value : type_expression;
}

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

@ -58,7 +58,7 @@ module Ast_generic_type (PARAMETER : AST_PARAMETER_TYPE) = struct
| TC_arrow of type_expression * type_expression
and type_expression = {type_content: type_content; type_meta: type_meta}
and type_expression = {type_content: type_content; location: Location.t; type_meta: type_meta}
open Trace
let map_type_operator f = function

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

@ -104,14 +104,14 @@ module Substitution = struct
| Ast_core.T_constant constant ->
ok @@ Ast_core.T_constant constant
and s_abstr_type_expression : Ast_core.type_expression w = fun ~substs {type_content;type_meta} ->
and s_abstr_type_expression : Ast_core.type_expression w = fun ~substs {type_content;location;type_meta} ->
let%bind type_content = s_abstr_type_content ~substs type_content in
ok @@ Ast_core.{type_content;type_meta}
ok @@ Ast_core.{type_content;location;type_meta}
and s_type_expression : T.type_expression w = fun ~substs { type_content; type_meta } ->
and s_type_expression : T.type_expression w = fun ~substs { type_content; location; type_meta } ->
let%bind type_content = s_type_content ~substs type_content in
let%bind type_meta = bind_map_option (s_abstr_type_expression ~substs) type_meta in
ok @@ T.{ type_content; type_meta}
ok @@ T.{ type_content; location; type_meta}
and s_literal : T.literal w = fun ~substs -> function
| T.Literal_unit ->
let () = ignore @@ substs in

18
src/test/coase_tests.ml
View File

@ -36,14 +36,14 @@ let card owner =
]
let card_ty = t_record_ez [
("card_owner" , t_address) ;
("card_pattern" , t_nat) ;
("card_owner" , t_address ()) ;
("card_pattern" , t_nat ()) ;
]
let card_ez owner = card (e_address owner)
let make_cards assoc_lst =
let card_id_ty = t_nat in
let card_id_ty = t_nat () in
e_typed_map assoc_lst card_id_ty card_ty
let card_pattern (coeff , qtt) =
@ -54,15 +54,15 @@ let card_pattern (coeff , qtt) =
let card_pattern_ty =
t_record_ez [
("coefficient" , t_tez) ;
("quantity" , t_nat) ;
("coefficient" , t_tez ()) ;
("quantity" , t_nat ()) ;
]
let card_pattern_ez (coeff , qtt) =
card_pattern (e_mutez coeff , e_nat qtt)
let make_card_patterns lst =
let card_pattern_id_ty = t_nat in
let card_pattern_id_ty = t_nat () in
let assoc_lst = List.mapi (fun i x -> (e_nat i , x)) lst in
e_typed_map assoc_lst card_pattern_id_ty card_pattern_ty
@ -112,7 +112,7 @@ let buy () =
e_pair buy_action storage
in
let make_expected = fun n ->
let ops = e_typed_list [] t_operation in
let ops = e_typed_list [] (t_operation ()) in
let storage =
let cards =
cards_ez first_owner n @
@ -151,7 +151,7 @@ let dispatch_buy () =
e_pair action storage
in
let make_expected = fun n ->
let ops = e_typed_list [] t_operation in
let ops = e_typed_list [] (t_operation ()) in
let storage =
let cards =
cards_ez first_owner n @
@ -190,7 +190,7 @@ let transfer () =
e_pair transfer_action storage
in
let make_expected = fun n ->
let ops = e_typed_list [] t_operation in
let ops = e_typed_list [] (t_operation ()) in
let storage =
let cards =
let new_card = card_ez second_owner in

12
src/test/hash_lock_tests.ml
View File

@ -43,9 +43,9 @@ let (first_committer , first_contract) =
Protocol.Alpha_context.Contract.to_b58check kt , kt
let empty_op_list =
(e_typed_list [] t_operation)
(e_typed_list [] (t_operation ()))
let empty_message = e_lambda (Var.of_name "arguments")
(Some t_unit) (Some (t_list t_operation))
(Some (t_unit ())) (Some (t_list (t_operation ())))
empty_op_list
@ -61,8 +61,8 @@ let commit () =
packed_sender]))
in
let pre_commits = e_typed_big_map [] t_address (t_record_ez [("date", t_timestamp);
("salted_hash", t_bytes)])
let pre_commits = e_typed_big_map [] (t_address ()) (t_record_ez [("date", (t_timestamp ()));
("salted_hash", (t_bytes ()))])
in
let init_storage = storage test_hash true pre_commits in
let commit =
@ -91,8 +91,8 @@ let reveal_no_commit () =
in
let test_hash_raw = sha_256_hash (Bytes.of_string "hello world") in
let test_hash = e_bytes_raw test_hash_raw in
let pre_commits = e_typed_big_map [] t_address (t_record_ez [("date", t_timestamp);
("salted_hash", t_bytes)])
let pre_commits = e_typed_big_map [] (t_address ()) (t_record_ez [("date", (t_timestamp ()));
("salted_hash", (t_bytes ()))])
in
let init_storage = storage test_hash true pre_commits in
expect_string_failwith program "reveal"

6
src/test/id_tests.ml
View File

@ -87,7 +87,7 @@ let buy_id_sender_addr () =
("controller", e_address new_addr) ;
("profile", new_website)]
in
let param = e_pair owner_website (e_typed_none t_address) in
let param = e_pair owner_website (e_typed_none (t_address ())) in
let new_storage = e_tuple [(e_big_map [(e_int 0, id_details_1) ;
(e_int 1, id_details_2)]) ;
e_int 2;
@ -297,8 +297,8 @@ let update_details_unchanged () =
e_tuple [e_mutez 1000000 ; e_mutez 1000000]]
in
let param = e_tuple [e_int 1 ;
e_typed_none t_bytes ;
e_typed_none t_address] in
e_typed_none (t_bytes ()) ;
e_typed_none (t_address ())] in
let%bind () = expect_eq ~options program "update_details"
(e_pair param storage)
(e_pair (e_list []) storage)

80
src/test/integration_tests.ml
View File

@ -945,11 +945,11 @@ let option () : unit result =
expect_eq_evaluate program "s" expected
in
let%bind () =
let expected = e_typed_none t_int in
let expected = e_typed_none (t_int ()) in
expect_eq_evaluate program "n" expected
in
let%bind () =
let expected = e_typed_none t_int in
let expected = e_typed_none (t_int ()) in
expect_eq program "assign" (e_int 12) expected
in
ok ()
@ -961,7 +961,7 @@ let moption () : unit result =
expect_eq_evaluate program "s" expected
in
let%bind () =
let expected = e_typed_none t_int in
let expected = e_typed_none (t_int ()) in
expect_eq_evaluate program "n" expected
in
ok ()
@ -973,7 +973,7 @@ let reoption () : unit result =
expect_eq_evaluate program "s" expected
in
let%bind () =
let expected = e_typed_none t_int in
let expected = e_typed_none (t_int ()) in
expect_eq_evaluate program "n" expected
in
ok ()
@ -983,7 +983,7 @@ let map_ type_f path : unit result =
let%bind program = type_f path in
let ez lst =
let lst' = List.map (fun (x, y) -> e_int x, e_int y) lst in
e_typed_map lst' t_int t_int
e_typed_map lst' (t_int ()) (t_int ())
in
let%bind () =
let make_input = fun n ->
@ -1036,7 +1036,7 @@ let map_ type_f path : unit result =
expect_eq program "mem" (e_tuple [(e_int 1000) ; input_map]) (e_bool false)
in
let%bind () = expect_eq_evaluate program "empty_map"
(e_annotation (e_map []) (t_map t_int t_int)) in
(e_annotation (e_map []) (t_map (t_int()) (t_int()))) in
let%bind () =
let expected = ez @@ List.map (fun x -> (x, 23)) [144 ; 51 ; 42 ; 120 ; 421] in
expect_eq_evaluate program "map1" expected
@ -1071,7 +1071,7 @@ let big_map_ type_f path : unit result =
let%bind program = type_f path in
let ez lst =
let lst' = List.map (fun (x, y) -> e_int x, e_int y) lst in
(e_typed_big_map lst' t_int t_int)
(e_typed_big_map lst' (t_int ()) (t_int()))
in
let%bind () =
let make_input = fun n ->
@ -1111,7 +1111,7 @@ let list () : unit result =
let%bind program = type_file "./contracts/list.ligo" in
let ez lst =
let lst' = List.map e_int lst in
e_typed_list lst' t_int
e_typed_list lst' (t_int ())
in
let%bind () =
let expected = ez [23 ; 42] in
@ -1287,7 +1287,7 @@ let loop () : unit result =
let%bind () =
let ez lst =
let lst' = List.map (fun (x, y) -> e_string x, e_int y) lst in
e_typed_map lst' t_string t_int
e_typed_map lst' (t_string ()) (t_int ())
in
let expected = ez [ ("I" , 12) ; ("am" , 12) ; ("foo" , 12) ] in
expect_eq program "for_collection_with_patches" input expected in
@ -1352,7 +1352,7 @@ let matching () : unit result =
let aux n =
let input = match n with
| Some s -> e_some (e_int s)
| None -> e_typed_none t_int in
| None -> e_typed_none (t_int ()) in
let expected = e_int (match n with
| Some s -> s
| None -> 23) in
@ -1366,7 +1366,7 @@ let matching () : unit result =
let aux n =
let input = match n with
| Some s -> e_some (e_int s)
| None -> e_typed_none t_int in
| None -> e_typed_none (t_int ()) in
let expected = e_int (match n with
| Some s -> s
| None -> 42) in
@ -1377,7 +1377,7 @@ let matching () : unit result =
[Some 0 ; Some 2 ; Some 42 ; Some 163 ; Some (-1) ; None]
in
let%bind () =
let aux lst = e_annotation (e_list @@ List.map e_int lst) (t_list t_int) in
let aux lst = e_annotation (e_list @@ List.map e_int lst) (t_list (t_int ())) in
let%bind () = expect_eq program "match_expr_list" (aux [ 14 ; 2 ; 3 ]) (e_int 14) in
let%bind () = expect_eq program "match_expr_list" (aux [ 13 ; 2 ; 3 ]) (e_int 13) in
let%bind () = expect_eq program "match_expr_list" (aux []) (e_int (-1)) in
@ -1413,7 +1413,7 @@ let quote_declarations () : unit result =
let counter_contract () : unit result =
let%bind program = type_file "./contracts/counter.ligo" in
let make_input = fun n-> e_pair (e_int n) (e_int 42) in
let make_expected = fun n -> e_pair (e_typed_list [] t_operation) (e_int (42 + n)) in
let make_expected = fun n -> e_pair (e_typed_list [] (t_operation ())) (e_int (42 + n)) in
expect_eq_n program "main" make_input make_expected
let super_counter_contract () : unit result =
@ -1423,7 +1423,7 @@ let super_counter_contract () : unit result =
e_pair (e_constructor action (e_int n)) (e_int 42) in
let make_expected = fun n ->
let op = if n mod 2 = 0 then (+) else (-) in
e_pair (e_typed_list [] t_operation) (e_int (op 42 n)) in
e_pair (e_typed_list [] (t_operation ())) (e_int (op 42 n)) in
expect_eq_n program "main" make_input make_expected
let super_counter_contract_mligo () : unit result =
@ -1433,7 +1433,7 @@ let super_counter_contract_mligo () : unit result =
e_pair (e_constructor action (e_int n)) (e_int 42) in
let make_expected = fun n ->
let op = if n mod 2 = 0 then (+) else (-) in
e_pair (e_typed_list [] t_operation) (e_int (op 42 n)) in
e_pair (e_typed_list [] (t_operation ())) (e_int (op 42 n)) in
expect_eq_n program "main" make_input make_expected
let super_counter_contract_religo () : unit result =
@ -1443,7 +1443,7 @@ let super_counter_contract_religo () : unit result =
e_pair (e_constructor action (e_int n)) (e_int 42) in
let make_expected = fun n ->
let op = if n mod 2 = 0 then (+) else (-) in
e_pair (e_typed_list [] t_operation) (e_int (op 42 n)) in
e_pair (e_typed_list [] (t_operation())) (e_int (op 42 n)) in
expect_eq_n program "main" make_input make_expected
@ -1454,13 +1454,13 @@ let dispatch_counter_contract () : unit result =
e_pair (e_constructor action (e_int n)) (e_int 42) in
let make_expected = fun n ->
let op = if n mod 2 = 0 then (+) else (-) in
e_pair (e_typed_list [] t_operation) (e_int (op 42 n)) in
e_pair (e_typed_list [] (t_operation())) (e_int (op 42 n)) in
expect_eq_n program "main" make_input make_expected
let failwith_ligo () : unit result =
let%bind program = type_file "./contracts/failwith.ligo" in
let should_fail = expect_fail program "main" in
let should_work input = expect_eq program "main" input (e_pair (e_typed_list [] t_operation) (e_unit ())) in
let should_work input = expect_eq program "main" input (e_pair (e_typed_list [] (t_operation())) (e_unit ())) in
let%bind _ = should_work (e_pair (e_constructor "Zero" (e_nat 0)) (e_unit ())) in
let%bind _ = should_fail (e_pair (e_constructor "Zero" (e_nat 1)) (e_unit ())) in
let%bind _ = should_work (e_pair (e_constructor "Pos" (e_nat 1)) (e_unit ())) in
@ -1485,7 +1485,7 @@ let failwith_religo () : unit result =
let assert_mligo () : unit result =
let%bind program = mtype_file "./contracts/assert.mligo" in
let make_input b = e_pair (e_bool b) (e_unit ()) in
let make_expected = e_pair (e_typed_list [] t_operation) (e_unit ()) in
let make_expected = e_pair (e_typed_list [] (t_operation())) (e_unit ()) in
let%bind _ = expect_fail program "main" (make_input false) in
let%bind _ = expect_eq program "main" (make_input true) make_expected in
ok ()
@ -1493,7 +1493,7 @@ let assert_mligo () : unit result =
let assert_religo () : unit result =
let%bind program = retype_file "./contracts/assert.religo" in
let make_input b = e_pair (e_bool b) (e_unit ()) in
let make_expected = e_pair (e_typed_list [] t_operation) (e_unit ()) in
let make_expected = e_pair (e_typed_list [] (t_operation())) (e_unit ()) in
let%bind _ = expect_fail program "main" (make_input false) in
let%bind _ = expect_eq program "main" (make_input true) make_expected in
ok ()
@ -1541,7 +1541,7 @@ let recursion_religo () : unit result =
let guess_string_mligo () : unit result =
let%bind program = type_file "./contracts/guess_string.mligo" in
let make_input = fun n -> e_pair (e_int n) (e_int 42) in
let make_expected = fun n -> e_pair (e_typed_list [] t_operation) (e_int (42 + n))
let make_expected = fun n -> e_pair (e_typed_list [] (t_operation())) (e_int (42 + n))
in expect_eq_n program "main" make_input make_expected
let basic_mligo () : unit result =
@ -1555,13 +1555,13 @@ let basic_religo () : unit result =
let counter_mligo () : unit result =
let%bind program = mtype_file "./contracts/counter.mligo" in
let make_input n = e_pair (e_int n) (e_int 42) in
let make_expected n = e_pair (e_typed_list [] t_operation) (e_int (42 + n)) in
let make_expected n = e_pair (e_typed_list [] (t_operation ())) (e_int (42 + n)) in
expect_eq_n program "main" make_input make_expected
let counter_religo () : unit result =
let%bind program = retype_file "./contracts/counter.religo" in
let make_input n = e_pair (e_int n) (e_int 42) in
let make_expected n = e_pair (e_typed_list [] t_operation) (e_int (42 + n)) in
let make_expected n = e_pair (e_typed_list [] (t_operation ())) (e_int (42 + n)) in
expect_eq_n program "main" make_input make_expected
@ -1569,14 +1569,14 @@ let let_in_mligo () : unit result =
let%bind program = mtype_file "./contracts/letin.mligo" in
let make_input n = e_pair (e_int n) (e_pair (e_int 3) (e_int 5)) in
let make_expected n =
e_pair (e_typed_list [] t_operation) (e_pair (e_int (7+n)) (e_int (3+5)))
e_pair (e_typed_list [] (t_operation ())) (e_pair (e_int (7+n)) (e_int (3+5)))
in expect_eq_n program "main" make_input make_expected
let let_in_religo () : unit result =
let%bind program = retype_file "./contracts/letin.religo" in
let make_input n = e_pair (e_int n) (e_pair (e_int 3) (e_int 5)) in
let make_expected n =
e_pair (e_typed_list [] t_operation) (e_pair (e_int (7+n)) (e_int (3+5)))
e_pair (e_typed_list [] (t_operation ())) (e_pair (e_int (7+n)) (e_int (3+5)))
in expect_eq_n program "main" make_input make_expected
@ -1586,7 +1586,7 @@ let match_variant () : unit result =
let make_input n =
e_pair (e_constructor "Sub" (e_int n)) (e_int 3) in
let make_expected n =
e_pair (e_typed_list [] t_operation) (e_int (3-n))
e_pair (e_typed_list [] (t_operation ())) (e_int (3-n))
in expect_eq_n program "main" make_input make_expected in
let%bind () =
let input = e_bool true in
@ -1601,7 +1601,7 @@ let match_variant () : unit result =
let expected = e_int 3 in
expect_eq program "match_list" input expected in
let%bind () =
let input = e_typed_list [] t_int in
let input = e_typed_list [] (t_int ()) in
let expected = e_int 10 in
expect_eq program "match_list" input expected in
let%bind () =
@ -1615,7 +1615,7 @@ let match_variant_re () : unit result =
let make_input n =
e_pair (e_constructor "Sub" (e_int n)) (e_int 3) in
let make_expected n =
e_pair (e_typed_list [] t_operation) (e_int (3-n))
e_pair (e_typed_list [] (t_operation ())) (e_int (3-n))
in expect_eq_n program "main" make_input make_expected
@ -1624,7 +1624,7 @@ let match_matej () : unit result =
let make_input n =
e_pair (e_constructor "Decrement" (e_int n)) (e_int 3) in
let make_expected n =
e_pair (e_typed_list [] t_operation) (e_int (3-n))
e_pair (e_typed_list [] (t_operation ())) (e_int (3-n))
in expect_eq_n program "main" make_input make_expected
let match_matej_re () : unit result =
@ -1632,7 +1632,7 @@ let match_matej_re () : unit result =
let make_input n =
e_pair (e_constructor "Decrement" (e_int n)) (e_int 3) in
let make_expected n =
e_pair (e_typed_list [] t_operation) (e_int (3-n))
e_pair (e_typed_list [] (t_operation ())) (e_int (3-n))
in expect_eq_n program "main" make_input make_expected
@ -1646,7 +1646,7 @@ let mligo_list () : unit result =
e_pair (e_list [e_int n; e_int (2*n)])
(e_pair (e_int 3) (e_list [e_int 8])) in
let make_expected n =
e_pair (e_typed_list [] t_operation)
e_pair (e_typed_list [] (t_operation ()))
(e_pair (e_int (n+3)) (e_list [e_int (2*n)]))
in
expect_eq_n program "main" make_input make_expected
@ -1668,7 +1668,7 @@ let religo_list () : unit result =
e_pair (e_list [e_int n; e_int (2*n)])
(e_pair (e_int 3) (e_list [e_int 8])) in
let make_expected n =
e_pair (e_typed_list [] t_operation)
e_pair (e_typed_list [] (t_operation ()))
(e_pair (e_int (n+3)) (e_list [e_int (2*n)]))
in
expect_eq_n program "main" make_input make_expected
@ -1721,7 +1721,7 @@ let fibo_mligo () : unit result =
let website1_ligo () : unit result =
let%bind program = type_file "./contracts/website1.ligo" in
let make_input = fun n-> e_pair (e_int n) (e_int 42) in
let make_expected = fun _n -> e_pair (e_typed_list [] t_operation) (e_int (42 + 1)) in
let make_expected = fun _n -> e_pair (e_typed_list [] (t_operation ())) (e_int (42 + 1)) in
expect_eq_n program "main" make_input make_expected
let website2_ligo () : unit result =
@ -1731,7 +1731,7 @@ let website2_ligo () : unit result =
e_pair (e_constructor action (e_int n)) (e_int 42) in
let make_expected = fun n ->
let op = if n mod 2 = 0 then (+) else (-) in
e_pair (e_typed_list [] t_operation) (e_int (op 42 n)) in
e_pair (e_typed_list [] (t_operation ())) (e_int (op 42 n)) in
expect_eq_n program "main" make_input make_expected
let tez_ligo () : unit result =
@ -1764,7 +1764,7 @@ let website2_mligo () : unit result =
e_pair (e_constructor action (e_int n)) (e_int 42) in
let make_expected = fun n ->
let op = if n mod 2 = 0 then (+) else (-) in
e_pair (e_typed_list [] t_operation) (e_int (op 42 n)) in
e_pair (e_typed_list [] (t_operation ())) (e_int (op 42 n)) in
expect_eq_n program "main" make_input make_expected
let website2_religo () : unit result =
@ -1774,7 +1774,7 @@ let website2_religo () : unit result =
e_pair (e_constructor action (e_int n)) (e_int 42) in
let make_expected = fun n ->
let op = if n mod 2 = 0 then (+) else (-) in
e_pair (e_typed_list [] t_operation) (e_int (op 42 n)) in
e_pair (e_typed_list [] (t_operation ())) (e_int (op 42 n)) in
expect_eq_n program "main" make_input make_expected
@ -2004,7 +2004,7 @@ let deep_access_ligo () : unit result =
expect_eq program "asymetric_tuple_access" make_input make_expected in
let%bind () =
let make_input = e_record_ez [ ("nesty",
e_record_ez [ ("mymap", e_typed_map [] t_int t_string) ] ) ; ] in
e_record_ez [ ("mymap", e_typed_map [] (t_int ()) (t_string ())) ] ) ; ] in
let make_expected = e_string "one" in
expect_eq program "nested_record" make_input make_expected in
ok ()
@ -2160,7 +2160,7 @@ let set_delegate () : unit result =
let (raw_pkh,_,_) = Signature.generate_key () in
let pkh_str = Signature.Public_key_hash.to_b58check raw_pkh in
let%bind program = type_file "./contracts/set_delegate.ligo" in
let%bind () = expect_eq program "main" (e_key_hash pkh_str) (e_typed_list [] t_operation)
let%bind () = expect_eq program "main" (e_key_hash pkh_str) (e_typed_list [] (t_operation ()))
in ok ()
let set_delegate_mligo () : unit result =
@ -2168,7 +2168,7 @@ let set_delegate_mligo () : unit result =
let (raw_pkh,_,_) = Signature.generate_key () in
let pkh_str = Signature.Public_key_hash.to_b58check raw_pkh in
let%bind program = mtype_file "./contracts/set_delegate.mligo" in
let%bind () = expect_eq program "main" (e_key_hash pkh_str) (e_typed_list [] t_operation)
let%bind () = expect_eq program "main" (e_key_hash pkh_str) (e_typed_list [] (t_operation ()))
in ok ()
let set_delegate_religo () : unit result =
@ -2176,7 +2176,7 @@ let set_delegate_religo () : unit result =
let (raw_pkh,_,_) = Signature.generate_key () in
let pkh_str = Signature.Public_key_hash.to_b58check raw_pkh in
let%bind program = retype_file "./contracts/set_delegate.religo" in
let%bind () = expect_eq program "main" (e_key_hash pkh_str) (e_typed_list [] t_operation)
let%bind () = expect_eq program "main" (e_key_hash pkh_str) (e_typed_list [] (t_operation ()))
in ok ()
let type_tuple_destruct () : unit result =

8
src/test/multisig_tests.ml
View File

@ -40,13 +40,13 @@ let init_storage threshold counter pkeys =
("id" , e_string "MULTISIG" ) ;
("counter" , e_nat counter ) ;
("threshold" , e_nat threshold) ;
("auth" , e_typed_list keys t_key ) ;
("auth" , e_typed_list keys (t_key ())) ;
]
let empty_op_list =
(e_typed_list [] t_operation)
(e_typed_list [] (t_operation ()))
let empty_message = e_lambda (Var.of_name "arguments")
(Some t_unit) (Some (t_list t_operation))
(Some (t_unit ())) (Some (t_list (t_operation ())))
empty_op_list
let chain_id_zero = e_chain_id @@ Tezos_crypto.Base58.simple_encode
Tezos_base__TzPervasives.Chain_id.b58check_encoding
@ -71,7 +71,7 @@ let params counter msg keys is_validl f s =
(e_record_ez [
("counter" , e_nat counter ) ;
("message" , msg) ;
("signatures" , e_typed_list signed_msgs (t_pair (t_key_hash,t_signature)) ) ;
("signatures" , e_typed_list signed_msgs (t_pair (t_key_hash (),t_signature ())) ) ;
])
(* Provide one valid signature when the threshold is two of two keys *)

24
src/test/multisig_v2_tests.ml
View File

@ -27,13 +27,13 @@ let compile_main () =
open Ast_imperative
let empty_op_list =
(e_typed_list [] t_operation)
(e_typed_list [] (t_operation ()))
let empty_message = e_lambda (Var.of_name "arguments")
(Some t_bytes) (Some (t_list t_operation))
(Some (t_bytes ())) (Some (t_list (t_operation ())))
empty_op_list
let empty_message2 = e_lambda (Var.of_name "arguments")
(Some t_bytes) (Some (t_list t_operation))
( e_let_in ((Var.of_name "foo"),Some t_unit) false (e_unit ()) empty_op_list)
(Some (t_bytes ())) (Some (t_list (t_operation ())))
( e_let_in ((Var.of_name "foo"),Some (t_unit ())) false (e_unit ()) empty_op_list)
let send_param msg = e_constructor "Send" msg
let withdraw_param = e_constructor "Withdraw" empty_message
@ -54,13 +54,13 @@ let storage {state_hash ; threshold ; max_proposal ; max_msg_size ; id_counter_l
([],[])
id_counter_list in
e_record_ez [
("state_hash" , e_bytes_raw state_hash ) ;
("threshold" , e_nat threshold ) ;
("max_proposal" , e_nat max_proposal ) ;
("max_message_size" , e_nat max_msg_size ) ;
("authorized_addresses", e_typed_set auth_set t_address ) ;
("message_store" , e_typed_map msg_store_list t_bytes (t_set t_address) ) ;
("proposal_counters" , e_typed_map counter_store t_address t_nat ) ;
("state_hash" , e_bytes_raw state_hash ) ;
("threshold" , e_nat threshold ) ;
("max_proposal" , e_nat max_proposal ) ;
("max_message_size" , e_nat max_msg_size ) ;
("authorized_addresses", e_typed_set auth_set (t_address ()) ) ;
("message_store" , e_typed_map msg_store_list (t_bytes ()) (t_set (t_address ())) ) ;
("proposal_counters" , e_typed_map counter_store (t_address ()) (t_nat ()) ) ;
]
(* sender not stored in the authorized set *)
@ -238,7 +238,7 @@ let succeeded_storing () =
let init_storage th = {
threshold = th ; max_proposal = 1 ; max_msg_size = 15 ; state_hash = Bytes.empty ;
id_counter_list = [1,0 ; 2,0 ; 3,0] ;
msg_store_list = [(bytes, e_typed_set [] t_address)] ;
msg_store_list = [(bytes, e_typed_set [] (t_address ()))] ;
} in
let options =
let sender = contract 1 in

4
src/test/pledge_tests.ml
View File

@ -38,9 +38,9 @@ let (stranger_addr , stranger_contract) =
Protocol.Alpha_context.Contract.to_b58check kt , kt
let empty_op_list =
(e_typed_list [] t_operation)
(e_typed_list [] (t_operation ()))
let empty_message = e_lambda (Var.of_name "arguments")
(Some t_unit) (Some (t_list t_operation))
(Some (t_unit ())) (Some (t_list (t_operation ())))
empty_op_list

4
src/test/replaceable_id_tests.ml
View File

@ -27,9 +27,9 @@ let compile_main () =
open Ast_imperative
let empty_op_list =
(e_typed_list [] t_operation)
(e_typed_list [] (t_operation ()))
let empty_message = e_lambda (Var.of_name "arguments")
(Some t_unit) (Some (t_list t_operation))
(Some (t_unit ())) (Some (t_list (t_operation ())))
empty_op_list
let storage id = e_address @@ addr id

4
src/test/time_lock_repeat_tests.ml
View File

@ -26,9 +26,9 @@ let compile_main () =
ok ()
let empty_op_list =
(e_typed_list [] t_operation)
(e_typed_list [] (t_operation ()))
let empty_message = e_lambda (Var.of_name "arguments")
(Some t_unit) (Some (t_list t_operation))
(Some (t_unit ())) (Some (t_list (t_operation ())))
empty_op_list
let call msg = e_constructor "Call" msg

4
src/test/time_lock_tests.ml
View File

@ -27,9 +27,9 @@ let compile_main () =
open Ast_imperative
let empty_op_list =
(e_typed_list [] t_operation)
(e_typed_list [] (t_operation ()))
let empty_message = e_lambda (Var.of_name "arguments")
(Some t_unit) (Some (t_list t_operation))
(Some (t_unit ())) (Some (t_list (t_operation ())))
empty_op_list
let call msg = e_constructor "Call" msg

2
src/test/typer_tests.ml
View File

@ -46,7 +46,7 @@ module TestExpressions = struct
let lambda () : unit result =
test_expression
I.(e_lambda (Var.of_name "x") (Some t_int) (Some t_int) (e_var "x"))
I.(e_lambda (Var.of_name "x") (Some (t_int ())) (Some (t_int ())) (e_var "x"))
O.(t_function (t_int ()) (t_int ()) ())
let tuple () : unit result =

2
src/test/vote_tests.ml
View File

@ -21,7 +21,7 @@ let init_storage name = e_record_ez [
("title" , e_string name) ;
("yea", e_nat 0) ;
("nay", e_nat 0) ;
("voters" , e_typed_set [] t_address) ;
("voters" , e_typed_set [] (t_address ())) ;
("start_time" , e_timestamp 0) ;
("finish_time" , e_timestamp 1000000000) ;
]