Changeset 31233 in project


Ignore:
Timestamp:
08/18/14 13:03:07 (5 years ago)
Author:
juergen
Message:

list-bind corrected, list-in? added, record-printer changed

Location:
release/4/typed-lists
Files:
3 edited
5 copied

Legend:

Unmodified
Added
Removed
  • release/4/typed-lists/tags/1.1/tests/run.scm

    r31219 r31233  
    128128    (list-not-every? odd? (typed-list 1 2 3))
    129129    (list-not-any? odd? (typed-list 2 4 6))
     130    (list-in? (typed-list 2 3) (typed-list 1 2 3))
     131    (not (list-in? (typed-list 1 2 3) (typed-list 2 3)))
     132    (not (list-in? (typed-list 1 2 3) (typed-list 2 1 3)))
     133    (list-in? (typed-list) (typed-list 2 3))
    130134    ))
    131135
     
    234238        (sym-list-bind (x . y) (sym-typed-list 'a 'b 'c) y)
    235239      (sym-typed-list 'b 'c))
     240    (xpr:val
     241      (sym-list-bind (x . y) (sym-typed-list 'a 'b) (list x y)))
    236242    (sym-list-null? (sym-list-bind x (sym-list-null) x))
    237243    (sym-list-bind () (sym-list-null) #t)
  • release/4/typed-lists/tags/1.1/typed-lists.scm

    r31219 r31233  
    4646   list-drop list-drop-while list-take list-take-while list-repeat list-iterate
    4747   list-iterate-while list-iterate-until list-zip list-interpose list-every?
    48    list-some list-not-every? list-not-any? list-bind
     48   list-some list-not-every? list-not-any? list-in? list-bind
    4949   ;sets
    5050   sets set? set typed-list->set set->typed-list set-in?  set-cardinality
     
    6969    (rest typed-list?)))
    7070
    71 (define-record-printer (typed-list lst out)
    72   (display (typed-list->untyped-list lst) out))
     71(define-record-printer (typed-list tlst out)
     72  (let ((str (sprintf "~s" (typed-list->untyped-list tlst))))
     73    (string-set! str (- (string-length str) 1) #\])
     74    (string-set! str 0 #\[)
     75    (display str out)))
     76
     77;(define-reader-ctor 'typed typed-list)
    7378
    7479(define (list-null? xpr)
     
    114119              `(if (<= ,(length head) (list-length ,tlst))
    115120                 (receive (hd tl) (list-split-at ,(length head) ,tlst)
    116                    (list-apply
    117                      (compose
    118                        untyped-list->typed-list
    119                        (list-apply (lambda ,head
    120                                      (lambda ,tail ,xpr ,@xprs)) hd))
    121                      tl))
     121                   (let ((,tail tl))
     122                     (list-apply (lambda ,head ,xpr ,@xprs) hd)))
    122123                 (error 'list-bind "match error" ',pat ,tlst)))))))))
    123124
     
    534535           (loop rest))))))
    535536
     537(define (list-in? tlst1 tlst2)
     538  (cases typed-list tlst1
     539    (list-null () #t)
     540    (list-cons (first rest)
     541      (let ((start (list-member first tlst2)))
     542        (if start
     543          (let loop ((ls0 tlst1) (ls1 start))
     544            (cond
     545              ((and (list-null? ls0) (list-null? ls1)) #t)
     546              ((list-null? ls0) #t)
     547              ((list-null? ls1) #f)
     548              ((equ? (list-first ls0) (list-first ls1))
     549               (loop (list-rest ls0) (list-rest ls1)))
     550              (else #f)))
     551          #f)))))
     552
    536553;;; documentation
    537554(define typed-lists
     
    588605      (list-not-every? ok? tlst)
    589606      (list-not-any? ok? tlst)
     607      (list-in? tlst0 tlst1)
    590608      (list-bind (x ... . xs) tlst xpr . xprs)
    591609      ))
  • release/4/typed-lists/tags/1.1/typed-lists.setup

    r31219 r31233  
    77 'typed-lists
    88 '("typed-lists.so" "typed-lists.import.so")
    9  '((version "1.0")))
     9 '((version "1.1")))
    1010
  • release/4/typed-lists/trunk/tests/run.scm

    r31219 r31233  
    128128    (list-not-every? odd? (typed-list 1 2 3))
    129129    (list-not-any? odd? (typed-list 2 4 6))
     130    (list-in? (typed-list 2 3) (typed-list 1 2 3))
     131    (not (list-in? (typed-list 1 2 3) (typed-list 2 3)))
     132    (not (list-in? (typed-list 1 2 3) (typed-list 2 1 3)))
     133    (list-in? (typed-list) (typed-list 2 3))
    130134    ))
    131135
     
    234238        (sym-list-bind (x . y) (sym-typed-list 'a 'b 'c) y)
    235239      (sym-typed-list 'b 'c))
     240    (xpr:val
     241      (sym-list-bind (x . y) (sym-typed-list 'a 'b) (list x y)))
    236242    (sym-list-null? (sym-list-bind x (sym-list-null) x))
    237243    (sym-list-bind () (sym-list-null) #t)
  • release/4/typed-lists/trunk/typed-lists.scm

    r31219 r31233  
    4646   list-drop list-drop-while list-take list-take-while list-repeat list-iterate
    4747   list-iterate-while list-iterate-until list-zip list-interpose list-every?
    48    list-some list-not-every? list-not-any? list-bind
     48   list-some list-not-every? list-not-any? list-in? list-bind
    4949   ;sets
    5050   sets set? set typed-list->set set->typed-list set-in?  set-cardinality
     
    6969    (rest typed-list?)))
    7070
    71 (define-record-printer (typed-list lst out)
    72   (display (typed-list->untyped-list lst) out))
     71(define-record-printer (typed-list tlst out)
     72  (let ((str (sprintf "~s" (typed-list->untyped-list tlst))))
     73    (string-set! str (- (string-length str) 1) #\])
     74    (string-set! str 0 #\[)
     75    (display str out)))
     76
     77;(define-reader-ctor 'typed typed-list)
    7378
    7479(define (list-null? xpr)
     
    114119              `(if (<= ,(length head) (list-length ,tlst))
    115120                 (receive (hd tl) (list-split-at ,(length head) ,tlst)
    116                    (list-apply
    117                      (compose
    118                        untyped-list->typed-list
    119                        (list-apply (lambda ,head
    120                                      (lambda ,tail ,xpr ,@xprs)) hd))
    121                      tl))
     121                   (let ((,tail tl))
     122                     (list-apply (lambda ,head ,xpr ,@xprs) hd)))
    122123                 (error 'list-bind "match error" ',pat ,tlst)))))))))
    123124
     
    534535           (loop rest))))))
    535536
     537(define (list-in? tlst1 tlst2)
     538  (cases typed-list tlst1
     539    (list-null () #t)
     540    (list-cons (first rest)
     541      (let ((start (list-member first tlst2)))
     542        (if start
     543          (let loop ((ls0 tlst1) (ls1 start))
     544            (cond
     545              ((and (list-null? ls0) (list-null? ls1)) #t)
     546              ((list-null? ls0) #t)
     547              ((list-null? ls1) #f)
     548              ((equ? (list-first ls0) (list-first ls1))
     549               (loop (list-rest ls0) (list-rest ls1)))
     550              (else #f)))
     551          #f)))))
     552
    536553;;; documentation
    537554(define typed-lists
     
    588605      (list-not-every? ok? tlst)
    589606      (list-not-any? ok? tlst)
     607      (list-in? tlst0 tlst1)
    590608      (list-bind (x ... . xs) tlst xpr . xprs)
    591609      ))
  • release/4/typed-lists/trunk/typed-lists.setup

    r31219 r31233  
    77 'typed-lists
    88 '("typed-lists.so" "typed-lists.import.so")
    9  '((version "1.0")))
     9 '((version "1.1")))
    1010
Note: See TracChangeset for help on using the changeset viewer.