two-stack-queue.scm

(use-modules (ice-9 match))

(define f
  (let A ((stack '()))
    (lambda (. y)
      (match y
        (('put i)
         (A (cons i stack)))
        (('get)
         (let ((s2 (if (> (length stack) 0)
                       (reverse stack)
                       '(()))))
           (cons (car s2) (A (reverse (cdr s2))))))))))

(define f-mut
  (lambda ()
    (let ((stack '()))
      (cons
       ;; get
       (lambda ()
         (let ((s2 (if (> (length stack) 0)
                       (reverse stack)
                       '(()))))
           (let ((ret (car s2)))
             (set! stack (reverse (cdr s2)))
             ret)))
       ;; put
       (lambda (x)
         (set! stack (cons x stack)))))))

(define (run1 args)
  (let B ((f# f) (a 'put))
    (if (eq? a 'put)
        (let A ((f#2 f#) (i 0))
          (if (< i 10000)
              (A (f#2 'put i) (1+ i))
              (B f#2 'get)))
        (let C ((f#3 f#) (i 0))
          (let ((f#3r (f# 'get)))
            (if (< i 10000)
                (C (cdr f#3r) (1+ i))))))))

(define (run2 args)
  (let ((ff (f-mut)))
    (let ((getf (car ff)) (putf (cdr ff)))
      (for-each (lambda (x) (putf x)) (iota 10000))
      (for-each (lambda (x) (getf)) (iota 10000)))))