Improve "key not found" error messages for string/symbol keys

M2/Macaulay2/d/binding.d

@@ -395,6 +395,9 @@ export NewOfFromE := Expr(NewOfFromS);
 export InverseS := makeProtectedSymbolClosure("InverseMethod");
 export InverseE := Expr(InverseS);
 
+export RobustPrintS := makeProtectedSymbolClosure("RobustPrintMethod");
+export RobustPrintE := Expr(RobustPrintS);
+
 export StopIterationS := makeProtectedSymbolClosure("StopIteration");
 export StopIterationE := Expr(StopIterationS);
 

M2/Macaulay2/d/evaluate.d

@@ -2092,6 +2092,8 @@ AssignQuotedElemFun = assignquotedelemfun; -- what is this for? never used
 
 export notFun(a:Expr):Expr := if a == True then False else if a == False then True else unarymethod(a,notS);
 
+-- evaluate.d depends on hashtables.dd, so we use a pointer
+-- to evaluate methods in hashtables.dd before it is defined.
 applyEEEpointer = applyEEE;
 
 nullify(c:Code):Expr := (

M2/Macaulay2/d/hashtables.dd

@@ -5,6 +5,8 @@ use classes;
 
 header "#include <cassert>";
 
+-- applyEEE is not defined until evaluate.d,
+-- so we use a pointer and populate it later.
 dummyapplyEEE(g:Expr,e0:Expr,e1:Expr):Expr := g;
 export applyEEEpointer := dummyapplyEEE;
 
@@ -311,6 +313,17 @@ export copy(o:HashTable,newClass:HashTable,newParent:HashTable,newMutable:bool):
 export copy(o:HashTable,newClass:HashTable,newMutable:bool):HashTable := copy(o,newClass,o.parent,newMutable);
 -----------------------------------------------------------------------------
 
+lookup(object:HashTable, key:Expr):Expr; -- forward declaration
+
+KeyNotFound(object:string, key:Expr):Expr := (
+    -- TODO: implement a similar trick to call synonym(object)
+    msg := "key not found in " + object;
+    see := lookup(Class(key), RobustPrintE);
+    if see != notfoundE then
+    when applyEEEpointer(see, toExpr(msg), key)
+    is str:stringCell do msg = str.v else nothing;
+    buildErrorPacket(msg));
+
 export lookup1(object:HashTable,key:Expr,keyhash:hash_t):Expr := (
      -- warning: can return notfoundE, which should not be given to the user
      res := notfoundE;
@@ -327,53 +340,28 @@ export lookup1(object:HashTable,key:Expr,keyhash:hash_t):Expr := (
      if lockit then unlock(object.mutex);
      res);
 export lookup1(object:HashTable,key:Expr):Expr := lookup1(object,key,hash(key));
+
+-- lookup a key in the hash table and either return the value or an error packet if not found
 export lookup1force(object:HashTable,key:Expr,keyhash:hash_t):Expr := (
-     lockit := object.Mutable && !object.beingInitialized;
-     if lockit then lockRead(object.mutex);
-     keymod := int(keyhash & (length(object.table)-1));
-     bucket := object.table.keymod;
-     while bucket != bucket.next do (
-	  if bucket.key == key || bucket.hash == keyhash && equal(bucket.key,key)==True then (
-	       res := bucket.value;
-	       if lockit then unlock(object.mutex);
-	       return res);
-	  bucket = bucket.next;
-	  );
-     if lockit then unlock(object.mutex);
-     buildErrorPacket("key not found in hash table"));
+    result := lookup1(object, key, keyhash);
+    if result != notfoundE then result
+    else KeyNotFound("hash table", key));
 export lookup1force(object:HashTable,key:Expr):Expr := lookup1force(object,key,hash(key));
+
+-- query a key in the hash table and report whether it is found or not
 export lookup1Q(object:HashTable,key:Expr,keyhash:hash_t):bool := (
-     lockit := object.Mutable && !object.beingInitialized;
-     if lockit then lockRead(object.mutex);
-     keymod := int(keyhash & (length(object.table)-1));
-     bucket := object.table.keymod;
-     while bucket != bucket.next do (
-	  if bucket.key == key || bucket.hash == keyhash && equal(bucket.key,key)==True then (
-	       if lockit then unlock(object.mutex);
-	       return true);
-	  bucket = bucket.next;
-	  );
-     if lockit then unlock(object.mutex);
-     false);
+    result := lookup1(object, key, keyhash);
+    if result != notfoundE then true else false);
 export lookup1Q(object:HashTable,key:Expr):bool := lookup1Q(object,key,hash(key));
