ligo interpreter : moving combinators do a dedicated module

This commit is contained in:
Lesenechal Remi 2020-02-07 15:55:39 +01:00
parent 69ddce1860
commit ce70c82122
3 changed files with 38 additions and 35 deletions

View File

@ -1,42 +1,10 @@
open Trace open Trace
open Ligo_interpreter.Types open Ligo_interpreter.Types
open Ligo_interpreter.Combinators
include Stage_common.Types include Stage_common.Types
module Env = Ligo_interpreter.Environment 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 = let apply_comparison : Ast_typed.constant -> value list -> value result =
fun c operands -> match (c,operands) with 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 (V_Ct C_unit) elts
| ( C_FOLD_WHILE , [ V_Func_val (arg_name, body, env) ; init ] ) -> | ( C_FOLD_WHILE , [ V_Func_val (arg_name, body, env) ; init ] ) ->
let rec aux el = 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 env' = Env.extend env (arg_name, folded_val) in
let%bind res = eval body env' in let%bind res = eval body env' in
let%bind continue = is_true b in let%bind continue = is_true b in

View File

@ -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"

View File

@ -1,3 +1,4 @@
module Types = Types module Types = Types
module PP = PP module PP = PP
module Environment = Environment module Environment = Environment
module Combinators = Combinators