Fatiamento de seqüências em Scheme

Python oferece uma funcionalidade interessante para ser usadas com seqüências (string, listas e qualquer objeto com o método __getslice__, suponho). O fatiamento de Python admite índices negativos, omissão de índices e índices maiores que o tamanho da seqüência.

Exemplos:

>>> "abcdef"[3:6]
'def'
>>> [1, 2, 3, 4, 5][:3]
[1, 2, 3]
>>> [1,2,3,4,5][:-3]
[1, 2]
>>> [1,2,3,4,5][-3:]
[3, 4, 5]
>>> [1,2,3,4,5][-10:]
[1, 2, 3, 4, 5]

A seguir está uma implementação de algo parecido para Chicken, que funciona com listas, vetores, strings e permite a adição de fatiadores personalizados para o procedimento slice.

#!/usr/bin/csi -script

(use (srfi 1 13))

(define slice
 (let ()
   (define (positive? n) (> n 0))
   (define (negative? n) (< n 0))
   (define (both-positive? n m) (and n m (>= n 0) (>= m 0)))
 
   (define (from/to from to len)
     (cond
      ((and from (> from len))         ; [XXX:2]
        #f)
      ((and (both-positive? from to)   ; [1:2]
             from to
            (> to from)
            (< to len))
       (cons from to))
      ((and (both-positive? from to)   ; [1:XXX]
             from to
            (> to from)
            (>= to len))
       (cons from len))
      ((and (both-positive? from to)   ; [2:1]
             from to
            (> from to))
       #f)
      ((and from                       ; [-1:]
             (< from 0)
            (not to))
       (cons (if (>= (abs from) len)
                 0
                 (+ len from))
             len))
      ((and (not from)                 ; [:-1]
             to
            (< to 0))
       (cons 0
             (if (>= (abs to) len)
                 len
                 (+ len to))))
      ((and from                       ; [1:]
             (>= from 0)
            (not to))
       (cons from len))
      ((and from to                    ; [-2:-1]
             (< from 0)
            (< to 0)
            (< to from))
       #f)
      ((and from to                    ; [-1:-2]
             (< from 0)
            (< to 0))
       (cons (if (>= (abs from) len)
                 0
                 (+ len from))
             (if (>= (abs to) len)
                 len
                 (+ len to))))      
      (else #f)))

   (define (generic-slicer obj from to ruler empty obj-slicer)
     (let* ((len (ruler obj))
            (from&to (from/to from to len))
            (from (and from&to (car from&to)))
            (to (and from&to (cdr from&to))))
       (if (and from to)
           (obj-slicer obj from to)
           empty)))

   (define (string-slice s from to)
     (generic-slicer s from to string-length "" substring))

   (define (list-slice l from to)
     (generic-slicer l from to length '()
                     (lambda (l from to)
                       (take (drop l from) (- to from)))))

   (define (vector-slice v from to)
     (define (subvector vector start end)
       (let ((sub (make-vector (- end start))))
         (let loop ((i 0))
           (if (< i (- end start))
               (begin (vector-set! sub i (vector-ref vector (+ i start)))
                      (loop (+ i 1)))))
         sub))
     (generic-slicer v from to vector-length '#() subvector))


   (let ((slicers
          (list (lambda (obj)
                  (and (string? obj)
                       string-slice))
                (lambda (obj)
                  (and (vector? obj)
                       vector-slice))
                (lambda (obj)
                  (and (list? obj)
                       list-slice)))))
     (lambda (obj #!optional from to)
       (if (procedure? obj)
           (set! slicers (cons obj slicers))
           (let loop ((slicers slicers))
             (if (null? slicers)
                 (error "No slicer for the given object.")
                 (let* ((slicer (car slicers))
                        (slice (slicer obj)))
                   (if slice
                       (slice obj from to)
                       (loop (cdr slicers)))))))))))

Abaixo está o arquivo de teste do código de fatiamento (usando a extensão test), o qual também serve como exemplo de uso.

#!/usr/bin/csi -script

(use test)

(load "slice.scm")

;;;
;;; Strings
;;;
(define s "1234567")

(display "s = ")
(pp s)
(test "" (slice s 0 0))
(test "" (slice s 1 0))
(test "1" (slice s 0 1))
(test "" (slice s 10 10))
(test "1234567" (slice s 0 10))
(test "" (slice s 10 0))

(test "1234567" (slice s 0))
(test "7" (slice s -1))
(test "" (slice s 10))
(test "1234567" (slice s -10))
(test "4567" (slice s -4))

(test "" (slice s -4 -4))
(test "45" (slice s -4 -2))
(test "" (slice s -4 -10))
(test "123" (slice s -10 -4))


;;;
;;; Lists
;;;
(define l '(1 2 3 4 5 6 7))

(newline)
(display "l = ")
(pp l)

(test '() (slice l 0 0))
(test '() (slice l 1 0))
(test '(1) (slice l 0 1))
(test '(2 3) (slice l 1 3))
(test '() (slice l 10 10))
(test '(1 2 3 4 5 6 7) (slice l 0 10))
(test '() (slice l 10 0))

(test '(1 2 3 4 5 6 7) (slice l 0))
(test '(7) (slice l -1))
(test '() (slice l 10))
(test '(1 2 3 4 5 6 7) (slice l -10))
(test '(4 5 6 7) (slice l -4))

(test '() (slice l -4 -4))
(test '(4 5) (slice l -4 -2))
(test '() (slice l -4 -10))
(test '(1 2 3) (slice l -10 -4))

;;;
;;; Vectors
;;;
(define v '#(1 2 3 4 5 6 7))

(newline)
(display "v = ")
(pp v)

(test '#() (slice v 0 0))
(test '#() (slice v 1 0))
(test '#(1) (slice v 0 1))
(test '#(2 3) (slice v 1 3))
(test '#() (slice v 10 10))
(test '#(1 2 3 4 5 6 7) (slice v 0 10))
(test '#() (slice v 10 0))

(test '#(1 2 3 4 5 6 7) (slice v 0))
(test '#(7) (slice v -1))
(test '#() (slice v 10))
(test '#(1 2 3 4 5 6 7) (slice v -10))
(test '#(4 5 6 7) (slice v -4))

(test '#() (slice v -4 -4))
(test '#(4 5) (slice v -4 -2))
(test '#() (slice v -4 -10))
(test '#(1 2 3) (slice v -10 -4))

;;;
;;; Custom object
;;;
(define-record custom-string text)

(define s (make-custom-string "custom string"))
(slice (lambda (obj)
        (and (custom-string? obj)
             (lambda (obj from to)
               (handle-exceptions
                exn
                ""
                (substring (custom-string-text obj) from to))))))

(newline)
(display "s = ")
(pp s)

(test "" (slice s 0 0))
(test "" (slice s 1 0))
(test "c" (slice s 0 1))

A seguir está a saída da execução do programa de teste:

s = "1234567"
(slice s 0 0) .................................. [ PASS]
(slice s 1 0) .................................. [ PASS]
(slice s 0 1) .................................. [ PASS]
(slice s 10 10) ................................ [ PASS]
(slice s 0 10) ................................. [ PASS]
(slice s 10 0) ................................. [ PASS]
(slice s 0) .................................... [ PASS]
(slice s -1) ................................... [ PASS]
(slice s 10) ................................... [ PASS]
(slice s -10) .................................. [ PASS]
(slice s -4) ................................... [ PASS]
(slice s -4 -4) ................................ [ PASS]
(slice s -4 -2) ................................ [ PASS]
(slice s -4 -10) ............................... [ PASS]
(slice s -10 -4) ............................... [ PASS]

l = (1 2 3 4 5 6 7)
(slice l 0 0) .................................. [ PASS]
(slice l 1 0) .................................. [ PASS]
(slice l 0 1) .................................. [ PASS]
(slice l 1 3) .................................. [ PASS]
(slice l 10 10) ................................ [ PASS]
(slice l 0 10) ................................. [ PASS]
(slice l 10 0) ................................. [ PASS]
(slice l 0) .................................... [ PASS]
(slice l -1) ................................... [ PASS]
(slice l 10) ................................... [ PASS]
(slice l -10) .................................. [ PASS]
(slice l -4) ................................... [ PASS]
(slice l -4 -4) ................................ [ PASS]
(slice l -4 -2) ................................ [ PASS]
(slice l -4 -10) ............................... [ PASS]
(slice l -10 -4) ............................... [ PASS]

v = #(1 2 3 4 5 6 7)
(slice v 0 0) .................................. [ PASS]
(slice v 1 0) .................................. [ PASS]
(slice v 0 1) .................................. [ PASS]
(slice v 1 3) .................................. [ PASS]
(slice v 10 10) ................................ [ PASS]
(slice v 0 10) ................................. [ PASS]
(slice v 10 0) ................................. [ PASS]
(slice v 0) .................................... [ PASS]
(slice v -1) ................................... [ PASS]
(slice v 10) ................................... [ PASS]
(slice v -10) .................................. [ PASS]
(slice v -4) ................................... [ PASS]
(slice v -4 -4) ................................ [ PASS]
(slice v -4 -2) ................................ [ PASS]
(slice v -4 -10) ............................... [ PASS]
(slice v -10 -4) ............................... [ PASS]

s = #<custom-string>
(slice s 0 0) .................................. [ PASS]
(slice s 1 0) .................................. [ PASS]
(slice s 0 1) .................................. [ PASS]

Spam via telefone

Como se não bastasse a praga de spams que assola o mundo dos e-mails, há algum tempo venho recebendo propagandas não solicitadas da própria companhia telefônica (TIM) -- tanto através de SMS como, ultimamente, por ligações e mensagens de voz.

Hoje decidi ligar para a TIM para ver se conseguia me livrar desse transtorno. O atendente me disse que não é possível desativar esse "serviço" e sugeriu que eu mandasse um e-mail para a ouvidoria TIM, cujo endereço estaria disponível no site da empresa. Quando eu disse que não faria por medo de começar a receber spam da TIM por e-mail também, ele mesmo deu uma risada discreta, como se estivesse pensando "ele tem razão, é muita burrice fazer isso".