Changeset 33705 in project


Ignore:
Timestamp:
10/10/16 14:54:40 (3 years ago)
Author:
juergen
Message:

holes 1.2 with holes aguments numerically ordered

Location:
release/4/holes
Files:
3 edited
5 copied

Legend:

Unmodified
Added
Removed
  • release/4/holes/tags/1.2/holes.scm

    r33696 r33705  
    8989          (lambda (ok? lst)
    9090            (compress (map ok? lst) lst)))
    91         (remove-dups
    92           (lambda (syms)
    93             (let loop ((syms syms) (result '()))
     91        (ninsert
     92          (lambda (n lon)
     93            (let loop ((lon lon))
    9494              (cond
    95                 ((null? syms)
    96                  (reverse result))
    97                 ((memq (car syms) result)
    98                  (loop (cdr syms) result))
    99                 (else (loop (cdr syms) (cons (car syms) result)))))))
     95                ((null? lon) (list n))
     96                ((= n (car lon)) lon)
     97                ((< n (car lon)) (cons n lon))
     98                ((> n (car lon))
     99                 (cons (car lon) (loop (cdr lon))))))))
     100        )
     101        (let* (
     102          (nsort
     103            (lambda (lon)
     104              (let loop ((lon lon) (result '()))
     105                (if (null? lon)
     106                  result
     107                  (loop (cdr lon) (ninsert (car lon) result))))))
     108          (hsort
     109            (lambda (holes)
     110              (let* (
     111                (strings (map symbol->string holes))
     112                (substrings
     113                  (map (lambda (s)
     114                         (substring s 1 (fx- (string-length s) 1)))
     115                       strings))
     116                (nums (map string->number
     117                           (filter (lambda (s)
     118                                     (not (string=? s "")))
     119                                   substrings)))
     120                (snums (nsort nums))
     121                (sstrings (map (lambda (s)
     122                                 (string-append "!" s "!"))
     123                               (map number->string snums)))
     124                (sholes (map string->symbol sstrings))
     125                )
     126                (if (memq '!! holes)
     127                  (cons '!! sholes)
     128                  sholes))))
    100129          )
    101130          `(,%lambda
    102              ,(remove-dups (filter hole? (flatten* code)))
    103              ,@code)))))
     131             ,(hsort (filter hole? (flatten* code)))
     132             ,@code))))))
    104133
    105134(set-sharp-read-syntax! #\#
     
    113142          "  extracts holes, i.e. a pair of bangs"
    114143          "  possible enclosing a seqence of digits"
    115           "  form code, removes duplicates, and uses"
     144          "  form code, sorts them numerically while"
     145          "  removing duplicates, and uses"
    116146          "  the resulting list as argument list of"
    117147          "  a procedure with body code."
  • release/4/holes/tags/1.2/holes.setup

    r33696 r33705  
    77 'holes
    88 '("holes.so" "holes.import.so")
    9  '((version "1.1")))
     9 '((version "1.2")))
    1010
  • release/4/holes/tags/1.2/tests/run.scm

    r33696 r33705  
    4242    (equal? (##(list !! !1! 2 (vector !!)) 1 2)
    4343            '(1 2 2 #(1)))
     44    (equal? (##(cons !2! !1!) 1 2) '(2 . 1))
     45    (equal? (##(list (cons !2! !1!) (cons !1! !2!)) 1 2)
     46            '((2 . 1) (1 . 2)))
    4447  ))
    4548
  • release/4/holes/trunk/holes.scm

    r33696 r33705  
    8989          (lambda (ok? lst)
    9090            (compress (map ok? lst) lst)))
    91         (remove-dups
    92           (lambda (syms)
    93             (let loop ((syms syms) (result '()))
     91        (ninsert
     92          (lambda (n lon)
     93            (let loop ((lon lon))
    9494              (cond
    95                 ((null? syms)
    96                  (reverse result))
    97                 ((memq (car syms) result)
    98                  (loop (cdr syms) result))
    99                 (else (loop (cdr syms) (cons (car syms) result)))))))
     95                ((null? lon) (list n))
     96                ((= n (car lon)) lon)
     97                ((< n (car lon)) (cons n lon))
     98                ((> n (car lon))
     99                 (cons (car lon) (loop (cdr lon))))))))
     100        )
     101        (let* (
     102          (nsort
     103            (lambda (lon)
     104              (let loop ((lon lon) (result '()))
     105                (if (null? lon)
     106                  result
     107                  (loop (cdr lon) (ninsert (car lon) result))))))
     108          (hsort
     109            (lambda (holes)
     110              (let* (
     111                (strings (map symbol->string holes))
     112                (substrings
     113                  (map (lambda (s)
     114                         (substring s 1 (fx- (string-length s) 1)))
     115                       strings))
     116                (nums (map string->number
     117                           (filter (lambda (s)
     118                                     (not (string=? s "")))
     119                                   substrings)))
     120                (snums (nsort nums))
     121                (sstrings (map (lambda (s)
     122                                 (string-append "!" s "!"))
     123                               (map number->string snums)))
     124                (sholes (map string->symbol sstrings))
     125                )
     126                (if (memq '!! holes)
     127                  (cons '!! sholes)
     128                  sholes))))
    100129          )
    101130          `(,%lambda
    102              ,(remove-dups (filter hole? (flatten* code)))
    103              ,@code)))))
     131             ,(hsort (filter hole? (flatten* code)))
     132             ,@code))))))
    104133
    105134(set-sharp-read-syntax! #\#
     
    113142          "  extracts holes, i.e. a pair of bangs"
    114143          "  possible enclosing a seqence of digits"
    115           "  form code, removes duplicates, and uses"
     144          "  form code, sorts them numerically while"
     145          "  removing duplicates, and uses"
    116146          "  the resulting list as argument list of"
    117147          "  a procedure with body code."
  • release/4/holes/trunk/holes.setup

    r33696 r33705  
    77 'holes
    88 '("holes.so" "holes.import.so")
    9  '((version "1.1")))
     9 '((version "1.2")))
    1010
  • release/4/holes/trunk/tests/run.scm

    r33696 r33705  
    4242    (equal? (##(list !! !1! 2 (vector !!)) 1 2)
    4343            '(1 2 2 #(1)))
     44    (equal? (##(cons !2! !1!) 1 2) '(2 . 1))
     45    (equal? (##(list (cons !2! !1!) (cons !1! !2!)) 1 2)
     46            '((2 . 1) (1 . 2)))
    4447  ))
    4548
Note: See TracChangeset for help on using the changeset viewer.