;;;; Copyright 2002, Jonathan Bachrach.  See file TERMS.

(use goo/boot)
(use goo/fun)
(use goo/class)
(use goo/macros)
(use goo/any)
(use goo/log)
(use goo/chr)
(use goo/mag)
(use goo/math)
(use goo/types)
(use goo/cols/col)

(df @t? (x|<type> => <union>) 
  (new <union> union-elts (@lst x (new <singleton> type-object #f))))

;;;;!! Interface
(exported
 ;; defined in boot
 <seq> <seq.>
 
 ;; == (elt x 0)
 (dg 1st (x|<seq> => <any>))

 ;; == (elt x 1)
 (dg 2nd (x|<seq> => <any>)) ;; in types

 ;; == (elt x 2)
 (dg 3rd (x|<seq> => <any>))

 ;; == (elt x (- (len x) 1))
 (dg last (x|<seq> => <any>))

 ;; finds position of v in x else returns false.
 (dg pos (x|<seq> v|<any> => (@t? <int>)))

 ;; finds position of y in x else returns false.
 (dg finds (x|<seq> y|<seq> => (@t? <int>)))

 (dg do2 (f|<fun> x|<seq> y|<seq>))
 (dg do3 (f|<fun> x|<seq> y|<seq> z|<seq>))
 (dg map2 (f|<fun> x|<seq> y|<seq> => <seq>))
 (dg any2? (test|<fun> x|<seq> y|<seq> => <log>))
 (dg all2? (test|<fun> x|<seq> y|<seq> => <log>))

 ;; returns reversed sequence.
 (dg rev (x|<seq> => <seq>))

 ;; returns concatenated sequences.
 (dg cat (x|<seq> more|... => <seq>))

 ;; returns two sequences concatenated.
 (dg cat2 (x|<seq> y|<seq> => <seq>))

 ;; push/pops elements nondestructively
 (dg push (l|<seq> x|<any> => <seq>))
 (dg pop (l|<seq> => (tup new-col|<seq> value|<any>)))

 ;; subsequence of x between from and below.
 (dg sub (x|<seq> from|<int> below|<int> => <seq>))
 (dg sub* (x|<seq> from|<int> => <seq>))

 ;; inserts e into x below index before
 (dg ins (x|<seq> e|<any> before|<int> => <seq>))

 ;; returns new sequence with elements corresponding to those where test
 ;; returns non-false.
 (dg pick (test|<fun> x|<seq> => <seq>))

 ;; returns new sequence with elements corresponding to those where test
 ;; returns non-false.
 (dg reject (test|<fun> x|<seq> => <seq>))

 ;; returns sequence with all v's deleted from x.
 (dg del-vals (x|<seq> v|<any>  => <seq>))

 ;; returns sequence with all duplicates removed.
 (dg del-dups (x|<seq> => <seq>))

 ;; sorts a sequence
 (dg sort (x|<seq> => <seq>))
 (dg sort-by (x|<seq> test|<fun> => <seq>))

 ;; returns true if sequence s begins/ends with sequence begin/end
 (dg suffix? (s|<seq> suffix|<seq> => <log>))

 (dg prefix? (s|<seq> prefix|<seq> => <log>))

 (dg repeat (s|<seq> n|<int> => <seq>))

 ;;; Split 'str' apart on occurrences of 'sep' (similar to Perl).
 (dg split (s|<seq> sep => <seq>))

;;; Join each sequence in 'ss' with 'sep' (similar to Perl).
 (dg join (ss|<seq> sep|<seq> => <seq>))

;; UNDOCUMENTED:
 (df range-check (x|<seq> i|<int>))

 (df range-check? (x|<seq> i|<int>))
 ;; (df range-error (x|<seq> i|<int>))
 (dg vals-to-str (s|<seq> => <str>))
 (dg do-key-vals (fn|<fun> key-vals|<seq>))
)

;;;;!! Implementation

;;;; Collection protocol

(dm key-type (x|<col> => <type>) <int>)

;;;; Sequence protocol

(dm 1st (x|<seq> => <any>) (elt x 0))

(dm 2nd (x|<seq> => <any>) (elt x 1))

(dm 3rd (x|<seq> => <any>) (elt x 2))

(dm map (f|<fun> c|<seq> => <seq>)
  (rep con ((res '()) (e (enum c)))
    (if (fin? e)
        (col-res c (rev! res))
        (con (add res (f (now e))) (nxt e)))))

(dm map-keyed (f|<fun> c|<seq> => <seq>)
  (rep con ((res '()) (e (enum c)))
    (if (fin? e)
        (col-res c (rev! res))
        (con (add res (f (now-key e) (now e))) (nxt e)))))

(dm do2 (f|<fun> x|<seq> y|<seq>)
  (rep lop ((ex (enum x)) (ey (enum y)))
    (unless (or (fin? ex) (fin? ey))
      (f (now ex) (now ey))
      (lop (nxt ex) (nxt ey)))))

(dm do3 (f|<fun> x|<seq> y|<seq> z|<seq>)
  (rep lop ((ex (enum x)) (ey (enum y)) (ez (enum z)))
    (unless (or (fin? ex) (fin? ey) (fin? ez))
      (f (now ex) (now ey) (now ez))
      (lop (nxt ex) (nxt ey) (nxt ez)))))

(dm map2 (f|<fun> x|<seq> y|<seq> => <seq>)
  (rep con ((res '()) (ex (enum x)) (ey (enum y)))
    (if (or (fin? ex) (fin? ey))
        (col-res x (rev! res))
        (con (add res (f (now ex) (now ey))) 
             (nxt ex) (nxt ey)))))

(dm any2? (test|<fun> x|<seq> y|<seq> => <log>)
  (rep fnd ((ex (enum x)) (ey (enum y)))
    (if (or (fin? ex) (fin? ey))
        #f
        (or (as-log (test (now ex) (now ey)))
            (fnd (nxt ex) (nxt ey))))))

(dm all2? (test|<fun> x|<seq> y|<seq> => <log>)
  (rep fnd ((ex (enum x)) (ey (enum y)))
    (or (fin? ex) (fin? ey)
        (and (test (now ex) (now ey)) 
             (fnd (nxt ex) (nxt ey))))))

(dm = (c1|<seq> c2|<seq> => <log>)
  (rep eq ((e1 (enum c1)) (e2 (enum c2)))
    (if (fin? e1)
        (fin? e2)
        (and (= (now e1)  (now e2))
             (eq (nxt e1) (nxt e2))))))

;; TODO: SHOULD USE BACKWARD ITERATION PROTOCOL???
(dm last (x|<seq> => <any>) (elt x (- (len x) 1)))

(dm pos (x|<seq> v => (@t? <int>))
  (find-or (fun (a) (== v a)) x #f))

(dm finds ((x <seq>) (y <seq>) => (@t? <int>))
  (rep outer ((xsi 0))
    (if (< xsi (+ (- (len x) (len y)) 1))
        (rep inner ((xi xsi) (yi 0))
          (if (and (< xi (len x)) (< yi (len y)))
              (if (== (elt x xi) (elt y yi))
                  (inner (+ xi 1) (+ yi 1))
                  (outer (+ xsi 1)))
              xsi))
        #f)))

(dm rev (x|<seq> => <seq>)
  (rep con ((seq '()) (e (enum x)))
    (if (fin? e)
        (col-res x seq)
        (con (add seq (now e)) (nxt e)))))

;; required: rev!

(dm cat (x|<seq> ss|... => <seq>)
  (fold cat2 x ss))

(dm cat2 (x|<seq> y|<seq> => <seq>)
  (rep con-x ((seq '()) (ex (enum x)))
    (if (fin? ex)
        (rep con-y ((seq seq) (ey (enum y)))
          (if (fin? ey)
              (col-res x (rev! seq))
              (con-y (add seq (now ey)) (nxt ey))))
        (con-x (add seq (now ex)) (nxt ex)))))

(dm sub (x|<seq> from|<int> below|<int> => <seq>)
  (rep con-x ((seq '()) ((i <int>) 0) (e (enum x)))
    (if (fin? e)
        (col-res x (rev! seq))
        (con-x (if (if (>= i from) (< i below)) (add seq (now e)) seq)
               (+ i 1) (nxt e)))))

(dm sub* (x|<seq> from|<int> => <seq>)
  (sub x from (len x)))

(dm push (l|<seq> x|<any> => <seq>)
  (ins l x 0))

(dm pop (l|<seq> => (tup new-col|<seq> value|<any>))
  (tup (sub l 1 (len l)) (elt l 0)))

(dm pick (test|<fun> x|<seq> => <seq>)
  (rep con ((seq '()) (e (enum x)))
    (if (fin? e)
        (col-res x (rev! seq))
        (let ((v (now e)))
          (con (if (test v) (add seq v) seq) (nxt e))))))

(dm reject (test|<fun> x|<seq> => <seq>)
  (pick (fun (x) (not (test x))) x))

(dm del (x|<seq> key|<int> => <seq>) 
  (cat (sub x 0 key) (sub x (+ key 1) (len x))))

(dm del-vals (s|<seq> x => <seq>)
  (reject (fun (e) (== e x)) s))

(dm del-dups (x|<seq> => <seq>)
  (col-res x (rev! (fold (fun (s e) (if (mem? s e) s (pair e s))) '() x))))

(dm ins (x|<seq> v|<any> before|<int> => <seq>)
  (rep copy ((r '()) (i 0) (e (enum x)))
    (if (= i before)
        (copy (pair v r) (+ i 1) e)
        (if (fin? e)
            (col-res x (rev! r))
            (copy (pair (now e) r) (+ i 1) (nxt e))))))

;; TODO: PERHAPS THIS SHOULD BE THE AS <SEQ> <MAP> MET INSTEAD
(dm elts (x|<seq> keys|<seq> => <seq>)
  (rep copy ((r '()) (e (enum x)) (i 0) (keys (enum (sort keys))))
    (cond ((fin? keys)
           (col-res x (rev! r)))
          ((fin? e)
           (range-error x i))
          (#t 
           (let ((key (now keys)))
             (cond ((= i key)
                    (copy (pair (now e) r) (nxt e) (+ i 1) (nxt keys)))
                   ((isa? key <int>)
                    (copy r                (nxt e) (+ i 1) keys))
                   (#t
                    (range-error x key))))))))

(dm sort (x|<seq> => <seq>) (sort-by x <))

;; <seq.> declaration in vec. should be fine, but we don't want any circularities in here.
(dm sort-by (A|<seq!> test|<fun> => <seq!>)
  (sort-by! (dup A) test))

;;;; Undocumented

(dm keys (d|<seq> => <seq>)
  (below (len d)))

(df (range-check inline) (x|<seq> i|<int>)
  (when (or (< i 0) (>= i (len x)))
    (range-error x i)))

(df (range-check? inline) (x|<seq> i|<int>)
  (and (>= i 0) (< i (len x))))

(dm add (x|<seq> e => <seq>)
  (ins x e 0))

(dm add-new (c|<seq> x => <seq>)
  (unless (mem? c x) (add c x)) 
  c)

(dm vals-to-str (s|<seq> => <str>)
  (fold (fun (s e) (cat s (if (nul? s) "" " ") (to-str e))) "" s))

(dm do-key-vals (fn|<fun> key-vals|<seq>)
  (rep rep ((e (enum key-vals)))
    (unless (fin? e)
      (def key  (now e))
      (def nxts (nxt e))
      (def val  (and (not (fin? e)) (now e)))
      (fn key val) (rep (nxt e)))))

(dm col (t|(t< <col>) key-vals|...)
  (def x (fab t (1st (trunc/ (len key-vals) 2))))
  (do-key-vals (fun (key val) (set (fab-elt x key) val)) key-vals)
  x)

(dm suffix? (s|<seq> end|<seq> => <log>)
  (= (sub s (- (len s) (len end)) (len s)) end))

(dm prefix? (s|<seq> begin|<seq> => <log>)
  (= (sub s 0 (len begin)) begin))

;;; Build a sequence containing the specified number of cat'd sequences.
(dm repeat (s|<seq> n|<int> => <seq>)
  (if (<= n 0)
      (nul (class-of s))
      (cat2 s (repeat s (- n 1)))))

;;; Split 'str' apart on occurrences of 'sep' (similar to Perl).
;;; TODO - Add a <str> <str> method.
(dm split (s|<seq> sep => <lst>)
  (def match (pos s sep))
  (if (== match #f)
      (lst s)
      (pair (sub s 0 match)
            (split (sub s (+ match 1) (len s)) sep))))

;;; Join each sequence in 'ss' with 'sep' (similar to Perl).
(dm join (ss|<seq> sep|<seq> => <seq>)
  (if (nul? ss)
      (nul (class-of sep))
      (fold (fun (x y) (cat x sep y)) (elt ss 0) (sub ss 1 (len ss)))))

;; from range.goo
(need-implementation below sort-by!)
