Improve runtime pretty printing

Author: rossberg

interpreter/exec/eval.ml

@@ -653,10 +653,14 @@ let rec step (c : config) : config =
           Ref r :: vs', []
         | FuncRef f when Rtt.match_rtt (Func.read_rtt f) rtt ->
           Ref r :: vs', []
-        | Data.DataRef _ | FuncRef _ ->
+        | Data.DataRef d ->
           vs', [Trapping ("cast failure, expected " ^
-            string_of_def_type (Rtt.def_type_of rtt) ^ " but got " ^
-            string_of_value (Ref r)) @@ e.at]
+            Rtt.string_of_rtt rtt ^ " but got " ^
+            Rtt.string_of_rtt (Data.read_rtt d)) @@ e.at]
+        | FuncRef f ->
+          vs', [Trapping ("cast failure, expected " ^
+            Rtt.string_of_rtt rtt ^ " but got " ^
+            Rtt.string_of_rtt (Func.read_rtt f)) @@ e.at]
         | _ ->
           Crash.error e.at "wrong reference type"
         )

interpreter/runtime/rtt.ml

@@ -31,6 +31,13 @@ let rec match_rtt rtt1 rtt2 =
   | Rtt (_, None) -> false
   | Rtt (_, Some rtt1') -> match_rtt rtt1' rtt2
 
+let rec string_of_rtt (Rtt (x, sup)) =
+  string_of_var (SemVar x) ^
+  (match sup with
+  | None -> ""
+  | Some rtt' -> " (sub " ^ string_of_rtt rtt' ^ ")"
+  )
+
 
 let () =
   let eq_ref' = !Value.eq_ref' in

interpreter/runtime/rtt.mli

@@ -13,3 +13,5 @@ val def_type_of : rtt -> def_type
 val depth : rtt -> int32
 
 val match_rtt : rtt -> rtt -> bool
+
+val string_of_rtt : rtt -> string

interpreter/syntax/types.ml

@@ -250,18 +250,21 @@ let string_of_name n =
   Buffer.contents b
 
 let rec string_of_var =
-  let inner = ref 0 in
+  let inner = ref [] in
   function
   | SynVar x -> I32.to_string_u x
   | SemVar x ->
-    if !inner > 3 then "..." else
-    ( incr inner;
+    let h = Hashtbl.hash x in
+    string_of_int h ^
+    if List.mem h !inner then "" else
+    ( inner := h :: !inner;
       try
         let s = string_of_def_type (def_of x) in
-        decr inner; "(" ^ s ^ ")"
-      with exn -> inner := 0; raise exn
+        inner := List.tl !inner; "=(" ^ s ^ ")"
+      with exn -> inner := []; raise exn
     )
 
+
 and string_of_nullability = function
   | NonNullable -> ""
   | Nullable -> "null "