Changeset 37980 in project


Ignore:
Timestamp:
11/07/19 17:58:00 (10 days ago)
Author:
juergen
Message:

version 1.1 with parameter hole-delimiters

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

Legend:

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

    r36335 r37980  
    55 (test-dependencies simple-tests)
    66 (author "[[Juergen Lorenz]]")
    7  (version "1.0")
     7 (version "1.1")
    88 (components (extension holes)))
    99
  • release/5/holes/tags/1.1/holes.scm

    r36335 r37980  
    5050(module holes (holes @@ @> @<)
    5151  (import scheme
    52           (only (chicken base) error case-lambda print)
    53           (only (chicken read-syntax) set-sharp-read-syntax!))
     52          (only (chicken base) error case-lambda print make-parameter)
     53          (only (chicken syntax) define-for-syntax)
     54          (only (chicken read-syntax)
     55                set-sharp-read-syntax!
     56                set-read-syntax!))
    5457  (import-for-syntax (only (chicken base) receive)
    5558                     (only (chicken fixnum) fx- fx+ fx=))
    5659
     60(define-for-syntax hole-delimiters
     61  (make-parameter "<>"
     62                  (lambda (arg)
     63                    (if (and (string? arg)
     64                             (or (string=? arg "!!")
     65                                 (string=? arg "<>")))
     66                        arg
     67                        "<>"))
     68                  ))
    5769;;; (@@ code)
    5870;;; ---------
     
    8092                        (len (length lst))
    8193                        (target (string->list "0123456789")))
    82                    (and (char=? (car lst) #\!)
    83                         (char=? (list-ref lst (fx- len 1)) #\!)
     94                   (and (char=? (car lst)
     95                                (string-ref (hole-delimiters) 0))
     96                        (char=? (list-ref lst (fx- len 1))
     97                                (string-ref (hole-delimiters) 1))
    8498                        (let loop ((k 1) (result #t))
    8599                          (call/cc
     
    139153                                   substrings)))
    140154                (snums (nsort nums))
    141                 (sstrings (map (lambda (s)
    142                                  (string-append "!" s "!"))
    143                                (map number->string snums)))
     155                (sstrings
     156                  (map (lambda (s)
     157                         (string-append (substring (hole-delimiters) 0 1)
     158                                        s
     159                                        (substring (hole-delimiters) 1)))
     160                       (map number->string snums)))
    144161                (sholes (map string->symbol sstrings))
    145162                )
    146                 (if (memq '!! holes)
    147                   (cons '!! sholes)
     163                (if (memq (string->symbol (hole-delimiters)) holes)
     164                  (cons (string->symbol (hole-delimiters)) sholes)
    148165                  sholes))))
    149166          )
     
    153170
    154171(set-sharp-read-syntax! #\#
     172  (lambda (port) `(@@ ,(read port))))
     173(set-read-syntax! #\^
    155174  (lambda (port) `(@@ ,(read port))))
    156175
     
    181200      (holes sym ..)
    182201      "documentation procedure")
     202    (hole-delimiters
     203      parameter:
     204      (hole-delimiters str ..)
     205      "returns or sets the delimiters"
     206      "accepted strings are \"<>\" and \"!!\""
     207      "\"<>\" is the default")
    183208    (@@
    184209      macro:
    185210      (@@ code)
    186211      "extracts holes, i.e. a pair of bangs"
     212      "or the pair <> depending on the parameter"
     213      "hole-delimiters"
    187214      "possible enclosing a seqence of digits"
    188215      "from code, sorts them numerically while"
     
    192219      ""
    193220      "Can be called with sharp-read-syntax ##"
     221      "or read-syntax ^"
    194222      "Note, that (@@ code), and hence ##code,"
    195       "is always a procedure!")
     223      "or ^code is always a procedure!")
    196224    (@>
    197225      procedure:
  • release/5/holes/tags/1.1/tests/run.scm

    r36335 r37980  
    1010(print "\n\n")
    1111
    12 (define-test (holes?)
     12(hole-delimiters "!!")
     13
     14(define-test (bang-holes?)
    1315  (equal? ((@> map add1) '(0 1 2)) '(1 2 3))
    1416  (= ((@< list-ref 2) '(0 1 2 3)) 2)
     
    4850  )
    4951
     52(hole-delimiters "<>")
     53
     54(define-test (holes?)
     55  (= (^5) 5)
     56  (= (^(+ <> 2) 5) 7)
     57  (= (^(- <2> <1>) 5 7) 2)
     58  (equal? (^(list <> <1> <1> (vector <>)) 1 2)
     59          '(1 2 2 #(1)))
     60  (procedure? ^(lambda (x) (- x <>)))
     61  (= ((^(lambda (x) (- x <>)) 2) 3) 1)
     62  )
     63
    5064(compound-test (HOLES)
     65 (bang-holes?)
    5166 (holes?)
    5267 )
  • release/5/holes/trunk/holes.egg

    r36335 r37980  
    55 (test-dependencies simple-tests)
    66 (author "[[Juergen Lorenz]]")
    7  (version "1.0")
     7 (version "1.1")
    88 (components (extension holes)))
    99
  • release/5/holes/trunk/holes.scm

    r36335 r37980  
    5050(module holes (holes @@ @> @<)
    5151  (import scheme
    52           (only (chicken base) error case-lambda print)
    53           (only (chicken read-syntax) set-sharp-read-syntax!))
     52          (only (chicken base) error case-lambda print make-parameter)
     53          (only (chicken syntax) define-for-syntax)
     54          (only (chicken read-syntax)
     55                set-sharp-read-syntax!
     56                set-read-syntax!))
    5457  (import-for-syntax (only (chicken base) receive)
    5558                     (only (chicken fixnum) fx- fx+ fx=))
    5659
     60(define-for-syntax hole-delimiters
     61  (make-parameter "<>"
     62                  (lambda (arg)
     63                    (if (and (string? arg)
     64                             (or (string=? arg "!!")
     65                                 (string=? arg "<>")))
     66                        arg
     67                        "<>"))
     68                  ))
    5769;;; (@@ code)
    5870;;; ---------
     
    8092                        (len (length lst))
    8193                        (target (string->list "0123456789")))
    82                    (and (char=? (car lst) #\!)
    83                         (char=? (list-ref lst (fx- len 1)) #\!)
     94                   (and (char=? (car lst)
     95                                (string-ref (hole-delimiters) 0))
     96                        (char=? (list-ref lst (fx- len 1))
     97                                (string-ref (hole-delimiters) 1))
    8498                        (let loop ((k 1) (result #t))
    8599                          (call/cc
     
    139153                                   substrings)))
    140154                (snums (nsort nums))
    141                 (sstrings (map (lambda (s)
    142                                  (string-append "!" s "!"))
    143                                (map number->string snums)))
     155                (sstrings
     156                  (map (lambda (s)
     157                         (string-append (substring (hole-delimiters) 0 1)
     158                                        s
     159                                        (substring (hole-delimiters) 1)))
     160                       (map number->string snums)))
    144161                (sholes (map string->symbol sstrings))
    145162                )
    146                 (if (memq '!! holes)
    147                   (cons '!! sholes)
     163                (if (memq (string->symbol (hole-delimiters)) holes)
     164                  (cons (string->symbol (hole-delimiters)) sholes)
    148165                  sholes))))
    149166          )
     
    153170
    154171(set-sharp-read-syntax! #\#
     172  (lambda (port) `(@@ ,(read port))))
     173(set-read-syntax! #\^
    155174  (lambda (port) `(@@ ,(read port))))
    156175
     
    181200      (holes sym ..)
    182201      "documentation procedure")
     202    (hole-delimiters
     203      parameter:
     204      (hole-delimiters str ..)
     205      "returns or sets the delimiters"
     206      "accepted strings are \"<>\" and \"!!\""
     207      "\"<>\" is the default")
    183208    (@@
    184209      macro:
    185210      (@@ code)
    186211      "extracts holes, i.e. a pair of bangs"
     212      "or the pair <> depending on the parameter"
     213      "hole-delimiters"
    187214      "possible enclosing a seqence of digits"
    188215      "from code, sorts them numerically while"
     
    192219      ""
    193220      "Can be called with sharp-read-syntax ##"
     221      "or read-syntax ^"
    194222      "Note, that (@@ code), and hence ##code,"
    195       "is always a procedure!")
     223      "or ^code is always a procedure!")
    196224    (@>
    197225      procedure:
  • release/5/holes/trunk/tests/run.scm

    r36335 r37980  
    1010(print "\n\n")
    1111
    12 (define-test (holes?)
     12(hole-delimiters "!!")
     13
     14(define-test (bang-holes?)
    1315  (equal? ((@> map add1) '(0 1 2)) '(1 2 3))
    1416  (= ((@< list-ref 2) '(0 1 2 3)) 2)
     
    4850  )
    4951
     52(hole-delimiters "<>")
     53
     54(define-test (holes?)
     55  (= (^5) 5)
     56  (= (^(+ <> 2) 5) 7)
     57  (= (^(- <2> <1>) 5 7) 2)
     58  (equal? (^(list <> <1> <1> (vector <>)) 1 2)
     59          '(1 2 2 #(1)))
     60  (procedure? ^(lambda (x) (- x <>)))
     61  (= ((^(lambda (x) (- x <>)) 2) 3) 1)
     62  )
     63
    5064(compound-test (HOLES)
     65 (bang-holes?)
    5166 (holes?)
    5267 )
Note: See TracChangeset for help on using the changeset viewer.