Evaluator streaming (#2339)

Author: Negabinary

.changetours/2339-evaluator-streaming.changetour.md

@@ -13,6 +13,7 @@ src/web/exercises/**/*.ml linguist-generated
 hazel.opam linguist-generated
 hazel.opam.locked linguist-generated
 package-lock.json linguist-generated
+.changetours/** linguist-generated
 
 *.md linguist-documentation
 docs/** linguist-documentation

.gitattributes

@@ -77,7 +77,7 @@ let gen_code_grading_report = (exercise): report => {
              );
         switch (evaluated) {
         | StepLimitExceeded => None
-        | Completed((_, evaluated)) =>
+        | LimitedCompleted((_, evaluated)) =>
           evaluated
           |> EvaluatorState.get_tests
           |> TestResults.mk_results

src/CLI/Grade.re

@@ -19,12 +19,17 @@ let evaluate = (exp: Exp.t): Exp.t => {
 };
 
 let evaluate_incremental =
-    (~prev: IncrEval.t=IncrEval.empty, exp: Exp.t): (Exp.t, IncrEval.t) => {
+    (~prev: EvaluatorState.incr_eval=IncrEval.empty, exp: Exp.t)
+    : (Exp.t, EvaluatorState.incr_eval) => {
   let (info_map, elab) = statics_and_elab(exp);
-  let info_map =
-    EvalInfoMap.of_info_map(~probe_all=CoreSettings.on.probe_all, info_map);
+  let eval_info =
+    EvalInfo.of_info_map(
+      ~probe_all=CoreSettings.on.probe_all,
+      ~targets=Id.Map.empty,
+      info_map,
+    );
   let (result, state) =
-    Evaluator.evaluate(~prev, ~info_map, ~env=Builtins.env_init, elab);
+    Evaluator.evaluate(~prev, ~eval_info, ~env=Builtins.env_init, elab);
   (result, state.incr_eval);
 };
 
@@ -43,7 +48,7 @@ let evaluate_with_probe_map =
   let elaborated = elaborate(exp);
   let (result, state) =
     Evaluator.evaluate(
-      ~targets=sample_map,
+      ~eval_info=EvalInfo.of_targets(sample_map),
       ~env=Builtins.env_init,
       elaborated,
     );

src/CLI/Run.re

@@ -734,7 +734,7 @@ let is_jump_target = (info_map: Statics.Map.t, z: Zipper.t): option(Id.t) => {
 let step_into_call_stack =
     (
       ~syntax: CachedSyntax.t,
-      ~call_stack: Sample.call_stack,
+      ~call_stack: CallStack.t,
       ~ap_id: Id.t,
       info_map: Statics.Map.t,
       z: Zipper.t,
@@ -780,14 +780,7 @@ let step_into_call_stack =
     };
 
   /* Set pin and dyn cursor using the call_stack */
-  let new_stack: Sample.call_stack = [
-    {
-      id: ap_id,
-      name: None,
-      fn_def_id: None,
-    },
-    ...call_stack,
-  ];
+  let new_stack = CallStack.extend(ap_id, call_stack);
 
   /* Determine where to jump and where to look for samples.
    * For function literals:

src/haz3lcore/ProbePerform.re

@@ -9,23 +9,23 @@ let trim_non_content: Segment.t => Segment.t =
 
 let prev_pieces = (seg: Segment.t): list(option(Piece.t)) => {
   let rec go =
-          (xs: list(Piece.t), prev: option(Piece.t))
+          (acc, xs: list(Piece.t), prev: option(Piece.t))
           : list(option(Piece.t)) =>
     switch (xs) {
-    | [] => []
-    | [x, ...xs] => [prev, ...go(xs, Some(x))]
+    | [] => List.rev(acc)
+    | [x, ...xs] => go([prev, ...acc], xs, Some(x))
     };
-  go(seg, None);
+  go([], seg, None);
 };
 
 let next_pieces = (seg: Segment.t): list(option(Piece.t)) => {
-  let rec go = (xs: list(Piece.t)): list(option(Piece.t)) =>
+  let rec go = (acc, xs: list(Piece.t)): list(option(Piece.t)) =>
     switch (xs) {
-    | [] => []
-    | [_] => [None]
-    | [_, next, ...rest] => [Some(next), ...go([next, ...rest])]
+    | [] => List.rev(acc)
+    | [_] => List.rev([None, ...acc])
+    | [_, next, ...rest] => go([Some(next), ...acc], [next, ...rest])
     };
-  go(seg);
+  go([], seg);
 };
 
 let union_all =
@@ -35,20 +35,27 @@ let union_all =
   );
 
 /* This does not strictly 'complete' a segment but rather does a
- * rough version of it that suffices for indentation calculation */
-let rec shallow_complete_segment = (seg: Segment.t): Segment.t =>
-  switch (seg) {
-  | [] => []
-  | [Tile(t), ...rest] when !Tile.is_complete(t) => [
-      Tile({
-        ...t,
-        shards: List.init(List.length(t.label), i => i),
-        children: t.children @ [shallow_complete_segment(rest)],
-        /* Note: Potentially wrong number of children */
-      }),
-    ]
-  | [p, ...rest] => [p, ...shallow_complete_segment(rest)]
-  };
+ * rough version of it that suffices for indentation calculation.
+ * Tail-recursive in segment length (recursion depth is bounded by
+ * the number of incomplete tiles, not the number of pieces). */
+let rec shallow_complete_segment = (seg: Segment.t): Segment.t => {
+  let rec go = (acc, seg: Segment.t): Segment.t =>
+    switch (seg) {
+    | [] => List.rev(acc)
+    | [Tile(t), ...rest] when !Tile.is_complete(t) =>
+      List.rev([
+        Piece.Tile({
+          ...t,
+          shards: List.init(List.length(t.label), i => i),
+          children: t.children @ [shallow_complete_segment(rest)],
+          /* Note: Potentially wrong number of children */
+        }),
+        ...acc,
+      ])
+    | [p, ...rest] => go([p, ...acc], rest)
+    };
+  go([], seg);
+};
 
 /* Find the shortest prefix of the segment containing all incomplete tiles
  * followed by two consecutive linebreaks (aka a blank line)  */
@@ -174,9 +181,13 @@ let rec go' = ((not_top, base: int, seg: Segment.t)) => {
       },
       (base, Id.Map.empty),
       complete_trimmed_seg,
-      List.combine(
-        prev_pieces(complete_trimmed_seg),
-        next_pieces(complete_trimmed_seg),
+      /* stack-safe zip (List.combine is not tail-recursive) */
+      List.rev(
+        List.rev_map2(
+          (prev, next) => (prev, next),
+          prev_pieces(complete_trimmed_seg),
+          next_pieces(complete_trimmed_seg),
+        ),
       ),
     );
   map;