(load "record.ss")

;;; MEM

(define make-memid (lambda () (lambda (x) x)))

(define apply-memk (lambda (k v) (k v)))

(define mem (lambda (x y) (mem-cps x y (make-memid))))

(define mem-cps
  (lambda (a ls k)
    (cond
      ((null? ls) (apply-memk k #f))
      ((eq? a (car ls)) (apply-memk k #t))
      (else (mem-cps a (cdr ls) k)))))

;;; REMOVE-ALL

(define-record remid ())

(define apply-remk
  (lambda (k v)
    (variant-case k
      (remid () v)
      (else (error 'apply-k "invalid continuation ~s" k)))))

(define remove-all (lambda (x y) (remove-all-cps x y (make-remid))))

(define remove-all-cps
  (lambda (ls1 ls2 k)
    (cond
      ((null? ls1) (apply-remk k ls2))
      (else (remove-all-cps (cdr ls1) (remq (car ls1) ls2) k)))))

;;; APPEND-ALL

(define make-appk (lambda () (lambda (x) x)))

(define make-app1
  (lambda (k lss)
    (lambda (v) (apply-appk k (append (car lss) v)))))

(define apply-appk (lambda (k v) (k v)))

(define append-all (lambda (x) (append-all-cps x (make-appk))))

(define append-all-cps
  (lambda (lss k)
    (cond
      ((null? lss) (apply-appk k '()))
      (else (append-all-cps (cdr lss) (make-app1 k lss))))))

;;; NUMLIST?

(define-record numid ())
(define-record num1 (ls k))
(define-record num2 (k v1))

(define apply-numk
  (lambda (k v)
    (variant-case k
      (numid () v)
      (num1 (ls k) (numlist?-cps (cdr ls) (make-num2 k v)))
      (num2 (k v1) (apply-numk k (and v1 v)))
      (else (error 'apply-k "invalid continuation ~s" k)))))

(define numlist? (lambda (x) (numlist?-cps x (make-numid))))

(define numlist?-cps
  (lambda (ls k)
    (cond
      ((null? ls) (apply-numk k #t))
      ((number? ls) (apply-numk k #t))
      ((atom? ls) (apply-numk k #f))
      (else (numlist?-cps (car ls) (make-num1 ls k))))))

;;; EVAL-AE

(define-record evalid ())
(define-record eval1 (exp k oper))
(define-record eval2 (k v1 oper))

(define apply-evalk
  (lambda (k v)
    (variant-case k
      (evalid () v)
      (eval1 (exp k oper) (eval-ae-cps (caddr exp) (make-eval2 k v oper)))
      (eval2 (k v1 oper) (apply-evalk k (oper v1 v))))))

(define eval-ae (lambda (x) (eval-ae-cps x (make-evalid))))

(define eval-ae-cps
  (lambda (exp k)
    (cond
      ((number? exp) (apply-evalk k exp))
      ((atom? exp) (error 'eval-ae-cps "invalid expression ~s" exp))
      ((not (= (length exp) 3))
       (error 'eval-ae-cps "invalid expression ~s" exp))
      (else
	(let ((oper (case (car exp)
		      ((+) +)
		      ((-) -)
		      ((*) *)
		      ((/) /)
		      (else (error 'eval-ae-cps "bad expression ~s" exp)))))
	  (eval-ae-cps (cadr exp) (make-eval1 exp k oper)))))))