Add "with ... do" statement for context management

M2/Macaulay2/d/binding.d

@@ -333,6 +333,7 @@ bumpPrecedence();
      special("if",    unaryif,    precSpace, wide);
      special("try",   unarytry,   precSpace, wide);
      special("catch", unarycatch, precSpace, wide);
+     special("with",  unarywith,  precSpace, wide);
 bumpPrecedence();
      export ParenStarParenS := makeKeyword(postfix("(*)"));
 bumpPrecedence();
@@ -411,6 +412,12 @@ export RobustPrintNetE := Expr(RobustPrintNetS);
 export RobustPrintStringS := makeProtectedSymbolClosure("RobustPrintStringMethod");
 export RobustPrintStringE := Expr(RobustPrintStringS);
 
+export EnterMethodS := makeProtectedSymbolClosure("EnterMethod");
+export EnterMethodE := Expr(EnterMethodS);
+
+export ExitMethodS := makeProtectedSymbolClosure("ExitMethod");
+export ExitMethodE := Expr(ExitMethodS);
+
 export StopIterationS := makeProtectedSymbolClosure("StopIteration");
 export StopIterationE := Expr(StopIterationS);
 
@@ -946,6 +953,10 @@ export bind(e:ParseTree,dictionary:Dictionary):void := (
      is i:Catch do (
 	  bind(i.primary,dictionary);
 	  )
+     is i:WithDo do (
+	  bind(i.primary,dictionary);
+	  bind(i.doClause,dictionary);
+	  )
      );
 export localBind(e:ParseTree,dictionary:Dictionary):bool := (
      HadError = false;

M2/Macaulay2/d/common.d

@@ -42,6 +42,7 @@ export codePosition(c:Code):Position := ( -- TODO retire
     is f:adjacentCode              do f.position
     is f:functionCode              do f.position
     is f:catchCode                 do f.position
+    is f:withDoCode                do f.position
     is f:Error                     do f.position
     );
 

M2/Macaulay2/d/convertr.d

@@ -321,6 +321,7 @@ export convert0(e:ParseTree):Code := (
 	else if n.newInitializer == dummyTree
 	then Code(newOfCode(    convert(n.newClass), convert(n.newParent),                            pos))
 	else Code(newOfFromCode(convert(n.newClass), convert(n.newParent), convert(n.newInitializer), pos)))
+    is w:WithDo do Code(withDoCode(convert(w.primary), convert(w.doClause), pos))
     is d:dummy do dummyCode
     );
 

M2/Macaulay2/d/debugging.dd

@@ -86,6 +86,7 @@ export tostring(c:Code):string := (
     is x:newFromCode   do concatenate(array(string)("(new ", tostring(x.newClause),                                " from: ", tostring(x.fromClause), ")"))
     is x:newOfCode     do concatenate(array(string)("(new ", tostring(x.newClause), " of: ", tostring(x.ofClause), ")"))
     is x:newCode       do concatenate(array(string)("(new ", tostring(x.newClause), ")"))
+    is x:withDoCode    do concatenate(array(string)("(with ", tostring(x.primary), " do: ", tostring(x.doClause), ")"))
     );
 
 export toExpr(c:Code):Expr := Pseudocode(c);
@@ -166,6 +167,8 @@ export toList(c:Code):Expr := (
     is x:newOfCode     do list(toExpr("new"), seq(toExpr(x.newClause), list(toExpr("of"),   toExpr(x.ofClause))))
     is x:newCode       do list(toExpr("new"), seq(toExpr(x.newClause)))
     --
+    is x:withDoCode    do list(toExpr("with"), seq(toExpr(x.primary), list(toExpr("do"), toExpr(x.doClause))))
+    --
     else toExpr(tostring(c)));
 
 disassemble(e:Expr):Expr := (
@@ -426,4 +429,8 @@ export toExpr(e:ParseTree):Expr := (
 	toExpr(n.newClass),
 	toExpr(n.newParent),
 	toExpr(n.newInitializer))
+    is w:WithDo do list(
+	toExpr("WithDo"),
+	toExpr(w.primary),
+	toExpr(w.doClause))
     is dummy do list(toExpr("dummy")));

M2/Macaulay2/d/evaluate.d

@@ -1298,6 +1298,21 @@ parallelAssignmentFun(x:parallelAssignmentCode):Expr := (
 	else ParallelAssignmentError(nlhs))
     else ParallelAssignmentError(nlhs));
 
