UNSAFE MODULE ObLib;
IMPORT SynLocation, ObCommand, Text, Pickle2 AS Pickle, Wr, Thread,
       TimeStamp, Fingerprint, ObLibTbl, Rd, WeakerRef, WeakRef,
       PickleStubs, RTAllocator;

  PROCEDURE Setup()  =
  BEGIN
    libraries := NIL;
    helpCommandSet := ObCommand.NewSet();
  END Setup;

  PROCEDURE Extend(library: T; env: Env): Env =
    BEGIN
      IF Lookup(library.name, env)#NIL THEN
        RETURN NEW(Env, library:=library, rest:=env);
      ELSE
        RETURN NEW(Env, library:=library, rest:=env);
      END;
    END Extend;

  PROCEDURE Register(library: T) =
    BEGIN
      libraries := Extend(library, libraries);
    END Register;

  PROCEDURE RegisterHelp(name: TEXT; helpProc: HelpProc) =
    BEGIN
      ObCommand.Register(helpCommandSet,
          NEW(ObCommand.T, name:=name,
              sortingName:="mod " & name,
              Exec:=helpProc));
    END RegisterHelp;

  PROCEDURE Lookup(name: TEXT; env: Env): Env =
    BEGIN
      LOOP
        IF env=NIL THEN RETURN NIL END;
        IF Text.Equal(name, env.library.name) THEN RETURN env END;
        env := env.rest;
      END;
    END Lookup;

  PROCEDURE LookupFixity(opName: TEXT; env: Env; VAR (*out*)libName: TEXT)
      : OpFixity =
    VAR opCodes: REF ARRAY OF OpCode;
    BEGIN
      LOOP
        IF env=NIL THEN RETURN OpFixity.Undefined END;
        opCodes := env.library.opCodes;
        FOR i:=0 TO NUMBER(opCodes^)-1 DO
          IF Text.Equal(opName, opCodes^[i].name) THEN
            libName := env.library.name;
            RETURN opCodes^[i].fixity;
          END;
        END;
        env := env.rest;
      END;
    END LookupFixity;

  PROCEDURE EncodeTermOp(self: T; opName: TEXT;
      VAR(*out*)code: OpCode; <*UNUSED*>location: SynLocation.T): BOOLEAN =
    BEGIN
      FOR i:=FIRST(self.opCodes^) TO LAST(self.opCodes^) DO
        IF Text.Equal(opName, self.opCodes^[i].name) THEN
          code := self.opCodes^[i];
          RETURN TRUE;
        END;
      END;
      RETURN FALSE;
    END EncodeTermOp;

REVEAL
  ObLibSpecial = Pickle.Special BRANDED OBJECT
                       OVERRIDES
                         write := WriteLib;
                         read := ReadLib;
                       END;

PROCEDURE LookupFP (fp: Fingerprint.T; newLib: T): T =
  VAR lib: T := NIL;
      wref, wrefOld: WeakerRef.T;
  BEGIN
    LOCK mu DO
      IF libTbl.get(fp, wref) THEN
        lib := WeakRef.ToRef(wref.weakRef);
      END;
      IF lib = NIL AND newLib # NIL THEN
        wref := NEW(WeakerRef.T, weakRef:=WeakRef.FromRef(newLib, CleanupLib));
        IF NOT libTbl.put(fp, wref) THEN
          EVAL libTbl.delete(fp, wrefOld);
          EVAL libTbl.put(fp, wref);
        END;
        lib := newLib;
      END;
      RETURN lib;
    END;
  END LookupFP;

PROCEDURE CheckFP (lib: T) =
  VAR wref: WeakerRef.T;
  BEGIN
    LOCK mu DO
      IF Fingerprint.Equal(lib.ts, Fingerprint.Zero) THEN
        lib.ts := ComputeFP();
        wref := NEW(WeakerRef.T, weakRef:=WeakRef.FromRef(lib, CleanupLib));
        EVAL libTbl.put(lib.ts, wref);
      END;
    END;
  END CheckFP;

PROCEDURE ComputeFP() : Fingerprint.T =
  VAR ts := TimeStamp.New();
  BEGIN
    RETURN Fingerprint.FromChars(
             LOOPHOLE(ts, ARRAY [0..15] OF CHAR), Fingerprint.OfEmpty);
  END ComputeFP;

PROCEDURE CleanupLib(<*UNUSED*>READONLY self: WeakRef.T; ref: REFANY) =
  VAR lib: T := ref;
      val: WeakerRef.T;
  BEGIN
    LOCK mu DO
      EVAL libTbl.delete(lib.ts, val);
    END;
  END CleanupLib;

VAR
  libTbl: ObLibTbl.T := NEW(ObLibTbl.Default).init();

VAR
  mu := NEW(MUTEX);

PROCEDURE WriteLib (<*UNUSED*>ts: ObLibSpecial;
                    ref: REFANY; out: Pickle.Writer)
  RAISES {Pickle.Error, Wr.Failure, Thread.Alerted} =
  VAR o := NARROW(ref, T);
  BEGIN
    CheckFP(o);
    out.writeType(TYPECODE(ref));
    PickleStubs.OutBytes(out, o.ts.byte);
    PickleStubs.OutText(out, o.name);
    PickleStubs.OutRef(out, o.opCodes);
  END WriteLib;

PROCEDURE ReadLib (<*UNUSED*>ts: ObLibSpecial;
                   in: Pickle.Reader;
                   id: Pickle.RefID):REFANY
  RAISES {Pickle.Error, Rd.EndOfFile, Rd.Failure, Thread.Alerted} =
  <*FATAL RTAllocator.OutOfMemory*>
  VAR ac := in.readType();
      lib := NARROW(RTAllocator.NewTraced(ac),T);
  BEGIN
    PickleStubs.InBytes(in, lib.ts.byte);
    lib := LookupFP(lib.ts, lib);
    in.noteRef(lib, id);

    lib.name := PickleStubs.InText(in);
    lib.opCodes := PickleStubs.InRef(in);
    RETURN lib;
  END ReadLib;

BEGIN
  Pickle.RegisterSpecial(NEW(ObLibSpecial, sc := TYPECODE(T)));
END ObLib.