Add error(Error) and allow subclassing of Error

The type is stored in the "value" field of the Error object.

Author: d-torrance

M2/Macaulay2/d/actors4.d

@@ -663,10 +663,20 @@ stringcatfun(e:Expr):Expr := (
 setupfun("concatenate",stringcatfun);
 
 errorfun(e:Expr):Expr := (
-     e = stringcatfun(e);
      when e
      is s:stringCell do buildErrorPacket(s.v)
-     else buildErrorPacket("expects a string or sequence of strings as its argument"));
+     is x:HashTable do (
+	 if ancestor(x.Class, errorClass) then (
+	     y := lookup1(x, toExpr("message"));
+	     if y == notfoundE
+	     then buildErrorPacket("expected a message")
+	     else (
+		 when y
+		 is msg:stringCell
+		 do Expr(Error(dummyPosition, msg.v, x.Class, false, dummyFrame))
+		 else buildErrorPacket("expected message to be a string")))
+	 else buildErrorPacket("expected an error object"))
+     else buildErrorPacket("expected a string or hash table"));
 setupfun("error",errorfun).Protected = false;		    -- this will be replaced by a toplevel function that calls this one
 
 mingleseq(a:Sequence):Expr := (

M2/Macaulay2/d/evaluate.d

@@ -1672,6 +1672,11 @@ setupop(TestS, testfun);
 
 export toExpr(err:Error):Expr := (
     h := newHashTable(errorClass, nothingClass);
+    when err.value
+    is val:HashTable do (
+	if ancestor(val, errorClass) then h.Class = val
+	else nothing)
+    else nothing;
     h.beingInitialized = true;
     storeInHashTable(h, toExpr("position"), locate(err.position));
     storeInHashTable(h, toExpr("message"), toExpr(err.message));

M2/Macaulay2/m2/debugging.m2

@@ -3,6 +3,8 @@
 needs "nets.m2"
 needs "methods.m2"
 
+new Error from String := (T, msg) -> new T from {"message" => msg}
+
 processArgs := args -> concatenate (
      args = sequence args;
      apply(args, x -> 
@@ -13,9 +15,11 @@ processArgs := args -> concatenate (
      apply(args, x -> if class x === Symbol then ("\n", toString locate x, ": here is the first use of '",toString x, "'") else "")
      )
 olderror := error
-error = args -> (
-     -- this is the body of the "error" function, which prints out error messages
-     olderror processArgs args)
+error = method(Dispatch => Thing)
+error String := olderror
+error Error := err -> olderror new class err from processArgs err#"message"
+error Sequence := olderror @@ processArgs
+error Thing := error @@ sequence
 protect symbol error
 
 warningMessage0 = (args,deb) -> (