(*------------------------------------------------------------------------*)

IMPLEMENTATION MODULE SearchBase;

FROM SYSTEM IMPORT WORD;

FROM Memory IMPORT ALLOCATE, DEALLOCATE;
IMPORT Strings;

IMPORT Errors;

(*------------------------------------------------------------------------*)

PROCEDURE NewPattern (type: PatternType; VAR pattern: PatternPtr): BOOLEAN;

   BEGIN
      NEW (pattern);
      IF pattern # NIL THEN
         pattern^.next := NIL;
         pattern^.refer := FieldSet {};
         pattern^.type := type;
         WITH pattern^ DO
            (* Initialise pointers to allow disposal of partially assigned
            patterns resulting from parsing failure *)
            CASE type OF
              CharStringP: str := NIL
            | ExclusionP: patt := NIL
            | MinimumP: minPatt := NIL
            | MaximumP: maxPatt := NIL
            | AlternateP: altList := NIL
            | SequenceP: seqList := NIL
            ELSE (* do nothing *)
            END (* case *);
         END (* with *);
         RETURN TRUE
      ELSE
         Errors.Report (INTEGER (Errors.SearchInsufficientRoom));
         RETURN FALSE
      END (* if *);
   END NewPattern;

(*------------------------------------------------------------------------*)

PROCEDURE DisposePattern (VAR pattern: PatternPtr);

   VAR res: INTEGER;

   BEGIN
      res := Traverse (pattern, DisposePatt, 0);
      pattern := NIL;
   END DisposePattern;

PROCEDURE DisposePatt (pattern: PatternPtr; args: WORD): INTEGER;

   BEGIN
      WITH pattern^ DO
         CASE type OF
           CharStringP: IF str # NIL THEN Strings.Dispose (str) END
         ELSE (* do nothing *)
         END (* case *);
      END (* with *);
      DISPOSE (pattern);
      RETURN 0
   END DisposePatt;

(*------------------------------------------------------------------------*)

PROCEDURE NewReplace (type: ReplaceType; VAR replace: ReplacePtr): BOOLEAN;

   BEGIN
      NEW (replace);
      IF replace # NIL THEN
         replace^.next := NIL;
         replace^.type := type;
         WITH replace^ DO
            (* Initialise pointers to allow disposal of partially assigned
            patterns resulting from parsing failure *)
            CASE type OF
              CharStringR: str := NIL
            ELSE (* do nothing *)
            END (* case *);
         END (* with *);
         RETURN TRUE
      ELSE
         Errors.Report (INTEGER (Errors.SearchInsufficientRoom));
         RETURN FALSE
      END (* if *);
   END NewReplace;

(*------------------------------------------------------------------------*)

PROCEDURE DisposeReplace (VAR replace: ReplacePtr);

   VAR
      repl  : ReplacePtr;
      temp  : ReplacePtr;

   BEGIN
      repl := replace;
      WHILE repl # NIL DO
         WITH repl^ DO
            temp := next;
            CASE type OF
              CharStringR: IF str # NIL THEN Strings.Dispose (str) END
            ELSE (* do nothing *)
            END (* case *);
         END (* with *);
         DISPOSE (repl);
         repl := temp
      END (* while *);
      replace := NIL;
   END DisposeReplace;

(*------------------------------------------------------------------------*)

PROCEDURE Traverse (pattern: PatternPtr; traverseProc: TraverseProc; args: WORD): INTEGER;

   (* Traverses pattern in left-right order, calling actionProc for each
   pattern traversed. Copes with actionProc disposing of pattern *)

   VAR
      nextPatt  : PatternPtr;
      listPatt  : PatternPtr;
      res       : INTEGER;

   BEGIN
      IF pattern = NIL THEN RETURN 0 END;
      WITH pattern^ DO
         CASE type OF
           ExclusionP: nextPatt := patt
         | MinimumP: nextPatt := minPatt
         | MaximumP: nextPatt := maxPatt
         | AlternateP: nextPatt := altList
         | SequenceP: nextPatt := seqList
         ELSE nextPatt := NIL
         END (* case *);
      END (* with *);
      listPatt := pattern^.next;
      res := traverseProc (pattern, args); IF res < 0 THEN RETURN res END;
      res := Traverse (nextPatt, traverseProc, args); IF res < 0 THEN RETURN res END;
      res := Traverse (listPatt, traverseProc, args); IF res < 0 THEN RETURN res END;
      RETURN 0
   END Traverse;

(*------------------------------------------------------------------------*)

END SearchBase.