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

Replace function that returns result by function that returns option

Browse Source
This commit is contained in:
Pierre-Emmanuel Wulfman 2020-04-20 17:39:36 +02:00
parent 85222c1d65
commit 173a0c4031
4 changed files with 275 additions and 261 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -152,6 +152,14 @@ module Errors = struct
let message () = description in let message () = description in
error title message error title message
let unknown_built_in name =
let title () = "\n Unknown built-in function" in
let message () = "" in
let data = [
("built-in", fun () -> name);
] in
error ~data title message
end end
open Errors open Errors
@ -224,8 +232,8 @@ and compile_type_expression : Raw.type_expr -> type_expression result = fun te -
| TVar v -> ( | TVar v -> (
let (v, loc) = r_split v in let (v, loc) = r_split v in
match type_constants v with match type_constants v with
| Ok (s,_) -> ok @@ make_t ~loc @@ T_constant s | Some s -> ok @@ make_t ~loc @@ T_constant s
| Error _ -> ok @@ make_t ~loc @@ T_variable (Var.of_name v) | None -> ok @@ make_t ~loc @@ T_variable (Var.of_name v)
) )
| TFun x -> ( | TFun x -> (
let (x,loc) = r_split x in let (x,loc) = r_split x in
@ -275,7 +283,7 @@ and compile_type_expression : Raw.type_expr -> type_expression result = fun te -
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_option (unknown_predefined_type name) @@
type_operators name.value in type_operators name.value in
t_operator ~loc cst lst' ) t_operator ~loc cst lst' )
) )
@ -491,8 +499,8 @@ let rec compile_expression :
| EVar c -> | EVar c ->
let (c',loc) = r_split c in let (c',loc) = r_split c in
(match constants c' with (match constants c' with
| Error _ -> return @@ e_variable ~loc (Var.of_name c.value) | None -> return @@ e_variable ~loc (Var.of_name c.value)
| Ok (s,_) -> return @@ e_constant s []) | Some s -> return @@ e_constant s [])
| ECall x -> ( | ECall x -> (
let ((e1 , e2) , loc) = r_split x in let ((e1 , e2) , loc) = r_split x in
let%bind args = bind_map_list compile_expression (nseq_to_list e2) in let%bind args = bind_map_list compile_expression (nseq_to_list e2) in
@ -505,8 +513,8 @@ let rec compile_expression :
| EVar f -> ( | EVar f -> (
let (f , f_loc) = r_split f in let (f , f_loc) = r_split f in
match constants f with match constants f with
| Error _ -> return @@ chain_application (e_variable ~loc:f_loc (Var.of_name f)) args | None -> return @@ chain_application (e_variable ~loc:f_loc (Var.of_name f)) args
| Ok (s, _) -> return @@ e_constant ~loc s args | Some s -> return @@ e_constant ~loc s args
) )
| e1 -> | e1 ->
let%bind e1' = compile_expression e1 in let%bind e1' = compile_expression e1 in
@ -802,14 +810,14 @@ and compile_binop (name:string) (t:_ Raw.bin_op Region.reg) : expression result
let (args , loc) = r_split t in let (args , loc) = r_split t in
let%bind a = compile_expression args.arg1 in let%bind a = compile_expression args.arg1 in
let%bind b = compile_expression args.arg2 in let%bind b = compile_expression args.arg2 in
let%bind name = constants name in let%bind name = trace_option (unknown_built_in name) @@ constants name in
return @@ e_constant ~loc name [ a ; b ] return @@ e_constant ~loc name [ a ; b ]
and compile_unop (name:string) (t:_ Raw.un_op Region.reg) : expression result = and compile_unop (name:string) (t:_ Raw.un_op Region.reg) : expression result =
let return x = ok @@ x in let return x = ok @@ x in
let (t , loc) = r_split t in let (t , loc) = r_split t in
let%bind a = compile_expression t.arg in let%bind a = compile_expression t.arg in
let%bind name = constants name in let%bind name = trace_option (unknown_built_in name) @@ constants name in
return @@ e_constant ~loc name [ a ] return @@ e_constant ~loc name [ a ]
and compile_tuple_expression ?loc (lst:Raw.expr list) : expression result = and compile_tuple_expression ?loc (lst:Raw.expr list) : expression result =

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

@ -110,6 +110,15 @@ module Errors = struct
~offsets:true ~mode:`Point t) ~offsets:true ~mode:`Point t)
] in ] in
error ~data title message error ~data title message
let unknown_built_in name =
let title () = "\n Unknown built-in function" in
let message () = "" in
let data = [
("built-in", fun () -> name);
] in
error ~data title message
end end
open Errors open Errors
@ -153,8 +162,8 @@ let rec compile_type_expression (t:Raw.type_expr) : type_expression result =
| TVar v -> ( | TVar v -> (
let (v,loc) = r_split v in let (v,loc) = r_split v in
match type_constants v with match type_constants v with
| Ok (s,_) -> ok @@ make_t ~loc @@ T_constant s | Some s -> ok @@ make_t ~loc @@ T_constant s
| Error _ -> ok @@ make_t ~loc @@ T_variable (Var.of_name v) | None -> ok @@ make_t ~loc @@ T_variable (Var.of_name v)
) )
| TFun x -> ( | TFun x -> (
let (x,loc) = r_split x in let (x,loc) = r_split x in
@ -202,7 +211,7 @@ let rec compile_type_expression (t:Raw.type_expr) : type_expression result =
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_option (unknown_predefined_type name) @@
type_operators name.value in type_operators name.value in
t_operator ~loc cst lst) t_operator ~loc cst lst)
| TProd p -> | TProd p ->
@ -277,8 +286,8 @@ let rec compile_expression (t:Raw.expr) : expr result =
| EVar c -> ( | EVar c -> (
let (c' , loc) = r_split c in let (c' , loc) = r_split c in
match constants c' with match constants c' with
| Error _ -> return @@ e_variable ~loc (Var.of_name c.value) | None -> return @@ e_variable ~loc (Var.of_name c.value)
| Ok (s,_) -> return @@ e_constant ~loc s [] | Some s -> return @@ e_constant ~loc s []
) )
| ECall x -> ( | ECall x -> (
let ((f, args) , loc) = r_split x in let ((f, args) , loc) = r_split x in
@ -288,10 +297,10 @@ let rec compile_expression (t:Raw.expr) : expr result =
| EVar name -> ( | EVar name -> (
let (f_name , f_loc) = r_split name in let (f_name , f_loc) = r_split name in
match constants f_name with match constants f_name with
| Error _ -> | None ->
let%bind arg = compile_tuple_expression ~loc:args_loc args' in let%bind arg = compile_tuple_expression ~loc:args_loc args' in
return @@ e_application ~loc (e_variable ~loc:f_loc (Var.of_name f_name)) arg return @@ e_application ~loc (e_variable ~loc:f_loc (Var.of_name f_name)) arg
| Ok (s,_) -> | Some s ->
let%bind lst = bind_map_list compile_expression args' in let%bind lst = bind_map_list compile_expression args' in
return @@ e_constant ~loc s lst return @@ e_constant ~loc s lst
) )
@ -538,14 +547,14 @@ and compile_binop (name:string) (t:_ Raw.bin_op Region.reg) : expression result
let (t , loc) = r_split t in let (t , loc) = r_split t in
let%bind a = compile_expression t.arg1 in let%bind a = compile_expression t.arg1 in
let%bind b = compile_expression t.arg2 in let%bind b = compile_expression t.arg2 in
let%bind name = constants name in let%bind name = trace_option (unknown_built_in name) @@ constants name in
return @@ e_constant ~loc name [ a ; b ] return @@ e_constant ~loc name [ a ; b ]
and compile_unop (name:string) (t:_ Raw.un_op Region.reg) : expression result = and compile_unop (name:string) (t:_ Raw.un_op Region.reg) : expression result =
let return x = ok x in let return x = ok x in
let (t , loc) = r_split t in let (t , loc) = r_split t in
let%bind a = compile_expression t.arg in let%bind a = compile_expression t.arg in
let%bind name = constants name in let%bind name = trace_option (unknown_built_in name) @@ constants name in
return @@ e_constant ~loc name [ a ] return @@ e_constant ~loc name [ a ]
and compile_tuple_expression ?loc (lst:Raw.expr list) : expression result = and compile_tuple_expression ?loc (lst:Raw.expr list) : expression result =
@ -780,10 +789,10 @@ and compile_single_instruction : Raw.instruction -> (_ -> expression result) res
| EVar name -> ( | EVar name -> (
let (f_name , f_loc) = r_split name in let (f_name , f_loc) = r_split name in
match constants f_name with match constants f_name with
| Error _ -> | None ->
let%bind arg = compile_tuple_expression ~loc:args_loc args' in let%bind arg = compile_tuple_expression ~loc:args_loc args' in
return_statement @@ e_application ~loc (e_variable ~loc:f_loc (Var.of_name f_name)) arg return_statement @@ e_application ~loc (e_variable ~loc:f_loc (Var.of_name f_name)) arg
| Ok (s,_) -> | Some s ->
let%bind lst = bind_map_list compile_expression args' in let%bind lst = bind_map_list compile_expression args' in
return_statement @@ e_constant ~loc s lst return_statement @@ e_constant ~loc s lst
) )

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

@ -36,245 +36,244 @@ module Concrete_to_imperative = struct
let type_constants s = let type_constants s =
match s with match s with
"chain_id" -> ok TC_chain_id "chain_id" -> Some TC_chain_id
| "unit" -> ok TC_unit | "unit" -> Some TC_unit
| "string" -> ok TC_string | "string" -> Some TC_string
| "bytes" -> ok TC_bytes | "bytes" -> Some TC_bytes
| "nat" -> ok TC_nat | "nat" -> Some TC_nat
| "int" -> ok TC_int | "int" -> Some TC_int
| "tez" -> ok TC_mutez | "tez" -> Some TC_mutez
| "bool" -> ok TC_bool | "bool" -> Some TC_bool
| "operation" -> ok TC_operation | "operation" -> Some TC_operation
| "address" -> ok TC_address | "address" -> Some TC_address
| "key" -> ok TC_key | "key" -> Some TC_key
| "key_hash" -> ok TC_key_hash | "key_hash" -> Some TC_key_hash
| "signature" -> ok TC_signature | "signature" -> Some TC_signature
| "timestamp" -> ok TC_timestamp | "timestamp" -> Some TC_timestamp
| _ -> simple_fail @@ "Not a built-in type (" ^ s ^ ")." | _ -> None
let type_operators s = let type_operators s =
match s with match s with
"list" -> ok @@ TC_list unit_expr "list" -> Some (TC_list unit_expr)
| "option" -> ok @@ TC_option unit_expr | "option" -> Some (TC_option unit_expr)
| "set" -> ok @@ TC_set unit_expr | "set" -> Some (TC_set unit_expr)
| "map" -> ok @@ TC_map (unit_expr,unit_expr) | "map" -> Some (TC_map (unit_expr,unit_expr))
| "big_map" -> ok @@ TC_big_map (unit_expr,unit_expr) | "big_map" -> Some (TC_big_map (unit_expr,unit_expr))
| "michelson_or" -> ok @@ TC_michelson_or (unit_expr,"",unit_expr,"") | "michelson_or" -> Some (TC_michelson_or (unit_expr,"",unit_expr,""))
| "contract" -> ok @@ TC_contract unit_expr | "contract" -> Some (TC_contract unit_expr)
| _ -> simple_fail @@ "Not a built-in type (" ^ s ^ ")." | _ -> None
let pseudo_modules = function let pseudo_modules = function
| "Tezos.chain_id" -> ok C_CHAIN_ID | "Tezos.chain_id" -> Some C_CHAIN_ID
| "Tezos.balance" -> ok C_BALANCE | "Tezos.balance" -> Some C_BALANCE
| "Tezos.now" -> ok C_NOW | "Tezos.now" -> Some C_NOW
| "Tezos.amount" -> ok C_AMOUNT | "Tezos.amount" -> Some C_AMOUNT
| "Tezos.sender" -> ok C_SENDER | "Tezos.sender" -> Some C_SENDER
| "Tezos.address" -> ok C_ADDRESS | "Tezos.address" -> Some C_ADDRESS
| "Tezos.self" -> ok C_SELF | "Tezos.self" -> Some C_SELF
| "Tezos.self_address" -> ok C_SELF_ADDRESS | "Tezos.self_address" -> Some C_SELF_ADDRESS
| "Tezos.implicit_account" -> ok C_IMPLICIT_ACCOUNT | "Tezos.implicit_account" -> Some C_IMPLICIT_ACCOUNT
| "Tezos.source" -> ok C_SOURCE | "Tezos.source" -> Some C_SOURCE
| "Tezos.failwith" -> ok C_FAILWITH | "Tezos.failwith" -> Some C_FAILWITH
| "Tezos.create_contract" -> ok C_CREATE_CONTRACT | "Tezos.create_contract" -> Some C_CREATE_CONTRACT
| "Tezos.transaction" -> ok C_CALL | "Tezos.transaction" -> Some C_CALL
| "Tezos.set_delegate" -> ok C_SET_DELEGATE | "Tezos.set_delegate" -> Some C_SET_DELEGATE
| "Tezos.get_contract_opt" -> ok C_CONTRACT_OPT | "Tezos.get_contract_opt" -> Some C_CONTRACT_OPT
| "Tezos.get_entrypoint_opt" -> ok C_CONTRACT_ENTRYPOINT_OPT | "Tezos.get_entrypoint_opt" -> Some C_CONTRACT_ENTRYPOINT_OPT
(* Crypto module *) (* Crypto module *)
| "Crypto.check" -> ok C_CHECK_SIGNATURE | "Crypto.check" -> Some C_CHECK_SIGNATURE
| "Crypto.hash_key" -> ok C_HASH_KEY | "Crypto.hash_key" -> Some C_HASH_KEY
| "Crypto.blake2b" -> ok C_BLAKE2b | "Crypto.blake2b" -> Some C_BLAKE2b
| "Crypto.sha256" -> ok C_SHA256 | "Crypto.sha256" -> Some C_SHA256
| "Crypto.sha512" -> ok C_SHA512 | "Crypto.sha512" -> Some C_SHA512
(* Bytes module *) (* Bytes module *)
| "Bytes.pack" -> ok C_BYTES_PACK | "Bytes.pack" -> Some C_BYTES_PACK
| "Bytes.unpack" -> ok C_BYTES_UNPACK | "Bytes.unpack" -> Some C_BYTES_UNPACK
| "Bytes.length" -> ok C_SIZE | "Bytes.length" -> Some C_SIZE
| "Bytes.concat" -> ok C_CONCAT | "Bytes.concat" -> Some C_CONCAT
| "Bytes.sub" -> ok C_SLICE | "Bytes.sub" -> Some C_SLICE
(* List module *) (* List module *)
| "List.length" -> ok C_SIZE | "List.length" -> Some C_SIZE
| "List.size" -> ok C_SIZE | "List.size" -> Some C_SIZE
| "List.iter" -> ok C_LIST_ITER | "List.iter" -> Some C_LIST_ITER
| "List.map" -> ok C_LIST_MAP | "List.map" -> Some C_LIST_MAP
| "List.fold" -> ok C_LIST_FOLD | "List.fold" -> Some C_LIST_FOLD
(* Set module *) (* Set module *)
| "Set.empty" -> ok C_SET_EMPTY | "Set.empty" -> Some C_SET_EMPTY
| "Set.literal" -> ok C_SET_LITERAL | "Set.literal" -> Some C_SET_LITERAL
| "Set.cardinal" -> ok C_SIZE | "Set.cardinal" -> Some C_SIZE
| "Set.mem" -> ok C_SET_MEM | "Set.mem" -> Some C_SET_MEM
| "Set.add" -> ok C_SET_ADD | "Set.add" -> Some C_SET_ADD
| "Set.remove" -> ok C_SET_REMOVE | "Set.remove" -> Some C_SET_REMOVE
| "Set.iter" -> ok C_SET_ITER | "Set.iter" -> Some C_SET_ITER
| "Set.fold" -> ok C_SET_FOLD | "Set.fold" -> Some C_SET_FOLD
(* Map module *) (* Map module *)
| "Map.find_opt" -> ok C_MAP_FIND_OPT | "Map.find_opt" -> Some C_MAP_FIND_OPT
| "Map.update" -> ok C_MAP_UPDATE | "Map.update" -> Some C_MAP_UPDATE
| "Map.iter" -> ok C_MAP_ITER | "Map.iter" -> Some C_MAP_ITER
| "Map.map" -> ok C_MAP_MAP | "Map.map" -> Some C_MAP_MAP
| "Map.fold" -> ok C_MAP_FOLD | "Map.fold" -> Some C_MAP_FOLD
| "Map.mem" -> ok C_MAP_MEM | "Map.mem" -> Some C_MAP_MEM
| "Map.size" -> ok C_SIZE | "Map.size" -> Some C_SIZE
| "Map.add" -> ok C_MAP_ADD | "Map.add" -> Some C_MAP_ADD
| "Map.remove" -> ok C_MAP_REMOVE | "Map.remove" -> Some C_MAP_REMOVE
| "Map.empty" -> ok C_MAP_EMPTY | "Map.empty" -> Some C_MAP_EMPTY
| "Map.literal" -> ok C_MAP_LITERAL | "Map.literal" -> Some C_MAP_LITERAL
(* Big_map module *) (* Big_map module *)
| "Big_map.find" -> ok C_MAP_FIND | "Big_map.find" -> Some C_MAP_FIND
| "Big_map.find_opt" -> ok C_MAP_FIND_OPT | "Big_map.find_opt" -> Some C_MAP_FIND_OPT
| "Big_map.update" -> ok C_MAP_UPDATE | "Big_map.update" -> Some C_MAP_UPDATE
| "Big_map.literal" -> ok C_BIG_MAP_LITERAL | "Big_map.literal" -> Some C_BIG_MAP_LITERAL
| "Big_map.empty" -> ok C_BIG_MAP_EMPTY | "Big_map.empty" -> Some C_BIG_MAP_EMPTY
| "Big_map.mem" -> ok C_MAP_MEM | "Big_map.mem" -> Some C_MAP_MEM
| "Big_map.remove" -> ok C_MAP_REMOVE | "Big_map.remove" -> Some C_MAP_REMOVE
| "Big_map.add" -> ok C_MAP_ADD | "Big_map.add" -> Some C_MAP_ADD
(* Bitwise module *) (* Bitwise module *)
| "Bitwise.or" -> ok C_OR | "Bitwise.or" -> Some C_OR
| "Bitwise.and" -> ok C_AND | "Bitwise.and" -> Some C_AND
| "Bitwise.xor" -> ok C_XOR | "Bitwise.xor" -> Some C_XOR
| "Bitwise.shift_left" -> ok C_LSL | "Bitwise.shift_left" -> Some C_LSL
| "Bitwise.shift_right" -> ok C_LSR | "Bitwise.shift_right" -> Some C_LSR
(* String module *) (* String module *)
| "String.length" -> ok C_SIZE | "String.length" -> Some C_SIZE
| "String.size" -> ok C_SIZE (* Deprecated *) | "String.size" -> Some C_SIZE (* Deprecated *)
| "String.slice" -> ok C_SLICE (* Deprecated *) | "String.slice" -> Some C_SLICE (* Deprecated *)
| "String.sub" -> ok C_SLICE | "String.sub" -> Some C_SLICE
| "String.concat" -> ok C_CONCAT | "String.concat" -> Some C_CONCAT
| _ -> simple_fail "Not a built-in" | _ -> None
module Pascaligo = struct module Pascaligo = struct
let constants = function let constants = function
(* Tezos module (ex-Michelson) *) (* Tezos module (ex-Michelson) *)
| "chain_id" -> ok C_CHAIN_ID (* Deprecated *) | "chain_id" -> Some C_CHAIN_ID (* Deprecated *)
| "get_chain_id" -> ok C_CHAIN_ID (* Deprecated *) | "get_chain_id" -> Some C_CHAIN_ID (* Deprecated *)
| "balance" -> ok C_BALANCE (* Deprecated *) | "balance" -> Some C_BALANCE (* Deprecated *)
| "now" -> ok C_NOW (* Deprecated *) | "now" -> Some C_NOW (* Deprecated *)
| "amount" -> ok C_AMOUNT (* Deprecated *) | "amount" -> Some C_AMOUNT (* Deprecated *)
| "sender" -> ok C_SENDER (* Deprecated *) | "sender" -> Some C_SENDER (* Deprecated *)
| "address" -> ok C_ADDRESS (* Deprecated *) | "address" -> Some C_ADDRESS (* Deprecated *)
| "self_address" -> ok C_SELF_ADDRESS (* Deprecated *) | "self_address" -> Some C_SELF_ADDRESS (* Deprecated *)
| "implicit_account" -> ok C_IMPLICIT_ACCOUNT (* Deprecated *) | "implicit_account" -> Some C_IMPLICIT_ACCOUNT (* Deprecated *)
| "source" -> ok C_SOURCE (* Deprecated *) | "source" -> Some C_SOURCE (* Deprecated *)
| "failwith" -> ok C_FAILWITH | "failwith" -> Some C_FAILWITH
| "transaction" -> ok C_CALL (* Deprecated *) | "transaction" -> Some C_CALL (* Deprecated *)
| "set_delegate" -> ok C_SET_DELEGATE (* Deprecated *) | "set_delegate" -> Some C_SET_DELEGATE (* Deprecated *)
| "get_contract" -> ok C_CONTRACT (* Deprecated *) | "get_contract" -> Some C_CONTRACT (* Deprecated *)
| "get_contract_opt" -> ok C_CONTRACT_OPT (* Deprecated *) | "get_contract_opt" -> Some C_CONTRACT_OPT (* Deprecated *)
| "get_entrypoint" -> ok C_CONTRACT_ENTRYPOINT (* Deprecated *) | "get_entrypoint" -> Some C_CONTRACT_ENTRYPOINT (* Deprecated *)
| "get_entrypoint_opt" -> ok C_CONTRACT_ENTRYPOINT_OPT (* Deprecated *) | "get_entrypoint_opt" -> Some C_CONTRACT_ENTRYPOINT_OPT (* Deprecated *)
| "Michelson.is_nat" -> ok C_IS_NAT (* Deprecated *) | "Michelson.is_nat" -> Some C_IS_NAT (* Deprecated *)
| "is_nat" -> ok C_IS_NAT | "is_nat" -> Some C_IS_NAT
| "int" -> ok C_INT | "int" -> Some C_INT
| "abs" -> ok C_ABS | "abs" -> Some C_ABS
| "ediv" -> ok C_EDIV | "ediv" -> Some C_EDIV
| "unit" -> ok C_UNIT | "unit" -> Some C_UNIT
| "NEG" -> ok C_NEG | "NEG" -> Some C_NEG
| "ADD" -> ok C_ADD | "ADD" -> Some C_ADD
| "SUB" -> ok C_SUB | "SUB" -> Some C_SUB
| "TIMES" -> ok C_MUL | "TIMES" -> Some C_MUL
| "DIV" -> ok C_DIV | "DIV" -> Some C_DIV
| "MOD" -> ok C_MOD | "MOD" -> Some C_MOD
| "EQ" -> ok C_EQ | "EQ" -> Some C_EQ
| "NOT" -> ok C_NOT | "NOT" -> Some C_NOT
| "AND" -> ok C_AND | "AND" -> Some C_AND
| "OR" -> ok C_OR | "OR" -> Some C_OR
| "GT" -> ok C_GT | "GT" -> Some C_GT
| "GE" -> ok C_GE | "GE" -> Some C_GE
| "LT" -> ok C_LT | "LT" -> Some C_LT
| "LE" -> ok C_LE | "LE" -> Some C_LE
| "CONS" -> ok C_CONS | "CONS" -> Some C_CONS
| "cons" -> ok C_CONS (* Deprecated *) | "cons" -> Some C_CONS (* Deprecated *)
| "NEQ" -> ok C_NEQ | "NEQ" -> Some C_NEQ
(* Crypto module *) (* Crypto module *)
| "crypto_check" -> ok C_CHECK_SIGNATURE (* Deprecated *) | "crypto_check" -> Some C_CHECK_SIGNATURE (* Deprecated *)
| "crypto_hash_key" -> ok C_HASH_KEY (* Deprecated *) | "crypto_hash_key" -> Some C_HASH_KEY (* Deprecated *)
| "blake2b" -> ok C_BLAKE2b (* Deprecated *) | "blake2b" -> Some C_BLAKE2b (* Deprecated *)
| "sha_256" -> ok C_SHA256 (* Deprecated *) | "sha_256" -> Some C_SHA256 (* Deprecated *)
| "sha_512" -> ok C_SHA512 (* Deprecated *) | "sha_512" -> Some C_SHA512 (* Deprecated *)
(* Bytes module *) (* Bytes module *)
| "bytes_pack" -> ok C_BYTES_PACK (* Deprecated *) | "bytes_pack" -> Some C_BYTES_PACK (* Deprecated *)
| "bytes_unpack" -> ok C_BYTES_UNPACK (* Deprecated *) | "bytes_unpack" -> Some C_BYTES_UNPACK (* Deprecated *)
| "Bytes.size" -> ok C_SIZE (* Deprecated *) | "Bytes.size" -> Some C_SIZE (* Deprecated *)
| "bytes_concat" -> ok C_CONCAT (* Deprecated *) | "bytes_concat" -> Some C_CONCAT (* Deprecated *)
| "bytes_slice" -> ok C_SLICE (* Deprecated *) | "bytes_slice" -> Some C_SLICE (* Deprecated *)
| "Bytes.slice" -> ok C_SLICE (* Deprecated *) | "Bytes.slice" -> Some C_SLICE (* Deprecated *)
(* List module *) (* List module *)
| "list_size" -> ok C_SIZE (* Deprecated *) | "list_size" -> Some C_SIZE (* Deprecated *)
| "list_iter" -> ok C_LIST_ITER (* Deprecated *) | "list_iter" -> Some C_LIST_ITER (* Deprecated *)
| "list_map" -> ok C_LIST_MAP (* Deprecated *) | "list_map" -> Some C_LIST_MAP (* Deprecated *)
| "list_fold" -> ok C_LIST_FOLD (* Deprecated *) | "list_fold" -> Some C_LIST_FOLD (* Deprecated *)
(* Set module *) (* Set module *)
| "Set.size" -> ok C_SIZE (* Deprecated *) | "Set.size" -> Some C_SIZE (* Deprecated *)
| "set_size" -> ok C_SIZE (* Deprecated *) | "set_size" -> Some C_SIZE (* Deprecated *)
| "set_empty" -> ok C_SET_EMPTY (* Deprecated *) | "set_empty" -> Some C_SET_EMPTY (* Deprecated *)
| "set_mem" -> ok C_SET_MEM (* Deprecated *) | "set_mem" -> Some C_SET_MEM (* Deprecated *)
| "set_add" -> ok C_SET_ADD (* Deprecated *) | "set_add" -> Some C_SET_ADD (* Deprecated *)
| "set_remove" -> ok C_SET_REMOVE (* Deprecated *) | "set_remove" -> Some C_SET_REMOVE (* Deprecated *)
| "set_iter" -> ok C_SET_ITER (* Deprecated *) | "set_iter" -> Some C_SET_ITER (* Deprecated *)
| "set_fold" -> ok C_SET_FOLD (* Deprecated *) | "set_fold" -> Some C_SET_FOLD (* Deprecated *)
(* Map module *) (* Map module *)
| "get_force" -> ok C_MAP_FIND (* Deprecated *) | "get_force" -> Some C_MAP_FIND (* Deprecated *)
| "map_get" -> ok C_MAP_FIND_OPT (* Deprecated *) | "map_get" -> Some C_MAP_FIND_OPT (* Deprecated *)
| "map_update" -> ok C_MAP_UPDATE (* Deprecated *) | "map_update" -> Some C_MAP_UPDATE (* Deprecated *)
| "map_remove" -> ok C_MAP_REMOVE (* Deprecated *) | "map_remove" -> Some C_MAP_REMOVE (* Deprecated *)
| "map_iter" -> ok C_MAP_ITER (* Deprecated *) | "map_iter" -> Some C_MAP_ITER (* Deprecated *)
| "map_map" -> ok C_MAP_MAP (* Deprecated *) | "map_map" -> Some C_MAP_MAP (* Deprecated *)
| "map_fold" -> ok C_MAP_FOLD (* Deprecated *) | "map_fold" -> Some C_MAP_FOLD (* Deprecated *)
| "map_mem" -> ok C_MAP_MEM (* Deprecated *) | "map_mem" -> Some C_MAP_MEM (* Deprecated *)
| "map_size" -> ok C_SIZE (* Deprecated *) | "map_size" -> Some C_SIZE (* Deprecated *)
(* Bitwise module *) (* Bitwise module *)
| "bitwise_or" -> ok C_OR (* Deprecated *) | "bitwise_or" -> Some C_OR (* Deprecated *)
| "bitwise_and" -> ok C_AND (* Deprecated *) | "bitwise_and" -> Some C_AND (* Deprecated *)
| "bitwise_xor" -> ok C_XOR (* Deprecated *) | "bitwise_xor" -> Some C_XOR (* Deprecated *)
| "bitwise_lsl" -> ok C_LSL (* Deprecated *) | "bitwise_lsl" -> Some C_LSL (* Deprecated *)
| "bitwise_lsr" -> ok C_LSR (* Deprecated *) | "bitwise_lsr" -> Some C_LSR (* Deprecated *)
(* String module *) (* String module *)
| "string_slice" -> ok C_SLICE (* Deprecated *) | "string_slice" -> Some C_SLICE (* Deprecated *)
| "string_concat" -> ok C_CONCAT (* Deprecated *) | "string_concat" -> Some C_CONCAT (* Deprecated *)
(* Others *) (* Others *)
| "assert" -> ok C_ASSERTION | "assert" -> Some C_ASSERTION
| "size" -> ok C_SIZE (* Deprecated *) | "size" -> Some C_SIZE (* Deprecated *)
| _ as c -> | _ as c -> pseudo_modules c
pseudo_modules c
let type_constants = type_constants let type_constants = type_constants
let type_operators = type_operators let type_operators = type_operators
@ -284,85 +283,84 @@ module Concrete_to_imperative = struct
let constants = function let constants = function
(* Tezos (ex-Michelson, ex-Current, ex-Operation) *) (* Tezos (ex-Michelson, ex-Current, ex-Operation) *)
| "chain_id" -> ok C_CHAIN_ID (* Deprecated *) | "chain_id" -> Some C_CHAIN_ID (* Deprecated *)
| "Current.balance" -> ok C_BALANCE (* Deprecated *) | "Current.balance" -> Some C_BALANCE (* Deprecated *)
| "balance" -> ok C_BALANCE (* Deprecated *) | "balance" -> Some C_BALANCE (* Deprecated *)
| "Current.time" -> ok C_NOW (* Deprecated *) | "Current.time" -> Some C_NOW (* Deprecated *)
| "time" -> ok C_NOW (* Deprecated *) | "time" -> Some C_NOW (* Deprecated *)
| "Current.amount" -> ok C_AMOUNT (* Deprecated *) | "Current.amount" -> Some C_AMOUNT (* Deprecated *)
| "amount" -> ok C_AMOUNT (* Deprecated *) | "amount" -> Some C_AMOUNT (* Deprecated *)
| "Current.sender" -> ok C_SENDER (* Deprecated *) | "Current.sender" -> Some C_SENDER (* Deprecated *)
| "sender" -> ok C_SENDER (* Deprecated *) | "sender" -> Some C_SENDER (* Deprecated *)
| "Current.address" -> ok C_ADDRESS (* Deprecated *) | "Current.address" -> Some C_ADDRESS (* Deprecated *)
| "Current.self_address" -> ok C_SELF_ADDRESS (* Deprecated *) | "Current.self_address" -> Some C_SELF_ADDRESS (* Deprecated *)
| "Current.implicit_account" -> ok C_IMPLICIT_ACCOUNT (* Deprecated *) | "Current.implicit_account" -> Some C_IMPLICIT_ACCOUNT (* Deprecated *)
| "Current.source" -> ok C_SOURCE (* Deprecated *) | "Current.source" -> Some C_SOURCE (* Deprecated *)
| "source" -> ok C_SOURCE (* Deprecated *) | "source" -> Some C_SOURCE (* Deprecated *)
| "Current.failwith" -> ok C_FAILWITH (* Deprecated *) | "Current.failwith" -> Some C_FAILWITH (* Deprecated *)
| "failwith" -> ok C_FAILWITH | "failwith" -> Some C_FAILWITH
| "Operation.transaction" -> ok C_CALL (* Deprecated *) | "Operation.transaction" -> Some C_CALL (* Deprecated *)
| "Operation.set_delegate" -> ok C_SET_DELEGATE (* Deprecated *) | "Operation.set_delegate" -> Some C_SET_DELEGATE (* Deprecated *)
| "Operation.get_contract" -> ok C_CONTRACT (* Deprecated *) | "Operation.get_contract" -> Some C_CONTRACT (* Deprecated *)
| "Operation.get_contract_opt" -> ok C_CONTRACT_OPT (* Deprecated *) | "Operation.get_contract_opt" -> Some C_CONTRACT_OPT (* Deprecated *)
| "Operation.get_entrypoint" -> ok C_CONTRACT_ENTRYPOINT (* Deprecated *) | "Operation.get_entrypoint" -> Some C_CONTRACT_ENTRYPOINT (* Deprecated *)
| "Operation.get_entrypoint_opt" -> ok C_CONTRACT_ENTRYPOINT_OPT (* Deprecated *) | "Operation.get_entrypoint_opt" -> Some C_CONTRACT_ENTRYPOINT_OPT (* Deprecated *)
| "Michelson.is_nat" -> ok C_IS_NAT (* Deprecated *) | "Michelson.is_nat" -> Some C_IS_NAT (* Deprecated *)
| "is_nat" -> ok C_IS_NAT | "is_nat" -> Some C_IS_NAT
| "int" -> ok C_INT | "int" -> Some C_INT
| "abs" -> ok C_ABS | "abs" -> Some C_ABS
| "ediv" -> ok C_EDIV | "ediv" -> Some C_EDIV
| "unit" -> ok C_UNIT | "unit" -> Some C_UNIT
| "NEG" -> ok C_NEG | "NEG" -> Some C_NEG
| "ADD" -> ok C_ADD | "ADD" -> Some C_ADD
| "SUB" -> ok C_SUB | "SUB" -> Some C_SUB
| "TIMES" -> ok C_MUL | "TIMES" -> Some C_MUL
| "DIV" -> ok C_DIV | "DIV" -> Some C_DIV
| "MOD" -> ok C_MOD | "MOD" -> Some C_MOD
| "EQ" -> ok C_EQ | "EQ" -> Some C_EQ
| "NOT" -> ok C_NOT | "NOT" -> Some C_NOT
| "AND" -> ok C_AND | "AND" -> Some C_AND
| "OR" -> ok C_OR | "OR" -> Some C_OR
| "GT" -> ok C_GT | "GT" -> Some C_GT
| "GE" -> ok C_GE | "GE" -> Some C_GE
| "LT" -> ok C_LT | "LT" -> Some C_LT
| "LE" -> ok C_LE | "LE" -> Some C_LE
| "CONS" -> ok C_CONS | "CONS" -> Some C_CONS
| "NEQ" -> ok C_NEQ | "NEQ" -> Some C_NEQ
(* Bytes module *) (* Bytes module *)
| "Bytes.size" -> ok C_SIZE (* Deprecated *) | "Bytes.size" -> Some C_SIZE (* Deprecated *)
| "Bytes.slice" -> ok C_SLICE (* Deprecated *) | "Bytes.slice" -> Some C_SLICE (* Deprecated *)
(* Set module *) (* Set module *)
| "Set.size" -> ok C_SIZE (* Deprecated *) | "Set.size" -> Some C_SIZE (* Deprecated *)
(* Map module *) (* Map module *)
| "Map.find" -> ok C_MAP_FIND (* Deprecated *) | "Map.find" -> Some C_MAP_FIND (* Deprecated *)
(* Bitwise module *) (* Bitwise module *)
| "Bitwise.lor" -> ok C_OR (* Deprecated *) | "Bitwise.lor" -> Some C_OR (* Deprecated *)
| "Bitwise.land" -> ok C_AND (* Deprecated *) | "Bitwise.land" -> Some C_AND (* Deprecated *)
| "Bitwise.lxor" -> ok C_XOR (* Deprecated *) | "Bitwise.lxor" -> Some C_XOR (* Deprecated *)
(* Loop module *) (* Loop module *)
| "Loop.fold_while" -> ok C_FOLD_WHILE (* Deprecated *) | "Loop.fold_while" -> Some C_FOLD_WHILE (* Deprecated *)
| "Loop.resume" -> ok C_FOLD_CONTINUE (* Deprecated *) | "Loop.resume" -> Some C_FOLD_CONTINUE (* Deprecated *)
| "continue" -> ok C_FOLD_CONTINUE (* Deprecated *) | "continue" -> Some C_FOLD_CONTINUE (* Deprecated *)
| "Loop.stop" -> ok C_FOLD_STOP (* Deprecated *) | "Loop.stop" -> Some C_FOLD_STOP (* Deprecated *)
| "stop" -> ok C_FOLD_STOP (* Deprecated *) | "stop" -> Some C_FOLD_STOP (* Deprecated *)
(* Others *) (* Others *)
| "assert" -> ok C_ASSERTION | "assert" -> Some C_ASSERTION
| _ as c -> | _ as c -> pseudo_modules c
pseudo_modules c
let type_constants = type_constants let type_constants = type_constants
let type_operators = type_operators let type_operators = type_operators

13
src/passes/operators/operators.mli
View File

@ -1,18 +1,17 @@
module Concrete_to_imperative : sig module Concrete_to_imperative : sig
open Ast_imperative open Ast_imperative
open Trace
module Pascaligo : sig module Pascaligo : sig
val constants : string -> constant' result val constants : string -> constant' option
val type_constants : string -> type_constant result val type_constants : string -> type_constant option
val type_operators : string -> type_operator result val type_operators : string -> type_operator option
end end
module Cameligo : sig module Cameligo : sig
val constants : string -> constant' result val constants : string -> constant' option
val type_constants : string -> type_constant result val type_constants : string -> type_constant option
val type_operators : string -> type_operator result val type_operators : string -> type_operator option
end end
end end