string.egi

;;;;;
;;;;;
;;;;; String
;;;;;
;;;;;

(define $string
  (matcher
    {[,$val []
      {[$tgt  (if (eq? val 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]])]}]
     [$ [something]
      {[$tgt {tgt}]}]
     }))

(define $chop
  (lambda [$xs]
    (match xs string
      {[<snoc (| ,'\n' ,' ') $ys> (chop ys)]
       [_ xs]})))

;;;
;;; String as Collection
;;;

(define $S.empty?
  (lambda [$xs]
    (eq? 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.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 $alphabet?
  (match-lambda char
    {[,'a' #t] [,'b' #t] [,'c' #t] [,'d' #t] [,'e' #t]
     [,'f' #t] [,'g' #t] [,'h' #t] [,'i' #t] [,'j' #t]
     [,'k' #t] [,'l' #t] [,'m' #t] [,'n' #t] [,'o' #t]
     [,'p' #t] [,'q' #t] [,'r' #t] [,'s' #t] [,'t' #t]
     [,'u' #t] [,'v' #t] [,'w' #t] [,'x' #t] [,'y' #t]
     [,'z' #t]
     [,'A' #t] [,'B' #t] [,'C' #t] [,'D' #t] [,'E' #t]
     [,'F' #t] [,'G' #t] [,'H' #t] [,'I' #t] [,'J' #t]
     [,'K' #t] [,'L' #t] [,'M' #t] [,'N' #t] [,'O' #t]
     [,'P' #t] [,'Q' #t] [,'R' #t] [,'S' #t] [,'T' #t]
     [,'U' #t] [,'V' #t] [,'W' #t] [,'X' #t] [,'Y' #t]
     [,'Z' #t]
     [_ #f]}))

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

(define $upper-case
  (match-lambda char
    {[,'a' 'A'] [,'b' 'B'] [,'c' 'C'] [,'d' 'D'] [,'e' 'E']
     [,'f' 'F'] [,'g' 'G'] [,'h' 'H'] [,'i' 'I'] [,'j' 'J']
     [,'k' 'K'] [,'l' 'L'] [,'m' 'M'] [,'n' 'N'] [,'o' 'O']
     [,'p' 'P'] [,'q' 'Q'] [,'r' 'R'] [,'s' 'S'] [,'t' 'T']
     [,'u' 'U'] [,'v' 'V'] [,'w' 'W'] [,'x' 'X'] [,'y' 'Y']
     [,'z' 'Z']
     [$c c]}))

(define $lower-case
  (match-lambda char
    {[,'A' 'a'] [,'B' 'b'] [,'C' 'c'] [,'D' 'd'] [,'E' 'e']
     [,'F' 'f'] [,'G' 'g'] [,'H' 'h'] [,'I' 'i'] [,'J' 'j']
     [,'K' 'k'] [,'L' 'l'] [,'M' 'm'] [,'N' 'n'] [,'O' 'o']
     [,'P' 'p'] [,'Q' 'q'] [,'R' 'r'] [,'S' 's'] [,'T' 't']
     [,'U' 'u'] [,'V' 'v'] [,'W' 'w'] [,'X' 'x'] [,'Y' 'y']
     [,'Z' 'z']
     [$c c]}))