Merge branch 'dev' of gitlab.com:ligolang/ligo into feature/doc-pascaligo-loop

This commit is contained in:
Christian Rinderknecht 2020-02-05 16:29:37 +01:00
commit 7a484cb45c
19 changed files with 1481 additions and 1459 deletions

View File

@ -0,0 +1,38 @@
open Cli_expect
let%expect_test _ =
run_ligo_bad [ "compile-contract" ; "../../test/contracts/negative/gitlab_111.religo" ; "main" ] ;
[%expect {|
ligo: : Parse error in file "gitlab_111.religo", line 2, characters 0-3, after "=" and before "let":
This is an incorrect let binding.
-
Examples of correct let bindings:
let a: int = 4;
let (a: int, b: int) = (1, 2);
let func = (a: int, b: int) => a + b;
{}
If you're not sure how to fix this error, you can
do one of the following:
* Visit our documentation: https://ligolang.org/docs/intro/what-and-why/
* Ask a question on our Discord: https://discord.gg/9rhYaEt
* Open a gitlab issue: https://gitlab.com/ligolang/ligo/issues/new
* Check the changelog by running 'ligo changelog' |} ] ;
run_ligo_bad [ "compile-contract" ; "../../test/contracts/negative/missing_rpar.religo" ; "main" ] ;
[%expect {|
ligo: : Parse error in file "missing_rpar.religo", line 5, characters 0-3, after "m" and before "let":
Missing `)`.
{}
If you're not sure how to fix this error, you can
do one of the following:
* Visit our documentation: https://ligolang.org/docs/intro/what-and-why/
* Ask a question on our Discord: https://discord.gg/9rhYaEt
* Open a gitlab issue: https://gitlab.com/ligolang/ligo/issues/new
* Check the changelog by running 'ligo changelog' |} ] ;

View File