+evalWithDoCode(c:withDoCode):Expr := (
+    x := eval(c.primary);
+    when x is Error do return x else nothing;
+    entermethod := lookup(Class(x), EnterMethodE);
+    if entermethod == nullE
+    then return buildErrorPacket("no enter method found");
+    exitmethod := lookup(Class(x), ExitMethodE);
+    if exitmethod == nullE
+    then return buildErrorPacket("no exit method found");
+    before := applyEE(entermethod, x);
+    when before is Error do return before else nothing;
+    r := eval(c.doClause);
+    applyEE(exitmethod, x);
+    r);
+
 -- helper function used when evaluating tryCode and by null coalescion
 -- tryCaughtError is false unless an (non-interrupting) error occurred
 threadLocal tryCaughtError := false;
@@ -1738,6 +1753,7 @@ export evalraw(c:Code):Expr := (
 	  is c:newOfCode do NewOfFun(c.newClause,c.ofClause)
 	  is c:newFromCode do NewFromFun(c.newClause,c.fromClause)
 	  is c:newOfFromCode do NewOfFromFun(c.newClause,c.ofClause,c.fromClause)
+	  is c:withDoCode do evalWithDoCode(c)
 	  is nullCode do return nullE
 	  is v:realCode do return Expr(RRcell(v.x))
 	  is v:integerCode do return Expr(ZZcell(v.x))

M2/Macaulay2/d/parse.d

@@ -145,6 +145,7 @@ export Unary  := {+Operator:Token, rhs:ParseTree};
 export Postfix:= {+lhs:ParseTree, Operator:Token};
 export Parentheses := {+ left:Token, contents:ParseTree, right:Token };
 export EmptyParentheses := {+ left:Token, right:Token };
+export WithDo := {+ withToken:Token, primary:ParseTree, doClause:ParseTree};
 export dummy := {+position:Position};
 
 export ParseTree := (
@@ -153,7 +154,7 @@ export ParseTree := (
     or Unary or Binary or Postfix or IfThen or IfThenElse
     or Try or TryThen or TryThenElse or TryElse or TryThenDo or TryDo or Catch
     or WhileDo or WhileListDo or WhileList or For
-    or New
+    or New or WithDo
     or dummy );
 
 -- Code
@@ -242,6 +243,8 @@ export newFromCode   := {+newClause:Code,fromClause:Code,position:Position};
 export newOfCode     := {+newClause:Code,ofClause:Code,position:Position};
 export newCode       := {+newClause:Code,position:Position};
 
+export withDoCode := {+primary:Code,doClause:Code,position:Position};
+
 export CodeSequence     := tarray(Code);
 export sequenceCode     := {+x:CodeSequence, position:Position};
 export listCode         := {+y:CodeSequence, position:Position};
@@ -274,7 +277,7 @@ export Code := (
      or unaryCode or binaryCode or ternaryCode or multaryCode or forCode
      or sequenceCode or listCode or arrayCode or angleBarListCode or semiCode
      or newCode or newFromCode or newOfCode or newOfFromCode
-     or whileDoCode or whileListCode or whileListDoCode
+     or whileDoCode or whileListCode or whileListDoCode or withDoCode
      or ifCode or tryCode or adjacentCode or functionCode or catchCode
      or Error						    -- for tail recursion
      );

M2/Macaulay2/d/parser.d

@@ -522,6 +522,16 @@ export unarynew(newtoken:Token,file:TokenFile,prec:int,obeylines:bool):ParseTree
 	  if newinitializer == errorTree then return errorTree;
 	  );
      accumulate(ParseTree(New(newtoken,newclass,newparent,newinitializer)),file,prec,obeylines));
+export unarywith(withToken:Token,file:TokenFile,prec:int, obeylines:bool):ParseTree := (
+     primary := parse(file,withToken.word.parse.unaryStrength,obeylines);
+     if primary == errorTree then return errorTree;
+     doToken := gettoken(file,false);
+     if doToken.word == doW then (
+	 doClause := parse(file,doW.parse.unaryStrength,obeylines);
+	 if doClause == errorTree then errorTree
+	 else accumulate(ParseTree(WithDo(withToken,primary,doClause)),file,prec,obeylines))
+     else if doToken == errorToken then errorTree
+     else makeParseError(doToken,"syntax error: expected 'do'"));
 
 export treePosition(e:ParseTree):Position := (
     when e
@@ -559,6 +569,7 @@ export treePosition(e:ParseTree):Position := (
 	if t.newInitializer != dummyTree then t.newInitializer else
 	if t.newParent      != dummyTree then t.newParent      else t.newClass;
 	combinePositionL(t.newToken.position, treePosition(lastClass)))
+    is t:WithDo do combinePositionL(t.withToken.position, treePosition(t.doClause))
     is t:dummy do t.position
     );
 
