Changeset 36356 in project


Ignore:
Timestamp:
08/23/18 13:08:40 (3 months ago)
Author:
juergen
Message:

bindings 1.1 sequence routines prefixed

Location:
release/5/bindings
Files:
6 edited
1 copied

Legend:

Unmodified
Added
Removed
  • release/5/bindings/tags/1.1/bindings.egg

    r36333 r36356  
    55 (test-dependencies simple-tests)
    66 (author "Juergen Lorenz")
    7  (version "1.0")
     7 (version "1.1")
    88 (components (extension bindings)))
  • release/5/bindings/tags/1.1/bindings.scm

    r36333 r36356  
    7171
    7272Sequences are either lists, psuedolists, vectors or strings by default.
    73 The sequence operators needed are seq-ref, seq-tail and seq-null? with
     73The sequence operators needed are bind-seq-ref, bind-seq-tail and bind-seq-null? with
    7474the same syntax as the likely named list routines.  But there is a
    75 procedure, seq-db, which allows to add a pair consisting of a type
     75procedure, bind-seq-db, which allows to add a pair consisting of a type
    7676predicate and a vector containing the needed operators to a database.
    7777
     
    8282   bind-case-lambda* bind-named bind-let bind-let* bind-letrec bindrec
    8383   bindable? bind-define bind-set! bind/cc bindings
    84    seq-db seq-ref seq-tail seq-null? seq-exception pseudo-list?)
     84   bind-seq-db bind-seq-ref bind-seq-tail bind-seq-null? bind-seq-exception bind-pseudo-list?)
    8585
    8686  (import scheme
     
    9797;;; exceptions
    9898;;; ----------
    99 (define seq-exception
     99(define bind-seq-exception
    100100  (make-exception "sequence exception" 'sequence))
    101101
     
    107107(define-inline (0<= n) (fx>= n 0))
    108108
    109 (define (pseudo-list? xpr) #t)
    110 
    111 ;;; (seq-ref seq k)
     109(define (bind-pseudo-list? xpr) #t)
     110
     111;;; (bind-seq-ref seq k)
    112112;;; ---------------
    113113;;; access to a sequence item
    114 ;;; the second returned value is needed in seq-null?
    115 (define (seq-ref seq k)
    116   (assert (0<= k) 'seq-ref)
     114;;; the second returned value is needed in bind-seq-null?
     115(define (bind-seq-ref seq k)
     116  (assert (0<= k) 'bind-seq-ref)
    117117  (values
    118     (let loop ((db (seq-db)))
    119       ;; Since everything is a pseudo-list, which is checked last
     118    (let loop ((db (bind-seq-db)))
     119      ;; Since everything is a bind-pseudo-list, which is checked last
    120120      ;; db is never empty
    121121      (if ((caar db) seq)
     
    124124    #f))
    125125
    126 ;;; (seq-tail seq k)
     126;;; (bind-seq-tail seq k)
    127127;;; ----------------
    128128;;; access to the tail of a sequence
    129 (define (seq-tail seq k)
    130   (assert (0<= k) 'seq-tail)
    131   (let loop ((db (seq-db)))
    132     ;; Since everything is a pseudo-list, which is checked last
     129(define (bind-seq-tail seq k)
     130  (assert (0<= k) 'bind-seq-tail)
     131  (let loop ((db (bind-seq-db)))
     132    ;; Since everything is a bind-pseudo-list, which is checked last
    133133    ;; db is never empty
    134134    (if ((caar db) seq)
     
    136136      (loop (cdr db)))))
    137137
    138 ;;; (seq-null? seq)
     138;;; (bind-seq-null? seq)
    139139;;; ---------------
    140140;;; tests for emptiness of a sequence
    141 (define (seq-null? seq)
     141(define (bind-seq-null? seq)
    142142  (receive (result out-of-bounds?)
    143     (condition-case (seq-ref seq 0)
     143    (condition-case (bind-seq-ref seq 0)
    144144      ((exn) (values #t #t)))
    145145    (if out-of-bounds? #t #f)))
    146146
    147 ;;; (seq-db type? ref: ref tail: tail)
     147;;; (bind-seq-db type? ref: ref tail: tail)
    148148;;; ---------------------------------
    149149;;; adds a new sequence type to the front of the database
    150 ;;; (seq-db)
     150;;; (bind-seq-db)
    151151;;; --------
    152152;;; shows the sequence database
    153 (define seq-db
     153(define bind-seq-db
    154154  (let ((db (list (cons list? (vector list-ref list-tail))
    155155                  (cons vector? (vector vector-ref subvector))
    156156                  (cons string? (vector string-ref substring))
    157                   (cons pseudo-list?
     157                  (cons bind-pseudo-list?
    158158                        (vector (lambda (pl k) ; ref
    159159                                  (let loop ((pl pl) (n 0))
     
    164164                                       (loop (cdr pl) (1+ n)))
    165165                                      (else
    166                                         (raise (seq-exception 'seq-ref
     166                                        (raise (bind-seq-exception 'bind-seq-ref
    167167                                                              "out of range"
    168168                                                              pl k))))))
     
    175175                                       (loop (cdr pl) (1+ n)))
    176176                                      (else
    177                                         (raise (seq-exception 'seq-tail
     177                                        (raise (bind-seq-exception 'bind-seq-tail
    178178                                                              "out of range"
    179179                                                              pl k))))))
     
    198198                               ((cadar args) seq k)
    199199                               ((exn)
    200                                 (raise (seq-exception 'seq-ref
     200                                (raise (bind-seq-exception 'bind-seq-ref
    201201                                                      "out of range"
    202202                                                      seq k)))))))
     
    208208                               ((cadar args) seq k)
    209209                               ((exn)
    210                                 (raise (seq-exception 'seq-tail
     210                                (raise (bind-seq-exception 'bind-seq-tail
    211211                                                      "out of range"
    212212                                                      seq k)))))))
    213213             (else
    214                (raise (seq-exception 'seq-db
     214               (raise (bind-seq-exception 'bind-seq-db
    215215                                     "not a keyword"
    216216                                     (caar args))))
     
    249249        (%error (rename 'error))
    250250        (%equal? (rename 'equal?))
    251         (%seq-ref (rename 'seq-ref))
    252         (%seq-tail (rename 'seq-tail))
    253         (%seq-null? (rename 'seq-null?))
    254         (%seq-exception (rename 'seq-exception)))
     251        (%bind-seq-ref (rename 'bind-seq-ref))
     252        (%bind-seq-tail (rename 'bind-seq-tail))
     253        (%bind-seq-null? (rename 'bind-seq-null?))
     254        (%bind-seq-exception (rename 'bind-seq-exception)))
    255255    (let* ((fenders? (and (pair? xpr)
    256256                        (compare? (car xpr) %where)))
     
    268268                   `(,%if (,%and ,@fenders)
    269269                      (,%begin ,@xprs)
    270                       (,%raise (,%seq-exception
     270                      (,%raise (,%bind-seq-exception
    271271                                 'bind
    272272                                 "fenders not passed"
     
    307307                       ((null? sentinel)
    308308                        (values pairs literals
    309                                 (cons `(,%seq-null?
    310                                          (,%seq-tail ,seq ,k))
     309                                (cons `(,%bind-seq-null?
     310                                         (,%bind-seq-tail ,seq ,k))
    311311                                      tails)))
    312312                       ((symbol? sentinel)
     
    314314                          (values pairs literals tails)
    315315                          (values (cons (list sentinel
    316                                               `(,%seq-tail ,seq ,k))
     316                                              `(,%bind-seq-tail ,seq ,k))
    317317                                        pairs)
    318318                                  literals tails)))
     
    320320                         (values pairs
    321321                                 (cons `(,%equal? ',sentinel
    322                                                   (,%seq-tail ,seq ,k))
     322                                                  (,%bind-seq-tail ,seq ,k))
    323323                                       literals)
    324324                                 tails))))
     
    330330                          (loop (+ k 1) pairs literals tails)
    331331                          (loop (+ k 1)
    332                                 (cons (list item `(,%seq-ref ,seq ,k)) pairs)
     332                                (cons (list item `(,%bind-seq-ref ,seq ,k)) pairs)
    333333                                literals
    334334                                tails)))
     
    337337                              pairs
    338338                              (cons `(,%equal? ',item
    339                                                (,%seq-ref ,seq ,k))
     339                                               (,%bind-seq-ref ,seq ,k))
    340340                                    literals)
    341341                              tails))
    342342                       ((pair? item)
    343343                        (receive (ps ls ts)
    344                           (destructure item `(,%seq-ref ,seq ,k))
     344                          (destructure item `(,%bind-seq-ref ,seq ,k))
    345345                          (loop (+ k 1)
    346346                                (append ps pairs)
     
    355355               (,%if (,%and ,@literals)
    356356                 (,(rename binder) ,pairs ,body)
    357                  (,%raise (,%seq-exception
     357                 (,%raise (,%bind-seq-exception
    358358                            'bind
    359359                            "literals don't match"
    360360                            ',literals)))
    361                (,%raise (,%seq-exception
     361               (,%raise (,%bind-seq-exception
    362362                          'bind
    363363                          "length mismatch"
     
    463463      (let loop ((binds (map rule->bind rules)) (pats '()))
    464464        (if (null? binds)
    465            `(raise (seq-exception 'bind-case "no match"
     465           `(raise (bind-seq-exception 'bind-case "no match"
    466466                                  ,seq
    467467                                  ',(reverse pats)))
     
    475475;  (syntax-rules ()
    476476;    ((_ seq)
    477 ;     (raise (seq-exception 'bind-case "no match for" seq)))
     477;     (raise (bind-seq-exception 'bind-case "no match for" seq)))
    478478;    ((_ seq (pat (where . fenders) xpr . xprs))
    479479;     (condition-case (bind pat seq (where . fenders) xpr . xprs)
     
    878878      (bindings sym ..)
    879879      "documentation procedure")
    880     (seq-exception
     880    (bind-seq-exception
    881881      procedure:
    882       (seq-exception loc . args)
     882      (bind-seq-exception loc . args)
    883883      "generates an exception to be raised")
    884     (seq-db
     884    (bind-seq-db
    885885      procedure:
    886       (seq-db)
     886      (bind-seq-db)
    887887      "shows the sequence database"
    888       (seq-db type ref: ref tail: tail)
     888      (bind-seq-db type ref: ref tail: tail)
    889889      "adds a new sequence type to the database where the keywords"
    890       "name arguments being accessed as seq-ref and seq-tail"
     890      "name arguments being accessed as bind-seq-ref and bind-seq-tail"
    891891      "respectively")
    892     (seq-ref
     892    (bind-seq-ref
    893893      procedure:
    894       (seq-ref seq k)
     894      (bind-seq-ref seq k)
    895895      "sequence analog of list-ref")
    896     (seq-tail
     896    (bind-seq-tail
    897897      procedure:
    898       (seq-tail seq k)
     898      (bind-seq-tail seq k)
    899899      "sequence analog of list-tail")
    900     (seq-null?
     900    (bind-seq-null?
    901901      procedure:
    902       (seq-null? xpr)
     902      (bind-seq-null? xpr)
    903903      "sequence analog of null?")
    904     (pseudo-list
     904    (bind-pseudo-list
    905905      procedure:
    906       (pseudo-list? xpr)
     906      (bind-pseudo-list? xpr)
    907907      "always #t")
    908908    (bind
  • release/5/bindings/tags/1.1/tests/run.scm

    r36333 r36356  
    128128
    129129;  "ADD ARRAYS TO GENERIC SEQUENCES"
    130 ;  (seq-db array? ref: array-ref tail: array-tail)
     130;  (bind-seq-db array? ref: array-ref tail: array-tail)
    131131;  (equal?
    132132;    (bind (x y z) (array 1 2 3) (list x y z))
  • release/5/bindings/trunk/bindings.egg

    r36333 r36356  
    55 (test-dependencies simple-tests)
    66 (author "Juergen Lorenz")
    7  (version "1.0")
     7 (version "1.1")
    88 (components (extension bindings)))
  • release/5/bindings/trunk/bindings.scm

    r36333 r36356  
    7171
    7272Sequences are either lists, psuedolists, vectors or strings by default.
    73 The sequence operators needed are seq-ref, seq-tail and seq-null? with
     73The sequence operators needed are bind-seq-ref, bind-seq-tail and bind-seq-null? with
    7474the same syntax as the likely named list routines.  But there is a
    75 procedure, seq-db, which allows to add a pair consisting of a type
     75procedure, bind-seq-db, which allows to add a pair consisting of a type
    7676predicate and a vector containing the needed operators to a database.
    7777
     
    8282   bind-case-lambda* bind-named bind-let bind-let* bind-letrec bindrec
    8383   bindable? bind-define bind-set! bind/cc bindings
    84    seq-db seq-ref seq-tail seq-null? seq-exception pseudo-list?)
     84   bind-seq-db bind-seq-ref bind-seq-tail bind-seq-null? bind-seq-exception bind-pseudo-list?)
    8585
    8686  (import scheme
     
    9797;;; exceptions
    9898;;; ----------
    99 (define seq-exception
     99(define bind-seq-exception
    100100  (make-exception "sequence exception" 'sequence))
    101101
     
    107107(define-inline (0<= n) (fx>= n 0))
    108108
    109 (define (pseudo-list? xpr) #t)
    110 
    111 ;;; (seq-ref seq k)
     109(define (bind-pseudo-list? xpr) #t)
     110
     111;;; (bind-seq-ref seq k)
    112112;;; ---------------
    113113;;; access to a sequence item
    114 ;;; the second returned value is needed in seq-null?
    115 (define (seq-ref seq k)
    116   (assert (0<= k) 'seq-ref)
     114;;; the second returned value is needed in bind-seq-null?
     115(define (bind-seq-ref seq k)
     116  (assert (0<= k) 'bind-seq-ref)
    117117  (values
    118     (let loop ((db (seq-db)))
    119       ;; Since everything is a pseudo-list, which is checked last
     118    (let loop ((db (bind-seq-db)))
     119      ;; Since everything is a bind-pseudo-list, which is checked last
    120120      ;; db is never empty
    121121      (if ((caar db) seq)
     
    124124    #f))
    125125
    126 ;;; (seq-tail seq k)
     126;;; (bind-seq-tail seq k)
    127127;;; ----------------
    128128;;; access to the tail of a sequence
    129 (define (seq-tail seq k)
    130   (assert (0<= k) 'seq-tail)
    131   (let loop ((db (seq-db)))
    132     ;; Since everything is a pseudo-list, which is checked last
     129(define (bind-seq-tail seq k)
     130  (assert (0<= k) 'bind-seq-tail)
     131  (let loop ((db (bind-seq-db)))
     132    ;; Since everything is a bind-pseudo-list, which is checked last
    133133    ;; db is never empty
    134134    (if ((caar db) seq)
     
    136136      (loop (cdr db)))))
    137137
    138 ;;; (seq-null? seq)
     138;;; (bind-seq-null? seq)
    139139;;; ---------------
    140140;;; tests for emptiness of a sequence
    141 (define (seq-null? seq)
     141(define (bind-seq-null? seq)
    142142  (receive (result out-of-bounds?)
    143     (condition-case (seq-ref seq 0)
     143    (condition-case (bind-seq-ref seq 0)
    144144      ((exn) (values #t #t)))
    145145    (if out-of-bounds? #t #f)))
    146146
    147 ;;; (seq-db type? ref: ref tail: tail)
     147;;; (bind-seq-db type? ref: ref tail: tail)
    148148;;; ---------------------------------
    149149;;; adds a new sequence type to the front of the database
    150 ;;; (seq-db)
     150;;; (bind-seq-db)
    151151;;; --------
    152152;;; shows the sequence database
    153 (define seq-db
     153(define bind-seq-db
    154154  (let ((db (list (cons list? (vector list-ref list-tail))
    155155                  (cons vector? (vector vector-ref subvector))
    156156                  (cons string? (vector string-ref substring))
    157                   (cons pseudo-list?
     157                  (cons bind-pseudo-list?
    158158                        (vector (lambda (pl k) ; ref
    159159                                  (let loop ((pl pl) (n 0))
     
    164164                                       (loop (cdr pl) (1+ n)))
    165165                                      (else
    166                                         (raise (seq-exception 'seq-ref
     166                                        (raise (bind-seq-exception 'bind-seq-ref
    167167                                                              "out of range"
    168168                                                              pl k))))))
     
    175175                                       (loop (cdr pl) (1+ n)))
    176176                                      (else
    177                                         (raise (seq-exception 'seq-tail
     177                                        (raise (bind-seq-exception 'bind-seq-tail
    178178                                                              "out of range"
    179179                                                              pl k))))))
     
    198198                               ((cadar args) seq k)
    199199                               ((exn)
    200                                 (raise (seq-exception 'seq-ref
     200                                (raise (bind-seq-exception 'bind-seq-ref
    201201                                                      "out of range"
    202202                                                      seq k)))))))
     
    208208                               ((cadar args) seq k)
    209209                               ((exn)
    210                                 (raise (seq-exception 'seq-tail
     210                                (raise (bind-seq-exception 'bind-seq-tail
    211211                                                      "out of range"
    212212                                                      seq k)))))))
    213213             (else
    214                (raise (seq-exception 'seq-db
     214               (raise (bind-seq-exception 'bind-seq-db
    215215                                     "not a keyword"
    216216                                     (caar args))))
     
    249249        (%error (rename 'error))
    250250        (%equal? (rename 'equal?))
    251         (%seq-ref (rename 'seq-ref))
    252         (%seq-tail (rename 'seq-tail))
    253         (%seq-null? (rename 'seq-null?))
    254         (%seq-exception (rename 'seq-exception)))
     251        (%bind-seq-ref (rename 'bind-seq-ref))
     252        (%bind-seq-tail (rename 'bind-seq-tail))
     253        (%bind-seq-null? (rename 'bind-seq-null?))
     254        (%bind-seq-exception (rename 'bind-seq-exception)))
    255255    (let* ((fenders? (and (pair? xpr)
    256256                        (compare? (car xpr) %where)))
     
    268268                   `(,%if (,%and ,@fenders)
    269269                      (,%begin ,@xprs)
    270                       (,%raise (,%seq-exception
     270                      (,%raise (,%bind-seq-exception
    271271                                 'bind
    272272                                 "fenders not passed"
     
    307307                       ((null? sentinel)
    308308                        (values pairs literals
    309                                 (cons `(,%seq-null?
    310                                          (,%seq-tail ,seq ,k))
     309                                (cons `(,%bind-seq-null?
     310                                         (,%bind-seq-tail ,seq ,k))
    311311                                      tails)))
    312312                       ((symbol? sentinel)
     
    314314                          (values pairs literals tails)
    315315                          (values (cons (list sentinel
    316                                               `(,%seq-tail ,seq ,k))
     316                                              `(,%bind-seq-tail ,seq ,k))
    317317                                        pairs)
    318318                                  literals tails)))
     
    320320                         (values pairs
    321321                                 (cons `(,%equal? ',sentinel
    322                                                   (,%seq-tail ,seq ,k))
     322                                                  (,%bind-seq-tail ,seq ,k))
    323323                                       literals)
    324324                                 tails))))
     
    330330                          (loop (+ k 1) pairs literals tails)
    331331                          (loop (+ k 1)
    332                                 (cons (list item `(,%seq-ref ,seq ,k)) pairs)
     332                                (cons (list item `(,%bind-seq-ref ,seq ,k)) pairs)
    333333                                literals
    334334                                tails)))
     
    337337                              pairs
    338338                              (cons `(,%equal? ',item
    339                                                (,%seq-ref ,seq ,k))
     339                                               (,%bind-seq-ref ,seq ,k))
    340340                                    literals)
    341341                              tails))
    342342                       ((pair? item)
    343343                        (receive (ps ls ts)
    344                           (destructure item `(,%seq-ref ,seq ,k))
     344                          (destructure item `(,%bind-seq-ref ,seq ,k))
    345345                          (loop (+ k 1)
    346346                                (append ps pairs)
     
    355355               (,%if (,%and ,@literals)
    356356                 (,(rename binder) ,pairs ,body)
    357                  (,%raise (,%seq-exception
     357                 (,%raise (,%bind-seq-exception
    358358                            'bind
    359359                            "literals don't match"
    360360                            ',literals)))
    361                (,%raise (,%seq-exception
     361               (,%raise (,%bind-seq-exception
    362362                          'bind
    363363                          "length mismatch"
     
    463463      (let loop ((binds (map rule->bind rules)) (pats '()))
    464464        (if (null? binds)
    465            `(raise (seq-exception 'bind-case "no match"
     465           `(raise (bind-seq-exception 'bind-case "no match"
    466466                                  ,seq
    467467                                  ',(reverse pats)))
     
    475475;  (syntax-rules ()
    476476;    ((_ seq)
    477 ;     (raise (seq-exception 'bind-case "no match for" seq)))
     477;     (raise (bind-seq-exception 'bind-case "no match for" seq)))
    478478;    ((_ seq (pat (where . fenders) xpr . xprs))
    479479;     (condition-case (bind pat seq (where . fenders) xpr . xprs)
     
    878878      (bindings sym ..)
    879879      "documentation procedure")
    880     (seq-exception
     880    (bind-seq-exception
    881881      procedure:
    882       (seq-exception loc . args)
     882      (bind-seq-exception loc . args)
    883883      "generates an exception to be raised")
    884     (seq-db
     884    (bind-seq-db
    885885      procedure:
    886       (seq-db)
     886      (bind-seq-db)
    887887      "shows the sequence database"
    888       (seq-db type ref: ref tail: tail)
     888      (bind-seq-db type ref: ref tail: tail)
    889889      "adds a new sequence type to the database where the keywords"
    890       "name arguments being accessed as seq-ref and seq-tail"
     890      "name arguments being accessed as bind-seq-ref and bind-seq-tail"
    891891      "respectively")
    892     (seq-ref
     892    (bind-seq-ref
    893893      procedure:
    894       (seq-ref seq k)
     894      (bind-seq-ref seq k)
    895895      "sequence analog of list-ref")
    896     (seq-tail
     896    (bind-seq-tail
    897897      procedure:
    898       (seq-tail seq k)
     898      (bind-seq-tail seq k)
    899899      "sequence analog of list-tail")
    900     (seq-null?
     900    (bind-seq-null?
    901901      procedure:
    902       (seq-null? xpr)
     902      (bind-seq-null? xpr)
    903903      "sequence analog of null?")
    904     (pseudo-list
     904    (bind-pseudo-list
    905905      procedure:
    906       (pseudo-list? xpr)
     906      (bind-pseudo-list? xpr)
    907907      "always #t")
    908908    (bind
  • release/5/bindings/trunk/tests/run.scm

    r36333 r36356  
    128128
    129129;  "ADD ARRAYS TO GENERIC SEQUENCES"
    130 ;  (seq-db array? ref: array-ref tail: array-tail)
     130;  (bind-seq-db array? ref: array-ref tail: array-tail)
    131131;  (equal?
    132132;    (bind (x y z) (array 1 2 3) (list x y z))
Note: See TracChangeset for help on using the changeset viewer.