remove large leading prefixes from stack traces

src/ljs/ljs_eval.ml

@@ -540,10 +540,10 @@ with
                 with Not_found -> string_of_value v store
                 end
           | v -> (pretty_value v) in
-        printf "%s\nUncaught exception: %s\n" (string_stack_trace t) err_msg;
+        eprintf "%s\nUncaught exception: %s\n" (string_stack_trace t) err_msg;
         failwith "Uncaught exception"
   | Break (p, l, v, _) -> failwith ("Broke to top of execution, missed label: " ^ l)
   | PrimErr (t, v) ->
-      printf "%s\nUncaught error: %s\n" (string_stack_trace t) (pretty_value v);
+      eprintf "%s\nUncaught error: %s\n" (string_stack_trace t) (pretty_value v);
       failwith "Uncaught error"
 

src/ljs/ljs_pretty.ml

@@ -114,11 +114,29 @@ and prop (f, prop) = match prop with
                                           horz[text "#setter";
                                                exp s]])]
 
-let stack_trace exprs =
-  let filtered = List.filter (fun expr ->
+
+(* Remove duplicate leading chains (like the environment) from a trace *)
+let remove_prefix_dups exprs =
+  match exprs with
+  | [] -> []
+  | v::rest ->
+    v::(snd
+      (List.fold_left (fun (first, trace) expr ->
+        match first with
+        | Some expr' ->
+            let nm e = (fst (pos_of e)).Lexing.pos_fname in
+            if nm expr = nm expr' then (first, trace) else (None, trace@[expr])
+        | None -> (None, trace@[expr])
+      ) (Some v, []) rest))
+
+let filter_dummies exprs =
+  List.filter (fun expr ->
     (fst (pos_of expr)) != Lexing.dummy_pos &&
-    (snd (pos_of expr)) != Lexing.dummy_pos) exprs in
-  vert (map (fun expr -> text (string_of_position (pos_of expr))) filtered)
+    (snd (pos_of expr)) != Lexing.dummy_pos) exprs
+
+let stack_trace exprs =
+  let filtered = remove_prefix_dups (filter_dummies exprs) in
+    vert (map (fun expr -> text (string_of_position (pos_of expr))) filtered)
 
 let string_stack_trace =
   FormatExt.to_string stack_trace