Changeset 37987 in project


Ignore:
Timestamp:
11/11/19 13:57:27 (4 weeks ago)
Author:
juergen
Message:

holes 1.2 with new delimiters and without read macros

Location:
release/5/holes/trunk
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • release/5/holes/trunk/holes.egg

    r37980 r37987  
    44 (license "BSD")
    55 (test-dependencies simple-tests)
    6  (author "[[Juergen Lorenz]]")
    7  (version "1.1")
     6 (author "Juergen Lorenz")
     7 (version "1.2")
    88 (components (extension holes)))
    99
  • release/5/holes/trunk/holes.scm

    r37980 r37987  
    3434#|[
    3535Besides the documentation procedure, this module exports two curry
    36 procedure, @> and @<, one macro, @@, and a sharp-read-macro, ##, which
    37 abbreviates the call of that latter macro.
    38 
    39 The macro transforms expressions with zero or more holes into a
    40 procedure. Insofar, it's a bit like cut or cute. But while in cut or
    41 cute a hole is the special identifier <>, in this module it's a pair of
    42 bangs, possibly enclosing a sequence of digits, for examples !! or !1!.
    43 In this way, holes needn't name different variables like in cut or cute.
    44 
    45 Another difference to cut or cute is, that the holes may appear in
    46 nested expressions at different levels. This gives great flexibility.
    47 And the sharp-read-syntax ## adds ease of use.
     36procedures, @> and @<, and a macro, @@, which implements the holes
     37mechanism. All three return procedures.
     38
     39Holes are symbols delimited by < and >, possibly enclosing zero or more
     40digits.  The macro @@ transforms expressions with zero or more holes
     41into a procedure. Insofar, it's a bit like cut or cute. But while in cut
     42or cute the same symbol <> can denote different arguments, in @@ <>, <1>
     43and <2>, say, are all different (and ordered) arguments.
    4844]|#
    4945
    5046(module holes (holes @@ @> @<)
    5147  (import scheme
    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!))
     48          (only (chicken base) error case-lambda print)
     49          (only (chicken syntax) define-for-syntax))
    5750  (import-for-syntax (only (chicken base) receive)
    5851                     (only (chicken fixnum) fx- fx+ fx=))
    5952
    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                   ))
    6953;;; (@@ code)
    7054;;; ---------
     
    9276                        (len (length lst))
    9377                        (target (string->list "0123456789")))
    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))
     78                   (and (char=? (car lst) #\<)
     79                                ;(string-ref delimiters 0))
     80                        (char=? (list-ref lst (fx- len 1)) #\>);)
     81                                ;(string-ref delimiters 1))
    9882                        (let loop ((k 1) (result #t))
    9983                          (call/cc
     
    155139                (sstrings
    156140                  (map (lambda (s)
    157                          (string-append (substring (hole-delimiters) 0 1)
     141                         (string-append "<";(substring delimiters 0 1) ;;;
    158142                                        s
    159                                         (substring (hole-delimiters) 1)))
     143                                        ">"));(substring delimiters 1)))
    160144                       (map number->string snums)))
    161145                (sholes (map string->symbol sstrings))
    162146                )
    163                 (if (memq (string->symbol (hole-delimiters)) holes)
    164                   (cons (string->symbol (hole-delimiters)) sholes)
     147                (if (memq (string->symbol "<>") holes);delimiters) holes)
     148                  (cons (string->symbol "<>") sholes) ;delimiters) sholes)
    165149                  sholes))))
    166150          )
     
    168152             ,(hsort (filter hole? (flatten* code)))
    169153             ,code))))))
    170 
    171 (set-sharp-read-syntax! #\#
    172   (lambda (port) `(@@ ,(read port))))
    173 (set-read-syntax! #\^
    174   (lambda (port) `(@@ ,(read port))))
    175154
    176155;;; (@> proc . head)
     
    200179      (holes sym ..)
    201180      "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")
    208181    (@@
    209182      macro:
    210183      (@@ code)
    211       "extracts holes, i.e. a pair of bangs"
    212       "or the pair <> depending on the parameter"
    213       "hole-delimiters"
     184      "extracts holes, i.e. a symbol delimited by < and >"
    214185      "possible enclosing a seqence of digits"
    215186      "from code, sorts them numerically while"
     
    217188      "the resulting list as argument list of"
    218189      "a procedure with body code."
     190      "Note, that (@@ code) is always a procedure!"
    219191      ""
    220       "Can be called with sharp-read-syntax ##"
    221       "or read-syntax ^"
    222       "Note, that (@@ code), and hence ##code,"
    223       "or ^code is always a procedure!")
     192      "The (@@ code) notation can be further simplyfied"
     193      "to, e.g, ^code with a read macro in the client code")
    224194    (@>
    225195      procedure:
  • release/5/holes/trunk/tests/run.scm

    r37980 r37987  
    44(pe '(@@ (+ !1! 5)))
    55(pe '(@@ '(1 . 2)))
    6 (pe '(@@ (+ 5 (* !! 2))))
    7 (pe '(@@ (!! 1 2 3)))
    8 (pe '(@@ '(1 2 #(3 4 !! 6))))
     6(pe '(@@ (+ 5 (* <> 2))))
     7(pe '(@@ (<> 1 2 3)))
     8(pe '(@@ '(1 2 #(3 4 <> 6))))
    99
    1010(print "\n\n")
    1111
    12 (hole-delimiters "!!")
    13 
    14 (define-test (bang-holes?)
     12(define-test (holes?)
    1513  (equal? ((@> map add1) '(0 1 2)) '(1 2 3))
    1614  (= ((@< list-ref 2) '(0 1 2 3)) 2)
     15  (procedure? (@@ 5))
    1716  (= ((@@ 5)) 5)
    18   (= (##5) 5)
    19   (procedure? ##(vector 1 !!))
    20   (procedure? ##(lambda (x) (- x !!)))
    21   (= ((##(lambda (x) (- x !!)) 2) 3) 1)
     17  (procedure? (@@ (vector 1 <>)))
     18  (procedure? (@@ (lambda (x) (- x <>))))
     19  (= (((@@ (lambda (x) (- x <>))) 2) 3) 1)
    2220  (equal? (call-with-values
    23             ##(values 1 2 3)
     21            (@@ (values 1 2 3))
    2422            list)
    2523          '(1 2 3))
    26   (= (##(+ !1! 5) 2) 7)
    27   (equal? (##'(1 . 2)) '(1 . 2))
    28   (= (##(+ 5 (* !! 2)) 7) 19)
    29   (= (##(!! 1 2 3) *) 6)
    30   (= (##(!! 1 2 3) +) 6)
    31   (equal? (##(list 1 2 (vector 3 4 !! 6)) 5)
     24  (= ((@@ (+ <1> 5)) 2) 7)
     25  (equal? ((@@ '(1 . 2))) '(1 . 2))
     26  (= ((@@ (+ 5 (* <> 2))) 7) 19)
     27  (= ((@@ (<> 1 2 3)) *) 6)
     28  (= ((@@ (<> 1 2 3)) +) 6)
     29  (equal? ((@@ (list 1 2 (vector 3 4 <> 6))) 5)
    3230          '(1 2 #(3 4 5 6)))
    33   (equal? (##(list 1 2 #(3 4 !! 6)))
     31  (equal? ((@@ (list 1 2 '#(3 4 <> 6))))
    3432          ; note that the third arg of list is quoted
    3533          ; hence there are no holes
    36           '(1 2 #(3 4 !! 6)))
    37   (equal? (##(vector 1 2 !!) 3)
     34          '(1 2 #(3 4 <> 6)))
     35  (equal? ((@@ (vector 1 2 <>)) 3)
    3836          #(1 2 3))
    39   (equal? (##(list 1 !! 2 !1!) 3 4)
     37  (equal? ((@@ (list 1 <> 2 <1>)) 3 4)
    4038          '(1 3 2 4))
    41   (equal? (##(list 1 !! 2 !!) 3)
     39  (equal? ((@@ (list 1 <> 2 <>)) 3)
    4240          '(1 3 2 3))
    43   (equal? (##(list 1 !! 2 (vector !!)) 3)
     41  (equal? ((@@ (list 1 <> 2 (vector <>))) 3)
    4442          '(1 3 2 #(3)))
    45   (equal? (##(list !! !1! 2 (vector !!)) 1 2)
     43  (equal? ((@@ (list <> <1> 2 (vector <>))) 1 2)
    4644          '(1 2 2 #(1)))
    47   (equal? (##(cons !2! !1!) 1 2) '(2 . 1))
    48   (equal? (##(list (cons !2! !1!) (cons !1! !2!)) 1 2)
     45  (equal? ((@@ (cons <2> <1>)) 1 2)
     46          '(2 . 1))
     47  (equal? ((@@ (list (cons <2> <1>) (cons <1> <2>))) 1 2)
    4948          '((2 . 1) (1 . 2)))
    5049  )
    5150
    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 
    6451(compound-test (HOLES)
    65  (bang-holes?)
    6652 (holes?)
    6753 )
Note: See TracChangeset for help on using the changeset viewer.