Loris  Check-in [e839f3b951]

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Add procedure make-chain-pred, which makes procedures taking any number of arguments and compares them two-and-two, in the order given, with a supplied predicate. For example: (define string-or-number= (make-chain-pred (lambda (a b) (= (if (string? a) (string->number a) a) (if (string? b) (string->number b) b))))) (string-or-number= "50" 50 "000050.00") will now evaluate to #t.
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:e839f3b9516143e61fdc669b483b7697cb374bb7
User & Date: jesper 2016-04-16 11:27:33
Context
2016-04-16
11:30
Use newly added make-chain-pred in constructing version comparisors check-in: 50a6cdb35a user: jesper tags: trunk
11:27
Add procedure make-chain-pred, which makes procedures taking any number of arguments and compares them two-and-two, in the order given, with a supplied predicate. For example: (define string-or-number= (make-chain-pred (lambda (a b) (= (if (string? a) (string->number a) a) (if (string? b) (string->number b) b))))) (string-or-number= "50" 50 "000050.00") will now evaluate to #t. check-in: e839f3b951 user: jesper tags: trunk
2016-04-15
23:27
Document our difference from semver.org. check-in: 6efeb03b55 user: jesper tags: trunk
Changes

Changes to convenience.scm.

20
21
22
23
24
25
26

27
28
29
30
31
32
33
..
81
82
83
84
85
86
87





















