remove fail
This commit is contained in:
parent
ef2f6060d5
commit
7974469159
@ -50,7 +50,6 @@ type kwd_down = Region.t
|
|||||||
type kwd_else = Region.t
|
type kwd_else = Region.t
|
||||||
type kwd_end = Region.t
|
type kwd_end = Region.t
|
||||||
type kwd_entrypoint = Region.t
|
type kwd_entrypoint = Region.t
|
||||||
type kwd_fail = Region.t
|
|
||||||
type kwd_for = Region.t
|
type kwd_for = Region.t
|
||||||
type kwd_from = Region.t
|
type kwd_from = Region.t
|
||||||
type kwd_function = Region.t
|
type kwd_function = Region.t
|
||||||
@ -343,7 +342,6 @@ and single_instr =
|
|||||||
| Assign of assignment reg
|
| Assign of assignment reg
|
||||||
| Loop of loop
|
| Loop of loop
|
||||||
| ProcCall of fun_call
|
| ProcCall of fun_call
|
||||||
| Fail of fail_instr reg
|
|
||||||
| Skip of kwd_skip
|
| Skip of kwd_skip
|
||||||
| RecordPatch of record_patch reg
|
| RecordPatch of record_patch reg
|
||||||
| MapPatch of map_patch reg
|
| MapPatch of map_patch reg
|
||||||
@ -394,11 +392,6 @@ and record_patch = {
|
|||||||
record_inj : record_expr
|
record_inj : record_expr
|
||||||
}
|
}
|
||||||
|
|
||||||
and fail_instr = {
|
|
||||||
kwd_fail : kwd_fail;
|
|
||||||
fail_expr : expr
|
|
||||||
}
|
|
||||||
|
|
||||||
and conditional = {
|
and conditional = {
|
||||||
kwd_if : kwd_if;
|
kwd_if : kwd_if;
|
||||||
test : expr;
|
test : expr;
|
||||||
@ -757,7 +750,6 @@ let instr_to_region = function
|
|||||||
| Single Loop For ForCollect {region; _}
|
| Single Loop For ForCollect {region; _}
|
||||||
| Single ProcCall {region; _}
|
| Single ProcCall {region; _}
|
||||||
| Single Skip region
|
| Single Skip region
|
||||||
| Single Fail {region; _}
|
|
||||||
| Single RecordPatch {region; _}
|
| Single RecordPatch {region; _}
|
||||||
| Single MapPatch {region; _}
|
| Single MapPatch {region; _}
|
||||||
| Single SetPatch {region; _}
|
| Single SetPatch {region; _}
|
||||||
|
@ -34,7 +34,6 @@ type kwd_down = Region.t
|
|||||||
type kwd_else = Region.t
|
type kwd_else = Region.t
|
||||||
type kwd_end = Region.t
|
type kwd_end = Region.t
|
||||||
type kwd_entrypoint = Region.t
|
type kwd_entrypoint = Region.t
|
||||||
type kwd_fail = Region.t
|
|
||||||
type kwd_for = Region.t
|
type kwd_for = Region.t
|
||||||
type kwd_from = Region.t
|
type kwd_from = Region.t
|
||||||
type kwd_function = Region.t
|
type kwd_function = Region.t
|
||||||
@ -327,7 +326,6 @@ and single_instr =
|
|||||||
| Assign of assignment reg
|
| Assign of assignment reg
|
||||||
| Loop of loop
|
| Loop of loop
|
||||||
| ProcCall of fun_call
|
| ProcCall of fun_call
|
||||||
| Fail of fail_instr reg
|
|
||||||
| Skip of kwd_skip
|
| Skip of kwd_skip
|
||||||
| RecordPatch of record_patch reg
|
| RecordPatch of record_patch reg
|
||||||
| MapPatch of map_patch reg
|
| MapPatch of map_patch reg
|
||||||
@ -378,11 +376,6 @@ and record_patch = {
|
|||||||
record_inj : field_assign reg injection reg
|
record_inj : field_assign reg injection reg
|
||||||
}
|
}
|
||||||
|
|
||||||
and fail_instr = {
|
|
||||||
kwd_fail : kwd_fail;
|
|
||||||
fail_expr : expr
|
|
||||||
}
|
|
||||||
|
|
||||||
and conditional = {
|
and conditional = {
|
||||||
kwd_if : kwd_if;
|
kwd_if : kwd_if;
|
||||||
test : expr;
|
test : expr;
|
||||||
|
@ -54,7 +54,6 @@
|
|||||||
%token <Region.t> Else (* "else" *)
|
%token <Region.t> Else (* "else" *)
|
||||||
%token <Region.t> End (* "end" *)
|
%token <Region.t> End (* "end" *)
|
||||||
%token <Region.t> Entrypoint (* "entrypoint" *)
|
%token <Region.t> Entrypoint (* "entrypoint" *)
|
||||||
%token <Region.t> Fail (* "fail" *)
|
|
||||||
%token <Region.t> For (* "for" *)
|
%token <Region.t> For (* "for" *)
|
||||||
%token <Region.t> Function (* "function" *)
|
%token <Region.t> Function (* "function" *)
|
||||||
%token <Region.t> From (* "from" *)
|
%token <Region.t> From (* "from" *)
|
||||||
|
@ -445,7 +445,6 @@ single_instr:
|
|||||||
| assignment { Assign $1 }
|
| assignment { Assign $1 }
|
||||||
| loop { Loop $1 }
|
| loop { Loop $1 }
|
||||||
| proc_call { ProcCall $1 }
|
| proc_call { ProcCall $1 }
|
||||||
| fail_instr { Fail $1 }
|
|
||||||
| Skip { Skip $1 }
|
| Skip { Skip $1 }
|
||||||
| record_patch { RecordPatch $1 }
|
| record_patch { RecordPatch $1 }
|
||||||
| map_patch { MapPatch $1 }
|
| map_patch { MapPatch $1 }
|
||||||
@ -555,12 +554,6 @@ record_patch:
|
|||||||
record_inj = $4}
|
record_inj = $4}
|
||||||
in {region; value}}
|
in {region; value}}
|
||||||
|
|
||||||
fail_instr:
|
|
||||||
Fail expr {
|
|
||||||
let region = cover $1 (expr_to_region $2)
|
|
||||||
and value = {kwd_fail = $1; fail_expr = $2}
|
|
||||||
in {region; value}}
|
|
||||||
|
|
||||||
proc_call:
|
proc_call:
|
||||||
fun_call { $1 }
|
fun_call { $1 }
|
||||||
|
|
||||||
|
@ -287,7 +287,6 @@ and print_single_instr = function
|
|||||||
| Assign assign -> print_assignment assign
|
| Assign assign -> print_assignment assign
|
||||||
| Loop loop -> print_loop loop
|
| Loop loop -> print_loop loop
|
||||||
| ProcCall fun_call -> print_fun_call fun_call
|
| ProcCall fun_call -> print_fun_call fun_call
|
||||||
| Fail {value; _} -> print_fail value
|
|
||||||
| Skip kwd_skip -> print_token kwd_skip "skip"
|
| Skip kwd_skip -> print_token kwd_skip "skip"
|
||||||
| RecordPatch {value; _} -> print_record_patch value
|
| RecordPatch {value; _} -> print_record_patch value
|
||||||
| MapPatch {value; _} -> print_map_patch value
|
| MapPatch {value; _} -> print_map_patch value
|
||||||
@ -295,10 +294,6 @@ and print_single_instr = function
|
|||||||
| MapRemove {value; _} -> print_map_remove value
|
| MapRemove {value; _} -> print_map_remove value
|
||||||
| SetRemove {value; _} -> print_set_remove value
|
| SetRemove {value; _} -> print_set_remove value
|
||||||
|
|
||||||
and print_fail {kwd_fail; fail_expr} =
|
|
||||||
print_token kwd_fail "fail";
|
|
||||||
print_expr fail_expr
|
|
||||||
|
|
||||||
and print_conditional node =
|
and print_conditional node =
|
||||||
let {kwd_if; test; kwd_then; ifso; terminator;
|
let {kwd_if; test; kwd_then; ifso; terminator;
|
||||||
kwd_else; ifnot} = node in
|
kwd_else; ifnot} = node in
|
||||||
|
@ -787,10 +787,6 @@ and simpl_single_instruction : Raw.single_instr -> (_ -> expression result) resu
|
|||||||
let%bind lst = bind_map_list simpl_expression args' in
|
let%bind lst = bind_map_list simpl_expression args' in
|
||||||
return_statement @@ e_constant ~loc s lst
|
return_statement @@ e_constant ~loc s lst
|
||||||
)
|
)
|
||||||
| Fail e -> (
|
|
||||||
let%bind expr = simpl_expression e.value.fail_expr in
|
|
||||||
return_statement @@ e_failwith expr
|
|
||||||
)
|
|
||||||
| Skip reg -> (
|
| Skip reg -> (
|
||||||
let loc = Location.lift reg in
|
let loc = Location.lift reg in
|
||||||
return_statement @@ e_skip ~loc ()
|
return_statement @@ e_skip ~loc ()
|
||||||
|
@ -45,10 +45,6 @@ let rec map_expression : mapper -> expression -> expression result = fun f e ->
|
|||||||
let%bind path' = map_path f path in
|
let%bind path' = map_path f path in
|
||||||
return @@ E_assign (name , path' , e')
|
return @@ E_assign (name , path' , e')
|
||||||
)
|
)
|
||||||
| E_failwith e -> (
|
|
||||||
let%bind e' = self e in
|
|
||||||
return @@ E_failwith e'
|
|
||||||
)
|
|
||||||
| E_matching (e , cases) -> (
|
| E_matching (e , cases) -> (
|
||||||
let%bind e' = self e in
|
let%bind e' = self e in
|
||||||
let%bind cases' = map_cases f cases in
|
let%bind cases' = map_cases f cases in
|
||||||
|
@ -206,14 +206,6 @@ module Errors = struct
|
|||||||
] in
|
] in
|
||||||
error ~data title message ()
|
error ~data title message ()
|
||||||
|
|
||||||
let deprecated_fail (ae : I.expression) () =
|
|
||||||
let title () = "fail is deprecated, use failwith instead" in
|
|
||||||
let message = title in
|
|
||||||
let data = [
|
|
||||||
("location" , fun () -> Format.asprintf "%a" Location.pp ae.location) ;
|
|
||||||
] in
|
|
||||||
error ~data title message ()
|
|
||||||
|
|
||||||
let constant_error loc lst tv_opt =
|
let constant_error loc lst tv_opt =
|
||||||
let title () = "typing constant" in
|
let title () = "typing constant" in
|
||||||
let message () = "" in
|
let message () = "" in
|
||||||
@ -404,7 +396,6 @@ and type_expression : environment -> ?tv_opt:O.type_value -> I.expression -> O.a
|
|||||||
trace main_error @@
|
trace main_error @@
|
||||||
match ae.expression with
|
match ae.expression with
|
||||||
(* Basic *)
|
(* Basic *)
|
||||||
| E_failwith _ -> fail @@ deprecated_fail ae
|
|
||||||
| E_variable name ->
|
| E_variable name ->
|
||||||
let%bind tv' =
|
let%bind tv' =
|
||||||
trace_option (unbound_variable e name ae.location)
|
trace_option (unbound_variable e name ae.location)
|
||||||
@ -653,32 +644,6 @@ and type_expression : environment -> ?tv_opt:O.type_value -> I.expression -> O.a
|
|||||||
(* Advanced *)
|
(* Advanced *)
|
||||||
| E_matching (ex, m) -> (
|
| E_matching (ex, m) -> (
|
||||||
let%bind ex' = type_expression e ex in
|
let%bind ex' = type_expression e ex in
|
||||||
match m with
|
|
||||||
(* Special case for assert-like failwiths. TODO: CLEAN THIS. *)
|
|
||||||
| I.Match_bool { match_false ; match_true } when I.is_e_failwith match_true -> (
|
|
||||||
let%bind fw = I.get_e_failwith match_true in
|
|
||||||
let%bind fw' = type_expression e fw in
|
|
||||||
let%bind mf' = type_expression e match_false in
|
|
||||||
let t = get_type_annotation ex' in
|
|
||||||
let%bind () =
|
|
||||||
trace_strong (match_error ~expected:m ~actual:t ae.location)
|
|
||||||
@@ assert_t_bool t in
|
|
||||||
let%bind () =
|
|
||||||
trace_strong (match_error
|
|
||||||
~msg:"matching not-unit on an assert"
|
|
||||||
~expected:m
|
|
||||||
~actual:t
|
|
||||||
ae.location)
|
|
||||||
@@ assert_t_unit (get_type_annotation mf') in
|
|
||||||
let mt' = make_a_e
|
|
||||||
(E_constant ("ASSERT_INFERRED" , [ex' ; fw']))
|
|
||||||
(t_unit ())
|
|
||||||
e
|
|
||||||
in
|
|
||||||
let m' = O.Match_bool { match_true = mt' ; match_false = mf' } in
|
|
||||||
return (O.E_matching (ex' , m')) (t_unit ())
|
|
||||||
)
|
|
||||||
| _ -> (
|
|
||||||
let%bind m' = type_match (type_expression ?tv_opt:None) e ex'.type_annotation m ae ae.location in
|
let%bind m' = type_match (type_expression ?tv_opt:None) e ex'.type_annotation m ae ae.location in
|
||||||
let tvs =
|
let tvs =
|
||||||
let aux (cur:O.value O.matching) =
|
let aux (cur:O.value O.matching) =
|
||||||
@ -701,7 +666,6 @@ and type_expression : environment -> ?tv_opt:O.type_value -> I.expression -> O.a
|
|||||||
tv_opt in
|
tv_opt in
|
||||||
return (O.E_matching (ex', m')) tv
|
return (O.E_matching (ex', m')) tv
|
||||||
)
|
)
|
||||||
)
|
|
||||||
| E_sequence (a , b) ->
|
| E_sequence (a , b) ->
|
||||||
let%bind a' = type_expression e a in
|
let%bind a' = type_expression e a in
|
||||||
let%bind b' = type_expression e b in
|
let%bind b' = type_expression e b in
|
||||||
@ -876,9 +840,6 @@ let rec untype_expression (e:O.annotated_expression) : (I.expression) result =
|
|||||||
let%bind ae' = untype_expression ae in
|
let%bind ae' = untype_expression ae in
|
||||||
let%bind m' = untype_matching untype_expression m in
|
let%bind m' = untype_matching untype_expression m in
|
||||||
return (e_matching ae' m')
|
return (e_matching ae' m')
|
||||||
| E_failwith ae ->
|
|
||||||
let%bind ae' = untype_expression ae in
|
|
||||||
return (e_failwith ae')
|
|
||||||
| E_sequence _
|
| E_sequence _
|
||||||
| E_loop _
|
| E_loop _
|
||||||
| E_assign _ -> fail @@ not_supported_yet_untranspile "not possible to untranspile statements yet" e.expression
|
| E_assign _ -> fail @@ not_supported_yet_untranspile "not possible to untranspile statements yet" e.expression
|
||||||
|
@ -253,10 +253,6 @@ and transpile_annotated_expression (ae:AST.annotated_expression) : expression re
|
|||||||
let%bind rhs' = transpile_annotated_expression rhs in
|
let%bind rhs' = transpile_annotated_expression rhs in
|
||||||
let%bind result' = transpile_annotated_expression result in
|
let%bind result' = transpile_annotated_expression result in
|
||||||
return (E_let_in ((binder, rhs'.type_value), rhs', result'))
|
return (E_let_in ((binder, rhs'.type_value), rhs', result'))
|
||||||
| E_failwith ae -> (
|
|
||||||
let%bind ae' = transpile_annotated_expression ae in
|
|
||||||
return @@ E_constant ("FAILWITH" , [ae'])
|
|
||||||
)
|
|
||||||
| E_literal l -> return @@ E_literal (transpile_literal l)
|
| E_literal l -> return @@ E_literal (transpile_literal l)
|
||||||
| E_variable name -> (
|
| E_variable name -> (
|
||||||
let%bind ele =
|
let%bind ele =
|
||||||
|
@ -52,8 +52,6 @@ let rec expression ppf (e:expression) = match e.expression with
|
|||||||
expression result
|
expression result
|
||||||
| E_matching (ae, m) ->
|
| E_matching (ae, m) ->
|
||||||
fprintf ppf "match %a with %a" expression ae (matching expression) m
|
fprintf ppf "match %a with %a" expression ae (matching expression) m
|
||||||
| E_failwith ae ->
|
|
||||||
fprintf ppf "failwith %a" expression ae
|
|
||||||
| E_sequence (a , b) ->
|
| E_sequence (a , b) ->
|
||||||
fprintf ppf "%a ; %a"
|
fprintf ppf "%a ; %a"
|
||||||
expression a
|
expression a
|
||||||
|
@ -84,7 +84,6 @@ let e_matching_bool ?loc a b c : expression = e_matching ?loc a (Match_bool {mat
|
|||||||
let e_accessor ?loc a b = location_wrap ?loc @@ E_accessor (a , b)
|
let e_accessor ?loc a b = location_wrap ?loc @@ E_accessor (a , b)
|
||||||
let e_accessor_props ?loc a b = e_accessor ?loc a (List.map (fun x -> Access_record x) b)
|
let e_accessor_props ?loc a b = e_accessor ?loc a (List.map (fun x -> Access_record x) b)
|
||||||
let e_variable ?loc v = location_wrap ?loc @@ E_variable v
|
let e_variable ?loc v = location_wrap ?loc @@ E_variable v
|
||||||
let e_failwith ?loc v = location_wrap ?loc @@ E_failwith v
|
|
||||||
let e_skip ?loc () = location_wrap ?loc @@ E_skip
|
let e_skip ?loc () = location_wrap ?loc @@ E_skip
|
||||||
let e_loop ?loc cond body = location_wrap ?loc @@ E_loop (cond , body)
|
let e_loop ?loc cond body = location_wrap ?loc @@ E_loop (cond , body)
|
||||||
let e_sequence ?loc a b = location_wrap ?loc @@ E_sequence (a , b)
|
let e_sequence ?loc a b = location_wrap ?loc @@ E_sequence (a , b)
|
||||||
@ -167,13 +166,6 @@ let get_e_tuple = fun t ->
|
|||||||
| E_tuple lst -> ok lst
|
| E_tuple lst -> ok lst
|
||||||
| _ -> simple_fail "not a tuple"
|
| _ -> simple_fail "not a tuple"
|
||||||
|
|
||||||
let get_e_failwith = fun e ->
|
|
||||||
match e.expression with
|
|
||||||
| E_failwith fw -> ok fw
|
|
||||||
| _ -> simple_fail "not a failwith"
|
|
||||||
|
|
||||||
let is_e_failwith e = to_bool @@ get_e_failwith e
|
|
||||||
|
|
||||||
let extract_pair : expression -> (expression * expression) result = fun e ->
|
let extract_pair : expression -> (expression * expression) result = fun e ->
|
||||||
match e.expression with
|
match e.expression with
|
||||||
| E_tuple [ a ; b ] -> ok (a , b)
|
| E_tuple [ a ; b ] -> ok (a , b)
|
||||||
|
@ -163,7 +163,7 @@ let rec assert_value_eq (a, b: (expression * expression )) : unit result =
|
|||||||
| (E_variable _, _) | (E_lambda _, _)
|
| (E_variable _, _) | (E_lambda _, _)
|
||||||
| (E_application _, _) | (E_let_in _, _)
|
| (E_application _, _) | (E_let_in _, _)
|
||||||
| (E_accessor _, _)
|
| (E_accessor _, _)
|
||||||
| (E_look_up _, _) | (E_matching _, _) | (E_failwith _, _) | (E_sequence _, _)
|
| (E_look_up _, _) | (E_matching _, _) | (E_sequence _, _)
|
||||||
| (E_loop _, _) | (E_assign _, _) | (E_skip, _) -> simple_fail "comparing not a value"
|
| (E_loop _, _) | (E_assign _, _) | (E_skip, _) -> simple_fail "comparing not a value"
|
||||||
|
|
||||||
let is_value_eq (a , b) = to_bool @@ assert_value_eq (a , b)
|
let is_value_eq (a , b) = to_bool @@ assert_value_eq (a , b)
|
||||||
|
@ -65,7 +65,6 @@ and expression' =
|
|||||||
| E_look_up of (expr * expr)
|
| E_look_up of (expr * expr)
|
||||||
(* Matching *)
|
(* Matching *)
|
||||||
| E_matching of (expr * matching_expr)
|
| E_matching of (expr * matching_expr)
|
||||||
| E_failwith of expr
|
|
||||||
(* Replace Statements *)
|
(* Replace Statements *)
|
||||||
| E_sequence of (expr * expr)
|
| E_sequence of (expr * expr)
|
||||||
| E_loop of (expr * expr)
|
| E_loop of (expr * expr)
|
||||||
|
@ -47,7 +47,6 @@ and expression ppf (e:expression) : unit =
|
|||||||
| E_look_up (ds, i) -> fprintf ppf "(%a)[%a]" annotated_expression ds annotated_expression i
|
| E_look_up (ds, i) -> fprintf ppf "(%a)[%a]" annotated_expression ds annotated_expression i
|
||||||
| E_matching (ae, m) ->
|
| E_matching (ae, m) ->
|
||||||
fprintf ppf "match %a with %a" annotated_expression ae (matching annotated_expression) m
|
fprintf ppf "match %a with %a" annotated_expression ae (matching annotated_expression) m
|
||||||
| E_failwith ae -> fprintf ppf "failwith %a" annotated_expression ae
|
|
||||||
| E_sequence (a , b) -> fprintf ppf "%a ; %a" annotated_expression a annotated_expression b
|
| E_sequence (a , b) -> fprintf ppf "%a ; %a" annotated_expression a annotated_expression b
|
||||||
| E_loop (expr , body) -> fprintf ppf "while %a { %a }" annotated_expression expr annotated_expression body
|
| E_loop (expr , body) -> fprintf ppf "while %a { %a }" annotated_expression expr annotated_expression body
|
||||||
| E_assign (name , path , expr) ->
|
| E_assign (name , path , expr) ->
|
||||||
|
@ -176,7 +176,6 @@ module Free_variables = struct
|
|||||||
| (E_map m | E_big_map m) -> unions @@ List.map self @@ List.concat @@ List.map (fun (a, b) -> [ a ; b ]) m
|
| (E_map m | E_big_map m) -> unions @@ List.map self @@ List.concat @@ List.map (fun (a, b) -> [ a ; b ]) m
|
||||||
| E_look_up (a , b) -> unions @@ List.map self [ a ; b ]
|
| E_look_up (a , b) -> unions @@ List.map self [ a ; b ]
|
||||||
| E_matching (a , cs) -> union (self a) (matching_expression b cs)
|
| E_matching (a , cs) -> union (self a) (matching_expression b cs)
|
||||||
| E_failwith a -> self a
|
|
||||||
| E_sequence (a , b) -> unions @@ List.map self [ a ; b ]
|
| E_sequence (a , b) -> unions @@ List.map self [ a ; b ]
|
||||||
| E_loop (expr , body) -> unions @@ List.map self [ expr ; body ]
|
| E_loop (expr , body) -> unions @@ List.map self [ expr ; body ]
|
||||||
| E_assign (_ , _ , expr) -> self expr
|
| E_assign (_ , _ , expr) -> self expr
|
||||||
@ -476,7 +475,7 @@ let rec assert_value_eq (a, b: (value*value)) : unit result =
|
|||||||
| (E_literal _, _) | (E_variable _, _) | (E_application _, _)
|
| (E_literal _, _) | (E_variable _, _) | (E_application _, _)
|
||||||
| (E_lambda _, _) | (E_let_in _, _) | (E_tuple_accessor _, _)
|
| (E_lambda _, _) | (E_let_in _, _) | (E_tuple_accessor _, _)
|
||||||
| (E_record_accessor _, _)
|
| (E_record_accessor _, _)
|
||||||
| (E_look_up _, _) | (E_matching _, _) | (E_failwith _, _)
|
| (E_look_up _, _) | (E_matching _, _)
|
||||||
| (E_assign _ , _)
|
| (E_assign _ , _)
|
||||||
| (E_sequence _, _) | (E_loop _, _)-> fail @@ error_uncomparable_values "can't compare sequences nor loops" a b
|
| (E_sequence _, _) | (E_loop _, _)-> fail @@ error_uncomparable_values "can't compare sequences nor loops" a b
|
||||||
|
|
||||||
|
@ -88,7 +88,6 @@ module Captured_variables = struct
|
|||||||
let%bind a' = self a in
|
let%bind a' = self a in
|
||||||
let%bind cs' = matching_expression b cs in
|
let%bind cs' = matching_expression b cs in
|
||||||
ok @@ union a' cs'
|
ok @@ union a' cs'
|
||||||
| E_failwith a -> self a
|
|
||||||
| E_sequence (_ , b) -> self b
|
| E_sequence (_ , b) -> self b
|
||||||
| E_loop (expr , body) ->
|
| E_loop (expr , body) ->
|
||||||
let%bind lst' = bind_map_list self [ expr ; body ] in
|
let%bind lst' = bind_map_list self [ expr ; body ] in
|
||||||
|
@ -105,7 +105,6 @@ and expression =
|
|||||||
| E_look_up of (ae * ae)
|
| E_look_up of (ae * ae)
|
||||||
(* Advanced *)
|
(* Advanced *)
|
||||||
| E_matching of (ae * matching_expr)
|
| E_matching of (ae * matching_expr)
|
||||||
| E_failwith of ae
|
|
||||||
(* Replace Statements *)
|
(* Replace Statements *)
|
||||||
| E_sequence of (ae * ae)
|
| E_sequence of (ae * ae)
|
||||||
| E_loop of (ae * ae)
|
| E_loop of (ae * ae)
|
||||||
|
@ -41,7 +41,7 @@ function transfer_single(const action : action_transfer_single ; const s : stora
|
|||||||
begin
|
begin
|
||||||
const cards : cards = s.cards ;
|
const cards : cards = s.cards ;
|
||||||
const card : card = get_force(action.card_to_transfer , cards) ;
|
const card : card = get_force(action.card_to_transfer , cards) ;
|
||||||
if (card.card_owner =/= source) then fail "This card doesn't belong to you" else skip ;
|
if (card.card_owner =/= source) then failwith ("This card doesn't belong to you") else skip ;
|
||||||
card.card_owner := action.destination ;
|
card.card_owner := action.destination ;
|
||||||
cards[action.card_to_transfer] := card ;
|
cards[action.card_to_transfer] := card ;
|
||||||
s.cards := cards ;
|
s.cards := cards ;
|
||||||
@ -51,7 +51,7 @@ function transfer_single(const action : action_transfer_single ; const s : stora
|
|||||||
function sell_single(const action : action_sell_single ; const s : storage_type) : (list(operation) * storage_type) is
|
function sell_single(const action : action_sell_single ; const s : storage_type) : (list(operation) * storage_type) is
|
||||||
begin
|
begin
|
||||||
const card : card = get_force(action.card_to_sell , s.cards) ;
|
const card : card = get_force(action.card_to_sell , s.cards) ;
|
||||||
if (card.card_owner =/= source) then fail "This card doesn't belong to you" else skip ;
|
if (card.card_owner =/= source) then failwith ("This card doesn't belong to you") else skip ;
|
||||||
const card_pattern : card_pattern = get_force(card.card_pattern , s.card_patterns) ;
|
const card_pattern : card_pattern = get_force(card.card_pattern , s.card_patterns) ;
|
||||||
card_pattern.quantity := abs(card_pattern.quantity - 1n);
|
card_pattern.quantity := abs(card_pattern.quantity - 1n);
|
||||||
const card_patterns : card_patterns = s.card_patterns ;
|
const card_patterns : card_patterns = s.card_patterns ;
|
||||||
@ -71,7 +71,7 @@ function buy_single(const action : action_buy_single ; const s : storage_type) :
|
|||||||
// Check funds
|
// Check funds
|
||||||
const card_pattern : card_pattern = get_force(action.card_to_buy , s.card_patterns) ;
|
const card_pattern : card_pattern = get_force(action.card_to_buy , s.card_patterns) ;
|
||||||
const price : tez = card_pattern.coefficient * (card_pattern.quantity + 1n) ;
|
const price : tez = card_pattern.coefficient * (card_pattern.quantity + 1n) ;
|
||||||
if (price > amount) then fail "Not enough money" else skip ;
|
if (price > amount) then failwith ("Not enough money") else skip ;
|
||||||
// Administrative procedure
|
// Administrative procedure
|
||||||
const operations : list(operation) = nil ;
|
const operations : list(operation) = nil ;
|
||||||
// Increase quantity
|
// Increase quantity
|
||||||
|
Loading…
Reference in New Issue
Block a user