#	PATTERNS
#
#	SNOBOL4-style pattern matching
#
#	Ralph E. Griswold
#
#	Last modified 7/27/83
#

global Mode, Float

procedure Anchor()			#  &ANCHOR = 1
   suspend ""
end

procedure Any(s)			#  ANY(S)
   suspend tab(any(s))
end

procedure Apply(s,p)			#  S ? P
   local tsubject, tpos, value
   initial {
      Float := Arb
      /Mode := Float			#  &ANCHOR = 0 if not already set
      }
   suspend (
      (tsubject := &subject) &
      (tpos := &pos) &
      (&subject <- s) &
      (&pos <- 1) &
      (Mode() & (value := p())) &
      (&pos <- tpos) &			# to restore on backtracking
      (&subject <- tsubject) &		# note this sets &pos
      (&pos <- tpos) &			# to restore on evaluation
      value
      )
end

procedure Arb()				#  ARB
   suspend tab(&pos to *&subject + 1)
end

procedure Arbno(p)			#  ARBNO(P)
   suspend "" | (p() || Arbno(p))
end

procedure Arbx(i)			#  ARB(I)
   suspend tab(&pos to *&subject + 1 by i)
end

procedure Bal()				#  BAL
   suspend Bbal() || Arbno(Bbal)
end

procedure Bbal()			#  used by Bal()
   suspend (="(" || Arbno(Bbal) || =")") | Notany("()")
end

procedure Break(s)			#  BREAK(S)
   suspend tab(upto(s) \ 1)
end

procedure Breakx(s)			#  BREAKX(S)
   suspend tab(upto(s))
end

procedure Cat(p1,p2)			#  P1 P2
   suspend p1() || p2()
end

procedure Discard(p)			#  /P
   suspend p() & ""
end

procedure Exog(s)			#  \S
   suspend s
end

procedure Find(s)			#  FIND(S)
   suspend tab(find(s) + 1)
end

procedure Len(i)			#  LEN(I)
   suspend move(i)
end

procedure Limit(p,i)			#  P \ i
   local j
   j := &pos
   suspend p() \ i
   &pos := j
end

procedure Locate(p)			#  LOCATE(P)
   suspend tab(&pos to *&subject + 1) & p()
end

procedure Marb()			# max-first ARB
   suspend tab(*&subject + 1 to &pos by -1)
end

procedure Notany(s)			#  NOTANY(S)
   suspend tab(any(~s))
end

procedure Pos(i)			#  POS(I)
   suspend pos(i + 1) & ""
end

procedure Replace(p,s)			#  P = S
   suspend p() & s
end

procedure Rpos(i)			#  RPOS(I)
   suspend pos(-i) & ""
end

procedure Rtab(i)			#  RTAB(I)
   suspend tab(-i)
end

procedure Span(s)			#  SPAN(S)
   suspend tab(many(s))
end

procedure String(s)			#  S
   suspend =s
end

procedure Succeed()			#  SUCCEED
   suspend |""
end

procedure Tab(i)			#  TAB(I)
   suspend tab(i + 1)
end

procedure Xform(f,p)			#  F(P)
   suspend f(p())
end