From f24f1043e72cddad2b29b09b79649ffc5e1d7c42 Mon Sep 17 00:00:00 2001
From: Son Ho
Date: Mon, 27 Jun 2022 06:19:11 +0200
Subject: Update eval_operand_prepare to not give a value to the continuation

---
 src/Cps.ml | 37 +++++++++++++++++++++++++++++++++----
 1 file changed, 33 insertions(+), 4 deletions(-)

(limited to 'src/Cps.ml')

diff --git a/src/Cps.ml b/src/Cps.ml
index d7c50f26..2d7dd2be 100644
--- a/src/Cps.ml
+++ b/src/Cps.ml
@@ -77,7 +77,6 @@ let comp_ret_val (f : (V.typed_value -> m_fun) -> m_fun)
   comp f g
 
 let apply (f : cm_fun) (g : m_fun) : m_fun = fun ctx -> f g ctx
-
 let id_cm_fun : cm_fun = fun cf ctx -> cf ctx
 
 (** If we have a list of [inputs] of type `'a list` and a function [f] which
@@ -92,7 +91,37 @@ let id_cm_fun : cm_fun = fun cf ctx -> cf ctx
     
     See the unit test below for an illustration.
  *)
-let fold_left_apply_continuation (f : 'a -> ('b -> 'c -> 'd) -> 'c -> 'd)
+let fold_left_apply_continuation (f : 'a -> ('c -> 'd) -> 'c -> 'd)
+    (inputs : 'a list) (cf : 'c -> 'd) : 'c -> 'd =
+  let rec eval_list (inputs : 'a list) (cf : 'c -> 'd) : 'c -> 'd =
+   fun ctx ->
+    match inputs with
+    | [] -> cf ctx
+    | x :: inputs -> comp (f x) (fun cf -> eval_list inputs cf) cf ctx
+  in
+  eval_list inputs cf
+
+(** Unit test/example for [fold_left_apply_continuation] *)
+let _ =
+  fold_left_apply_continuation
+    (fun x cf (ctx : int) -> cf (ctx + x))
+    [ 1; 20; 300; 4000 ]
+    (fun (ctx : int) -> assert (ctx = 4321))
+    0
+
+(** If we have a list of [inputs] of type `'a list` and a function [f] which
+    evaluates one element of type `'a` to compute a result of type `'b` before
+    giving it to a continuation, the following function performs a fold operation:
+    it evaluates all the inputs one by one by accumulating the results in a list,
+    and gives the list to a continuation.
+    
+    Note that we make sure that the results are listed in the order in
+    which they were computed (the first element of the list is the result
+    of applying [f] to the first element of the inputs).
+    
+    See the unit test below for an illustration.
+ *)
+let fold_left_list_apply_continuation (f : 'a -> ('b -> 'c -> 'd) -> 'c -> 'd)
     (inputs : 'a list) (cf : 'b list -> 'c -> 'd) : 'c -> 'd =
   let rec eval_list (inputs : 'a list) (cf : 'b list -> 'c -> 'd)
       (outputs : 'b list) : 'c -> 'd =
@@ -104,9 +133,9 @@ let fold_left_apply_continuation (f : 'a -> ('b -> 'c -> 'd) -> 'c -> 'd)
   in
   eval_list inputs cf []
 
-(** Unit test/example for [fold_left_apply_continuation] *)
+(** Unit test/example for [fold_left_list_apply_continuation] *)
 let _ =
-  fold_left_apply_continuation
+  fold_left_list_apply_continuation
     (fun x cf (ctx : unit) -> cf (10 + x) ctx)
     [ 0; 1; 2; 3; 4 ]
     (fun values _ctx -> assert (values = [ 10; 11; 12; 13; 14 ]))
-- 
cgit v1.2.3