This commit is contained in:
Pierre-Emmanuel Wulfman 2020-04-29 14:41:54 +02:00
parent 92d741f5f8
commit e467642f14
4 changed files with 6 additions and 6 deletions

View File

@ -328,7 +328,7 @@ and eval : Ast_typed.expression -> env -> value result
arguments in arguments in
apply_operator cons_name operands' apply_operator cons_name operands'
) )
| E_constructor { constructor = Constructor c ; element } when (c = "true" || c = "false") | E_constructor { constructor = Constructor c ; element } when (String.equal c "true" || String.equal c "false")
&& element.expression_content = Ast_typed.e_unit () -> ok @@ V_Ct (C_bool (bool_of_string c)) && element.expression_content = Ast_typed.e_unit () -> ok @@ V_Ct (C_bool (bool_of_string c))
| E_constructor { constructor = Constructor c ; element } -> | E_constructor { constructor = Constructor c ; element } ->
let%bind v' = eval element env in let%bind v' = eval element env in

View File

@ -232,7 +232,7 @@ let transpile_constant' : AST.constant' -> constant' = function
let rec transpile_type (t:AST.type_expression) : type_value result = let rec transpile_type (t:AST.type_expression) : type_value result =
match t.type_content with match t.type_content with
| T_variable (name) when Var.equal name Stage_common.Constant.t_bool -> ok (T_base TB_bool) | T_variable (name) when Var.equal name Stage_common.Constant.t_bool -> ok (T_base TB_bool)
| T_sum (m) when m = (AST.CMap.of_list [(Constructor "true", AST.{ctor_type=t_unit();michelson_annotation=None});(Constructor "false", AST.{ctor_type=t_unit ();michelson_annotation=None})])-> ok (T_base TB_bool) | t when (compare t (t_bool ()).type_content) = 0-> ok (T_base TB_bool)
| T_variable (name) -> fail @@ no_type_variable @@ name | T_variable (name) -> fail @@ no_type_variable @@ name
| T_constant (TC_int) -> ok (T_base TB_int) | T_constant (TC_int) -> ok (T_base TB_int)
| T_constant (TC_nat) -> ok (T_base TB_nat) | T_constant (TC_nat) -> ok (T_base TB_nat)
@ -411,7 +411,7 @@ and transpile_annotated_expression (ae:AST.expression) : expression result =
let%bind a = transpile_annotated_expression lamb in let%bind a = transpile_annotated_expression lamb in
let%bind b = transpile_annotated_expression args in let%bind b = transpile_annotated_expression args in
return @@ E_application (a, b) return @@ E_application (a, b)
| E_constructor {constructor=Constructor name;element} when (name="true"||name="false") && element.expression_content = AST.e_unit () -> | E_constructor {constructor=Constructor name;element} when (String.equal name "true"|| String.equal name "false") && element.expression_content = AST.e_unit () ->
return @@ E_literal (D_bool (bool_of_string name)) return @@ E_literal (D_bool (bool_of_string name))
| E_constructor {constructor;element} -> ( | E_constructor {constructor;element} -> (
let%bind param' = transpile_annotated_expression element in let%bind param' = transpile_annotated_expression element in

View File

@ -50,7 +50,7 @@ let rec untranspile (v : value) (t : AST.type_expression) : AST.expression resul
get_bool v in get_bool v in
return (e_bool b Environment.full_empty) return (e_bool b Environment.full_empty)
) )
| T_sum m when m = CMap.of_list [(Constructor "true",{ctor_type=t_unit ();michelson_annotation=None});(Constructor "false",{ctor_type=t_unit ();michelson_annotation=None})] -> ( | t when (compare t (t_bool ()).type_content) = 0-> (
let%bind b = let%bind b =
trace_strong (wrong_mini_c_value "bool" v) @@ trace_strong (wrong_mini_c_value "bool" v) @@
get_bool v in get_bool v in

View File

@ -93,7 +93,7 @@ let get_lambda_with_type e =
let get_t_bool (t:type_expression) : unit result = match t.type_content with let get_t_bool (t:type_expression) : unit result = match t.type_content with
| T_variable v when Var.equal v Stage_common.Constant.t_bool -> ok () | T_variable v when Var.equal v Stage_common.Constant.t_bool -> ok ()
| T_sum m when m = CMap.of_list [(Constructor "true", {ctor_type=t_unit();michelson_annotation=None});(Constructor "false",{ctor_type=t_unit();michelson_annotation=None})] -> ok () | t when (compare t (t_bool ()).type_content) = 0-> ok ()
| _ -> fail @@ Errors.not_a_x_type "bool" t () | _ -> fail @@ Errors.not_a_x_type "bool" t ()
let get_t_int (t:type_expression) : unit result = match t.type_content with let get_t_int (t:type_expression) : unit result = match t.type_content with
@ -345,7 +345,7 @@ let get_a_unit (t:expression) =
let get_a_bool (t:expression) = let get_a_bool (t:expression) =
match t.expression_content with match t.expression_content with
| E_constructor {constructor=Constructor name;element} when (name = "true" || name = "false") && element.expression_content = e_unit () -> ok (bool_of_string name) | E_constructor {constructor=Constructor name;element} when (String.equal name "true" || String.equal name "false") && element.expression_content = e_unit () -> ok (bool_of_string name)
| _ -> simple_fail "not a bool" | _ -> simple_fail "not a bool"