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

Fixed shadowing issue

Browse Source
This commit is contained in:
Georges Dupéron 2019-04-01 14:18:41 +02:00
parent f81c9868f8
commit b1502106e9
1 changed files with 22 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
src/ligo/mini_c.ml
View File

@ -207,7 +207,7 @@ module PP = struct
end end
module Translate_type = struct module Translate_type = struct
open Tezos_utils.Micheline.Michelson module O = Tezos_utils.Micheline.Michelson
module Ty = struct module Ty = struct
@ -304,62 +304,62 @@ module Translate_type = struct
end end
let base_type : type_base -> michelson result = let base_type : type_base -> O.michelson result =
function function
| Base_unit -> ok @@ prim T_unit | Base_unit -> ok @@ O.prim T_unit
| Base_bool -> ok @@ prim T_bool | Base_bool -> ok @@ O.prim T_bool
| Base_int -> ok @@ prim T_int | Base_int -> ok @@ O.prim T_int
| Base_nat -> ok @@ prim T_nat | Base_nat -> ok @@ O.prim T_nat
| Base_string -> ok @@ prim T_string | Base_string -> ok @@ O.prim T_string
| Base_bytes -> ok @@ prim T_bytes | Base_bytes -> ok @@ O.prim T_bytes
let rec type_ : type_value -> michelson result = let rec type_ : type_value -> O.michelson result =
function function
| T_base b -> base_type b | T_base b -> base_type b
| T_pair (t, t') -> ( | T_pair (t, t') -> (
type_ t >>? fun t -> type_ t >>? fun t ->
type_ t' >>? fun t' -> type_ t' >>? fun t' ->
ok @@ prim ~children:[t;t'] T_pair ok @@ O.prim ~children:[t;t'] O.T_pair
) )
| T_or (t, t') -> ( | T_or (t, t') -> (
type_ t >>? fun t -> type_ t >>? fun t ->
type_ t' >>? fun t' -> type_ t' >>? fun t' ->
ok @@ prim ~children:[t;t'] T_or ok @@ O.prim ~children:[t;t'] O.T_or
) )
| T_map kv -> | T_map kv ->
let%bind (k', v') = bind_map_pair type_ kv in let%bind (k', v') = bind_map_pair type_ kv in
ok @@ prim ~children:[k';v'] T_map ok @@ O.prim ~children:[k';v'] O.T_map
| T_option o -> | T_option o ->
let%bind o' = type_ o in let%bind o' = type_ o in
ok @@ prim ~children:[o'] T_option ok @@ O.prim ~children:[o'] O.T_option
| T_function (arg, ret) -> | T_function (arg, ret) ->
let%bind arg = type_ arg in let%bind arg = type_ arg in
let%bind ret = type_ ret in let%bind ret = type_ ret in
ok @@ prim ~children:[arg;ret] T_lambda ok @@ O.prim ~children:[arg;ret] T_lambda
| T_deep_closure (c, arg, ret) -> | T_deep_closure (c, arg, ret) ->
let%bind capture = environment_small c in let%bind capture = environment_small c in
let%bind arg = type_ arg in let%bind arg = type_ arg in
let%bind ret = type_ ret in let%bind ret = type_ ret in
ok @@ t_pair capture (t_lambda (t_pair capture arg) ret) ok @@ O.t_pair capture (O.t_lambda (O.t_pair capture arg) ret)
| T_shallow_closure (c, arg, ret) -> | T_shallow_closure (c, arg, ret) ->
let%bind capture = environment c in let%bind capture = environment c in
let%bind arg = type_ arg in let%bind arg = type_ arg in
let%bind ret = type_ ret in let%bind ret = type_ ret in
ok @@ t_pair capture (t_lambda (t_pair capture arg) ret) ok @@ O.t_pair capture (O.t_lambda (O.t_pair capture arg) ret)
and environment_element (name, tyv) = and environment_element (name, tyv) =
let%bind michelson_type = type_ tyv in let%bind michelson_type = type_ tyv in
ok @@ annotate ("@" ^ name) michelson_type ok @@ O.annotate ("@" ^ name) michelson_type
and environment_small' = let open Append_tree in function and environment_small' = let open Append_tree in function
| Leaf x -> environment_element x | Leaf x -> environment_element x
| Node {a;b} -> | Node {a;b} ->
let%bind a = environment_small' a in let%bind a = environment_small' a in
let%bind b = environment_small' b in let%bind b = environment_small' b in
ok @@ t_pair a b ok @@ O.t_pair a b
and environment_small = function and environment_small = function
| Empty -> ok @@ prim T_unit | Empty -> ok @@ O.prim O.T_unit
| Full x -> environment_small' x | Full x -> environment_small' x
and environment = and environment =
@ -369,7 +369,7 @@ module Translate_type = struct
| a :: b -> | a :: b ->
let%bind a = environment_small a in let%bind a = environment_small a in
let%bind b = environment b in let%bind b = environment b in
ok @@ t_pair a b ok @@ O.t_pair a b
end end
@ -456,13 +456,13 @@ module Environment = struct
| Node {a;b} -> | Node {a;b} ->
let%bind ((_, ty_a, _) as a) = to_mini_c_capture' env a in let%bind ((_, ty_a, _) as a) = to_mini_c_capture' env a in
let%bind ((_, ty_b, _) as b) = to_mini_c_capture' env b in let%bind ((_, ty_b, _) as b) = to_mini_c_capture' env b in
ok (E_constant ("PAIR", [a;b]), T_pair(ty_a, ty_b), env) ok (E_constant ("PAIR", [a;b]), (T_pair(ty_a, ty_b) : type_value), env)
let to_mini_c_capture env = function let to_mini_c_capture env = function
| Empty -> simple_fail "to_mini_c_capture" | Empty -> simple_fail "to_mini_c_capture"
| Full x -> to_mini_c_capture' env x | Full x -> to_mini_c_capture' env x
let rec to_mini_c_type' = function let rec to_mini_c_type' : _ -> type_value = function
| Leaf (_, t) -> t | Leaf (_, t) -> t
| Node {a;b} -> T_pair(to_mini_c_type' a, to_mini_c_type' b) | Node {a;b} -> T_pair(to_mini_c_type' a, to_mini_c_type' b)