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

add srcloc for types

Browse Source
This commit is contained in:
Pierre-Emmanuel Wulfman 2020-04-09 18:19:22 +02:00
parent 23912411e1
commit 7c29b075bb
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" ] ; run_ligo_bad [ "compile-contract" ; bad_contract "create_contract_no_inline.mligo" ; "main" ] ;
[%expect {| [%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 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" ] ; run_ligo_bad [ "compile-contract" ; "../../test/contracts/negative/error_typer_5.mligo" ; "main" ] ;
[%expect {| [%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 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 match te with
TPar x -> compile_type_expression x.value.inside TPar x -> compile_type_expression x.value.inside
| TVar v -> ( | TVar v -> (
match type_constants v.value with let (v, loc) = r_split v in
| Ok (s,_) -> ok @@ make_t @@ T_constant s match type_constants v with
| Error _ -> ok @@ make_t @@ T_variable (Var.of_name v.value) | Ok (s,_) -> ok @@ make_t ~loc @@ T_constant s
| Error _ -> ok @@ make_t ~loc @@ T_variable (Var.of_name v)
) )
| TFun x -> ( | TFun x -> (
let (x,loc) = r_split x in
let%bind (type1 , type2) = 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 a = compile_type_expression a in
let%bind b = compile_type_expression b in let%bind b = compile_type_expression b in
ok (a , b) ok (a , b)
in in
ok @@ make_t @@ T_arrow {type1;type2} ok @@ make_t ~loc @@ T_arrow {type1;type2}
) )
| TApp x -> ( | 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 lst = npseq_to_list tuple.value.inside in
let%bind lst' = bind_map_list compile_type_expression lst in let%bind lst' = bind_map_list compile_type_expression lst in
let%bind cst = let%bind cst =
trace (unknown_predefined_type name) @@ trace (unknown_predefined_type name) @@
type_operators name.value in type_operators name.value in
t_operator cst lst' t_operator ~loc cst lst'
) )
| TProd p -> ( | TProd p -> (
let%bind tpl = compile_list_type_expression @@ npseq_to_list p.value in let%bind tpl = compile_list_type_expression @@ npseq_to_list p.value in
ok tpl ok tpl
) )
| TRecord r -> | 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 aux = fun (x, y) -> let%bind y = compile_type_expression y in ok (x, y) in
let apply (x:Raw.field_decl Raw.reg) = let apply (x:Raw.field_decl Raw.reg) =
(x.value.field_name.value, x.value.field_type) in (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 bind_list
@@ List.map aux @@ List.map aux
@@ List.map apply @@ 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 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 -> | TSum s ->
let (s,loc) = r_split s in
let aux (v:Raw.variant Raw.reg) = let aux (v:Raw.variant Raw.reg) =
let args = let args =
match v.value.arg with 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 ok (v.value.constr.value, te) in
let%bind lst = bind_list let%bind lst = bind_list
@@ List.map aux @@ 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 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 = and compile_list_type_expression (lst:Raw.type_expr list) : type_expression result =
match lst with match lst with
| [] -> ok @@ t_unit | [] -> ok @@ t_unit ()
| [hd] -> compile_type_expression hd | [hd] -> compile_type_expression hd
| lst -> | lst ->
let%bind lst = bind_map_list compile_type_expression lst in 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 match t with
TPar x -> compile_type_expression x.value.inside TPar x -> compile_type_expression x.value.inside
| TVar v -> ( | TVar v -> (
match type_constants v.value with let (v,loc) = r_split v in
| Ok (s,_) -> ok @@ make_t @@ T_constant s match type_constants v with
| Error _ -> ok @@ make_t @@ T_variable (Var.of_name v.value) | Ok (s,_) -> ok @@ make_t ~loc @@ T_constant s
| Error _ -> ok @@ make_t ~loc @@ T_variable (Var.of_name v)
) )
| TFun x -> ( | TFun x -> (
let (x,loc) = r_split x in
let%bind (a , b) = let%bind (a , b) =
let (a , _ , b) = x.value in let (a , _ , b) = x in
bind_map_pair compile_type_expression (a , b) 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 -> | 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 lst = npseq_to_list tuple.value.inside in
let%bind lst = let%bind lst =
bind_list @@ List.map compile_type_expression lst in (** TODO: fix constant and operator*) bind_list @@ List.map compile_type_expression lst in (** TODO: fix constant and operator*)
let%bind cst = let%bind cst =
trace (unknown_predefined_type name) @@ trace (unknown_predefined_type name) @@
type_operators name.value in type_operators name.value in
t_operator cst lst t_operator ~loc cst lst
| TProd p -> | TProd p ->
let%bind tpl = compile_list_type_expression let%bind tpl = compile_list_type_expression
@@ npseq_to_list p.value in @@ npseq_to_list p.value in
ok tpl ok tpl
| TRecord r -> | TRecord r ->
let (r,loc ) = r_split r in
let aux = fun (x, y) -> let aux = fun (x, y) ->
let%bind y = compile_type_expression y in let%bind y = compile_type_expression y in
ok (x, y) ok (x, y)
@ -180,10 +184,11 @@ let rec compile_type_expression (t:Raw.type_expr) : type_expression result =
let%bind lst = bind_list let%bind lst = bind_list
@@ List.map aux @@ List.map aux
@@ List.map apply @@ 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 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 -> | TSum s ->
let (s,loc) = r_split s in
let aux (v:Raw.variant Raw.reg) = let aux (v:Raw.variant Raw.reg) =
let args = let args =
match v.value.arg with match v.value.arg with
@ -195,13 +200,13 @@ let rec compile_type_expression (t:Raw.type_expr) : type_expression result =
in in
let%bind lst = bind_list let%bind lst = bind_list
@@ List.map aux @@ 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 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 = and compile_list_type_expression (lst:Raw.type_expr list) : type_expression result =
match lst with match lst with
| [] -> ok @@ t_unit | [] -> ok @@ t_unit ()
| [hd] -> compile_type_expression hd | [hd] -> compile_type_expression hd
| lst -> | lst ->
let%bind lst = bind_list @@ List.map compile_type_expression lst in 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 open Errors
let peephole_type_expression : type_expression -> type_expression result = fun e -> 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 match e.type_content with
| T_sum cmap -> | T_sum cmap ->
let%bind _uu = bind_map_cmapi 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 -> and map_type_expression : ty_exp_mapper -> type_expression -> type_expression result = fun f te ->
let self = map_type_expression f in let self = map_type_expression f in
let%bind te' = f te 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 match te'.type_content with
| T_sum temap -> | T_sum temap ->
let%bind temap' = bind_map_cmap self temap in 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 open Trace
let peephole_type_expression : type_expression -> type_expression result = fun e -> 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 match e.type_content with
| T_operator (TC_michelson_or (l_ty,r_ty)) -> | 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) ]) 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 = let rec compile_type_expression : I.type_expression -> O.type_expression result =
fun te -> 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 match te.type_content with
| I.T_sum sum -> | I.T_sum sum ->
let sum = I.CMap.to_kv_list sum in 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} = and compile_for I.{binder;start;final;increment;body} =
let env_rec = Var.fresh () in let env_rec = Var.fresh () in
(*Make the cond and the step *) (*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 cond = compile_expression cond in
let%bind step = compile_expression increment in let%bind step = compile_expression increment in
let continue_expr = O.e_constant C_FOLD_CONTINUE [(O.e_variable env_rec)] in let continue_expr = O.e_constant C_FOLD_CONTINUE [(O.e_variable env_rec)] in
let ctrl = 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)@@ 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 continue_expr
in in
@ -482,7 +482,7 @@ and compile_for I.{binder;start;final;increment;body} =
(*Prep the lambda for the fold*) (*Prep the lambda for the fold*)
let stop_expr = O.e_constant C_FOLD_STOP [O.e_variable env_rec] in 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 @@ 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 O.e_cond cond (restore for_body) (stop_expr) in
(* Make the fold_while en precharge the vakye *) (* 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%bind start = compile_expression start in
let let_binder = (env_rec,None) in let let_binder = (env_rec,None) in
let return_expr = fun expr -> 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 init_rec @@
O.e_let_in let_binder false false loop @@ 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")) @@ 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 -> and map_type_expression : ty_exp_mapper -> type_expression -> type_expression result = fun f te ->
let self = map_type_expression f in let self = map_type_expression f in
let%bind te' = f te 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 match te'.type_content with
| T_sum temap -> | T_sum temap ->
let%bind temap' = bind_map_cmap self temap in 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 = let rec idle_type_expression : I.type_expression -> O.type_expression result =
fun te -> 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 match te.type_content with
| I.T_sum sum -> | I.T_sum sum ->
let sum = I.CMap.to_kv_list sum in 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} -> | I.E_sequence {expr1; expr2} ->
let%bind expr1 = compile_expression expr1 in let%bind expr1 = compile_expression expr1 in
let%bind expr2 = compile_expression expr2 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_skip -> ok @@ O.e_unit ~loc:e.location ()
| I.E_tuple t -> | I.E_tuple t ->
let aux (i,acc) el = 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 fun_type = uncompile_type_expression fun_type in
let%bind lambda = uncompile_lambda lambda in let%bind lambda = uncompile_lambda lambda in
return @@ I.E_recursive {fun_name;fun_type;lambda} 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 expr1 = uncompile_expression expr1 in
let%bind expr2 = uncompile_expression expr2 in let%bind expr2 = uncompile_expression expr2 in
return @@ I.E_sequence {expr1;expr2} 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 module Environment = O.Environment
type environment = Environment.t 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 title = (thunk "unbound type variable") in
let message () = "" in let message () = "" in
let data = [ let data = [
("variable" , fun () -> Format.asprintf "%a" I.PP.type_variable tv) ; ("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 loc) ;
(* ("location" , fun () -> Format.asprintf "%a" Location.pp (n.location)) ; *)
("in" , fun () -> Format.asprintf "%a" Environment.PP.full_environment e) ("in" , fun () -> Format.asprintf "%a" Environment.PP.full_environment e)
] in ] in
error ~data title message () 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 type_value at the leaves
*) *)
and evaluate_type (e:environment) (t:I.type_expression) : O.type_expression result = 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 match t.type_content with
| T_arrow {type1;type2} -> | T_arrow {type1;type2} ->
let%bind type1 = evaluate_type e type1 in 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) return (T_record m)
| T_variable name -> | T_variable name ->
let%bind tv = 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 @@ Environment.get_type_opt (name) e in
ok tv ok tv
| T_constant cst -> | 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 (Solver.TypeVariableMap.find_opt root assignments) in
let Solver.{ tv ; c_tag ; tv_list } = assignment 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 () = 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 ok @@ expr
in in
let p = apply_substs ~substs program 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 type environment = Environment.t
module Errors = struct 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 name = Var.to_name tv in
let suggestion = match name with let suggestion = match name with
| "integer" -> "int" | "integer" -> "int"
@ -22,8 +22,7 @@ module Errors = struct
let message () = "" in let message () = "" in
let data = [ let data = [
("variable" , fun () -> Format.asprintf "%a" I.PP.type_variable tv) ; ("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 loc) ;
(* ("location" , fun () -> Format.asprintf "%a" Location.pp (n.location)) ; *)
("in" , fun () -> Format.asprintf "%a" Environment.PP.full_environment e) ; ("in" , fun () -> Format.asprintf "%a" Environment.PP.full_environment e) ;
("did_you_mean" , fun () -> suggestion) ("did_you_mean" , fun () -> suggestion)
] in ] in
@ -590,7 +589,7 @@ and type_match : (environment -> I.expression -> O.expression result) -> environ
ok (O.Match_variant { cases ; tv }) ok (O.Match_variant { cases ; tv })
and evaluate_type (e:environment) (t:I.type_expression) : O.type_expression result = 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 match t.type_content with
| T_arrow {type1;type2} -> | T_arrow {type1;type2} ->
let%bind type1 = evaluate_type e type1 in 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) return (T_record m)
| T_variable name -> | T_variable name ->
let%bind tv = 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 @@ Environment.get_type_opt (name) e in
ok tv ok tv
| T_constant cst -> | T_constant cst ->

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

@ -41,7 +41,7 @@ module Errors = struct
end end
let check_entrypoint_annotation_format ep exp = let check_entrypoint_annotation_format ep (exp: expression) =
match String.split_on_char '%' ep with match String.split_on_char '%' ep with
| [ "" ; ep'] -> | [ "" ; ep'] ->
let cap = String.capitalize_ascii ep' in 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 bind_fold_list aux (init,[]) p
module Errors = struct module Errors = struct
let bad_contract_io entrypoint e () = let bad_contract_io entrypoint (e:expression) () =
let title = thunk "badly typed contract" in let title = thunk "badly typed contract" in
let message () = Format.asprintf "unexpected entrypoint type" in let message () = Format.asprintf "unexpected entrypoint type" in
let data = [ let data = [
@ -280,7 +280,7 @@ module Errors = struct
] in ] in
error ~data title message () 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 title = thunk "bad return type" in
let message () = Format.asprintf "expected %a, got %a" 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})} 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 ] in
error ~data title message () 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 title = thunk "badly typed contract" in
let message () = Format.asprintf "expected {%a} and {%a} to be the same in the entrypoint type" let message () = Format.asprintf "expected {%a} and {%a} to be the same in the entrypoint type"
Ast_typed.PP.type_expression t1 Ast_typed.PP.type_expression t1

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

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

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

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

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

