;;; tactics

(define succeed                         ; val -> tac
  (lambda (v)
    (lambda (succ fail)
      (succ v fail))))

(define fail                            ; () -> tac
  (lambda ()
    (lambda (succ fail)
      (fail))))

(define and-then                        ; tac * (val->tac) -> tac
  (lambda (tac tacfn)
    (lambda (succ fail)
      (tac (lambda (v backtrack) ((tacfn v) succ backtrack))
           fail))))

(define or-else                         ; tac * tac -> tac
  (lambda (t1 t2)
    (lambda (succ fail)
      (t1 succ (lambda () (t2 succ fail))))))

(define or-else*                        ; (list tac) -> tac
  (lambda l
    (let or-else-loop ((l l))
      (if (null? l) (fail)
        (or-else (car l)
          (or-else-loop (cdr l)))))))

(define cut                             ; tac -> tac
  (lambda (tac)
    (lambda (succ fail)
      ;; once tac succeeds, never go back to the choice points inside it:
      (tac (lambda (v back) (succ v fail))
           fail))))

(define repeat                          ; (val->tac) -> (val->tac)
  (lambda (tacfn)
    ;; keep doing (tacfn v) until it fails
    (lambda (v)
      (or-else
        (and-then
          (tacfn v)
          (repeat tacfn))
        (succeed v)))))

(define or-else-use*                     ; (val->tac)* -> (val->tac)
  (lambda l
    (let or-else-use*-loop ((l l))
      (if (null? l)
        (lambda (v) (fail))
        (lambda (v)
          (or-else ((car l) v)
            ((or-else-use*-loop (cdr l)) v)))))))


(define or-else-use                     ; (list (val->tac)) -> (val->tac)
  (lambda (l)
    (let or-else-use-loop ((l l))
      (if (null? l)
        (lambda (v) (fail))
        (lambda (v)
          (or-else ((car l) v)
            ((or-else-use-loop (cdr l)) v)))))))

(define print-it                        ; val -> tac
  (lambda (m)
    (display* (unparse m))
    (succeed m)))

(define trace-tac                       ; (val->tac) -> (val->tac)
  (lambda (tacfn)
    (lambda (m)
      (display* (unparse m))
      (tacfn m))))

(define report-tac
  (lambda (msg tacfn)
    (lambda (v1)
      (and-then
        (tacfn v1)
        (lambda (v)
          (printf "[by ~d]:~%" msg)
          (pretty-print (unparse v))
          (succeed v))))))

(define run-tac                         ; (tac * (val -> ans) * ans) -> ans
  (lambda (tac succ fail)
    (tac 
      (lambda (v failpoint) (succ v))
      fail)))