#lang typed/scheme #:optimize

(provide clist empty? head tail
         CatenableList append empty filter remove
         (rename-out [clist->list ->list]
                     [clist list] [kons cons]
                     [head first] [tail rest]
                     [kons-rear cons-to-end] [cmap map]
                     [cfoldl foldl] [cfoldr foldr]))
(require scheme/promise)

(require (prefix-in rtq: "bootstrapedqueue.ss"))

(define-struct: EmptyList ())

(define-struct: (A) List ([elem : A]
                          [ques : (rtq:Queue (Promise (List A)))]))

(define-type-alias CatenableList (All (A) (U (List A) EmptyList)))

;; An empty list
(define empty (make-EmptyList))

;; Checks for empty list
(: empty? : (All (A) ((CatenableList A) -> Boolean)))
(define (empty? cat)
  (EmptyList? cat))


(: link : (All (A) ((List A) (Promise (List A)) -> (List A))))
(define (link lst cat)
  (make-List (List-elem lst) (rtq:enqueue cat (List-ques lst))))

(: link-all : (All (A) ((rtq:Queue (Promise (List A))) -> (List A))))
(define (link-all rtq)
  (let ([hd (force (rtq:head rtq))]
        [tl (rtq:tail rtq)])
    (if (rtq:empty? tl)
        hd
        (link hd (delay (link-all tl))))))

;; Append helper
(: append-inner : (All (A) ((CatenableList A) (CatenableList A) -> (CatenableList A))))
(define (append-inner cat1 cat2)
  (cond
    [(EmptyList? cat1) cat2]
    [(EmptyList? cat2) cat1]
    [else (link cat1 (delay cat2))]))

;; List append
(: append : (All (A) ((CatenableList A) * -> (CatenableList A))))
(define (append . cats)
  (if (null? cats)
      empty
      (append-inner (car cats) (apply append (cdr cats)))))

;; Similar to list cons function
(: kons : (All (A) (A (CatenableList A) -> (CatenableList A))))
(define (kons elem cat)
  (append (make-List elem rtq:empty) cat))

;; Inserts an element at the rear end of the list
(: kons-rear : (All (A) (A (CatenableList A) -> (CatenableList A))))
(define (kons-rear elem cat)
  (append cat (make-List elem rtq:empty)))

;; Similar to list car function
(: head : (All (A) ((CatenableList A) -> A)))
(define (head cat)
  (if (EmptyList? cat)
      (error 'first "given list is empty")
      (List-elem cat)))

;; Similar to list cdr function
(: tail : (All (A) ((CatenableList A) -> (CatenableList A))))
(define (tail cat)
  (if (EmptyList? cat) 
      (error 'rest "given list is empty")
      (tail-helper cat)))

(: tail-helper : (All (A) ((List A) -> (CatenableList A))))
(define (tail-helper cat)
  (let ([ques (List-ques cat)])
    (if (rtq:empty? ques) 
        empty
        (link-all ques))))

;; Similar to list map function
(: cmap : (All (A C B ...) ((A B ... B -> C) (CatenableList A) 
                                             (CatenableList B) ... B -> 
                                             (CatenableList C))))
(define (cmap func lst . lsts)
  (if (or (empty? lst) (ormap empty? lsts))
      empty
      (kons (apply func (head lst) (map head lsts)) 
            (apply cmap func (tail lst) (map tail lsts)))))

;; Similar to list foldl function
(: cfoldl : 
   (All (C A B ...) ((C A B ... B -> C) C (CatenableList A) 
                                        (CatenableList B) ... B -> C)))
(define (cfoldl func base fst . rst)
  (if (or (empty? fst) (ormap empty? rst))
      base
      (apply cfoldl 
             func 
             (apply func base (head fst) (map head rst))
             (tail fst)
             (map tail rst))))

;; Similar to list foldr function
(: cfoldr : 
   (All (C A B ...) ((C A B ... B -> C) C (CatenableList A) 
                                        (CatenableList B) ... B -> C)))
(define (cfoldr func base fst . rst)
  (if (or (empty? fst) (ormap empty? rst))
      base
      (apply func (apply cfoldr 
                         func 
                         base
                         (tail fst)
                         (map tail rst)) (head fst) (map head rst))))

;; Similar to list filter function
(: filter : (All (A) ((A -> Boolean) (CatenableList A) -> (CatenableList A))))
(define (filter func que)
  (: inner : (All (A) ((A -> Boolean) (CatenableList A) (CatenableList A) -> (CatenableList A))))
  (define (inner func que accum)
    (if (empty? que)
        accum
        (let ([head (head que)]
              [tail (tail que)])
          (if (func head)
              (inner func tail (kons head accum))
              (inner func tail accum)))))
  (inner func que empty))

;; Similar to list remove function
(: remove : (All (A) ((A -> Boolean) (CatenableList A) -> (CatenableList A))))
(define (remove func que)
  (: inner : (All (A) ((A -> Boolean) (CatenableList A) (CatenableList A) -> (CatenableList A))))
  (define (inner func que accum)
    (if (empty? que)
        accum
        (let ([head (head que)]
              [tail (tail que)])
          (if (func head)
              (inner func tail accum)
              (inner func tail (kons head accum))))))
  (inner func que empty))

;; list constructor
(: clist : (All (A) (A * -> (CatenableList A))))
(define (clist . lst)
  (foldr (inst kons A) empty lst))


(: clist->list : (All (A) ((CatenableList A) -> (Listof A))))
(define (clist->list cat)
  (if (EmptyList? cat)
      null
      (cons (head cat) (clist->list (tail cat)))))