+
+-- lookup a key in the hash table or its parent until it is found, otherwise return null
 export lookup(object:HashTable,key:Expr,keyhash:hash_t):Expr := (
-     while true do (
-	  lockit := object.Mutable && !object.beingInitialized;
-	  if lockit then lockRead(object.mutex);
-     	  keymod := int(keyhash & (length(object.table)-1));
-     	  bucket := object.table.keymod;
-     	  while bucket != bucket.next do (
-	       if bucket.key == key || bucket.hash == keyhash && equal(bucket.key,key)==True then (
-		    res := bucket.value;
-		    if lockit then unlock(object.mutex);
-		    return res);
-	       bucket = bucket.next;
-	       );
-	  if lockit then unlock(object.mutex);
-	  if object == thingClass then break;
-	  object = object.parent;
-	  );
-     nullE);	  
+    while true do (
+	result := lookup1(object, key, keyhash);
+	if result != notfoundE  then return result;
+	if object == thingClass then break;
+	object = object.parent);
+    nullE);
 export lookup(object:HashTable,key:Expr):Expr := lookup(object,key,hash(key));
 export lookup(object:HashTable,key:SymbolClosure):Expr := (
      lookup(object,Expr(key),key.symbol.hash)
@@ -813,7 +801,7 @@ export subvalue(left:Expr,right:Expr):Expr := (
 	       if !f.isopen then return buildErrorPacket("database closed");
 	       when dbmfetch(f.handle,key.v)
 	       is a:string do Expr(stringCell(a))
-	       else buildErrorPacket("encountered missing value"))
+	       else KeyNotFound("database", right))
 	  else buildErrorPacket("expected a string as key to database"))
      -- # typical value: symbol #, List, ZZ, Thing
      -- # typical value: symbol #, BasicList, ZZ, Thing
@@ -828,7 +816,7 @@ export subvalue(left:Expr,right:Expr):Expr := (
 	       d := dc.dictionary;
 	       when lookup(s.v,d.symboltable)
 	       is x:Symbol do Expr(SymbolClosure(if x.thread then threadFrame else dc.frame,x))
-	       else buildErrorPacket("key not found in dictionary")
+	       else KeyNotFound("dictionary", right)
 	       )
 	  else buildErrorPacket("expected key for dictionary to be a string")
 	  )

M2/Macaulay2/m2/robust.m2