@ -159,8 +159,8 @@ declarations:
| declaration declarations { Utils.nseq_cons $1 $2 } | declaration declarations { Utils.nseq_cons $1 $2 }
declaration: declaration:
| type_decl ";" { TypeDecl $1 } | type_decl ";"? { TypeDecl $1 }
| let_declaration ";" { Let $1 } | let_declaration ";"? { Let $1 }
(* Type declarations *) (* Type declarations *)
@ -226,7 +226,7 @@ core_type:
in TApp {region; value = constr,arg} } in TApp {region; value = constr,arg} }
sum_type: sum_type:
"|" nsepseq(variant,"|") { ioption("|") nsepseq(variant,"|") {
Scoping.check_variants (Utils.nsepseq_to_list $2); Scoping.check_variants (Utils.nsepseq_to_list $2);
let region = nsepseq_to_region (fun x -> x.region) $2 let region = nsepseq_to_region (fun x -> x.region) $2
in TSum {region; value=$2} } in TSum {region; value=$2} }
@ -418,13 +418,13 @@ unit:
(* Expressions *) (* Expressions *)
interactive_expr: interactive_expr:
expr EOF { $1 } expr_with_let_expr EOF { $1 }
expr: expr:
base_cond__open(expr) | switch_expr(base_cond) { $1 } base_cond__open(expr) | switch_expr(base_cond) { $1 }
base_cond__open(x): base_cond__open(x):
base_expr(x) | conditional(x) { $1 } base_expr(x) | conditional(expr_with_let_expr) { $1 }
base_cond: base_cond:
base_cond__open(base_cond) { $1 } base_cond__open(base_cond) { $1 }
@ -567,7 +567,7 @@ fun_expr:
in EFun {region; value=f} } in EFun {region; value=f} }
base_expr(right_expr): base_expr(right_expr):
let_expr(right_expr) | disj_expr_level | fun_expr { $1 } disj_expr_level | fun_expr { $1 }
conditional(right_expr): conditional(right_expr):
if_then_else(right_expr) | if_then(right_expr) { $1 } if_then_else(right_expr) | if_then(right_expr) { $1 }
@ -576,10 +576,10 @@ parenthesized_expr:
"{" expr "}" | "(" expr ")" { $2 } "{" expr "}" | "(" expr ")" { $2 }
if_then(right_expr): if_then(right_expr):
"if" parenthesized_expr "{" closed_if "}" { "if" parenthesized_expr "{" closed_if ";"? "}" {
let the_unit = ghost, ghost in let the_unit = ghost, ghost in
let ifnot = EUnit {region=ghost; value=the_unit} in let ifnot = EUnit {region=ghost; value=the_unit} in
let region = cover $1 $5 in let region = cover $1 $6 in
let value = {kwd_if = $1; let value = {kwd_if = $1;
test = $2; test = $2;
kwd_then = $3; kwd_then = $3;
@ -589,8 +589,8 @@ if_then(right_expr):
in ECond {region; value} } in ECond {region; value} }
if_then_else(right_expr): if_then_else(right_expr):
"if" parenthesized_expr "{" closed_if ";" "}" "if" parenthesized_expr "{" closed_if ";"? "}"
"else" "{" right_expr ";" "}" { "else" "{" right_expr ";"? "}" {
let region = cover $1 $11 in let region = cover $1 $11 in
let value = {kwd_if = $1; let value = {kwd_if = $1;
test = $2; test = $2;
@ -609,6 +609,7 @@ base_if_then_else:
closed_if: closed_if:
base_if_then_else__open(closed_if) base_if_then_else__open(closed_if)
| switch_expr(base_if_then_else) { $1 } | switch_expr(base_if_then_else) { $1 }
| let_expr(expr_with_let_expr) { $1 }
switch_expr(right_expr): switch_expr(right_expr):
"switch" switch_expr_ "{" cases(right_expr) "}" { "switch" switch_expr_ "{" cases(right_expr) "}" {
@ -896,8 +897,12 @@ update_record:
rbrace = $6} rbrace = $6}
in {region; value} } in {region; value} }
expr_with_let_expr:
expr { $1 }
| let_expr(expr_with_let_expr) { $1 }
sequence_or_record_in: sequence_or_record_in:
expr ";" sep_or_term_list(expr,";") { expr_with_let_expr ";" sep_or_term_list(expr_with_let_expr,";") {
let elts, _region = $3 in let elts, _region = $3 in
let s_elts = Utils.nsepseq_cons $1 $2 elts let s_elts = Utils.nsepseq_cons $1 $2 elts
in PaSequence {s_elts; s_terminator=None} in PaSequence {s_elts; s_terminator=None}
@ -907,7 +912,7 @@ sequence_or_record_in:
let r_elts = Utils.nsepseq_cons $1 $2 elts let r_elts = Utils.nsepseq_cons $1 $2 elts
in PaRecord {r_elts; r_terminator = None} in PaRecord {r_elts; r_terminator = None}
} }
| expr ";"? { PaSingleExpr $1 } | expr_with_let_expr ";"? { PaSingleExpr $1 }
sequence_or_record: sequence_or_record:
"{" sequence_or_record_in "}" { "{" sequence_or_record_in "}" {

File diff suppressed because it is too large Load Diff

View File

@ -35,8 +35,10 @@ module Wrap = struct
let rec type_expression_to_type_value : T.type_value -> O.type_value = fun te -> let rec type_expression_to_type_value : T.type_value -> O.type_value = fun te ->
match te.type_value' with match te.type_value' with
| T_sum kvmap -> | T_sum kvmap ->
let () = failwith "fixme: don't use to_list, it drops the variant keys, rows have a differnt kind than argument lists for now!" in
P_constant (C_variant, T.CMap.to_list @@ T.CMap.map type_expression_to_type_value kvmap) P_constant (C_variant, T.CMap.to_list @@ T.CMap.map type_expression_to_type_value kvmap)
| T_record kvmap -> | T_record kvmap ->
let () = failwith "fixme: don't use to_list, it drops the record keys, rows have a differnt kind than argument lists for now!" in
P_constant (C_record, T.LMap.to_list @@ T.LMap.map type_expression_to_type_value kvmap) P_constant (C_record, T.LMap.to_list @@ T.LMap.map type_expression_to_type_value kvmap)
| T_arrow (arg , ret) -> | T_arrow (arg , ret) ->
P_constant (C_arrow, List.map type_expression_to_type_value [ arg ; ret ]) P_constant (C_arrow, List.map type_expression_to_type_value [ arg ; ret ])
@ -77,8 +79,10 @@ module Wrap = struct
let rec type_expression_to_type_value_copypasted : I.type_expression -> O.type_value = fun te -> let rec type_expression_to_type_value_copypasted : I.type_expression -> O.type_value = fun te ->
match te.type_expression' with match te.type_expression' with
| T_sum kvmap -> | T_sum kvmap ->
let () = failwith "fixme: don't use to_list, it drops the variant keys, rows have a differnt kind than argument lists for now!" in
P_constant (C_variant, I.CMap.to_list @@ I.CMap.map type_expression_to_type_value_copypasted kvmap) P_constant (C_variant, I.CMap.to_list @@ I.CMap.map type_expression_to_type_value_copypasted kvmap)
| T_record kvmap -> | T_record kvmap ->
let () = failwith "fixme: don't use to_list, it drops the record keys, rows have a differnt kind than argument lists for now!" in
P_constant (C_record, I.LMap.to_list @@ I.LMap.map type_expression_to_type_value_copypasted kvmap) P_constant (C_record, I.LMap.to_list @@ I.LMap.map type_expression_to_type_value_copypasted kvmap)
| T_arrow (arg , ret) -> | T_arrow (arg , ret) ->
P_constant (C_arrow, List.map type_expression_to_type_value_copypasted [ arg ; ret ]) P_constant (C_arrow, List.map type_expression_to_type_value_copypasted [ arg ; ret ])

View File

@ -897,7 +897,8 @@ and type_expression : environment -> Solver.state -> ?tv_opt:O.type_value -> I.e
| E_constant (name, lst) -> | E_constant (name, lst) ->
let () = ignore (name , lst) in let () = ignore (name , lst) in
Pervasives.failwith "TODO: E_constant" let _t = Operators.Typer.Operators_types.constant_type name in
Pervasives.failwith (Format.asprintf "TODO: E_constant (%a(%a))" Stage_common.PP.constant name (Format.pp_print_list Ast_simplified.PP.expression) lst)
(* (*
let%bind lst' = bind_list @@ List.map (type_expression e) lst in let%bind lst' = bind_list @@ List.map (type_expression e) lst in
let tv_lst = List.map get_type_annotation lst' in let tv_lst = List.map get_type_annotation lst' in

View File

@ -80,6 +80,12 @@ let get_operator : constant -> type_value -> expression list -> predicate result
prim ~children:[r_ty] I_CONTRACT ; prim ~children:[r_ty] I_CONTRACT ;
i_assert_some_msg (i_push_string "bad address for get_contract") ; i_assert_some_msg (i_push_string "bad address for get_contract") ;
] ]
| C_CONTRACT_OPT ->
let%bind tc = get_t_option ty in
let%bind r = get_t_contract tc in
let%bind r_ty = Compiler_type.type_ r in
ok @@ simple_unary @@ prim ~children:[r_ty] I_CONTRACT ;
| C_CONTRACT_ENTRYPOINT -> | C_CONTRACT_ENTRYPOINT ->
let%bind r = get_t_contract ty in let%bind r = get_t_contract ty in
let%bind r_ty = Compiler_type.type_ r in let%bind r_ty = Compiler_type.type_ r in
@ -94,6 +100,20 @@ let get_operator : constant -> type_value -> expression list -> predicate result
prim ~annot:[entry] ~children:[r_ty] I_CONTRACT ; prim ~annot:[entry] ~children:[r_ty] I_CONTRACT ;
i_assert_some_msg (i_push_string @@ Format.sprintf "bad address for get_entrypoint (%s)" entry) ; i_assert_some_msg (i_push_string @@ Format.sprintf "bad address for get_entrypoint (%s)" entry) ;
] ]
| C_CONTRACT_ENTRYPOINT_OPT ->
let%bind tc = get_t_option ty in
let%bind r = get_t_contract tc in
let%bind r_ty = Compiler_type.type_ r in
let%bind entry = match lst with
| [ { content = E_literal (D_string entry); type_value = _ } ; _addr ] -> ok entry
| [ _entry ; _addr ] ->
fail @@ contract_entrypoint_must_be_literal ~loc:__LOC__
| _ ->
fail @@ corner_case ~loc:__LOC__ "mini_c . CONTRACT_ENTRYPOINT" in
ok @@ simple_binary @@ seq [
i_drop ; (* drop the entrypoint... *)
prim ~annot:[entry] ~children:[r_ty] I_CONTRACT ;
]
| x -> simple_fail (Format.asprintf "predicate \"%a\" doesn't exist" Stage_common.PP.constant x) | x -> simple_fail (Format.asprintf "predicate \"%a\" doesn't exist" Stage_common.PP.constant x)
) )

View File

@ -70,7 +70,9 @@ module Simplify = struct
| "get_chain_id" -> ok C_CHAIN_ID | "get_chain_id" -> ok C_CHAIN_ID
| "transaction" -> ok C_CALL | "transaction" -> ok C_CALL
| "get_contract" -> ok C_CONTRACT | "get_contract" -> ok C_CONTRACT
| "get_contract_opt"-> ok C_CONTRACT_OPT
| "get_entrypoint" -> ok C_CONTRACT_ENTRYPOINT | "get_entrypoint" -> ok C_CONTRACT_ENTRYPOINT
| "get_entrypoint_opt" -> ok C_CONTRACT_ENTRYPOINT_OPT
| "size" -> ok C_SIZE | "size" -> ok C_SIZE
| "int" -> ok C_INT | "int" -> ok C_INT
| "abs" -> ok C_ABS | "abs" -> ok C_ABS
@ -228,7 +230,9 @@ module Simplify = struct
| "Operation.transaction" -> ok C_CALL | "Operation.transaction" -> ok C_CALL
| "Operation.set_delegate" -> ok C_SET_DELEGATE | "Operation.set_delegate" -> ok C_SET_DELEGATE
| "Operation.get_contract" -> ok C_CONTRACT | "Operation.get_contract" -> ok C_CONTRACT
| "Operation.get_contract_opt" -> ok C_CONTRACT_OPT
| "Operation.get_entrypoint" -> ok C_CONTRACT_ENTRYPOINT | "Operation.get_entrypoint" -> ok C_CONTRACT_ENTRYPOINT
| "Operation.get_entrypoint_opt" -> ok C_CONTRACT_ENTRYPOINT_OPT
| "int" -> ok C_INT | "int" -> ok C_INT
| "abs" -> ok C_ABS | "abs" -> ok C_ABS
| "unit" -> ok C_UNIT | "unit" -> ok C_UNIT
@ -365,6 +369,93 @@ module Typer = struct
let t_set_add = forall "a" @@ fun a -> a --> set a --> set a let t_set_add = forall "a" @@ fun a -> a --> set a --> set a
let t_set_remove = forall "a" @@ fun a -> a --> set a --> set a let t_set_remove = forall "a" @@ fun a -> a --> set a --> set a
let t_not = bool --> bool let t_not = bool --> bool
let constant_type : constant -> Typesystem.Core.type_value result = function
| C_INT -> ok @@ t_int ;
| C_UNIT -> ok @@ t_unit ;
| C_NOW -> ok @@ t_now ;
| C_IS_NAT -> ok @@ failwith "t_is_nat" ;
| C_SOME -> ok @@ t_some ;
| C_NONE -> ok @@ t_none ;
| C_ASSERTION -> ok @@ t_assertion ;
| C_FAILWITH -> ok @@ t_failwith ;
(* LOOPS *)
| C_FOLD_WHILE -> ok @@ failwith "t_fold_while" ;
| C_CONTINUE -> ok @@ failwith "t_continue" ;
| C_STOP -> ok @@ failwith "t_stop" ;
(* MATH *)
| C_NEG -> ok @@ failwith "t_neg" ;
| C_ABS -> ok @@ t_abs ;
| C_ADD -> ok @@ t_add ;
| C_SUB -> ok @@ t_sub ;
| C_MUL -> ok @@ t_times;
| C_DIV -> ok @@ t_div ;
| C_MOD -> ok @@ t_mod ;
(* LOGIC *)
| C_NOT -> ok @@ t_not ;
| C_AND -> ok @@ failwith "t_and" ;
| C_OR -> ok @@ failwith "t_or" ;
| C_XOR -> ok @@ failwith "t_xor" ;
(* COMPARATOR *)
| C_EQ -> ok @@ failwith "t_comparator EQ" ;
| C_NEQ -> ok @@ failwith "t_comparator NEQ" ;
| C_LT -> ok @@ failwith "t_comparator LT" ;
| C_GT -> ok @@ failwith "t_comparator GT" ;
| C_LE -> ok @@ failwith "t_comparator LE" ;
| C_GE -> ok @@ failwith "t_comparator GE" ;
(* BYTES / STRING *)
| C_SIZE -> ok @@ t_size ;
| C_CONCAT -> ok @@ failwith "t_concat" ;
| C_SLICE -> ok @@ t_slice ;
| C_BYTES_PACK -> ok @@ t_bytes_pack ;
| C_BYTES_UNPACK -> ok @@ t_bytes_unpack ;
| C_CONS -> ok @@ t_cons ;
(* SET *)
| C_SET_EMPTY -> ok @@ failwith "t_set_empty" ;
| C_SET_ADD -> ok @@ t_set_add ;
| C_SET_REMOVE -> ok @@ t_set_remove ;
| C_SET_ITER -> ok @@ failwith "t_set_iter" ;
| C_SET_FOLD -> ok @@ failwith "t_set_fold" ;
| C_SET_MEM -> ok @@ t_set_mem ;
(* LIST *)
| C_LIST_ITER -> ok @@ failwith "t_list_iter" ;
| C_LIST_MAP -> ok @@ failwith "t_list_map" ;
| C_LIST_FOLD -> ok @@ failwith "t_list_fold" ;
| C_LIST_CONS -> ok @@ failwith "t_list_cons" ;
(* MAP *)
| C_MAP_GET -> ok @@ failwith "t_map_get" ;
| C_MAP_GET_FORCE -> ok @@ failwith "t_map_get_force" ;
| C_MAP_ADD -> ok @@ t_map_add ;
| C_MAP_REMOVE -> ok @@ t_map_remove ;
| C_MAP_UPDATE -> ok @@ t_map_update ;
| C_MAP_ITER -> ok @@ t_map_iter ;
| C_MAP_MAP -> ok @@ t_map_map ;
| C_MAP_FOLD -> ok @@ t_map_fold ;
| C_MAP_MEM -> ok @@ t_map_mem ;
| C_MAP_FIND -> ok @@ t_map_find ;
| C_MAP_FIND_OPT -> ok @@ t_map_find_opt ;
(* BIG MAP *)
(* CRYPTO *)
| C_SHA256 -> ok @@ t_hash256 ;
| C_SHA512 -> ok @@ t_hash512 ;
| C_BLAKE2b -> ok @@ t_blake2b ;
| C_HASH_KEY -> ok @@ t_hash_key ;
| C_CHECK_SIGNATURE -> ok @@ t_check_signature ;
| C_CHAIN_ID -> ok @@ failwith "t_chain_id" ;
(*BLOCKCHAIN *)
| C_CONTRACT -> ok @@ t_get_contract ;
| C_CONTRACT_ENTRYPOINT -> ok @@ failwith "t_get_entrypoint" ;
| C_AMOUNT -> ok @@ t_amount ;
| C_BALANCE -> ok @@ failwith "t_balance" ;
| C_CALL -> ok @@ t_transaction ;
| C_SENDER -> ok @@ t_sender ;
| C_SOURCE -> ok @@ t_source ;
| C_ADDRESS -> ok @@ t_address ;
| C_SELF_ADDRESS -> ok @@ failwith "t_self_address";
| C_IMPLICIT_ACCOUNT -> ok @@ failwith "t_implicit_account";
| C_SET_DELEGATE -> ok @@ failwith "t_set_delegate" ;
| c -> simple_fail @@ Format.asprintf "Typer not implemented for consant %a" Stage_common.PP.constant c
end end
let none = typer_0 "NONE" @@ fun tv_opt -> let none = typer_0 "NONE" @@ fun tv_opt ->
@ -570,6 +661,20 @@ module Typer = struct
get_t_contract tv in get_t_contract tv in
ok @@ t_contract tv' () ok @@ t_contract tv' ()
let get_contract_opt = typer_1_opt "CONTRACT OPT" @@ fun addr_tv tv_opt ->
if not (type_value_eq (addr_tv, t_address ()))
then fail @@ simple_error (Format.asprintf "get_contract_opt expects an address, got %a" PP.type_value addr_tv)
else
let%bind tv =
trace_option (simple_error "get_contract_opt needs a type annotation") tv_opt in
let%bind tv =
trace_strong (simple_error "get_entrypoint_opt has a not-option annotation") @@
get_t_option tv in
let%bind tv' =
trace_strong (simple_error "get_entrypoint_opt has a not-option(contract) annotation") @@
get_t_contract tv in
ok @@ t_option (t_contract tv' ()) ()
let get_entrypoint = typer_2_opt "CONTRACT_ENTRYPOINT" @@ fun entry_tv addr_tv tv_opt -> let get_entrypoint = typer_2_opt "CONTRACT_ENTRYPOINT" @@ fun entry_tv addr_tv tv_opt ->
if not (type_value_eq (entry_tv, t_string ())) if not (type_value_eq (entry_tv, t_string ()))
then fail @@ simple_error (Format.asprintf "get_entrypoint expects a string entrypoint label for first argument, got %a" PP.type_value entry_tv) then fail @@ simple_error (Format.asprintf "get_entrypoint expects a string entrypoint label for first argument, got %a" PP.type_value entry_tv)
@ -584,6 +689,23 @@ module Typer = struct
get_t_contract tv in get_t_contract tv in
ok @@ t_contract tv' () ok @@ t_contract tv' ()
let get_entrypoint_opt = typer_2_opt "CONTRACT_ENTRYPOINT_OPT" @@ fun entry_tv addr_tv tv_opt ->
if not (type_value_eq (entry_tv, t_string ()))
then fail @@ simple_error (Format.asprintf "get_entrypoint_opt expects a string entrypoint label for first argument, got %a" PP.type_value entry_tv)
else
if not (type_value_eq (addr_tv, t_address ()))
then fail @@ simple_error (Format.asprintf "get_entrypoint_opt expects an address for second argument, got %a" PP.type_value addr_tv)
else
let%bind tv =
trace_option (simple_error "get_entrypoint_opt needs a type annotation") tv_opt in
let%bind tv =
trace_strong (simple_error "get_entrypoint_opt has a not-option annotation") @@
get_t_option tv in
let%bind tv' =
trace_strong (simple_error "get_entrypoint_opt has a not-option(contract) annotation") @@
get_t_contract tv in
ok @@ t_option (t_contract tv' ())()
let set_delegate = typer_1 "SET_DELEGATE" @@ fun delegate_opt -> let set_delegate = typer_1 "SET_DELEGATE" @@ fun delegate_opt ->
let%bind () = assert_eq_1 delegate_opt (t_option (t_key_hash ()) ()) in let%bind () = assert_eq_1 delegate_opt (t_option (t_key_hash ()) ()) in
ok @@ t_operation () ok @@ t_operation ()
@ -933,7 +1055,9 @@ module Typer = struct
| C_CHAIN_ID -> ok @@ chain_id ; | C_CHAIN_ID -> ok @@ chain_id ;
(*BLOCKCHAIN *) (*BLOCKCHAIN *)
| C_CONTRACT -> ok @@ get_contract ; | C_CONTRACT -> ok @@ get_contract ;
| C_CONTRACT_OPT -> ok @@ get_contract_opt ;
| C_CONTRACT_ENTRYPOINT -> ok @@ get_entrypoint ; | C_CONTRACT_ENTRYPOINT -> ok @@ get_entrypoint ;
| C_CONTRACT_ENTRYPOINT_OPT -> ok @@ get_entrypoint_opt ;
| C_AMOUNT -> ok @@ amount ; | C_AMOUNT -> ok @@ amount ;
| C_BALANCE -> ok @@ balance ; | C_BALANCE -> ok @@ balance ;
| C_CALL -> ok @@ transaction ; | C_CALL -> ok @@ transaction ;

View File

@ -94,6 +94,7 @@ module Typer : sig
val t_set_add : Typesystem.Core.type_value val t_set_add : Typesystem.Core.type_value
val t_set_remove : Typesystem.Core.type_value val t_set_remove : Typesystem.Core.type_value
val t_not : Typesystem.Core.type_value val t_not : Typesystem.Core.type_value
val constant_type : constant -> Typesystem.Core.type_value Trace.result
end end
(* (*

View File

@ -108,7 +108,9 @@ let constant ppf : constant -> unit = function
(* Blockchain *) (* Blockchain *)
| C_CALL -> fprintf ppf "CALL" | C_CALL -> fprintf ppf "CALL"
| C_CONTRACT -> fprintf ppf "CONTRACT" | C_CONTRACT -> fprintf ppf "CONTRACT"
| C_CONTRACT_OPT -> fprintf ppf "CONTRACT_OPT"
| C_CONTRACT_ENTRYPOINT -> fprintf ppf "CONTRACT_ENTRYPOINT" | C_CONTRACT_ENTRYPOINT -> fprintf ppf "CONTRACT_ENTRYPOINT"
| C_CONTRACT_ENTRYPOINT_OPT -> fprintf ppf "CONTRACT_ENTRYPOINT_OPT"
| C_AMOUNT -> fprintf ppf "AMOUNT" | C_AMOUNT -> fprintf ppf "AMOUNT"
| C_BALANCE -> fprintf ppf "BALANCE" | C_BALANCE -> fprintf ppf "BALANCE"
| C_SOURCE -> fprintf ppf "SOURCE" | C_SOURCE -> fprintf ppf "SOURCE"

View File

@ -57,8 +57,8 @@ let type_expression'_of_string = function
| "TC_timestamp" , [] -> ok @@ T_constant(TC_timestamp) | "TC_timestamp" , [] -> ok @@ T_constant(TC_timestamp)
| _, [] -> | _, [] ->
failwith "internal error: wrong number of arguments for type constant" failwith "internal error: wrong number of arguments for type constant"
| _ -> | op, _ ->
failwith "internal error: unknown type operator" failwith (Format.asprintf "internal error: unknown type operator in src/stages/common/misc.ml %s" op)
let string_of_type_operator = function let string_of_type_operator = function
| TC_contract x -> "TC_contract" , [x] | TC_contract x -> "TC_contract" , [x]

View File

@ -225,7 +225,9 @@ type constant =
(* Blockchain *) (* Blockchain *)
| C_CALL | C_CALL
| C_CONTRACT | C_CONTRACT
| C_CONTRACT_OPT
| C_CONTRACT_ENTRYPOINT | C_CONTRACT_ENTRYPOINT
| C_CONTRACT_ENTRYPOINT_OPT
| C_AMOUNT | C_AMOUNT
| C_BALANCE | C_BALANCE
| C_SOURCE | C_SOURCE

View File

@ -77,7 +77,11 @@ let type_expression'_of_simple_c_constant = function
| C_set , [x] -> ok @@ T_operator(TC_set x) | C_set , [x] -> ok @@ T_operator(TC_set x)
| C_map , [x ; y] -> ok @@ T_operator(TC_map (x , y)) | C_map , [x ; y] -> ok @@ T_operator(TC_map (x , y))
| C_big_map , [x ; y] -> ok @@ T_operator(TC_big_map (x, y)) | C_big_map , [x ; y] -> ok @@ T_operator(TC_big_map (x, y))
| (C_contract | C_option | C_list | C_set | C_map | C_big_map), _ -> | C_arrow , [x ; y] -> ok @@ T_operator(TC_arrow (x, y))
| C_tuple , lst -> ok @@ T_operator(TC_tuple lst)
| C_record , _lst -> ok @@ failwith "records are not supported yet: T_record lst"
| C_variant , _lst -> ok @@ failwith "sums are not supported yet: T_sum lst"
| (C_contract | C_option | C_list | C_set | C_map | C_big_map | C_arrow ), _ ->
failwith "internal error: wrong number of arguments for type operator" failwith "internal error: wrong number of arguments for type operator"
| C_unit , [] -> ok @@ T_constant(TC_unit) | C_unit , [] -> ok @@ T_constant(TC_unit)
@ -94,8 +98,6 @@ let type_expression'_of_simple_c_constant = function
| C_chain_id , [] -> ok @@ T_constant(TC_chain_id) | C_chain_id , [] -> ok @@ T_constant(TC_chain_id)
| C_signature , [] -> ok @@ T_constant(TC_signature) | C_signature , [] -> ok @@ T_constant(TC_signature)
| C_timestamp , [] -> ok @@ T_constant(TC_timestamp) | C_timestamp , [] -> ok @@ T_constant(TC_timestamp)
| _ , [] -> | (C_unit | C_string | C_bytes | C_nat | C_int | C_mutez | C_bool | C_operation | C_address | C_key | C_key_hash | C_chain_id | C_signature | C_timestamp), _::_ ->
failwith "internal error: wrong number of arguments for type constant" failwith "internal error: wrong number of arguments for type constant"
| _ , _ ->
failwith "internal error: unknown type operator"

View File

@ -3,3 +3,14 @@ function cb(const a : address; const s : unit) : list(operation) * unit is
const c : contract(unit) = get_entrypoint("%cb", a) const c : contract(unit) = get_entrypoint("%cb", a)
} }
with (list transaction(unit, 0mutez, c) end, s) with (list transaction(unit, 0mutez, c) end, s)
function cbo(const a : address; const s : unit) : list(operation) * unit is
block {
const c : contract(unit) =
case (get_entrypoint_opt("%cbo", a) : option(contract (unit))) of
| Some (c) -> c
| None -> (failwith ("entrypoint not found") : contract (unit))
end
}
with (list transaction(unit, 0mutez, c) end, s)

View File

@ -0,0 +1,16 @@
function cb(const s : unit) : list(operation) * unit is
block {
const c : contract(unit) = get_contract(source)
}
with (list transaction(unit, 0mutez, c) end, s)
function cbo(const s : unit) : list(operation) * unit is
block {
const c : contract(unit) =
case (get_contract_opt(source) : option(contract (unit))) of
| Some (c) -> c
| None -> (failwith ("contract not found") : contract (unit))
end
}
with (list transaction(unit, 0mutez, c) end, s)

View File

@ -3,7 +3,7 @@ type storage = int;
/* variant defining pseudo multi-entrypoint actions */ /* variant defining pseudo multi-entrypoint actions */
type action = type action =
| Increment(int) Increment(int)
| Decrement(int); | Decrement(int);
let add = ((a: int), (b: int)) => a + b; let add = ((a: int), (b: int)) => a + b;

View File

@ -0,0 +1,2 @@
let a =
let b = 2;

View File

@ -0,0 +1,5 @@
type foo = big_map(int, int);
let test_case = (n: int, m: foo): foo => Big_map.update(23, Some(n), m
let z = 4;

View File

@ -0,0 +1,13 @@
type f = int
let a = (b: f) => {
if (b == 2) {
3
} else {
4
}
}
let c = (c: f) => {
3
}

View File

@ -1916,6 +1916,26 @@ let attributes_religo () : unit result =
in in
ok () ok ()
let get_contract_ligo () : unit result =
let%bind program = type_file "./contracts/get_contract.ligo" in
let%bind () =
let make_input = fun _n -> e_unit () in
let make_expected : int -> Ast_simplified.expression -> unit result = fun _n result ->
let%bind (ops , storage) = get_e_pair result.expression in
let%bind () =
let%bind lst = get_e_list ops.expression in
Assert.assert_list_size lst 1 in
let expected_storage = e_unit () in
Ast_simplified.Misc.assert_value_eq (expected_storage , storage)
in
let%bind () =
let amount = Memory_proto_alpha.Protocol.Alpha_context.Tez.zero in
let options = Proto_alpha_utils.Memory_proto_alpha.make_options ~amount () in
let%bind () = expect_n_strict_pos_small ~options program "cb" make_input make_expected in
expect_n_strict_pos_small ~options program "cbo" make_input make_expected in
ok ()
in
ok()
let entrypoints_ligo () : unit result = let entrypoints_ligo () : unit result =
let%bind _program = type_file "./contracts/entrypoints.ligo" in let%bind _program = type_file "./contracts/entrypoints.ligo" in
@ -2178,6 +2198,15 @@ let tuple_type_religo () : unit result =
in in
ok () ok ()
let no_semicolon_religo () : unit result =
let%bind program = retype_file "./contracts/no_semicolon.religo" in
let%bind () =
let input _ = e_int 2 in
let expected _ = e_int 3 in
expect_eq_n program "a" input expected
in
ok ()
let main = test_suite "Integration (End to End)" [ let main = test_suite "Integration (End to End)" [
test "bytes unpack" bytes_unpack ; test "bytes unpack" bytes_unpack ;
test "bytes unpack (mligo)" bytes_unpack_mligo ; test "bytes unpack (mligo)" bytes_unpack_mligo ;
@ -2328,6 +2357,7 @@ let main = test_suite "Integration (End to End)" [
test "tuples_sequences_functions (religo)" tuples_sequences_functions_religo ; test "tuples_sequences_functions (religo)" tuples_sequences_functions_religo ;
test "simple_access (ligo)" simple_access_ligo; test "simple_access (ligo)" simple_access_ligo;
test "deep_access (ligo)" deep_access_ligo; test "deep_access (ligo)" deep_access_ligo;
test "get_contract (ligo)" get_contract_ligo;
test "entrypoints (ligo)" entrypoints_ligo ; test "entrypoints (ligo)" entrypoints_ligo ;
test "curry (mligo)" curry ; test "curry (mligo)" curry ;
test "type tuple destruct (mligo)" type_tuple_destruct ; test "type tuple destruct (mligo)" type_tuple_destruct ;
@ -2342,4 +2372,5 @@ let main = test_suite "Integration (End to End)" [
test "empty case (religo)" empty_case_religo ; test "empty case (religo)" empty_case_religo ;
test "tuple type (mligo)" tuple_type_mligo ; test "tuple type (mligo)" tuple_type_mligo ;
test "tuple type (religo)" tuple_type_religo ; test "tuple type (religo)" tuple_type_religo ;
test "no semicolon (religo)" no_semicolon_religo ;
] ]