diff --git a/src/passes/6-interpreter/interpreter.ml b/src/passes/6-interpreter/interpreter.ml index 162f902ab..1cd8f65e1 100644 --- a/src/passes/6-interpreter/interpreter.ml +++ b/src/passes/6-interpreter/interpreter.ml @@ -1,42 +1,10 @@ open Trace open Ligo_interpreter.Types +open Ligo_interpreter.Combinators include Stage_common.Types module Env = Ligo_interpreter.Environment -(* combinators ? *) -let v_pair : value * value -> value = - fun (a,b) -> V_Record (LMap.of_list [(Label "0", a) ; (Label "1",b)]) - -let v_bool : bool -> value = - fun b -> V_Ct (C_bool b) - -let v_unit : unit -> value = - fun () -> V_Ct (C_unit) - -let v_some : value -> value = - fun v -> V_Construct ("Some", v) - -let v_none : unit -> value = - fun () -> V_Construct ("None", v_unit ()) - -let get_pair : value -> (value * value) result = - fun p -> - let err = simple_error "value is not a pair" in - ( match p with - | V_Record lmap -> - let%bind fst = trace_option err @@ - LMap.find_opt (Label "0") lmap in - let%bind snd = trace_option err @@ - LMap.find_opt (Label "1") lmap in - ok (fst,snd) - | _ -> fail err ) - -let is_true : value -> bool result = - fun b -> match b with - | V_Ct (C_bool b) -> ok b - | _ -> simple_fail "value is not a bool" - let apply_comparison : Ast_typed.constant -> value list -> value result = fun c operands -> match (c,operands) with @@ -183,7 +151,7 @@ let rec apply_operator : Ast_typed.constant -> value list -> value result = (V_Ct C_unit) elts | ( C_FOLD_WHILE , [ V_Func_val (arg_name, body, env) ; init ] ) -> let rec aux el = - let%bind (b,folded_val) = get_pair el in + let%bind (b,folded_val) = extract_pair el in let env' = Env.extend env (arg_name, folded_val) in let%bind res = eval body env' in let%bind continue = is_true b in diff --git a/src/stages/ligo_interpreter/combinators.ml b/src/stages/ligo_interpreter/combinators.ml new file mode 100644 index 000000000..d01ef460f --- /dev/null +++ b/src/stages/ligo_interpreter/combinators.ml @@ -0,0 +1,34 @@ +open Trace +open Types + +let v_pair : value * value -> value = + fun (a,b) -> V_Record (LMap.of_list [(Label "0", a) ; (Label "1",b)]) + +let v_bool : bool -> value = + fun b -> V_Ct (C_bool b) + +let v_unit : unit -> value = + fun () -> V_Ct (C_unit) + +let v_some : value -> value = + fun v -> V_Construct ("Some", v) + +let v_none : unit -> value = + fun () -> V_Construct ("None", v_unit ()) + +let extract_pair : value -> (value * value) result = + fun p -> + let err = simple_error "value is not a pair" in + ( match p with + | V_Record lmap -> + let%bind fst = trace_option err @@ + LMap.find_opt (Label "0") lmap in + let%bind snd = trace_option err @@ + LMap.find_opt (Label "1") lmap in + ok (fst,snd) + | _ -> fail err ) + +let is_true : value -> bool result = + fun b -> match b with + | V_Ct (C_bool b) -> ok b + | _ -> simple_fail "value is not a bool" diff --git a/src/stages/ligo_interpreter/ligo_interpreter.ml b/src/stages/ligo_interpreter/ligo_interpreter.ml index b0722ca9f..60ca6311e 100644 --- a/src/stages/ligo_interpreter/ligo_interpreter.ml +++ b/src/stages/ligo_interpreter/ligo_interpreter.ml @@ -1,3 +1,4 @@ module Types = Types module PP = PP -module Environment = Environment \ No newline at end of file +module Environment = Environment +module Combinators = Combinators \ No newline at end of file