(defclass ometa-prim ()
  ((input :accessor input :initarg :input)
   (input-stack :accessor input-stack :initform nil)))

(defvar o-fail (list 'o-fail-object))
(defun o-fail? (x)
  (eq x o-fail))

(defmethod oAnd ((o ometa-prim) args)
  (if (null args)
      (return-from oAnd t))
  (let (answer)
    (loop for x in (if (stringp args)
		       (coerce args 'list)
		       args)
	  do (progn
	       (setf answer (apply x (list o)))
	       (if (o-fail? answer)
		   (return-from oAnd o-fail))))
    answer))

(defmethod oOr ((o ometa-prim) args)
  (save-input o)
  (loop for x in (if (stringp args)
		     (coerce args 'list)
		     args) do
	(progn
	  (restore-input o)
	  (let ((answer (apply x (list o))))
	    (unless (o-fail? answer)
	      (discard-input o)
	      (return-from oOr answer))
	    )))
  (discard-input o)
  o-fail)

(defmethod omany ((o ometa-prim) x)
  (let (answer)
    (loop do
	  (progn
	    (save-input o)
	    (let ((v (apply x (list o))))
	      (if (o-fail? v)
		  (progn
		    (restore-and-discard-input o)
		    (return-from omany (nreverse answer)))
		  )
	      (push v answer)
	      (discard-input o))))))

(defmethod omany1 ((o ometa-prim) x)
  (let ((v (apply x (list o))))
    (if (o-fail? v)
	o-fail
	(let ((answer (list v)))
	  (loop do
		(progn
		  (save-input o)
		  (let ((v (apply x (list o))))
		    (if (o-fail? v)
			(progn
			  (restore-and-discard-input o)
			  (return-from omany1 (nreverse answer)))
			)
		    (push v answer)
		    (discard-input o))))))))

(defmethod seq ((o ometa-prim))
  (let (xs)
    (oAnd o (list
	      (lambda (o)
		(setf xs (apply 'anything (list o))))
	      (lambda (o)
		(loop for x in (if (stringp xs)
				   (coerce xs 'list)
				   xs) do
		      (progn
			(if (o-fail? (applyWithArguments 'exactly o (list x)))
			    (return-from seq o-fail))
			)))
	      (lambda (o) xs)))))

(defmethod opred ((o ometa-prim) p)
  (or p o-fail))

(defmethod onot ((o ometa-prim) x)
  (save-input o)
  (if (o-fail? (apply x (list o)))
      (progn
	(restore-and-discard-input o)
	t)
      (progn
	(discard-input o)
	o-fail)))

(defmethod anything ((o ometa-prim))
  (if (null (input o))
      o-fail
      (pop (input o))))

(defmethod discard-input ((o ometa-prim))
  (pop (input-stack o)))
(defmethod restore-input ((o ometa-prim))
  (setf (input o) (car (input-stack o))))
(defmethod save-input ((o ometa-prim))
  (push (copy-list (input o)) 
	(input-stack o)))
(defmethod restore-and-discard-input ((o ometa-prim))
  (restore-input o)
  (discard-input o))

(defun applyWithArguments (fn o args)
  (loop for a in args do
	(push a (input o)))
  (apply fn (list o)))

(defmethod oform ((o ometa-prim) x)
  (let ((v (anything o)))
    (if (or (o-fail? v) (not (listp v))) 
	(return-from oform o-fail)
	(progn
	  (save-input o)
	  (setf (input o) (copy-list v))
	  (let ((result (funcall x o)))
	    (if (or (o-fail? result)
		    (o-fail? (or (null (input o))
				 o-fail)))
		(progn
		  (discard-input o)
		  (return-from oform o-fail))
		(progn
		  (restore-and-discard-input o)
		  v)))))))