@ -19,7 +19,7 @@ module Errors = struct
end end
open Errors 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 = let tuple_to_record lst =
@ -27,56 +27,56 @@ let tuple_to_record lst =
let (_, lst ) = List.fold_left aux (0,[]) lst in let (_, lst ) = List.fold_left aux (0,[]) lst in
lst lst
let t_bool : type_expression = make_t @@ T_constant (TC_bool) let t_bool ?loc () : type_expression = make_t ?loc @@ T_constant (TC_bool)
let t_string : type_expression = make_t @@ T_constant (TC_string) let t_string ?loc () : type_expression = make_t ?loc @@ T_constant (TC_string)
let t_bytes : type_expression = make_t @@ T_constant (TC_bytes) let t_bytes ?loc () : type_expression = make_t ?loc @@ T_constant (TC_bytes)
let t_int : type_expression = make_t @@ T_constant (TC_int) let t_int ?loc () : type_expression = make_t ?loc @@ T_constant (TC_int)
let t_operation : type_expression = make_t @@ T_constant (TC_operation) let t_operation ?loc () : type_expression = make_t ?loc @@ T_constant (TC_operation)
let t_nat : type_expression = make_t @@ T_constant (TC_nat) let t_nat ?loc () : type_expression = make_t ?loc @@ T_constant (TC_nat)
let t_tez : type_expression = make_t @@ T_constant (TC_mutez) let t_tez ?loc () : type_expression = make_t ?loc @@ T_constant (TC_mutez)
let t_unit : type_expression = make_t @@ T_constant (TC_unit) let t_unit ?loc () : type_expression = make_t ?loc @@ T_constant (TC_unit)
let t_address : type_expression = make_t @@ T_constant (TC_address) let t_address ?loc () : type_expression = make_t ?loc @@ T_constant (TC_address)
let t_signature : type_expression = make_t @@ T_constant (TC_signature) let t_signature ?loc () : type_expression = make_t ?loc @@ T_constant (TC_signature)
let t_key : type_expression = make_t @@ T_constant (TC_key) let t_key ?loc () : type_expression = make_t ?loc @@ T_constant (TC_key)
let t_key_hash : type_expression = make_t @@ T_constant (TC_key_hash) let t_key_hash ?loc () : type_expression = make_t ?loc @@ T_constant (TC_key_hash)
let t_timestamp : type_expression = make_t @@ T_constant (TC_timestamp) let t_timestamp ?loc () : type_expression = make_t ?loc @@ T_constant (TC_timestamp)
let t_option o : type_expression = make_t @@ T_operator (TC_option o) let t_option ?loc o : type_expression = make_t ?loc @@ T_operator (TC_option o)
let t_list t : type_expression = make_t @@ T_operator (TC_list t) let t_list ?loc t : type_expression = make_t ?loc @@ T_operator (TC_list t)
let t_variable n : type_expression = make_t @@ T_variable (Var.of_name n) let t_variable ?loc n : type_expression = make_t ?loc @@ T_variable (Var.of_name n)
let t_record_ez lst = let t_record_ez ?loc lst =
let lst = List.map (fun (k, v) -> (Label k, v)) lst in let lst = List.map (fun (k, v) -> (Label k, v)) lst in
let m = LMap.of_list lst in let m = LMap.of_list lst in
make_t @@ T_record m make_t ?loc @@ T_record m
let t_record m : type_expression = let t_record ?loc m : type_expression =
let lst = Map.String.to_kv_list m in 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_pair ?loc (a , b) : type_expression = t_record_ez ?loc [("0",a) ; ("1",b)]
let t_tuple lst : type_expression = t_record_ez (tuple_to_record lst) 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 aux prev (k, v) = CMap.add (Constructor k) v prev in
let map = List.fold_left aux CMap.empty lst in let map = List.fold_left aux CMap.empty lst in
make_t @@ T_sum map make_t ?loc @@ T_sum map
let t_sum m : type_expression = let t_sum ?loc m : type_expression =
let lst = Map.String.to_kv_list m in 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_function ?loc type1 type2 : type_expression = make_t ?loc @@ T_arrow {type1; type2}
let t_map key value : type_expression = make_t @@ T_operator (TC_map (key, value)) let t_map ?loc key value : type_expression = make_t ?loc @@ 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_big_map ?loc key value : type_expression = make_t ?loc @@ T_operator (TC_big_map (key , value))
let t_set key : type_expression = make_t @@ T_operator (TC_set key) let t_set ?loc key : type_expression = make_t ?loc @@ T_operator (TC_set key)
let t_contract contract : type_expression = make_t @@ T_operator (TC_contract contract) let t_contract ?loc contract : type_expression = make_t ?loc @@ T_operator (TC_contract contract)
(* TODO find a better way than using list*) (* 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 match op,lst with
| TC_set _ , [t] -> ok @@ t_set t | TC_set _ , [t] -> ok @@ t_set ?loc t
| TC_list _ , [t] -> ok @@ t_list t | TC_list _ , [t] -> ok @@ t_list ?loc t
| TC_option _ , [t] -> ok @@ t_option t | TC_option _ , [t] -> ok @@ t_option ?loc t
| TC_map (_,_) , [kt;vt] -> ok @@ t_map kt vt | TC_map (_,_) , [kt;vt] -> ok @@ t_map kt ?loc vt
| TC_big_map (_,_) , [kt;vt] -> ok @@ t_big_map kt vt | TC_big_map (_,_) , [kt;vt] -> ok @@ t_big_map ?loc kt vt
| TC_contract _ , [t] -> ok @@ t_contract t | TC_contract _ , [t] -> ok @@ t_contract ?loc t
| _ , _ -> fail @@ bad_type_operator op | _ , _ -> fail @@ bad_type_operator op
let make_e ?(loc = Location.generated) expression_content = { expression_content; location=loc } 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 val bad_kind : name -> Location.t -> unit -> error
end end
*) *)
val make_t : type_content -> type_expression val make_t : ?loc:Location.t -> type_content -> type_expression
val t_bool : type_expression val t_bool : ?loc:Location.t -> unit -> type_expression
val t_string : type_expression val t_string : ?loc:Location.t -> unit -> type_expression
val t_bytes : type_expression val t_bytes : ?loc:Location.t -> unit -> type_expression
val t_int : type_expression val t_int : ?loc:Location.t -> unit -> type_expression
val t_operation : type_expression val t_operation : ?loc:Location.t -> unit -> type_expression
val t_nat : type_expression val t_nat : ?loc:Location.t -> unit -> type_expression
val t_tez : type_expression val t_tez : ?loc:Location.t -> unit -> type_expression
val t_unit : type_expression val t_unit : ?loc:Location.t -> unit -> type_expression
val t_address : type_expression val t_address : ?loc:Location.t -> unit -> type_expression
val t_key : type_expression val t_key : ?loc:Location.t -> unit -> type_expression
val t_key_hash : type_expression val t_key_hash : ?loc:Location.t -> unit -> type_expression
val t_timestamp : type_expression val t_timestamp : ?loc:Location.t -> unit -> type_expression
val t_signature : type_expression val t_signature : ?loc:Location.t -> unit -> type_expression
(* (*
val t_option : type_expression -> type_expression val t_option : type_expression -> type_expression
*) *)
val t_list : type_expression -> type_expression val t_list : ?loc:Location.t -> type_expression -> type_expression
val t_variable : string -> type_expression val t_variable : ?loc:Location.t -> string -> type_expression
(* (*
val t_record : te_map -> type_expression val t_record : te_map -> type_expression
*) *)
val t_pair : ( type_expression * type_expression ) -> type_expression val t_pair : ?loc:Location.t -> ( type_expression * type_expression ) -> type_expression
val t_tuple : type_expression list -> 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 : ?loc:Location.t -> type_expression Map.String.t -> type_expression
val t_record_ez : (string * type_expression) list -> 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 t_sum : ?loc:Location.t -> type_expression Map.String.t -> type_expression
val ez_t_sum : ( string * type_expression ) list -> 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_function : ?loc:Location.t -> type_expression -> type_expression -> type_expression
val t_map : 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_operator : ?loc:Location.t -> type_operator -> type_expression list -> type_expression result
val t_set : type_expression -> type_expression val t_set : ?loc:Location.t -> type_expression -> type_expression
val make_e : ?loc:Location.t -> expression_content -> expression val make_e : ?loc:Location.t -> expression_content -> expression
val e_var : ?loc:Location.t -> string -> 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 error (thunk "No declaration with the given name") message
end 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 = { let make_e ?(location = Location.generated) expression_content type_expression environment = {
expression_content ; expression_content ;
type_expression ; 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 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_signature ?loc ?s () : type_expression = make_t ?loc (T_constant TC_signature) s
let t_chain_id ?s () : type_expression = make_t (T_constant TC_chain_id) s let t_chain_id ?loc ?s () : type_expression = make_t ?loc (T_constant TC_chain_id) s
let t_bool ?s () : type_expression = make_t (T_constant TC_bool) s let t_bool ?loc ?s () : type_expression = make_t ?loc (T_constant TC_bool) s
let t_string ?s () : type_expression = make_t (T_constant TC_string) s let t_string ?loc ?s () : type_expression = make_t ?loc (T_constant TC_string) s
let t_bytes ?s () : type_expression = make_t (T_constant TC_bytes) s let t_bytes ?loc ?s () : type_expression = make_t ?loc (T_constant TC_bytes) s
let t_key ?s () : type_expression = make_t (T_constant TC_key) s let t_key ?loc ?s () : type_expression = make_t ?loc (T_constant TC_key) s
let t_key_hash ?s () : type_expression = make_t (T_constant TC_key_hash) s let t_key_hash ?loc ?s () : type_expression = make_t ?loc (T_constant TC_key_hash) s
let t_int ?s () : type_expression = make_t (T_constant TC_int) s let t_int ?loc ?s () : type_expression = make_t ?loc (T_constant TC_int) s
let t_address ?s () : type_expression = make_t (T_constant TC_address) s let t_address ?loc ?s () : type_expression = make_t ?loc (T_constant TC_address) s
let t_operation ?s () : type_expression = make_t (T_constant TC_operation) s let t_operation ?loc ?s () : type_expression = make_t ?loc (T_constant TC_operation) s
let t_nat ?s () : type_expression = make_t (T_constant TC_nat) s let t_nat ?loc ?s () : type_expression = make_t ?loc (T_constant TC_nat) s
let t_mutez ?s () : type_expression = make_t (T_constant TC_mutez) s let t_mutez ?loc ?s () : type_expression = make_t ?loc (T_constant TC_mutez) s
let t_timestamp ?s () : type_expression = make_t (T_constant TC_timestamp) s let t_timestamp ?loc ?s () : type_expression = make_t ?loc (T_constant TC_timestamp) s
let t_unit ?s () : type_expression = make_t (T_constant TC_unit) s let t_unit ?loc ?s () : type_expression = make_t ?loc (T_constant TC_unit) s
let t_option o ?s () : type_expression = make_t (T_operator (TC_option o)) s let t_option o ?loc ?s () : type_expression = make_t ?loc (T_operator (TC_option o)) s
let t_variable t ?s () : type_expression = make_t (T_variable t) s let t_variable t ?loc ?s () : type_expression = make_t ?loc (T_variable t) s
let t_list t ?s () : type_expression = make_t (T_operator (TC_list t)) s let t_list t ?loc ?s () : type_expression = make_t ?loc (T_operator (TC_list t)) s
let t_set t ?s () : type_expression = make_t (T_operator (TC_set t)) s let t_set t ?loc ?s () : type_expression = make_t ?loc (T_operator (TC_set t)) s
let t_contract t ?s () : type_expression = make_t (T_operator (TC_contract 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 t_record m ?loc ?s () : type_expression = make_t ?loc (T_record m) s
let make_t_ez_record (lst:(string * type_expression) list) : type_expression = 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 lst = List.map (fun (x,y) -> (Label x, y) ) lst in
let map = LMap.of_list lst in let map = LMap.of_list lst in
make_t (T_record map) None make_t ?loc (T_record map) None
let ez_t_record lst ?s () : type_expression = let ez_t_record lst ?loc ?s () : type_expression =
let m = LMap.of_list lst in let m = LMap.of_list lst in
t_record m ?s () t_record m ?loc ?s ()
let t_pair a b ?s () : type_expression = ez_t_record [(Label "0",a) ; (Label "1",b)] ?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_map ?loc k v ?s () = make_t ?loc (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_big_map ?loc k v ?s () = make_t ?loc (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_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 t_sum m ?loc ?s () : type_expression = make_t ?loc (T_sum m) s
let make_t_ez_sum (lst:(constructor' * type_expression) list) : type_expression = 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 aux prev (k, v) = CMap.add k v prev in
let map = List.fold_left aux CMap.empty lst 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_function param result ?loc ?s () : type_expression = make_t ?loc (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_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_expression (x:expression) = x.type_expression
let get_type' (x:type_expression) = x.type_content 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 open Types
val make_n_t : type_variable -> type_expression -> named_type_content 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 make_e : ?location:Location.t -> expression_content -> type_expression -> full_environment -> expression
val t_bool : ?s:S.type_expression -> unit -> type_expression val t_bool : ?loc:Location.t -> ?s:S.type_expression -> unit -> type_expression
val t_string : ?s:S.type_expression -> unit -> type_expression val t_string : ?loc:Location.t -> ?s:S.type_expression -> unit -> type_expression
val t_bytes : ?s:S.type_expression -> unit -> type_expression val t_bytes : ?loc:Location.t -> ?s:S.type_expression -> unit -> type_expression
val t_key : ?s:S.type_expression -> unit -> type_expression val t_key : ?loc:Location.t -> ?s:S.type_expression -> unit -> type_expression
val t_key_hash : ?s:S.type_expression -> unit -> type_expression val t_key_hash : ?loc:Location.t -> ?s:S.type_expression -> unit -> type_expression
val t_operation : ?s:S.type_expression -> unit -> type_expression val t_operation : ?loc:Location.t -> ?s:S.type_expression -> unit -> type_expression
val t_timestamp : ?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 -> ?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 -> ?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 : ?s:S.type_expression -> unit -> type_expression val t_int : ?loc:Location.t -> ?s:S.type_expression -> unit -> type_expression
val t_nat : ?s:S.type_expression -> unit -> type_expression val t_nat : ?loc:Location.t -> ?s:S.type_expression -> unit -> type_expression
val t_mutez : ?s:S.type_expression -> unit -> type_expression val t_mutez : ?loc:Location.t -> ?s:S.type_expression -> unit -> type_expression
val t_address : ?s:S.type_expression -> unit -> type_expression val t_address : ?loc:Location.t -> ?s:S.type_expression -> unit -> type_expression
val t_chain_id : ?s:S.type_expression -> unit -> type_expression val t_chain_id : ?loc:Location.t -> ?s:S.type_expression -> unit -> type_expression
val t_signature : ?s:S.type_expression -> unit -> type_expression val t_signature : ?loc:Location.t -> ?s:S.type_expression -> unit -> type_expression
val t_unit : ?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 -> ?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 -> ?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 -> ?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 -> ?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 -> ?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 : (string* type_expression) list -> type_expression val make_t_ez_record : ?loc:Location.t -> (string* type_expression) list -> type_expression
val ez_t_record : ( label * type_expression ) list -> ?s:S.type_expression -> unit -> 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_map : ?loc:Location.t -> 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_big_map : ?loc:Location.t -> 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_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 -> ?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 : ( constructor' * type_expression ) list -> type_expression val make_t_ez_sum : ?loc:Location.t -> ( constructor' * type_expression ) list -> type_expression
val t_function : type_expression -> type_expression -> ?s:S.type_expression -> unit -> 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 -> ?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_expression : expression -> type_expression
val get_type' : type_expression -> type_content val get_type' : type_expression -> type_content
val get_environment : expression -> full_environment 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 = { and type_expression = {
type_content: type_content; type_content: type_content;
type_meta: type_meta; type_meta: type_meta;
location: location;
} }
type literal = type literal =
@ -413,4 +414,3 @@ and named_type_content = {
type_name : type_variable; type_name : type_variable;
type_value : type_expression; 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 | 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 open Trace
let map_type_operator f = function 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 -> | Ast_core.T_constant constant ->
ok @@ 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 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_content = s_type_content ~substs type_content in
let%bind type_meta = bind_map_option (s_abstr_type_expression ~substs) type_meta 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 and s_literal : T.literal w = fun ~substs -> function
| T.Literal_unit -> | T.Literal_unit ->
let () = ignore @@ substs in 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 [ let card_ty = t_record_ez [
("card_owner" , t_address) ; ("card_owner" , t_address ()) ;
("card_pattern" , t_nat) ; ("card_pattern" , t_nat ()) ;
] ]
let card_ez owner = card (e_address owner) let card_ez owner = card (e_address owner)
let make_cards assoc_lst = 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 e_typed_map assoc_lst card_id_ty card_ty
let card_pattern (coeff , qtt) = let card_pattern (coeff , qtt) =
@ -54,15 +54,15 @@ let card_pattern (coeff , qtt) =
let card_pattern_ty = let card_pattern_ty =
t_record_ez [ t_record_ez [
("coefficient" , t_tez) ; ("coefficient" , t_tez ()) ;
("quantity" , t_nat) ; ("quantity" , t_nat ()) ;
] ]
let card_pattern_ez (coeff , qtt) = let card_pattern_ez (coeff , qtt) =
card_pattern (e_mutez coeff , e_nat qtt) card_pattern (e_mutez coeff , e_nat qtt)
let make_card_patterns lst = 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 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 e_typed_map assoc_lst card_pattern_id_ty card_pattern_ty
@ -112,7 +112,7 @@ let buy () =
e_pair buy_action storage e_pair buy_action storage
in in
let make_expected = fun n -> let make_expected = fun n ->
let ops = e_typed_list [] t_operation in let ops = e_typed_list [] (t_operation ()) in
let storage = let storage =
let cards = let cards =
cards_ez first_owner n @ cards_ez first_owner n @
@ -151,7 +151,7 @@ let dispatch_buy () =
e_pair action storage e_pair action storage
in in
let make_expected = fun n -> let make_expected = fun n ->
let ops = e_typed_list [] t_operation in let ops = e_typed_list [] (t_operation ()) in
let storage = let storage =
let cards = let cards =
cards_ez first_owner n @ cards_ez first_owner n @
@ -190,7 +190,7 @@ let transfer () =
e_pair transfer_action storage e_pair transfer_action storage
in in
let make_expected = fun n -> let make_expected = fun n ->
let ops = e_typed_list [] t_operation in let ops = e_typed_list [] (t_operation ()) in
let storage = let storage =
let cards = let cards =
let new_card = card_ez second_owner in 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 Protocol.Alpha_context.Contract.to_b58check kt , kt
let empty_op_list = let empty_op_list =
(e_typed_list [] t_operation) (e_typed_list [] (t_operation ()))
let empty_message = e_lambda (Var.of_name "arguments") 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 empty_op_list
@ -61,8 +61,8 @@ let commit () =
packed_sender])) packed_sender]))
in in
let pre_commits = e_typed_big_map [] t_address (t_record_ez [("date", t_timestamp); let pre_commits = e_typed_big_map [] (t_address ()) (t_record_ez [("date", (t_timestamp ()));
("salted_hash", t_bytes)]) ("salted_hash", (t_bytes ()))])
in in
let init_storage = storage test_hash true pre_commits in let init_storage = storage test_hash true pre_commits in
let commit = let commit =
@ -91,8 +91,8 @@ let reveal_no_commit () =
in in
let test_hash_raw = sha_256_hash (Bytes.of_string "hello world") 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 test_hash = e_bytes_raw test_hash_raw in
let pre_commits = e_typed_big_map [] t_address (t_record_ez [("date", t_timestamp); let pre_commits = e_typed_big_map [] (t_address ()) (t_record_ez [("date", (t_timestamp ()));
("salted_hash", t_bytes)]) ("salted_hash", (t_bytes ()))])
in in
let init_storage = storage test_hash true pre_commits in let init_storage = storage test_hash true pre_commits in
expect_string_failwith program "reveal" 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) ; ("controller", e_address new_addr) ;
("profile", new_website)] ("profile", new_website)]
in 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) ; let new_storage = e_tuple [(e_big_map [(e_int 0, id_details_1) ;
(e_int 1, id_details_2)]) ; (e_int 1, id_details_2)]) ;
e_int 2; e_int 2;
@ -297,8 +297,8 @@ let update_details_unchanged () =
e_tuple [e_mutez 1000000 ; e_mutez 1000000]] e_tuple [e_mutez 1000000 ; e_mutez 1000000]]
in in
let param = e_tuple [e_int 1 ; let param = e_tuple [e_int 1 ;
e_typed_none t_bytes ; e_typed_none (t_bytes ()) ;
e_typed_none t_address] in e_typed_none (t_address ())] in
let%bind () = expect_eq ~options program "update_details" let%bind () = expect_eq ~options program "update_details"
(e_pair param storage) (e_pair param storage)
(e_pair (e_list []) 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 expect_eq_evaluate program "s" expected
in in
let%bind () = let%bind () =
let expected = e_typed_none t_int in let expected = e_typed_none (t_int ()) in
expect_eq_evaluate program "n" expected expect_eq_evaluate program "n" expected
in in
let%bind () = 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 expect_eq program "assign" (e_int 12) expected
in in
ok () ok ()
@ -961,7 +961,7 @@ let moption () : unit result =
expect_eq_evaluate program "s" expected expect_eq_evaluate program "s" expected
in in
let%bind () = let%bind () =
let expected = e_typed_none t_int in let expected = e_typed_none (t_int ()) in
expect_eq_evaluate program "n" expected expect_eq_evaluate program "n" expected
in in
ok () ok ()
@ -973,7 +973,7 @@ let reoption () : unit result =
expect_eq_evaluate program "s" expected expect_eq_evaluate program "s" expected
in in
let%bind () = let%bind () =
let expected = e_typed_none t_int in let expected = e_typed_none (t_int ()) in
expect_eq_evaluate program "n" expected expect_eq_evaluate program "n" expected
in in
ok () ok ()
@ -983,7 +983,7 @@ let map_ type_f path : unit result =
let%bind program = type_f path in let%bind program = type_f path in
let ez lst = let ez lst =
let lst' = List.map (fun (x, y) -> e_int x, e_int y) lst in 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 in
let%bind () = let%bind () =
let make_input = fun n -> 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) expect_eq program "mem" (e_tuple [(e_int 1000) ; input_map]) (e_bool false)
in in
let%bind () = expect_eq_evaluate program "empty_map" 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%bind () =
let expected = ez @@ List.map (fun x -> (x, 23)) [144 ; 51 ; 42 ; 120 ; 421] in let expected = ez @@ List.map (fun x -> (x, 23)) [144 ; 51 ; 42 ; 120 ; 421] in
expect_eq_evaluate program "map1" expected 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%bind program = type_f path in
let ez lst = let ez lst =
let lst' = List.map (fun (x, y) -> e_int x, e_int y) lst in 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 in
let%bind () = let%bind () =
let make_input = fun n -> let make_input = fun n ->
@ -1111,7 +1111,7 @@ let list () : unit result =
let%bind program = type_file "./contracts/list.ligo" in let%bind program = type_file "./contracts/list.ligo" in
let ez lst = let ez lst =
let lst' = List.map e_int lst in let lst' = List.map e_int lst in
e_typed_list lst' t_int e_typed_list lst' (t_int ())
in in
let%bind () = let%bind () =
let expected = ez [23 ; 42] in let expected = ez [23 ; 42] in
@ -1283,7 +1283,7 @@ let loop () : unit result =
let%bind () = let%bind () =
let ez lst = let ez lst =
let lst' = List.map (fun (x, y) -> e_string x, e_int y) lst in 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 in
let expected = ez [ ("I" , 12) ; ("am" , 12) ; ("foo" , 12) ] in let expected = ez [ ("I" , 12) ; ("am" , 12) ; ("foo" , 12) ] in
expect_eq program "for_collection_with_patches" input expected in expect_eq program "for_collection_with_patches" input expected in
@ -1348,7 +1348,7 @@ let matching () : unit result =
let aux n = let aux n =
let input = match n with let input = match n with
| Some s -> e_some (e_int s) | 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 let expected = e_int (match n with
| Some s -> s | Some s -> s
| None -> 23) in | None -> 23) in
@ -1362,7 +1362,7 @@ let matching () : unit result =
let aux n = let aux n =
let input = match n with let input = match n with
| Some s -> e_some (e_int s) | 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 let expected = e_int (match n with
| Some s -> s | Some s -> s
| None -> 42) in | None -> 42) in
@ -1373,7 +1373,7 @@ let matching () : unit result =
[Some 0 ; Some 2 ; Some 42 ; Some 163 ; Some (-1) ; None] [Some 0 ; Some 2 ; Some 42 ; Some 163 ; Some (-1) ; None]
in in
let%bind () = 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 [ 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 [ 13 ; 2 ; 3 ]) (e_int 13) in
let%bind () = expect_eq program "match_expr_list" (aux []) (e_int (-1)) in let%bind () = expect_eq program "match_expr_list" (aux []) (e_int (-1)) in
@ -1409,7 +1409,7 @@ let quote_declarations () : unit result =
let counter_contract () : unit result = let counter_contract () : unit result =
let%bind program = type_file "./contracts/counter.ligo" in 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_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 expect_eq_n program "main" make_input make_expected
let super_counter_contract () : unit result = let super_counter_contract () : unit result =
@ -1419,7 +1419,7 @@ let super_counter_contract () : unit result =
e_pair (e_constructor action (e_int n)) (e_int 42) in e_pair (e_constructor action (e_int n)) (e_int 42) in
let make_expected = fun n -> let make_expected = fun n ->
let op = if n mod 2 = 0 then (+) else (-) in 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 expect_eq_n program "main" make_input make_expected
let super_counter_contract_mligo () : unit result = let super_counter_contract_mligo () : unit result =
@ -1429,7 +1429,7 @@ let super_counter_contract_mligo () : unit result =
e_pair (e_constructor action (e_int n)) (e_int 42) in e_pair (e_constructor action (e_int n)) (e_int 42) in
let make_expected = fun n -> let make_expected = fun n ->
let op = if n mod 2 = 0 then (+) else (-) in 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 expect_eq_n program "main" make_input make_expected
let super_counter_contract_religo () : unit result = let super_counter_contract_religo () : unit result =
@ -1439,7 +1439,7 @@ let super_counter_contract_religo () : unit result =
e_pair (e_constructor action (e_int n)) (e_int 42) in e_pair (e_constructor action (e_int n)) (e_int 42) in
let make_expected = fun n -> let make_expected = fun n ->
let op = if n mod 2 = 0 then (+) else (-) in 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 expect_eq_n program "main" make_input make_expected
@ -1450,13 +1450,13 @@ let dispatch_counter_contract () : unit result =
e_pair (e_constructor action (e_int n)) (e_int 42) in e_pair (e_constructor action (e_int n)) (e_int 42) in
let make_expected = fun n -> let make_expected = fun n ->
let op = if n mod 2 = 0 then (+) else (-) in 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 expect_eq_n program "main" make_input make_expected
let failwith_ligo () : unit result = let failwith_ligo () : unit result =
let%bind program = type_file "./contracts/failwith.ligo" in let%bind program = type_file "./contracts/failwith.ligo" in
let should_fail = expect_fail program "main" 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_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_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 let%bind _ = should_work (e_pair (e_constructor "Pos" (e_nat 1)) (e_unit ())) in
@ -1481,7 +1481,7 @@ let failwith_religo () : unit result =
let assert_mligo () : unit result = let assert_mligo () : unit result =
let%bind program = mtype_file "./contracts/assert.mligo" in let%bind program = mtype_file "./contracts/assert.mligo" in
let make_input b = e_pair (e_bool b) (e_unit ()) 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_fail program "main" (make_input false) in
let%bind _ = expect_eq program "main" (make_input true) make_expected in let%bind _ = expect_eq program "main" (make_input true) make_expected in
ok () ok ()
@ -1489,7 +1489,7 @@ let assert_mligo () : unit result =
let assert_religo () : unit result = let assert_religo () : unit result =
let%bind program = retype_file "./contracts/assert.religo" in let%bind program = retype_file "./contracts/assert.religo" in
let make_input b = e_pair (e_bool b) (e_unit ()) 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_fail program "main" (make_input false) in
let%bind _ = expect_eq program "main" (make_input true) make_expected in let%bind _ = expect_eq program "main" (make_input true) make_expected in
ok () ok ()
@ -1537,7 +1537,7 @@ let recursion_religo () : unit result =
let guess_string_mligo () : unit result = let guess_string_mligo () : unit result =
let%bind program = type_file "./contracts/guess_string.mligo" in 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_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 in expect_eq_n program "main" make_input make_expected
let basic_mligo () : unit result = let basic_mligo () : unit result =
@ -1551,13 +1551,13 @@ let basic_religo () : unit result =
let counter_mligo () : unit result = let counter_mligo () : unit result =
let%bind program = mtype_file "./contracts/counter.mligo" in let%bind program = mtype_file "./contracts/counter.mligo" in
let make_input n = e_pair (e_int n) (e_int 42) 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 expect_eq_n program "main" make_input make_expected
let counter_religo () : unit result = let counter_religo () : unit result =
let%bind program = retype_file "./contracts/counter.religo" in let%bind program = retype_file "./contracts/counter.religo" in
let make_input n = e_pair (e_int n) (e_int 42) 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 expect_eq_n program "main" make_input make_expected
@ -1565,14 +1565,14 @@ let let_in_mligo () : unit result =
let%bind program = mtype_file "./contracts/letin.mligo" in 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_input n = e_pair (e_int n) (e_pair (e_int 3) (e_int 5)) in
let make_expected n = 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 in expect_eq_n program "main" make_input make_expected
let let_in_religo () : unit result = let let_in_religo () : unit result =
let%bind program = retype_file "./contracts/letin.religo" in 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_input n = e_pair (e_int n) (e_pair (e_int 3) (e_int 5)) in
let make_expected n = 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 in expect_eq_n program "main" make_input make_expected
@ -1582,7 +1582,7 @@ let match_variant () : unit result =
let make_input n = let make_input n =
e_pair (e_constructor "Sub" (e_int n)) (e_int 3) in e_pair (e_constructor "Sub" (e_int n)) (e_int 3) in
let make_expected n = 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 in expect_eq_n program "main" make_input make_expected in
let%bind () = let%bind () =
let input = e_bool true in let input = e_bool true in
@ -1597,7 +1597,7 @@ let match_variant () : unit result =
let expected = e_int 3 in let expected = e_int 3 in
expect_eq program "match_list" input expected in expect_eq program "match_list" input expected in
let%bind () = let%bind () =
let input = e_typed_list [] t_int in let input = e_typed_list [] (t_int ()) in
let expected = e_int 10 in let expected = e_int 10 in
expect_eq program "match_list" input expected in expect_eq program "match_list" input expected in
let%bind () = let%bind () =
@ -1611,7 +1611,7 @@ let match_variant_re () : unit result =
let make_input n = let make_input n =
e_pair (e_constructor "Sub" (e_int n)) (e_int 3) in e_pair (e_constructor "Sub" (e_int n)) (e_int 3) in
let make_expected n = 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 expect_eq_n program "main" make_input make_expected
@ -1620,7 +1620,7 @@ let match_matej () : unit result =
let make_input n = let make_input n =
e_pair (e_constructor "Decrement" (e_int n)) (e_int 3) in e_pair (e_constructor "Decrement" (e_int n)) (e_int 3) in
let make_expected n = 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 expect_eq_n program "main" make_input make_expected
let match_matej_re () : unit result = let match_matej_re () : unit result =
@ -1628,7 +1628,7 @@ let match_matej_re () : unit result =
let make_input n = let make_input n =
e_pair (e_constructor "Decrement" (e_int n)) (e_int 3) in e_pair (e_constructor "Decrement" (e_int n)) (e_int 3) in
let make_expected n = 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 expect_eq_n program "main" make_input make_expected
@ -1642,7 +1642,7 @@ let mligo_list () : unit result =
e_pair (e_list [e_int n; e_int (2*n)]) e_pair (e_list [e_int n; e_int (2*n)])
(e_pair (e_int 3) (e_list [e_int 8])) in (e_pair (e_int 3) (e_list [e_int 8])) in
let make_expected n = 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)])) (e_pair (e_int (n+3)) (e_list [e_int (2*n)]))
in in
expect_eq_n program "main" make_input make_expected expect_eq_n program "main" make_input make_expected
@ -1664,7 +1664,7 @@ let religo_list () : unit result =
e_pair (e_list [e_int n; e_int (2*n)]) e_pair (e_list [e_int n; e_int (2*n)])
(e_pair (e_int 3) (e_list [e_int 8])) in (e_pair (e_int 3) (e_list [e_int 8])) in
let make_expected n = 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)])) (e_pair (e_int (n+3)) (e_list [e_int (2*n)]))
in in
expect_eq_n program "main" make_input make_expected expect_eq_n program "main" make_input make_expected
@ -1717,7 +1717,7 @@ let fibo_mligo () : unit result =
let website1_ligo () : unit result = let website1_ligo () : unit result =
let%bind program = type_file "./contracts/website1.ligo" in 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_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 expect_eq_n program "main" make_input make_expected
let website2_ligo () : unit result = let website2_ligo () : unit result =
@ -1727,7 +1727,7 @@ let website2_ligo () : unit result =
e_pair (e_constructor action (e_int n)) (e_int 42) in e_pair (e_constructor action (e_int n)) (e_int 42) in
let make_expected = fun n -> let make_expected = fun n ->
let op = if n mod 2 = 0 then (+) else (-) in 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 expect_eq_n program "main" make_input make_expected
let tez_ligo () : unit result = let tez_ligo () : unit result =
@ -1760,7 +1760,7 @@ let website2_mligo () : unit result =
e_pair (e_constructor action (e_int n)) (e_int 42) in e_pair (e_constructor action (e_int n)) (e_int 42) in
let make_expected = fun n -> let make_expected = fun n ->
let op = if n mod 2 = 0 then (+) else (-) in 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 expect_eq_n program "main" make_input make_expected
let website2_religo () : unit result = let website2_religo () : unit result =
@ -1770,7 +1770,7 @@ let website2_religo () : unit result =
e_pair (e_constructor action (e_int n)) (e_int 42) in e_pair (e_constructor action (e_int n)) (e_int 42) in
let make_expected = fun n -> let make_expected = fun n ->
let op = if n mod 2 = 0 then (+) else (-) in 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 expect_eq_n program "main" make_input make_expected
@ -2000,7 +2000,7 @@ let deep_access_ligo () : unit result =
expect_eq program "asymetric_tuple_access" make_input make_expected in expect_eq program "asymetric_tuple_access" make_input make_expected in
let%bind () = let%bind () =
let make_input = e_record_ez [ ("nesty", 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 let make_expected = e_string "one" in
expect_eq program "nested_record" make_input make_expected in expect_eq program "nested_record" make_input make_expected in
ok () ok ()
@ -2156,7 +2156,7 @@ let set_delegate () : unit result =
let (raw_pkh,_,_) = Signature.generate_key () in let (raw_pkh,_,_) = Signature.generate_key () in
let pkh_str = Signature.Public_key_hash.to_b58check raw_pkh 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 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 () in ok ()
let set_delegate_mligo () : unit result = let set_delegate_mligo () : unit result =
@ -2164,7 +2164,7 @@ let set_delegate_mligo () : unit result =
let (raw_pkh,_,_) = Signature.generate_key () in let (raw_pkh,_,_) = Signature.generate_key () in
let pkh_str = Signature.Public_key_hash.to_b58check raw_pkh 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 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 () in ok ()
let set_delegate_religo () : unit result = let set_delegate_religo () : unit result =
@ -2172,7 +2172,7 @@ let set_delegate_religo () : unit result =
let (raw_pkh,_,_) = Signature.generate_key () in let (raw_pkh,_,_) = Signature.generate_key () in
let pkh_str = Signature.Public_key_hash.to_b58check raw_pkh 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 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 () in ok ()
let type_tuple_destruct () : unit result = 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" ) ; ("id" , e_string "MULTISIG" ) ;
("counter" , e_nat counter ) ; ("counter" , e_nat counter ) ;
("threshold" , e_nat threshold) ; ("threshold" , e_nat threshold) ;
("auth" , e_typed_list keys t_key ) ; ("auth" , e_typed_list keys (t_key ())) ;
] ]
let empty_op_list = let empty_op_list =
(e_typed_list [] t_operation) (e_typed_list [] (t_operation ()))
let empty_message = e_lambda (Var.of_name "arguments") 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 empty_op_list
let chain_id_zero = e_chain_id @@ Tezos_crypto.Base58.simple_encode let chain_id_zero = e_chain_id @@ Tezos_crypto.Base58.simple_encode
Tezos_base__TzPervasives.Chain_id.b58check_encoding Tezos_base__TzPervasives.Chain_id.b58check_encoding
@ -71,7 +71,7 @@ let params counter msg keys is_validl f s =
(e_record_ez [ (e_record_ez [
("counter" , e_nat counter ) ; ("counter" , e_nat counter ) ;
("message" , msg) ; ("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 *) (* 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 open Ast_imperative
let empty_op_list = let empty_op_list =
(e_typed_list [] t_operation) (e_typed_list [] (t_operation ()))
let empty_message = e_lambda (Var.of_name "arguments") 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 empty_op_list
let empty_message2 = e_lambda (Var.of_name "arguments") let empty_message2 = e_lambda (Var.of_name "arguments")
(Some t_bytes) (Some (t_list t_operation)) (Some (t_bytes ())) (Some (t_list (t_operation ())))
( e_let_in ((Var.of_name "foo"),Some t_unit) false (e_unit ()) empty_op_list) ( 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 send_param msg = e_constructor "Send" msg
let withdraw_param = e_constructor "Withdraw" empty_message 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 id_counter_list in
e_record_ez [ e_record_ez [
("state_hash" , e_bytes_raw state_hash ) ; ("state_hash" , e_bytes_raw state_hash ) ;
("threshold" , e_nat threshold ) ; ("threshold" , e_nat threshold ) ;
("max_proposal" , e_nat max_proposal ) ; ("max_proposal" , e_nat max_proposal ) ;
("max_message_size" , e_nat max_msg_size ) ; ("max_message_size" , e_nat max_msg_size ) ;
("authorized_addresses", e_typed_set auth_set t_address ) ; ("authorized_addresses", e_typed_set auth_set (t_address ()) ) ;
("message_store" , e_typed_map msg_store_list t_bytes (t_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 ) ; ("proposal_counters" , e_typed_map counter_store (t_address ()) (t_nat ()) ) ;
] ]
(* sender not stored in the authorized set *) (* sender not stored in the authorized set *)
@ -238,7 +238,7 @@ let succeeded_storing () =
let init_storage th = { let init_storage th = {
threshold = th ; max_proposal = 1 ; max_msg_size = 15 ; state_hash = Bytes.empty ; threshold = th ; max_proposal = 1 ; max_msg_size = 15 ; state_hash = Bytes.empty ;
id_counter_list = [1,0 ; 2,0 ; 3,0] ; 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 } in
let options = let options =
let sender = contract 1 in 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 Protocol.Alpha_context.Contract.to_b58check kt , kt
let empty_op_list = let empty_op_list =
(e_typed_list [] t_operation) (e_typed_list [] (t_operation ()))
let empty_message = e_lambda (Var.of_name "arguments") 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 empty_op_list

4
src/test/replaceable_id_tests.ml
View File

@ -27,9 +27,9 @@ let compile_main () =
open Ast_imperative open Ast_imperative
let empty_op_list = let empty_op_list =
(e_typed_list [] t_operation) (e_typed_list [] (t_operation ()))
let empty_message = e_lambda (Var.of_name "arguments") 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 empty_op_list
let storage id = e_address @@ addr id 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 () ok ()
let empty_op_list = let empty_op_list =
(e_typed_list [] t_operation) (e_typed_list [] (t_operation ()))
let empty_message = e_lambda (Var.of_name "arguments") 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 empty_op_list
let call msg = e_constructor "Call" msg 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 open Ast_imperative
let empty_op_list = let empty_op_list =
(e_typed_list [] t_operation) (e_typed_list [] (t_operation ()))
let empty_message = e_lambda (Var.of_name "arguments") 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 empty_op_list
let call msg = e_constructor "Call" msg 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 = let lambda () : unit result =
test_expression 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 ()) ()) O.(t_function (t_int ()) (t_int ()) ())
let tuple () : unit result = 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) ; ("title" , e_string name) ;
("yea", e_nat 0) ; ("yea", e_nat 0) ;
("nay", e_nat 0) ; ("nay", e_nat 0) ;
("voters" , e_typed_set [] t_address) ; ("voters" , e_typed_set [] (t_address ())) ;
("start_time" , e_timestamp 0) ; ("start_time" , e_timestamp 0) ;
("finish_time" , e_timestamp 1000000000) ; ("finish_time" , e_timestamp 1000000000) ;
] ]