obliqrt/src/ObEval.m3


 Copyright 1991 Digital Equipment Corporation. 
 Distributed only by permission. 

MODULE ObEval;
IMPORT Text, SynLocation, ObTree, ObValue, ObLib, ObBuiltIn, NetObj,
       Thread, SharedObj;

PROCEDURE Setup () =
  BEGIN
  END Setup;

PROCEDURE LookupIde (name  : ObTree.IdeName;
                     place : ObTree.IdePlace;
                     lValue: BOOLEAN;
                     env   : ObValue.Env;
                     glob  : ObValue.GlobalEnv;
                     loc   : SynLocation.T      ): ObValue.Val
  RAISES {ObValue.Exception} =
  VAR
    i  : INTEGER;
    val: ObValue.Val;
  BEGIN
    TYPECASE place OF
    | ObTree.IdePlaceGlobal (node) => val := glob^[node.index - 1];
    | ObTree.IdePlaceLocal (node) =>
        i := node.index;
        LOOP
          (* IF i<0 THEN ObErr.Fault("Eval.LookupIde") END; *)
          TYPECASE env OF
            (*
            | NULL =>
                ObErr.Fault("Eval.LookupIde: Unbound var: "
                  & ObTree.FmtIde(name, place, NIL));
            *)
          | ObValue.LocalEnv (node) =>
              IF i = 1 THEN
                (*
                IF NOT ObTree.SameIdeName(name, node.name) THEN
                      ObErr.Fault("Eval.LookupIde");
                END;
                *)
                val := node.val;
                EXIT;
              ELSE
                DEC(i);
                env := node.rest;
              END;
          ELSE                   <*ASSERT FALSE*>
          END;
        END;
    ELSE                         <*ASSERT FALSE*>
    END;
    IF lValue THEN
      RETURN val;
    ELSE
      TYPECASE val OF
      | ObValue.ValVar (node) =>
          TRY
            RETURN node.remote.Get();
          EXCEPT
          | NetObj.Error (atoms) =>
              ObValue.RaiseNetException("on remote access to variable '"
                                          & name.text & "'", atoms, loc);
            <*ASSERT FALSE*>
          | Thread.Alerted =>
              ObValue.RaiseException(
                ObValue.threadAlerted,
                "on remote access to variable '" & name.text & "'", loc);
            <*ASSERT FALSE*>
          END;
      ELSE
        RETURN val;
      END;
    END;
  END LookupIde;

PROCEDURE TermBindingSeq (binding     : ObTree.TermBinding;
                          var         : BOOLEAN;
                          initEnv, env: ObValue.Env;
                          glob        : ObValue.GlobalEnv;
                          mySelf      : ObValue.ValObj      ): ObValue.Env
  RAISES {ObValue.Error, ObValue.Exception} =
  VAR
    val : ObValue.Val;
    env1: ObValue.Env;
  BEGIN
    TYPECASE binding OF
    | NULL => RETURN env;
    | ObTree.TermBinding (node) =>
        env1 := initEnv;
        val := Term(node.term, (*in-out*) env1, glob, mySelf);
        IF var THEN val := ObValue.NewVar(val) END;
        RETURN TermBindingSeq(node.rest, var, initEnv,
                              NEW(ObValue.LocalEnv, name := node.binder,
                                  val := val, rest := env), glob, mySelf);
    END;
  END TermBindingSeq;

PROCEDURE TermBindingRec (binding: ObTree.TermBinding;
                          var    : BOOLEAN;
                          env    : ObValue.LocalEnv;
                          glob   : ObValue.GlobalEnv;
                          mySelf : ObValue.ValObj      ): ObValue.Env
  RAISES {ObValue.Error, ObValue.Exception} =
  (* Executes definitions backwards, but it's ok since they are all
     functions. *)
  VAR
    val            : ObValue.Val;
    dumFun         : ObValue.ValFun;
    recEnv, recEnv1: ObValue.Env;
  BEGIN
    TYPECASE binding OF
    | NULL => RETURN env;
    | ObTree.TermBinding (node) =>
        dumFun := NEW(ObValue.ValFun, fun := NIL, global := NIL);
        IF var THEN val := ObValue.NewVar(dumFun); ELSE val := dumFun; END;
        recEnv :=
          TermBindingRec(
            node.rest, var, NEW(ObValue.LocalEnv, name := node.binder,
                                val := val, rest := env), glob, mySelf);
        recEnv1 := recEnv;
        TYPECASE Term(node.term, (*in-out*) recEnv1, glob, mySelf) OF
        | ObValue.ValFun (valFun) =>
            dumFun.fun := valFun.fun;
            dumFun.global := valFun.global;
        ELSE
          ObValue.RaiseError(
            "Recursive definition of a non-function", binding.location);
        END;
        RETURN recEnv;
    END;
  END TermBindingRec;