@@ -594,6 +605,7 @@ export size(e:ParseTree):int := (
      is x:WhileList do   Ccode(int,"sizeof(*",x,")") + size(x.whileToken) + size(x.predicate)                    + size(x.listClause)
      is x:WhileListDo do Ccode(int,"sizeof(*",x,")") + size(x.whileToken) + size(x.predicate) + size(x.doClause) + size(x.listClause)
     is x:New do Ccode(int,"sizeof(*",x,")") + size(x.newToken) + size(x.newClass) + size(x.newParent) + size(x.newInitializer)
+    is x:WithDo do Ccode(int,"sizeof(*",x,")") + size(x.withToken) + size(x.primary) + size(x.doClause)
      );
 
 -- Local Variables:

M2/Macaulay2/m2/engine.m2

@@ -187,7 +187,9 @@ processWeights = (nvars,weights) -> (
 	       then error("Weights: expected weight vector of length ",toString nvars," but got ",toString (#wt))));
      weights);
 
+makeMonomialOrderingMutex := new Mutex
 makeMonomialOrdering = (monsize,inverses,nvars,degs,weights,ordering) -> (
+    with makeMonomialOrderingMutex do (
      -- 'monsize' is the old MonomialSize option, usually 8 or 16, or 'null' if unset
      -- 'inverses' is true or false, and tells whether the old "Inverses => true" option was used.
      -- 'nvars' tells the total number of variables.  Any extra variables will be ordered with GRevLex or GroupLex.
@@ -214,7 +216,7 @@ makeMonomialOrdering = (monsize,inverses,nvars,degs,weights,ordering) -> (
      varcount = 0;
      t := toList nonnull fixup2 t';
      logmo := new FunctionApplication from {rawMonomialOrdering,t};
-     (t,t',value logmo, logmo))
+     (t,t',value logmo, logmo)))
 
 RawMonomialOrdering ** RawMonomialOrdering := RawMonomialOrdering => rawProductMonomialOrdering
 

M2/Macaulay2/m2/enginering.m2

@@ -723,6 +723,12 @@ fraction(RingElement,RingElement) := (r,s) -> (
 Ring _ String := RingElement => (x,s) -> x.indexStrings#s
 Ring _ Symbol := RingElement => (x,s) -> x.indexSymbols#s
 
+EngineRing.EnterMethod = R -> (
+    scan(R.generatorSymbols, sym -> pushvar(sym, value sym));
+    use R)
+
+EngineRing.ExitMethod = R -> scan(R.generatorSymbols, popvar)
+
 -- Local Variables:
 -- compile-command: "make -C $M2BUILDDIR/Macaulay2/m2 "
 -- End:

M2/Macaulay2/m2/exports.m2

@@ -158,11 +158,13 @@ export {
 	"End",
 	"Engine",
 	"EngineRing",
+	"EnterMethod",
 	"Error",
 	"Equation",
 	"EulerConstant",
 	"ExampleFiles",
 	"Exclude",
+	"ExitMethod",
 	"Expression",
 	"Ext",
 	"Fano",
@@ -1279,6 +1281,7 @@ export {
 	"when",
 	"while",
 	"width",
+	"with",
 	"wrap",
 	"xor",
 	"youngest",

M2/Macaulay2/m2/files.m2

@@ -527,6 +527,8 @@ scanLines(Function,String) := (p,inf) -> (		    -- the function p can use "break
      ret)
 scanLines(Function,List) := (p,infs) -> scan(infs,inf->scanLines(p,inf))
 
+File.ExitMethod = close#0
+
 -- Local Variables:
 -- compile-command: "make -C $M2BUILDDIR/Macaulay2/m2 "
 -- End:

M2/Macaulay2/m2/methods.m2

@@ -725,6 +725,9 @@ registerFinalizer' = registerFinalizer
 registerFinalizer = method()
 registerFinalizer(Thing, String) := registerFinalizer'
 
+-- context management
+Thing.EnterMethod = Thing.ExitMethod = x -> null
+
 -- Local Variables:
 -- compile-command: "make -C $M2BUILDDIR/Macaulay2/m2 "
 -- End:

M2/Macaulay2/m2/reals.m2

@@ -589,6 +589,11 @@ ring ComplexField := R -> CC
 ring RealField := R -> RR
 ring RealIntervalField := R -> RRi
 
+InexactField.EnterMethod = kk -> (
+    pushvar(symbol defaultPrecision, defaultPrecision);
+    defaultPrecision = precision kk)
+InexactField.ExitMethod = kk -> popvar symbol defaultPrecision
+
 -- Local Variables:
 -- compile-command: "make -C $M2BUILDDIR/Macaulay2/m2 "
 -- End:

M2/Macaulay2/m2/threads.m2

@@ -36,6 +36,9 @@ tryLock Mutex := tryLock0
 unlock = method()
 unlock Mutex := unlock0
 
+Mutex.EnterMethod = lock
+Mutex.ExitMethod = unlock
+
 -----------------------------------------------------------------------------
 
 parallelApplyRaw = (L, f) ->

M2/Macaulay2/packages/Macaulay2Doc/doc_mutex.m2

@@ -42,6 +42,7 @@ doc ///
   SeeAlso
     "parallel programming with threads and tasks"
     AtomicInt
+    symbol with
   Subnodes
     (NewMethod, Mutex)
     (lock, Mutex)

M2/Macaulay2/packages/Macaulay2Doc/functions/use-doc.m2

@@ -74,5 +74,5 @@ document {
 	 ///,
      Caveat => {"Any values stored in the variables that have been assigned to are lost,
 	  hence this operation should not be used by code in a package."},
-     SeeAlso => {GlobalAssignHook}
+     SeeAlso => {GlobalAssignHook, symbol with}
      }

M2/Macaulay2/packages/Macaulay2Doc/ov_analytic_functions.m2

@@ -629,7 +629,8 @@ document { Key => "defaultPrecision",
      1/3.
      RR[x]
      numeric pi
-     ///
+     ///,
+     SeeAlso => {symbol with},
      }
 
 undocumented {

M2/Macaulay2/packages/Macaulay2Doc/ov_language.m2

@@ -548,6 +548,7 @@ document {
 	TO "break",
 	TO "continue",
 	TO "return",
+	TO "with",
     }
 }
 
@@ -1266,6 +1267,66 @@ document {
      Subnodes => TO seeParsing
      }
 
+doc ///
+  Key
+    symbol with
+    symbol EnterMethod
+    symbol ExitMethod
+  Headline
+    context management
+  Usage
+    with x do y
+  Inputs
+    x:Thing
+    y: -- Macaulay2 code
+  Description
+    Text
+      First, @VAR "x"@ is evaluated.  The @M2CODE "EnterMethod"@ for the
+      type of @VAR "x"@ is run with @VAR "x"@ as input.  Then @VAR "y"@ is
+      evaluated, and finally the @M2CODE "ExitMethod"@ for the type of
+      @VAR "x"@ is run with @VAR "x"@ as input, even if evaluating @VAR "y"@
+      failed.
+
+      For most Macaulay2 types, the enter and exit methods do nothing.  But
+      there are several useful cases.
+
+      If @VAR "x"@ is @ofClass File@, then @TO close@ is called on exit.
+    Example
+      file = openOut temporaryFileName();
+      try with file do (file << "Hello, world!" << endl; 1/0)
+      isOpen file
+    Text
+      If @VAR "x"@ is @ofClass Mutex@ then @TO lock@ is called on entrance and
+      @TO unlock@ on exit.
+    Example
+      mutex = new Mutex
+      with mutex do last trap tryLock mutex
+      tryLock mutex
+      unlock mutex
+    Text
+      If @VAR "x"@ is @ofClass EngineRing@, then @TO (use, Ring)@ is called
+      on entrance, but the previous values of the variables of the ring are
+      restored on exit.
+    Example
+      R = QQ[x]
+      x = 5
+      with R do x^2 + 3
+      x
+    Text
+      If @VAR "x"@ is @ofClass InexactField@, then @TO "defaultPrecision"@ is
+      set to the precision of the given field on entrance and restored on exit.
+    Example
+      with RR_100 do numeric pi
+      numeric pi
+    Text
+      It is possible to define enter and exit methods for any type.
+    Example
+      X = new Type of HashTable;
+      X.EnterMethod = x -> print "hi!";
+      X.ExitMethod = x -> print "bye!";
+      with new X do print "in the do clause!"
+///
+
 -- Local Variables:
 -- compile-command: "make -C $M2BUILDDIR/Macaulay2/m2 "
 -- End:

M2/Macaulay2/packages/Macaulay2Doc/ov_system.m2

@@ -1478,7 +1478,8 @@ document {
      it has received all its input.",
      PARA{},
      "If the file is ", TT "stdio", " then it is left open, and
-     no error is signaled."
+     no error is signaled.",
+     SeeAlso => {symbol with},
      }
 
 document {