@@ -57,13 +57,12 @@ silentRobustStringWithClass = (wid,sec,y) -> (
      part2 := concatenate(" (of class ", silentRobustString(wid//2,           sec,class y), ")");
      part1 :=                            silentRobustString(wid - width part2,sec,      y);
      concatenate(part1, part2));
+
+-- mainly called by KeyNotFound in hashtables.dd to print missing key errors
+Thing.RobustPrintMethod = (msg, obj) -> try toString stack { msg | ":",
+    horizontalJoin("\t", silentRobustNetWithClass(60, 5, 3, obj)) } else msg
+
 hush := false
-commentGuardString := "--"
-commentGuardNet := raise(horizontalJoin commentGuardString,-1)
-commentGuardWidth := #commentGuardString
-commentGuard := n -> if class n === String then concatenate(commentGuard,n) else (
-     (stack((height n + depth n):commentGuardNet))^(height n) | n
-     )
 scan(flexibleBinaryOperators, op -> (
 	  opstring := toString op;
 	  ht := 8;
@@ -78,13 +77,13 @@ scan(flexibleBinaryOperators, op -> (
 			      );
 			 if hush then error(line1, " not displayed");
 			 wid := max(printWidth,80);				    -- error might occur while printWidth is narrowed
-			 wid = wid - commentGuardWidth - width preX;
+			 wid = wid - width preX;
 			 hush = true;					    -- prevent error message recursion
 			 line2 := preX | silentRobustNetWithClass(wid,ht,errorPrintingTimeLimit,x);
 			 line3 := preY | silentRobustNetWithClass(wid,ht,errorPrintingTimeLimit,y);
 			 -* line4 := preZ | silentRobustNetWithClass(wid,ht,errorPrintingTimeLimit,z); *-
 			 hush = false;
-			 error toString stack(line1,commentGuard line2,commentGuard line3 -*,commentGuard line4 *-))));
+			 error toString stack(line1, line2, line3 -*, line4 *-))));
 	  if not Thing#?(op,Thing,Thing) then (
 	       undocumented' (op,Thing,Thing);
 	       installMethod(op, Thing, Thing, (x,y) -> (
@@ -94,12 +93,12 @@ scan(flexibleBinaryOperators, op -> (
 			 if hush then error(line1, " not displayed");
 			 preY := centerString(#preX, opstring);
 			 wid := max(printWidth,80);				    -- error might occur while printWidth is narrowed
-			 wid = wid - commentGuardWidth - width preX;
+			 wid = wid - width preX;
 			 hush = true;					    -- prevent error message recursion
 			 line2 := preX | silentRobustNetWithClass(wid,ht,errorPrintingTimeLimit,x);
 			 line3 := preY | silentRobustNetWithClass(wid,ht,errorPrintingTimeLimit,y);
 			 hush = false;
-			 error toString stack(line1,commentGuard line2,commentGuard line3))))));
+			 error toString stack(line1, line2, line3))))));
 scan( {(flexiblePrefixOperators,"prefix"), (flexiblePostfixOperators,"postfix")}, (ops,type) -> 
      scan(ops, op -> (
 	       ht := 8;
@@ -112,23 +111,23 @@ scan( {(flexiblePrefixOperators,"prefix"), (flexiblePostfixOperators,"postfix")}
 			      line1 := concatenate("no method for assignment to ", concatenate(type," operator ",op), " applied to objects:");
 			      if hush then error(line1, " not displayed");
 			      wid := max(printWidth,80);				    -- error might occur while printWidth is narrowed
-			      wid = wid - commentGuardWidth - width preX;
+			      wid = wid - width preX;
 			      hush = true;					    -- prevent error message recursion
 			      line2 := preY | silentRobustNetWithClass(wid,ht,errorPrintingTimeLimit,y);
 			      -* line3 := preZ | silentRobustNetWithClass(wid,ht,errorPrintingTimeLimit,z); *-
 			      hush = false;
-			      error toString stack(line1,commentGuard line2 -*,commentGuard line3 *- ))));
+			      error toString stack(line1, line2 -*, line3 *- ))));
 	       if not Thing#?op and op =!= symbol ?? then (
 		    undocumented' (op, Thing);
 		    installMethod(op, Thing, (x) -> (
 			      line1 := concatenate("no method for ", concatenate(type," operator ",op), " applied to object:");
 			      if hush then error(line1, " not displayed");
 			      wid := max(printWidth,80);				    -- error might occur while printWidth is narrowed
-			      wid = wid - commentGuardWidth - width preX;
+			      wid = wid - width preX;
 			      hush = true;					    -- prevent error message recursion
 			      line2 := preX | silentRobustNetWithClass(wid,ht,errorPrintingTimeLimit,x);
 			      hush = false;
-			      error toString stack(line1,commentGuard line2)));
+			      error toString stack(line1, line2)));
 		    ))))
 
 Thing#{Standard,Print} = x -> (