88
89
90
91
92
93
94
(define-library (loris convenience)
  (import (scheme base)
          (scheme write)
          (scheme case-lambda)
          (srfi 1))
  (export ->string conc
          alist-ref alist-update alist-combine

          with-exception-handler*
          cdip caip nand nor xor
          with-input-from-file* with-output-to-file*)
  (begin
    (define (->string o)
      (cond ((string? o) o)
            ((char? o) (string o))
................................................................................
                                               (loop (cdr rest)
                                                     (alist-update (caar rest)
                                                                   (if orig
                                                                       (comb orig (cdar rest))
                                                                       (cdar rest))
                                                                   result)))))))))))
        (fold combine '() tail)))






















    (define-syntax with-exception-handler*
      (syntax-rules ()
        ((_ handler body ...) (with-exception-handler handler (lambda () body ...)))))

    (define-syntax with-output-to-file*
      (syntax-rules ()







>







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
..
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
(define-library (loris convenience)
  (import (scheme base)
          (scheme write)
          (scheme case-lambda)
          (srfi 1))
  (export ->string conc
          alist-ref alist-update alist-combine
          make-chain-pred
          with-exception-handler*
          cdip caip nand nor xor
          with-input-from-file* with-output-to-file*)
  (begin
    (define (->string o)
      (cond ((string? o) o)
            ((char? o) (string o))
................................................................................
                                               (loop (cdr rest)
                                                     (alist-update (caar rest)
                                                                   (if orig
                                                                       (comb orig (cdar rest))
                                                                       (cdar rest))
                                                                   result)))))))))))
        (fold combine '() tail)))

    ;; Make a procedure taking an infinite number of arguments,
    ;; comparing them in sequence with pred?, which must be a lambda
    ;; taking two arguments.
    ;;
    ;; For example:
    ;;
    ;;   (define string-or-number=
    ;;    (make-chain-pred (lambda (a b)
    ;;                       (= (if (string? a) (string->number a) a)
    ;;                          (if (string? b) (string->number b) b)))))
    ;;
    ;; (string-or-number= "50" 50 "000050.00") will now evaluate to #t.
    (define (make-chain-pred pred?)
      (lambda (head . tail)
        (let test ((head head) (tail tail))
          (cond
           ((null? tail))
           ((not (pred? head (car tail))) #f)
           (else (test (car tail) (cdr tail)))))))
          

    (define-syntax with-exception-handler*
      (syntax-rules ()
        ((_ handler body ...) (with-exception-handler handler (lambda () body ...)))))

    (define-syntax with-output-to-file*
      (syntax-rules ()

Changes to version.scm.

23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
..
50
51
52
53
54
55
56



57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74











75
76
77
78
79
80
81
(define-library (loris version)
  (import (scheme base)
          (scheme case-lambda)
          (loris convenience)
          (srfi 1)
          (srfi 13)
          (srfi 14))
  (export semantic full-semantic assert tokenise-semantic-version)
  (begin
    (define version (list 2 1 0	        ; version:      numeric (major, minor, patch)
                          "devel"       ; pre-release:  #f or alphanumeric string (no hyphens!)
                          #f))          ; metadata:     #f or alphanumeric string (no hyphens!)

    (define (tokenise-semantic-version v)
      (if (not v) '()
................................................................................
      
    (define (semantic)
      (make-semantic (car version) (cadr version)))

    (define (full-semantic)
      (apply make-semantic version))




    (define (version-number< a b)
      (cond ((and (number? a) (not (number? b))) #t)
            ((and (not (number? a)) (number? b)) #f)
            ((and (number? a) (number? b)) (< a b))
            (else (string< a b))))

    (define version-number=? equal?)
    (define semantic-version=? equal?)	; works since equal? is list recursive as it is

    (define (semantic-version< a-list b-list)
      (let check ((a a-list)
                  (b b-list))
        (cond ((null? b) #f)
              ((null? a) #t)
              ((version-number< (car a) (car b)) #t)
              ((version-number< (car b) (car a)) #f)
              (else (check (cdr a) (cdr b))))))












    (define (compatible? wanted actual)
      ;; Unparse any prerelease tags present and append them to (list
      ;; MINOR PATCH).  We're not interested in the MAJOR version,
      ;; since checking for compatiblity simply means applying equal?
      ;; to them.
      (let ((wanted-tail (append (cdr (take wanted 3))
                                 (if (< 3 (length wanted))







|







 







>
>
>
|





<
<
<
|








>
>
>
>
>
>
>
>
>
>
>







23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
..
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65



66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
(define-library (loris version)
  (import (scheme base)
          (scheme case-lambda)
          (loris convenience)
          (srfi 1)
          (srfi 13)
          (srfi 14))
  (export semantic full-semantic assert tokenise-semantic-version version-number< semantic-version<)
  (begin
    (define version (list 2 1 0	        ; version:      numeric (major, minor, patch)
                          "devel"       ; pre-release:  #f or alphanumeric string (no hyphens!)
                          #f))          ; metadata:     #f or alphanumeric string (no hyphens!)

    (define (tokenise-semantic-version v)
      (if (not v) '()
................................................................................
      
    (define (semantic)
      (make-semantic (car version) (cadr version)))

    (define (full-semantic)
      (apply make-semantic version))

    (define version-number=? equal?)
    (define semantic-version=? equal?)	; works since equal? is list recursive as it is

    (define (version-number</compare-two a b)
      (cond ((and (number? a) (not (number? b))) #t)
            ((and (not (number? a)) (number? b)) #f)
            ((and (number? a) (number? b)) (< a b))
            (else (string< a b))))




    (define (semantic-version</compare-two a-list b-list)
      (let check ((a a-list)
                  (b b-list))
        (cond ((null? b) #f)
              ((null? a) #t)
              ((version-number< (car a) (car b)) #t)
              ((version-number< (car b) (car a)) #f)
              (else (check (cdr a) (cdr b))))))

    (define (make-lesser-than is<)
      (lambda (num1 . more-nums)
        (let loop ((lesser num1)
                   (rest more-nums))
          (cond ((null? rest) #t)
                ((not (is< lesser (car rest))) #f)
                (else (loop (car rest) (cdr rest)))))))

    (define version-number< (make-lesser-than version-number</compare-two))
    (define semantic-version< (make-lesser-than semantic-version</compare-two))

    (define (compatible? wanted actual)
      ;; Unparse any prerelease tags present and append them to (list
      ;; MINOR PATCH).  We're not interested in the MAJOR version,
      ;; since checking for compatiblity simply means applying equal?
      ;; to them.
      (let ((wanted-tail (append (cdr (take wanted 3))
                                 (if (< 3 (length wanted))