Changeset 37352 in project


Ignore:
Timestamp:
03/06/19 11:48:43 (3 months ago)
Author:
juergen
Message:

bindings 1.5 prepared for use in lazy-pairs

Location:
release/5/bindings
Files:
2 edited
4 copied

Legend:

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

    r37331 r37352  
    55 (test-dependencies simple-tests)
    66 (author "Juergen Lorenz")
    7  (version "1.4")
     7 (version "1.5")
    88 (components (extension bindings)))
  • release/5/bindings/tags/1.5/bindings.scm

    r37331 r37352  
    8282   bind-case-lambda* bind-named bind-let bind-let* bind-letrec bindrec
    8383   bindable? bind-define bind-set! bind/cc bindings bind-seq-db
    84         bind-seq-ref bind-seq-tail bind-seq-null? bind-seq-exception
    85          bind-pseudo-list?)
     84  bind-seq-ref bind-seq-tail bind-seq-null? bind-seq-exception
     85   bind-pseudo-list? eos)
    8686
    8787  (import scheme
    8888          (only (chicken base)
    8989                case-lambda receive error assert define-inline
    90                 subvector chop print)
     90                subvector chop print gensym)
    9191          (only (chicken condition) condition-case)
    9292          (only (chicken fixnum) fx+ fx- fx= fx>=)
     
    9696                     (only (chicken keyword) keyword?))
    9797
     98;;; needed in lazy-pairs
     99(define eos (gensym 'eos))
     100
    98101;;; exceptions
    99102;;; ----------
     
    111114
    112115;;; (bind-seq-ref seq k)
    113 ;;; ---------------
     116;;; --------------------
    114117;;; access to a sequence item
    115118;;; the second returned value is needed in bind-seq-null?
     
    126129
    127130;;; (bind-seq-tail seq k)
    128 ;;; ----------------
     131;;; ---------------------
    129132;;; access to the tail of a sequence
    130133(define (bind-seq-tail seq k)
     
    138141
    139142;;; (bind-seq-null? seq)
    140 ;;; ---------------
     143;;; --------------------
    141144;;; tests for emptiness of a sequence
    142145(define (bind-seq-null? seq)
     
    144147    (condition-case (bind-seq-ref seq 0)
    145148      ((exn) (values #t #t)))
    146     (if out-of-bounds? #t #f)))
     149    ;(if out-of-bounds? #t #f)))
     150    (cond
     151      ((eq? #t result) ; exn
     152       (if out-of-bounds? #t #f))
     153      ((and (symbol? result) (eq? result eos)) ; gensym, lazy-list
     154       #t)
     155      (else #f)
     156       )))
     157
    147158
    148159;;; (bind-seq-db type? ref: ref tail: tail)
    149 ;;; ---------------------------------
     160;;; ---------------------------------------
    150161;;; adds a new sequence type to the front of the database
    151162;;; (bind-seq-db)
    152 ;;; --------
     163;;; -------------
    153164;;; shows the sequence database
    154165(define bind-seq-db
     
    335346                                tails)))
    336347                       ;((atom? item) ; literal
    337                                                                                         ((and (not (pair? item)) (not (null? item)))
     348                      ((and (not (pair? item)) (not (null? item)))
    338349                        (loop (+ k 1)
    339350                              pairs
     
    343354                              tails))
    344355                       ;((pair? item)
    345                                                                                         ((or (null? item) (pair? item))
     356                      ((or (null? item) (pair? item))
    346357                        (receive (ps ls ts)
    347358                          (destructure item `(,%bind-seq-ref ,seq ,k))
     
    407418           ;             (cons pat
    408419           ;                   (cons %seq body)))))))))
    409                                         ,(apply list %bind-with %let pat %seq body))))))
     420          ,(apply list %bind-with %let pat %seq body))))))
    410421
    411422#|[
  • release/5/bindings/trunk/bindings.egg

    r37331 r37352  
    55 (test-dependencies simple-tests)
    66 (author "Juergen Lorenz")
    7  (version "1.4")
     7 (version "1.5")
    88 (components (extension bindings)))
  • release/5/bindings/trunk/bindings.scm

    r37331 r37352  
    8282   bind-case-lambda* bind-named bind-let bind-let* bind-letrec bindrec
    8383   bindable? bind-define bind-set! bind/cc bindings bind-seq-db
    84         bind-seq-ref bind-seq-tail bind-seq-null? bind-seq-exception
    85          bind-pseudo-list?)
     84  bind-seq-ref bind-seq-tail bind-seq-null? bind-seq-exception
     85   bind-pseudo-list? eos)
    8686
    8787  (import scheme
    8888          (only (chicken base)
    8989                case-lambda receive error assert define-inline
    90                 subvector chop print)
     90                subvector chop print gensym)
    9191          (only (chicken condition) condition-case)
    9292          (only (chicken fixnum) fx+ fx- fx= fx>=)
     
    9696                     (only (chicken keyword) keyword?))
    9797
     98;;; needed in lazy-pairs
     99(define eos (gensym 'eos))
     100
    98101;;; exceptions
    99102;;; ----------
     
    111114
    112115;;; (bind-seq-ref seq k)
    113 ;;; ---------------
     116;;; --------------------
    114117;;; access to a sequence item
    115118;;; the second returned value is needed in bind-seq-null?
     
    126129
    127130;;; (bind-seq-tail seq k)
    128 ;;; ----------------
     131;;; ---------------------
    129132;;; access to the tail of a sequence
    130133(define (bind-seq-tail seq k)
     
    138141
    139142;;; (bind-seq-null? seq)
    140 ;;; ---------------
     143;;; --------------------
    141144;;; tests for emptiness of a sequence
    142145(define (bind-seq-null? seq)
     
    144147    (condition-case (bind-seq-ref seq 0)
    145148      ((exn) (values #t #t)))
    146     (if out-of-bounds? #t #f)))
     149    ;(if out-of-bounds? #t #f)))
     150    (cond
     151      ((eq? #t result) ; exn
     152       (if out-of-bounds? #t #f))
     153      ((and (symbol? result) (eq? result eos)) ; gensym, lazy-list
     154       #t)
     155      (else #f)
     156       )))
     157
    147158
    148159;;; (bind-seq-db type? ref: ref tail: tail)
    149 ;;; ---------------------------------
     160;;; ---------------------------------------
    150161;;; adds a new sequence type to the front of the database
    151162;;; (bind-seq-db)
    152 ;;; --------
     163;;; -------------
    153164;;; shows the sequence database
    154165(define bind-seq-db
     
    335346                                tails)))
    336347                       ;((atom? item) ; literal
    337                                                                                         ((and (not (pair? item)) (not (null? item)))
     348                      ((and (not (pair? item)) (not (null? item)))
    338349                        (loop (+ k 1)
    339350                              pairs
     
    343354                              tails))
    344355                       ;((pair? item)
    345                                                                                         ((or (null? item) (pair? item))
     356                      ((or (null? item) (pair? item))
    346357                        (receive (ps ls ts)
    347358                          (destructure item `(,%bind-seq-ref ,seq ,k))
     
    407418           ;             (cons pat
    408419           ;                   (cons %seq body)))))))))
    409                                         ,(apply list %bind-with %let pat %seq body))))))
     420          ,(apply list %bind-with %let pat %seq body))))))
    410421
    411422#|[
Note: See TracChangeset for help on using the changeset viewer.