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

Alpha: consistent typechecking of contract storage initialization.

Browse Source
This commit is contained in:
Benjamin Canou 2017-06-06 19:39:46 +02:00
parent 35792ccc37
commit e69662efa5
2 changed files with 11 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
src/proto/alpha/apply.ml
View File

@ -104,10 +104,12 @@ let apply_manager_operation_content
end end
| Origination { manager ; delegate ; script ; | Origination { manager ; delegate ; script ;
spendable ; delegatable ; credit } -> spendable ; delegatable ; credit } ->
let script = match script with begin match script with
| None -> None | None -> return None
| Some script -> | Some ({ Script.storage ; code } as script) ->
Some (script, (Script_interpreter.dummy_code_fee, Script_interpreter.dummy_storage_fee)) in Script_ir_translator.parse_script ctxt storage code >>=? fun _ ->
return (Some (script, (Script_interpreter.dummy_code_fee, Script_interpreter.dummy_storage_fee)))
end >>=? fun script ->
Contract.spend ctxt source Constants.origination_burn >>=? fun ctxt -> Contract.spend ctxt source Constants.origination_burn >>=? fun ctxt ->
Contract.spend ctxt source credit >>=? fun ctxt -> Contract.spend ctxt source credit >>=? fun ctxt ->
Contract.originate ctxt Contract.originate ctxt

6
src/proto/alpha/script_ir_translator.ml
View File

@ -1409,12 +1409,16 @@ type ex_script = Ex_script : ('a, 'b, 'c) script -> ex_script
let parse_script let parse_script
: context -> Script.storage -> Script.code -> ex_script tzresult Lwt.t : context -> Script.storage -> Script.code -> ex_script tzresult Lwt.t
= fun ctxt { storage; storage_type } { code; arg_type; ret_type } -> = fun ctxt
{ storage; storage_type = init_storage_type }
{ code; arg_type; ret_type; storage_type } ->
(Lwt.return (parse_ty arg_type)) >>=? fun (Ex_ty arg_type) -> (Lwt.return (parse_ty arg_type)) >>=? fun (Ex_ty arg_type) ->
(Lwt.return (parse_ty ret_type)) >>=? fun (Ex_ty ret_type) -> (Lwt.return (parse_ty ret_type)) >>=? fun (Ex_ty ret_type) ->
(Lwt.return (parse_ty init_storage_type)) >>=? fun (Ex_ty init_storage_type) ->
(Lwt.return (parse_ty storage_type)) >>=? fun (Ex_ty storage_type) -> (Lwt.return (parse_ty storage_type)) >>=? fun (Ex_ty storage_type) ->
let arg_type_full = Pair_t (Pair_t (Tez_t, arg_type), storage_type) in let arg_type_full = Pair_t (Pair_t (Tez_t, arg_type), storage_type) in
let ret_type_full = Pair_t (ret_type, storage_type) in let ret_type_full = Pair_t (ret_type, storage_type) in
Lwt.return (ty_eq init_storage_type storage_type) >>=? fun (Eq _) ->
parse_data ctxt storage_type storage >>=? fun storage -> parse_data ctxt storage_type storage >>=? fun storage ->
parse_lambda ctxt ~storage_type arg_type_full ret_type_full code >>=? fun code -> parse_lambda ctxt ~storage_type arg_type_full ret_type_full code >>=? fun code ->
return (Ex_script { code; arg_type; ret_type; storage; storage_type }) return (Ex_script { code; arg_type; ret_type; storage; storage_type })