PROCEDURE Term (               term  : ObTree.Term;
                VAR (*in-out*) env   : ObValue.Env;
                               glob  : ObValue.GlobalEnv;
                               mySelf: ObValue.ValObj     ): ObValue.Val
  RAISES {ObValue.Error, ObValue.Exception} =
  TYPE Vals = REF ARRAY OF ObValue.Val;
  VAR result: ObValue.Val;
  BEGIN
    IF interrupt THEN
      interrupt := FALSE;
      ObValue.RaiseError("Interrupt", term.location);
    END;
    TYPECASE term OF
      (* | NULL => ObErr.Fault("Eval.Term NIL"); *)
    | ObTree.TermIde (node) =>
        result :=
          LookupIde(node.name, node.place, FALSE, env, glob, term.location);
    | ObTree.TermOk => result := ObValue.valOk;
    | ObTree.TermBool (node) =>
        IF node.cache = NIL THEN
          node.cache := NEW(ObValue.ValBool, bool := node.bool);
        END;
        result := node.cache;
    | ObTree.TermChar (node) =>
        IF node.cache = NIL THEN
          node.cache := NEW(ObValue.ValChar, char := node.char);
        END;
        result := node.cache;
    | ObTree.TermText (node) =>
        IF node.cache = NIL THEN
          node.cache := ObValue.NewText(node.text);
        END;
        result := node.cache;
    | ObTree.TermInt (node) =>
        IF node.cache = NIL THEN
          node.cache :=
            NEW(ObValue.ValInt, int := node.int, temp := FALSE);
        END;
        result := node.cache;
    | ObTree.TermReal (node) =>
        IF node.cache = NIL THEN
          node.cache :=
            NEW(ObValue.ValReal, real := node.real, temp := FALSE);
        END;
        result := node.cache;
    | ObTree.TermOption (node) =>
        VAR env1: ObValue.Env;
        BEGIN
          env1 := env;
          result :=
            NEW(ObValue.ValOption, tag := node.tag.text,
                val := Term(node.term, (*in-out*) env1, glob, mySelf));
        END;
    | ObTree.TermAlias (node) =>
        VAR
          env1: ObValue.Env;
          val : ObValue.Val;
        BEGIN
          env1 := env;
          val := Term(node.term, (*in-out*) env1, glob, mySelf);
          TYPECASE val OF
          | ObValue.ValObj (obj) =>
              result :=
                ObValue.NewAlias(obj, node.label.text, term.location);
          ELSE
            ObValue.RaiseError(
              "Aliasing must operate on an object", term.location);
          END;
        END;
    | ObTree.TermArray (node) =>
        VAR
          vals                 := NEW(Vals, node.elemsNo);
          argList              := node.elems;
          env1   : ObValue.Env;
        BEGIN
          FOR i := 0 TO node.elemsNo - 1 DO
            env1 := env;
            vals[i] := Term(argList.first, (*in-out*) env1, glob, mySelf);
            argList := argList.rest;
          END;
          result := ObValue.NewArrayFromVals(vals);
        END;
    | ObTree.TermOp (node) =>
        VAR
          argList                    := node.args;
          opCode                     := NARROW(node.opCode, ObLib.OpCode);
          argArray: ObValue.ArgArray;
          env1    : ObValue.Env;
          msg     : TEXT;
        BEGIN
          IF (opCode.arity >= -1) AND (node.argsNo # opCode.arity) THEN
            IF opCode.arity = -1 THEN
              msg := "Not expecting an argument list for procedure: "
                       & node.pkg.text & "_" & node.op.text;
            ELSIF node.argsNo = -1 THEN
              msg := "Expecting an argument list for procedure: "
                       & node.pkg.text & "_" & node.op.text;
            ELSE
              msg := ObValue.BadArgsNoMsg(
                       opCode.arity, node.argsNo, "procedure",
                       node.pkg.text & "_" & node.op.text);
            END;
            ObValue.RaiseError(msg, term.location);
          END;
          IF node.argsNo > NUMBER(argArray) THEN
            ObValue.RaiseError("Too many arguments", term.location);
          END;
          FOR i := 1 TO node.argsNo DO
            env1 := env;
            argArray[i] :=
              Term(argList.first, (*in-out*) env1, glob, mySelf);
            argList := argList.rest;
          END;
          result :=
            NARROW(node.package, ObLib.T).Eval(
              opCode, node.argsNo, argArray, node.temp, term.location);
        END;
    | ObTree.TermFun (node) =>
        VAR
          newGlob := NEW(ObValue.GlobalEnv, node.globalsNo);
          globals := node.globals;
        BEGIN
          FOR i := 0 TO node.globalsNo - 1 DO
            newGlob^[i] := LookupIde(globals.name, globals.place, TRUE,
                                     env, glob, term.location);
            globals := globals.rest;
          END;
          result := NEW(ObValue.ValFun, fun := node, global := newGlob);
        END;
    | ObTree.TermMeth (node) =>
        VAR
          newGlob := NEW(ObValue.GlobalEnv, node.globalsNo);
          globals := node.globals;
        BEGIN
          FOR i := 0 TO node.globalsNo - 1 DO
            newGlob^[i] := LookupIde(globals.name, globals.place, TRUE,
                                     env, glob, term.location);
            globals := globals.rest;
          END;
          result := NEW(ObValue.ValMeth, meth := node, global := newGlob);
        END;
    | ObTree.TermAppl (node) =>
        VAR
          env1, newEnv: ObValue.Env;
          newGlob     : ObValue.GlobalEnv;
          binderList  : ObTree.IdeList;
          argList     : ObTree.TermList;
          val         : ObValue.Val;
        BEGIN
          env1 := env;
          TYPECASE Term(node.fun, (*in-out*) env1, glob, mySelf) OF
          | ObValue.ValFun (clos) =>
              IF node.argsNo # clos.fun.bindersNo THEN
                ObValue.RaiseError(ObValue.BadArgsNoMsg(
                                     clos.fun.bindersNo, node.argsNo, "",
                                     ""), term.location);
              END;
              newGlob := clos.global;
              newEnv := NIL;
              binderList := clos.fun.binders;
              argList := node.args;
              FOR i := 1 TO node.argsNo DO
                env1 := env;
                newEnv := NEW(ObValue.LocalEnv, name := binderList.first,
                              val := Term(argList.first, (*in-out*) env1,
                                          glob, mySelf), rest := newEnv);
                binderList := binderList.rest;
                argList := argList.rest;
              END;
              result :=
                Term(clos.fun.body, (*in-out*) newEnv, newGlob, mySelf);
          | ObValue.ValEngine (engine) =>
              IF node.argsNo # 1 THEN
                ObValue.RaiseError(
                  ObValue.BadArgsNoMsg(1, node.argsNo, "", ""),
                  term.location);
              END;
              env1 := env;
              val := Term(node.args.first, (*in-out*) env1, glob, mySelf);
              TRY
                result := engine.remote.Eval(val, mySelf);
              EXCEPT
              | ObValue.ServerError (msg) =>
                  ObValue.RaiseError(msg, term.location);
              | NetObj.Error (atoms) =>
                  ObValue.RaiseNetException(
                    "on remote engine execution", atoms, term.location);
              | Thread.Alerted =>
                  ObValue.RaiseException(
                    ObValue.threadAlerted, "on remote engine execution",
                    term.location);
              END;
          ELSE
            ObValue.RaiseError(
              "Application of a non-procedure", term.location);
          END;
        END;
    | ObTree.TermObj (node) =>
        VAR
          sync: ObValue.Sync;
          fields    := NEW(REF ObValue.ObjFields, node.fieldsNo);
          fieldList := node.fields;
          env1: ObValue.Env;
        BEGIN
          CASE node.sync OF
          | ObTree.Sync.None => sync := NIL;
          | ObTree.Sync.Monitored =>
              sync := NEW(ObValue.Sync, mutex := NEW(Thread.Mutex));
          ELSE                   <*ASSERT FALSE*>
          END;
          FOR i := 0 TO node.fieldsNo - 1 DO
            env1 := env;
            fields^[i].label := fieldList.label.text;
            fields^[i].field :=
              Term(fieldList.term, (*in-out*) env1, glob, mySelf);
            TYPECASE fieldList.term OF
            | ObTree.TermMeth (meth) =>
              IF meth.update THEN fields^[i].update := TRUE END;
            ELSE END;
            fieldList := fieldList.rest;
          END;

          CASE node.semantics OF
          | ObTree.SharingSemantics.Remote =>
            result :=
                ObValue.NewObjectFromFields(fields, "", node.protected,
                                            sync);
          | ObTree.SharingSemantics.Replicated =>
            IF sync # NIL THEN
              ObValue.RaiseError(
                  "serialized implied by replicated", term.location);
            END;
            TRY
              result :=
                  ObValue.NewReplObjectFromFields(fields, "", node.protected);
            EXCEPT
            | SharedObj.Error (atoms) =>
              ObValue.RaiseSharedException(
                  "on replicated object creation", atoms, term.location);
            END;
          | ObTree.SharingSemantics.Simple =>
            result :=
                ObValue.NewSimpleObjectFromFields(fields, "", node.protected,
                                                  sync);
          END;
        END;
    | ObTree.TermClone (node) =>
        VAR
          env1   : ObValue.Env;
          objs   : ObTree.TermList;
          valObjs: REF ARRAY OF ObValue.ValObj;
        BEGIN
          TRY
            IF node.objsNo = 1 THEN
              env1 := env;
              TYPECASE Term(node.objs.first,
                            (*in-out*) env1, glob, mySelf) OF
              | ObValue.ValObj (obj) =>
                result := ObValue.ObjClone1(obj, mySelf);
              ELSE
                ObValue.RaiseError(
                  "Arguments of clone must be objects", term.location);
              END;
            ELSE
              objs := node.objs;
              valObjs := NEW(REF ARRAY OF ObValue.ValObj, node.objsNo);
              FOR i := 0 TO node.objsNo - 1 DO
                env1 := env;
                TYPECASE Term(objs.first, (*in-out*) env1, glob, mySelf) OF
                | ObValue.ValObj (obj) => valObjs^[i] := obj;
                ELSE
                  ObValue.RaiseError(
                    "Arguments of clone must be objects", term.location);
                END;
                objs := objs.rest;
              END;
              result :=
                ObValue.ObjClone( (*readonly*)valObjs^, mySelf);
            END;
          EXCEPT
          | ObValue.ServerError (msg) =>
            ObValue.RaiseError(msg, term.location);
          | SharedObj.Error (atoms) =>
            ObValue.RaiseSharedException(
                "on replicated object cloning", atoms, term.location);
          | NetObj.Error (atoms) =>
            ObValue.RaiseNetException(
                "on remote object cloning", atoms, term.location);
          | Thread.Alerted =>
            ObValue.RaiseException(
                ObValue.threadAlerted, "on remote object cloning",
                term.location);
          END;
        END;
    | ObTree.TermNotify (node) =>
        VAR
          env1   : ObValue.Env;
          val1   : ObValue.Val;
        BEGIN
          env1 := env;
          TYPECASE Term(node.withObj, (*in-out*) env1, glob, mySelf) OF
          | ObValue.ValFun (fun) =>
            env1 := env;
            val1 := Term(node.obj, (*in-out*) env1, glob, mySelf);
            TYPECASE val1 OF
            | ObValue.ValObj, ObValue.ValVar, ObValue.ValArray,
              ObValue.ValEngine, ObValue.ValFileSystem =>
              ObValue.ObjNotify(val1, fun);
            ELSE
              ObValue.RaiseError(
                  "First argument of notify must be a remote data object",
                  term.location);
            END;
          ELSE
            ObValue.RaiseError(
                "Second argument of notify must be a procedure",
                term.location);
          END;
          result := ObValue.valOk;
        END;
    | ObTree.TermPickler (node) =>
        VAR
          env1   : ObValue.Env;
        BEGIN
          env1 := env;
          TYPECASE Term(node.pklIn, (*in-out*) env1, glob, mySelf) OF
          | ObValue.ValSimpleObj (in) =>
            env1 := env;
            TYPECASE Term(node.pklOut, (*in-out*) env1, glob, mySelf) OF
            | ObValue.ValSimpleObj (out) =>
              env1 := env;
              TYPECASE Term(node.obj, (*in-out*) env1, glob, mySelf) OF
              | ObValue.ValObj(valobj) =>
                TRY
                  ObValue.SetObjPickler(valobj, in, out, mySelf);
                EXCEPT
                | ObValue.ServerError (msg) =>
                  ObValue.RaiseError(msg, term.location);
                | SharedObj.Error (atoms) =>
                  ObValue.RaiseSharedException("while setting pickler", atoms,
                                               term.location);
                | NetObj.Error (atoms) =>
                  ObValue.RaiseNetException("while setting pickler", atoms,
                                            term.location);
                | Thread.Alerted =>
                  ObValue.RaiseException(ObValue.threadAlerted,
                                         "while setting pickler",
                                         term.location);
                END;
              ELSE
                ObValue.RaiseError(
                    "First argument of registerPickler must be an object",
                    term.location);
              END;
            ELSE
              ObValue.RaiseError(
                  "Second argument of registerPickler must be a simple object",
                  term.location);
          END;
          ELSE
            ObValue.RaiseError(
                "Third argument of registerPickler must be a simple object",
                term.location);
          END;
          result := ObValue.valOk;
        END;
    | ObTree.TermReplicate (node) =>
        VAR
          env1 : ObValue.Env;
          array1: Vals;
          arr: REF ARRAY OF TEXT;
        BEGIN
          IF node.argsNo # 2 THEN
            ObValue.RaiseError(ObValue.BadArgsNoMsg(2, node.argsNo, "", ""),
                               term.location);
          END;
          env1 := env;
          TYPECASE Term(node.args.first, (*in-out*) env1, glob, mySelf) OF
          | ObValue.ValObj (obj) =>
            env1 := env;
            TYPECASE Term(node.args.rest.first,
                          (*in-out*) env1, glob, mySelf) OF
            | ObValue.ValArray (arrayObj) =>
              TRY
                array1 := arrayObj.remote.Obtain();
                arr := NEW(REF ARRAY OF TEXT, NUMBER(array1^));
                FOR i := 0 TO NUMBER(array1^)-1 DO
                  TYPECASE array1^[i] OF
                  | ObValue.ValText (txt) => arr[i] := txt.text;
                  ELSE
                    ObValue.RaiseError(
                        "second argument must be array of text",
                        term.location);
                  END;
                END;
                result := ObValue.ToReplObj(obj, mySelf, arr^);
              EXCEPT
              | ObValue.ServerError (msg) =>
                  ObValue.RaiseError(msg, term.location);
              | SharedObj.Error (atoms) =>
                  ObValue.RaiseSharedException(
                    "on conversion to replicated object", atoms,
                    term.location);
              | NetObj.Error (atoms) =>
                  ObValue.RaiseNetException(
                    "on conversion to replicated object", atoms,
                    term.location);
              | Thread.Alerted =>
                  ObValue.RaiseException(
                    ObValue.threadAlerted,
                    "on conversion to replicated object",
                    term.location);
              END;
            ELSE
              ObValue.RaiseError(
                  "second argument must be array of text", term.location);
            END;
          ELSE
            ObValue.RaiseError(
              "Redirection must operate on an object", term.location);
          END;
        END;
    | ObTree.TermRemote (node) =>
        VAR
          env1 : ObValue.Env;
        BEGIN
          env1 := env;
          TYPECASE Term(node.obj, (*in-out*) env1, glob, mySelf) OF
          | ObValue.ValObj (obj) =>
            TRY
              result := ObValue.ToRemObj(obj, mySelf);
            EXCEPT
            | ObValue.ServerError (msg) =>
              ObValue.RaiseError(msg, term.location);
            | SharedObj.Error (atoms) =>
              ObValue.RaiseSharedException(
                  "on conversion to remote object", atoms,
                  term.location);
            | NetObj.Error (atoms) =>
              ObValue.RaiseNetException(
                  "on conversion to remote object", atoms,
                  term.location);
            | Thread.Alerted =>
              ObValue.RaiseException(
                  ObValue.threadAlerted,
                  "on conversion to remote object",
                  term.location);
            END;
          ELSE
            ObValue.RaiseError(
              "remote must operate on an object", term.location);
          END;
        END;
    | ObTree.TermSimple (node) =>
        VAR
          env1 : ObValue.Env;
        BEGIN
          env1 := env;
          TYPECASE Term(node.obj, (*in-out*) env1, glob, mySelf) OF
          | ObValue.ValObj (obj) =>
            TRY
              result := ObValue.ToSimpleObj(obj, mySelf);
            EXCEPT
            | ObValue.ServerError (msg) =>
              ObValue.RaiseError(msg, term.location);
            | SharedObj.Error (atoms) =>
              ObValue.RaiseSharedException(
                  "on conversion to simple object", atoms,
                  term.location);
            | NetObj.Error (atoms) =>
              ObValue.RaiseNetException(
                  "on conversion to simple object", atoms,
                  term.location);
            | Thread.Alerted =>
              ObValue.RaiseException(
                  ObValue.threadAlerted,
                  "on conversion to simple object",
                  term.location);
            END;
          ELSE
            ObValue.RaiseError(
              "simple must operate on an object", term.location);
          END;
        END;
    | ObTree.TermRedirect (node) =>
        VAR
          env1 : ObValue.Env;
          toObj: ObValue.Val;
        BEGIN
          env1 := env;
          TYPECASE Term(node.obj, (*in-out*) env1, glob, mySelf) OF
          | ObValue.ValObj (obj) =>
              env1 := env;
              toObj := Term(node.toObj, (*in-out*) env1, glob, mySelf);
              TRY
                obj.Redirect(toObj, ObValue.Is(obj, mySelf, term.location));
              EXCEPT
              | ObValue.ServerError (msg) =>
                  ObValue.RaiseError(msg, term.location);
              | SharedObj.Error (atoms) =>
                  ObValue.RaiseSharedException(
                    "on replicated object invocation", atoms, term.location);
              | NetObj.Error (atoms) =>
                  ObValue.RaiseNetException(
                    "on remote object invocation", atoms, term.location);
              | Thread.Alerted =>
                  ObValue.RaiseException(
                    ObValue.threadAlerted, "on remote object invocation",
                    term.location);
              END;
              result := ObValue.valOk;
          ELSE
            ObValue.RaiseError(
              "Redirection must operate on an object", term.location);
          END;
        END;
    | ObTree.TermSelect (node) =>
        VAR
          env1    : ObValue.Env;
          argList : ObTree.TermList;
          argArray: ObValue.ArgArray;
        BEGIN
          IF node.argsNo > NUMBER(argArray) THEN
            ObValue.RaiseError("Too many arguments.", term.location);
          END;
          env1 := env;
          TYPECASE Term(node.obj, (*in-out*) env1, glob, mySelf) OF
          | ObValue.ValObj (obj) =>
              argList := node.args;
              FOR i := 1 TO node.argsNo DO
                env1 := env;
                argArray[i] :=
                  Term(argList.first, (*in-out*) env1, glob, mySelf);
                argList := argList.rest;
              END;
              TRY
                IF node.invoke THEN
                  FOR i := node.argsNo + 1 TO NUMBER(argArray) DO
                    argArray[i] := NIL; (* Clear for transmission *)
                  END;
                  result :=
                    obj.Invoke(node.label.text, node.argsNo,
                               argArray, ObValue.Is(obj, mySelf,
                                                    term.location),
                                      (*var*) node.labelIndexHint);
                ELSE
                  result := obj.Select(
                              node.label.text, ObValue.Is(obj, mySelf,
                                                          term.location),
                              (*var*) node.labelIndexHint);
                END;
              EXCEPT
              | ObValue.ServerError (msg) =>
                  ObValue.RaiseError(msg, term.location);
              | SharedObj.Error (atoms) =>
                  ObValue.RaiseSharedException(
                    "on replicated object invocation", atoms, term.location);
              | NetObj.Error (atoms) =>
                  ObValue.RaiseNetException(
                    "on remote object invocation", atoms, term.location);
              | Thread.Alerted =>
                  ObValue.RaiseException(
                    ObValue.threadAlerted, "on remote object invocation",
                    term.location);
              END;
          ELSE
            ObValue.RaiseError(
              "Selection must operate on an object", term.location);
          END;
        END;
    | ObTree.TermUpdate (node) =>
        VAR
          env1: ObValue.Env;
          val : ObValue.Val;
        BEGIN
          env1 := env;
          TYPECASE Term(node.obj, (*in-out*) env1, glob, mySelf) OF
          | ObValue.ValObj (obj) =>
              env1 := env;
              val := Term(node.term, (*in-out*) env1, glob, mySelf);
              TRY
                obj.Update(
                  node.label.text, val, ObValue.Is(obj, mySelf, term.location),
                  (*var*) node.labelIndexHint);
              EXCEPT
              | ObValue.ServerError (msg) =>
                  ObValue.RaiseError(msg, term.location);
              | SharedObj.Error (atoms) =>
                  ObValue.RaiseSharedException(
                    "on replicated object update", atoms, term.location);
              | NetObj.Error (atoms) =>
                  ObValue.RaiseNetException(
                    "on remote object update", atoms, term.location);
              | Thread.Alerted =>
                  ObValue.RaiseException(
                    ObValue.threadAlerted, "on remote object update",
                    term.location);
              END;
              result := ObValue.valOk;
          ELSE
            ObValue.RaiseError(
              "Update must operate on an object", term.location);
          END;
        END;
    | ObTree.TermSeq =>
        VAR
          term1 := term;
          env1  := env;
        BEGIN
          LOOP
            TYPECASE term1 OF
            | ObTree.TermSeq (seq) =>
                EVAL Term(seq.before, (*in-out*) env1, glob, mySelf);
                term1 := seq.after;
            ELSE
              result := Term(term1, (*in-out*) env1, glob, mySelf);
              EXIT;
            END;
          END;
        END;
    | ObTree.TermLet (node) =>
        IF node.rec THEN
          env := TermBindingRec(node.binding, node.var, env, glob, mySelf);
        ELSE
          env :=
            TermBindingSeq(node.binding, node.var, env, env, glob, mySelf);
        END;
        result := ObValue.valOk;
    | ObTree.TermAssign (node) =>
        VAR
          env1: ObValue.Env;
          val : ObValue.Val;
        BEGIN
          TYPECASE LookupIde(
                     node.name, node.place, TRUE, env, glob, term.location)
              OF
          | ObValue.ValVar (var) =>
              env1 := env;
              val := Term(node.val, (*in-out*) env1, glob, mySelf);
              TRY
                var.remote.Set(val);
              EXCEPT
              | NetObj.Error (atoms) =>
                  ObValue.RaiseNetException(
                    "on remote assigment to variable '" & node.name.text
                      & "'", atoms, term.location);
              | Thread.Alerted =>
                  ObValue.RaiseException(
                    ObValue.threadAlerted,
                    "on remote assigment to variable '" & node.name.text
                      & "'", term.location);
              END;
          ELSE
            ObValue.RaiseError(
              "Assigment must operate on a variable", term.location);
          END;
          result := ObValue.valOk;
        END;
    | ObTree.TermIf (node) =>
        VAR env1: ObValue.Env;
        BEGIN
          env1 := env;
          TYPECASE Term(node.test, (*in-out*) env1, glob, mySelf) OF
          | ObValue.ValBool (bool) =>
              IF bool.bool THEN
                env1 := env;
                result := Term(node.ifTrue, (*in-out*) env1, glob, mySelf);
              ELSIF node.ifFalse = NIL THEN
                result := ObValue.valOk;
              ELSE
                env1 := env;
                result :=
                  Term(node.ifFalse, (*in-out*) env1, glob, mySelf);
              END;
          ELSE
            ObValue.RaiseError(
              "Conditional test must be a boolean", term.location);
          END;
        END;
    | ObTree.TermCase (node) =>
        VAR
          env1    : ObValue.Env;
          caseList: ObTree.TermCaseList;
        BEGIN
          env1 := env;
          TYPECASE Term(node.option, (*in-out*) env1, glob, mySelf) OF
          | ObValue.ValOption (option) =>
              caseList := node.caseList;
              LOOP
                IF caseList = NIL THEN
                  ObValue.RaiseError("No case branch applies to tag: "
                                       & option.tag, term.location);
                END;
                IF caseList.tag = NIL THEN (* "else" case *)
                  env1 := env;
                  result :=
                    Term(caseList.body, (*in-out*) env1, glob, mySelf);
                  EXIT;
                END;
                IF Text.Equal(option.tag, caseList.tag.text) THEN
                  IF caseList.binder = NIL THEN
                    env1 := env;
                  ELSE
                    env1 := NEW(ObValue.LocalEnv, name := caseList.binder,
                                val := option.val, rest := env);
                  END;
                  result :=
                    Term(caseList.body, (*in-out*) env1, glob, mySelf);
                  EXIT;
                END;
                caseList := caseList.rest;
              END;
          ELSE
            ObValue.RaiseError(
              "Case over a non-option value", term.location);
          END;
        END;
    | ObTree.TermLoop (node) =>
        VAR env1: ObValue.Env;
        BEGIN
          TRY
            LOOP
              env1 := env;
              EVAL Term(node.loop, (*in-out*) env1, glob, mySelf);
            END;
          EXCEPT
          | ObValue.Error (pkt) =>
              IF NOT Text.Equal(pkt.msg, "exit") THEN
                RAISE ObValue.Error(pkt);
              END;
          END;
          result := ObValue.valOk;
        END;
    | ObTree.TermExit (node) =>
        RAISE ObValue.Error(NEW(ObValue.ErrorPacket, msg := "exit",
                                location := node.location));
    | ObTree.TermFor (node) =>
        VAR
          env1        : ObValue.Env;
          forEnv      : ObValue.LocalEnv;
          lbVal, ubVal: ObValue.Val;
          i, ub       : INTEGER;
        BEGIN
          env1 := env;
          lbVal := Term(node.lb, (*in-out*) env1, glob, mySelf);
          TYPECASE lbVal OF
          | ObValue.ValInt (node) => i := node.int;
          ELSE
            ObValue.RaiseError(
              "Lower bound of 'for' must be an integer", term.location);
          END;
          env1 := env;
          ubVal := Term(node.ub, (*in-out*) env1, glob, mySelf);
          TYPECASE ubVal OF
          | ObValue.ValInt (node) => ub := node.int;
          ELSE
            ObValue.RaiseError(
              "Upper bound of 'for' must be an integer", term.location);
          END;
          forEnv := NEW(ObValue.LocalEnv, name := node.binder, val := NIL,
                        rest := env);
          TRY
            LOOP
              IF i > ub THEN EXIT END;
              forEnv.val := NEW(ObValue.ValInt, int := i, temp := FALSE);
              env1 := forEnv;
              EVAL Term(node.body, (*in-out*) env1, glob, mySelf);
              INC(i);
            END;
          EXCEPT
          | ObValue.Error (pkt) =>
              IF NOT Text.Equal(pkt.msg, "exit") THEN
                RAISE ObValue.Error(pkt);
              END;
          END;
          result := ObValue.valOk;
        END;
    | ObTree.TermForeach (node) =>
        VAR
          env1                 : ObValue.Env;
          forEnv               : ObValue.LocalEnv;
          val, rangeVal        : ObValue.Val;
          vals, oldVals, array1: Vals;
          i, ub                : INTEGER;
        BEGIN
          env1 := env;
          rangeVal := Term(node.range, (*in-out*) env1, glob, mySelf);
          TYPECASE rangeVal OF
          | ObValue.ValArray (node) =>
              TRY
                array1 := node.remote.Obtain();
              EXCEPT
              | NetObj.Error (atoms) =>
                  ObValue.RaiseNetException(
                    "on remote array access", atoms, term.location);
              | Thread.Alerted =>
                  ObValue.RaiseException(
                    ObValue.threadAlerted, "on remote array access",
                    term.location);
              END;
          ELSE
            ObValue.RaiseError(
              "Range of 'for' must be an array", term.location);
          END;
          i := 0;
          forEnv := NEW(ObValue.LocalEnv, name := node.binder, val := NIL,
                        rest := env);
          TRY
            ub := NUMBER(array1^);
            IF node.map THEN vals := NEW(Vals, ub); END;
            LOOP
              IF i >= ub THEN EXIT END;
              forEnv.val := array1^[i];
              env1 := forEnv;
              val := Term(node.body, (*in-out*) env1, glob, mySelf);
              IF node.map THEN vals^[i] := val END;
              INC(i);
            END;
          EXCEPT
          | ObValue.Error (pkt) =>
              IF NOT Text.Equal(pkt.msg, "exit") THEN
                RAISE ObValue.Error(pkt);
              ELSIF node.map THEN
                oldVals := vals;
                vals := NEW(Vals, i);
                vals^ := SUBARRAY(oldVals^, 0, i);
              END;
          END;
          IF node.map THEN
            result := ObValue.NewArrayFromVals(vals);
          ELSE
            result := ObValue.valOk;
          END;
        END;
    | ObTree.TermException (node) =>
        VAR env1: ObValue.Env;
        BEGIN
          env1 := env;
          TYPECASE Term(node.name, (*in-out*) env1, glob, mySelf) OF
          | ObValue.ValText (str) =>
              result := NEW(ObValue.ValException, name := str.text);
          ELSE
            ObValue.RaiseError(
              "Argument of exception must be a text", term.location);
          END;
        END;
    | ObTree.TermRaise (node) =>
        VAR env1: ObValue.Env;
        BEGIN
          env1 := env;
          TYPECASE Term(node.exception, (*in-out*) env1, glob, mySelf) OF
          | ObValue.ValException (exc) =>
              ObValue.RaiseException(exc, "", node.location);
          ELSE
            ObValue.RaiseError(
              "Argument of raise must be an exception", term.location);
          END;
        END;
    | ObTree.TermTry (node) =>
        VAR
          env1   : ObValue.Env;
          tryList: ObTree.TermTryList;
        BEGIN
          TRY
            env1 := env;
            result := Term(node.body, (*in-out*) env1, glob, mySelf);
          EXCEPT
          | ObValue.Exception (packet) =>
              tryList := node.tryList;
              LOOP
                IF tryList = NIL THEN RAISE ObValue.Exception(packet) END;
                IF tryList.exception = NIL THEN (* "else" case *)
                  env1 := env;
                  result :=
                    Term(tryList.recover, (*in-out*) env1, glob, mySelf);
                  EXIT;
                END;
                env1 := env;
                TYPECASE
                    Term(tryList.exception, (*in-out*) env1, glob, mySelf)
                    OF
                | ObValue.ValException (exc) =>
                    IF ObValue.SameException(exc, packet.exception) THEN
                      env1 := env;
                      result := Term(tryList.recover, (*in-out*) env1,
                                     glob, mySelf);
                      EXIT;
                    END;
                    tryList := tryList.rest;
                ELSE
                  ObValue.RaiseError(
                    "Guard of try must be an exception", term.location);
                END;
              END;
          | ObValue.Error (packet) =>
              tryList := node.tryList;
              LOOP
                IF tryList = NIL THEN RAISE ObValue.Error(packet); END;
                IF tryList.exception = NIL THEN (* "else" case *)
                  env1 := env;
                  result :=
                    Term(tryList.recover, (*in-out*) env1, glob, mySelf);
                  EXIT;
                END;
                tryList := tryList.rest;
              END;
          END;
        END;
    | ObTree.TermTryFinally (node) =>
        VAR env1: ObValue.Env;
        BEGIN
          TRY
            env1 := env;
            result := Term(node.body, (*in-out*) env1, glob, mySelf);
          FINALLY
            env1 := env;
            result := Term(node.finally, (*in-out*) env1, glob, mySelf);
          END;
        END;
    | ObTree.TermWatch (node) =>
        VAR
          env1       : ObValue.Env;
          mySync     : ObValue.Sync;
        BEGIN
          TYPECASE mySelf OF
          | ObValue.ValRemObj (remObj) =>
            TYPECASE remObj.remote OF
            | ObValue.RemObjServer(remObjServer) =>
              IF remObjServer = NIL THEN
                ObValue.RaiseError(
                  "watch-until must be used inside a method", term.location);
              END;
              mySync := remObjServer.sync;
            ELSE
              ObValue.RaiseError(
                  "watch-until does not work on remote objects",
                  term.location);
            END;
          | ObValue.ValSimpleObj(simpleObj) =>
            (* Simple objs are always local! *)
            IF simpleObj = NIL THEN
              ObValue.RaiseError(
                  "watch-until must be used inside a method", term.location);
            END;
            mySync := simpleObj.simple.sync;
          ELSE
            ObValue.RaiseError(
              "watch-until does not work on remote or replicated objects",
              term.location);
          END;
          env1 := env;
          TYPECASE Term(node.condition, (*in-out*) env1, glob, mySelf) OF
          | ObBuiltIn.ValCondition (cond) =>
            IF mySync = NIL THEN
              ObValue.RaiseError(
                  "watch-until must be used inside a protected object",
                  term.location);
            ELSE
              LOOP
                env1 := env;
                TYPECASE Term(node.guard, (*in-out*) env1, glob, mySelf) OF
                | ObValue.ValBool (guard) =>
                  IF guard.bool THEN
                    EXIT
                  ELSE
                    Thread.Wait(mySync.mutex, cond.condition);
                  END;
                ELSE
                  ObValue.RaiseError(
                      "Argument 2 of watch-until must be a boolean",
                      term.location);
                END;
              END;
              result := ObValue.valOk;
            END;
          ELSE
            ObValue.RaiseError(
              "Argument 1 of watch-until must be a condition",
              term.location);
          END;
        END;
    ELSE                         <*ASSERT FALSE*>
    END;
    RETURN result;
  END Term;

PROCEDURE Call (         clos: ObValue.ValFun;
                READONLY args: ObValue.Vals;
                         loc : SynLocation.T    := NIL): ObValue.Val
  RAISES {ObValue.Error, ObValue.Exception} =
  VAR
    env    : ObValue.Env;
    binders: ObTree.IdeList;
  BEGIN
    IF clos.fun.bindersNo # NUMBER(args) THEN
      ObValue.RaiseError(ObValue.BadArgsNoMsg(
                           clos.fun.bindersNo, NUMBER(args), "", ""), loc);
    END;
    env := NIL;
    binders := clos.fun.binders;
    FOR i := 0 TO NUMBER(args) - 1 DO
      env := NEW(ObValue.LocalEnv, name := binders.first, val := args[i],
                 rest := env);
      binders := binders.rest;
    END;
    RETURN Term(clos.fun.body, (*in-out*) env, clos.global, NIL);
  END Call;

PROCEDURE CallEngine (engine: ObValue.ValEngine;
                      arg   : ObValue.Val;
                      loc   : SynLocation.T       := NIL): ObValue.Val
  RAISES {ObValue.Error, ObValue.Exception} =
  BEGIN
    TRY
      RETURN engine.remote.Eval(arg, NIL);
    EXCEPT
    | ObValue.ServerError (msg) =>
        ObValue.RaiseError(msg, loc); <*ASSERT FALSE*>
    | NetObj.Error (atoms) =>
        ObValue.RaiseNetException("on remote engine execution", atoms, loc); <*ASSERT FALSE*>
    | Thread.Alerted =>
        ObValue.RaiseException(
          ObValue.threadAlerted, "on remote engine execution", loc); <*ASSERT FALSE*>
    END;
  END CallEngine;

BEGIN
END ObEval.