string.egi

;;;;;
;;;;;
;;;;; S.ring
;;;;;
;;;;;

(define $string
  (matcher
    {[<regex-cg ,$regexpr $ $ $> [string (list string) string]
      {[$tgt (regex-cg regexpr tgt)]}]
     [<regex ,$regexpr $ $ $> [string string string]
      {[$tgt (regex regexpr tgt)]}]
     [<nil> []
      {[$tgt (if (eq? "" tgt)
               {[]}
               {})]}]
     [<cons $ $> [char string]
      {[$tgt (if (eq? "" tgt)
               {}
               {(uncons-string tgt)})]}]
     [<join $ <cons ,$px $>> [string string]
      {[$tgt (match-all (S.split (pack {px}) tgt) (list string)
               [<join (& !<nil> $xs) (& !<nil> $ys)> [(S.intercalate (pack {px}) xs)
                                (S.intercalate (pack {px}) ys)
                                ]])]}]
     [<join $ <join ,$pxs $>> [string string]
      {[$tgt (match-all (S.split pxs tgt) (list string)
               [<join (& !<nil> $xs) (& !<nil> $ys)> [(S.intercalate pxs xs)
                                (S.intercalate pxs ys)
                                ]])]}]
     [<join $ $> [string string]
      {[$tgt (match-all tgt string
                 [(loop $i [1 $n] <cons $xa_i ...> $rs) [(pack (map (lambda [$i] xa_i) (between 1 n))) rs]])]}]
     [,$val []
      {[$tgt  (if (eq? val tgt)
                {[]}
                {})]}]
     [$ [something]
      {[$tgt {tgt}]}]
     }))

;;;
;;; S.ring as collection
;;;
(define $S.empty?
  (lambda [$xs]
    (eq? xs "")))

(define $S.cons
  (lambda [$x $xs]
    (append-string (pack {x}) xs)))

(define $S.car
  (lambda [$xs]
    (match xs string
      {[<cons $x _> x]})))

(define $S.cdr
  (lambda [$xs]
    (match xs string
      {[<cons _ $r> r]})))

(define $S.rac
  (lambda [$str]
    (match str string
      {[<join _ <cons $c <nil>>> c]})))

(define $S.map
  (lambda [$f $xs]
    (pack (map f (unpack xs)))))

(define $S.length
  (lambda [$xs]
    (length-string xs)))

(define $S.split
  (lambda [$in $ls]
    (split-string in ls)))

(define $S.append
  (lambda [$xs $ys]
    (append-string xs ys)))

(define $S.concat
  (lambda [$xss]
    (foldr (lambda [$xs $rs] (S.append xs rs))
           ""
           xss)))

(define $S.intercalate (compose intersperse S.concat))

(define $S.replace
  (lambda [$before $after $str]
    (S.intercalate after (S.split before str))))


;;
;; Alphabet
;;
(define $C.between
  (lambda [$c1 $c2]
    (map itoc (between (ctoi c1) (ctoi c2)))))

(define $C.between?
  (lambda [$c1 $c2 $c]
    (and (gte? (ctoi c) (ctoi c1))
         (lte? (ctoi c) (ctoi c2)))))

(define $alphabet?
  (lambda [$c]
    (or (C.between? c#a c#z c)
        (C.between? c#A c#Z c))))

(define $alphabets?
  (lambda [$s]
    (all alphabet? (unpack s))))

(define $upper-case
  (lambda [$c]
    (if (C.between? c#a c#z c)
      (itoc (- (ctoi c) 32))
      c)))

(define $lower-case
  (lambda [$c]
    (if (C.between? c#A c#Z c)
      (itoc (+ (ctoi c) 32))
      c)))