intersperse-intercalate.lisp

;; some Haskell folding function mimics in Common Lisp
;; (note: string is vector in CL, not list as in Haskell)

(defun seqtyp (seq)
  (typecase seq
    (list   'list)
    (string 'string)
    (vector 'simple-vector)
    (t      (error "Type ~a is not supported in this context." (type-of seq)))))

(defun apply-cons (fn xs)
  (if xs (funcall fn (car xs) (cdr xs))))

(defun concat (seq-of-seq)         ; Foldable t => t[a]->[a]
  (apply-cons (lambda (hd tl) (apply #'concatenate (seqtyp hd) hd tl))
              (coerce seq-of-seq 'list)))

(defun concat-map (fn seq)         ; Foldable t => (a->[b])->t[a]->[b]
  (concat (map (seqtyp seq) fn seq)))

(defun intersperse (sep seq)
  (flet ((sub (hd tl) (cons hd (mapcan (lambda (x) (list sep x)) tl))))
    (etypecase seq
      (list   (apply-cons #'sub seq))
      (vector (coerce (apply-cons #'sub (coerce seq 'list)) (seqtyp seq))))))

(defun intercalate (xs xss)        ; [a] -> [[a]] -> [a]
  (concat (intersperse xs xss)))

#|
CL-USER> (concat '("aBc" "deF"))
"aBcdeF"
CL-USER> (map 'string #'char-upcase "aBc")
"ABC"
CL-USER> (concat-map #'string-upcase '("aBc" "deF"))
"ABCDEF"
CL-USER> (intersperse #\, "abcde")
"a,b,c,d,e"
CL-USER> (intersperse ", " '("aaa" "bbb" "ccc"))
("aaa" ", " "bbb" ", " "ccc")
CL-USER> (intercalate ", " '("aaa" "bbb" "ccc"))
"aaa, bbb, ccc"
|#

; intercalate: a version only for string
;(defun intercalate (sep string-list)
;  (if string-list
;      (apply #'concatenate 'string
;             (car string-list)
;             (mapcan (lambda (s) (list sep s)) (cdr string-list)))))