questions on libraries, pattern matching etc

classic Classic list List threaded Threaded
4 messages Options
Reply | Threaded
Open this post in threaded view
|

questions on libraries, pattern matching etc

Ben-2
hi
I'd like to test how I can use pattern match in Kawa. First I did try to use Kawas pattern matching function, but from what I saw it is a bit limited, for example there is no matching of lists. Thats why I did try to use the famous match.scm code from Alex Shinn. In order to exclude potential collitions with Kawas 'match', I renamed all 'match' strings in  to 'pmatch' and renamed also the file to 'pmatch.scm'

kawa -Dkawa.import.path=".:libs/kawa/*.scm" t.scm

---- t.scm ---
(import pmatch)

(pmatch (list 11 99 )
   (( a b )
      (display a)
      (display b))
   (_  (display "gaga")))

=> 11 99
-------

But I also get the following warning :

/libs/kawa/pmatch.scm:88:34: warning - no use of failure


Do you know how I can prevent that warning?
Ben



----- match.scm ----

     1 ;;;; match.scm -- portable hygienic pattern matcher
     2 ;;
     3 ;; This code is written by Alex Shinn and placed in the
     4 ;; Public Domain.  All warranties are disclaimed.
     5
     6 ;; This is a full superset of the popular MATCH package by Andrew
     7 ;; Wright, written in fully portable SYNTAX-RULES (R5RS only, breaks
     8 ;; in R6RS SYNTAX-RULES), and thus preserving hygiene.
     9
    10 ;; This is a simple generative pattern matcher - each pattern is
    11 ;; expanded into the required tests, calling a failure continuation if
    12 ;; the tests fail.  This makes the logic easy to follow and extend,
    13 ;; but produces sub-optimal code in cases where you have many similar
    14 ;; clauses due to repeating the same tests.  Nonetheless a smart
    15 ;; compiler should be able to remove the redundant tests.  For
    16 ;; MATCH-LET and DESTRUCTURING-BIND type uses there is no performance
    17 ;; hit.
    18
    19 ;; The original version was written on 2006/11/29 and described in the
    20 ;; following Usenet post:
    21 ;;   http://groups.google.com/group/comp.lang.scheme/msg/0941234de7112ffd
    22 ;; and is still available at
    23 ;;   http://synthcode.com/scheme/match-simple.scm
    24 ;; A variant of this file which uses COND-EXPAND in a few places can
    25 ;; be found at
    26 ;;   http://synthcode.com/scheme/match-cond-expand.scm
    27 ;;
    28 ;; 2008/03/20 - fixing bug where (a ...) matched non-lists
    29 ;; 2008/03/15 - removing redundant check in vector patterns
    30 ;; 2008/03/06 - you can use `...' portably now (thanks to Taylor Campbell)
    31 ;; 2007/09/04 - fixing quasiquote patterns
    32 ;; 2007/07/21 - allowing ellipse patterns in non-final list positions
    33 ;; 2007/04/10 - fixing potential hygiene issue in match-check-ellipse
    34 ;;              (thanks to Taylor Campbell)
    35 ;; 2007/04/08 - clean up, commenting
    36 ;; 2006/12/24 - bugfixes
    37 ;; 2006/12/01 - non-linear patterns, shared variables in OR, get!/set!
    38
    39 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    40 ;; force compile-time syntax errors with useful messages
    41
    42 (define-syntax match-syntax-error
    43  (syntax-rules ()
    44    ((_)
    45     (match-syntax-error "invalid match-syntax-error usage"))))
    46
    47 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    48
    49 ;; The basic interface.  MATCH just performs some basic syntax
    50 ;; validation, binds the match expression to a temporary variable `v',
    51 ;; and passes it on to MATCH-NEXT.  It's a constant throughout the
    52 ;; code below that the binding `v' is a direct variable reference, not
    53 ;; an expression.
    54
    55 (define-syntax match
    56  (syntax-rules ()
    57    ((match)
    58     (match-syntax-error "missing match expression"))
    59    ((match atom)
    60     (match-syntax-error "missing match clause"))
    61    ((match (app ...) (pat . body) ...)
    62     (let ((v (app ...)))
    63       (match-next v (app ...) (set! (app ...)) (pat . body) ...)))
    64    ((match #(vec ...) (pat . body) ...)
    65     (let ((v #(vec ...)))
    66       (match-next v v (set! v) (pat . body) ...)))
    67    ((match atom (pat . body) ...)
    68     (match-next atom atom (set! atom) (pat . body) ...))
    69    ))
    70
    71 ;; MATCH-NEXT passes each clause to MATCH-ONE in turn with its failure
    72 ;; thunk, which is expanded by recursing MATCH-NEXT on the remaining
    73 ;; clauses.  `g' and `s' are the get! and set! expressions
    74 ;; respectively.
    75
    76 (define-syntax match-next
    77  (syntax-rules (=>)
    78    ;; no more clauses, the match failed
    79    ((match-next v g s)
    80     (error 'match "no matching pattern"))
    81    ;; named failure continuation
    82    ((match-next v g s (pat (=> failure) . body) . rest)
    83     (let ((failure (lambda () (match-next v g s . rest))))
    84       ;; match-one analyzes the pattern for us
    85       (match-one v pat g s (match-drop-ids (begin . body)) (failure) ())))
    86    ;; anonymous failure continuation, give it a dummy name
    87    ((match-next v g s (pat . body) . rest)
    88     (match-next v g s (pat (=> failure) . body) . rest))))
    89
    90 ;; MATCH-ONE first checks for ellipse patterns, otherwise passes on to
    91 ;; MATCH-TWO.
    92
    93 (define-syntax match-one
    94  (syntax-rules ()
    95    ;; If it's a list of two values, check to see if the second one is
    96    ;; an ellipse and handle accordingly, otherwise go to MATCH-TWO.
    97    ((match-one v (p q . r) g s sk fk i)
    98     (match-check-ellipse
    99      q
   100      (match-extract-vars p (match-gen-ellipses v p r g s sk fk i) i ())
   101      (match-two v (p q . r) g s sk fk i)))
   102    ;; Otherwise, go directly to MATCH-TWO.
   103    ((match-one . x)
   104     (match-two . x))))
   105
   106 ;; This is the guts of the pattern matcher.  We are passed a lot of
   107 ;; information in the form:
   108 ;;
   109 ;;   (match-two var pattern getter setter success-k fail-k (ids ...))
   110 ;;
   111 ;; usually abbreviated
   112 ;;
   113 ;;   (match-two v p g s sk fk i)
   114 ;;
   115 ;; where VAR is the symbol name of the current variable we are
   116 ;; matching, PATTERN is the current pattern, getter and setter are the
   117 ;; corresponding accessors (e.g. CAR and SET-CAR! of the pair holding
   118 ;; VAR), SUCCESS-K is the success continuation, FAIL-K is the failure
   119 ;; continuation (which is just a thunk call and is thus safe to expand
   120 ;; multiple times) and IDS are the list of identifiers bound in the
   121 ;; pattern so far.
   122
   123 (define-syntax match-two
   124  (syntax-rules (_ ___ quote quasiquote ? $ = and or not set! get!)
   125    ((match-two v () g s (sk ...) fk i)
   126     (if (null? v) (sk ... i) fk))
   127    ((match-two v (quote p) g s (sk ...) fk i)
   128     (if (equal? v 'p) (sk ... i) fk))
   129    ((match-two v (quasiquote p) g s sk fk i)
   130     (match-quasiquote v p g s sk fk i))
   131    ((match-two v (and) g s (sk ...) fk i) (sk ... i))
   132    ((match-two v (and p q ...) g s sk fk i)
   133     (match-one v p g s (match-one v (and q ...) g s sk fk) fk i))
   134    ((match-two v (or) g s sk fk i) fk)
   135    ((match-two v (or p) g s sk fk i)
   136     (match-one v p g s sk fk i))
   137    ((match-two v (or p ...) g s sk fk i)
   138     (match-extract-vars (or p ...)
   139                         (match-gen-or v (p ...) g s sk fk i)
   140                         i
   141                         ()))
   142    ((match-two v (not p) g s (sk ...) fk i)
   143     (match-one v p g s (match-drop-ids fk) (sk ... i) i))
   144    ((match-two v (get! getter) g s (sk ...) fk i)
   145     (let ((getter (lambda () g))) (sk ... i)))
   146    ((match-two v (set! setter) g (s ...) (sk ...) fk i)
   147     (let ((setter (lambda (x) (s ... x)))) (sk ... i)))
   148    ((match-two v (? pred p ...) g s sk fk i)
   149     (if (pred v) (match-one v (and p ...) g s sk fk i) fk))
   150    ((match-two v (= proc p) g s sk fk i)
   151     (let ((w (proc v)))
   152       (match-one w p g s sk fk i)))
   153    ((match-two v (p ___ . r) g s sk fk i)
   154     (match-extract-vars p (match-gen-ellipses v p r g s sk fk i) i ()))
   155    ((match-two v (p) g s sk fk i)
   156     (if (and (pair? v) (null? (cdr v)))
   157       (let ((w (car v)))
   158         (match-one w p (car v) (set-car! v) sk fk i))
   159       fk))
   160    ((match-two v (p . q) g s sk fk i)
   161     (if (pair? v)
   162       (let ((w (car v)) (x (cdr v)))
   163         (match-one w p (car v) (set-car! v)
   164                    (match-one x q (cdr v) (set-cdr! v) sk fk)
   165                    fk
   166                    i))
   167       fk))
   168    ((match-two v #(p ...) g s sk fk i)
   169     (match-vector v 0 () (p ...) sk fk i))
   170    ((match-two v _ g s (sk ...) fk i) (sk ... i))
   171    ;; Not a pair or vector or special literal, test to see if it's a
   172    ;; new symbol, in which case we just bind it, or if it's an
   173    ;; already bound symbol or some other literal, in which case we
   174    ;; compare it with EQUAL?.
   175    ((match-two v x g s (sk ...) fk (id ...))
   176     (let-syntax
   177         ((new-sym?
   178           (syntax-rules (id ...)
   179             ((new-sym? x sk2 fk2) sk2)
   180             ((new-sym? y sk2 fk2) fk2))))
   181       (new-sym? random-sym-to-match
   182                 (let ((x v)) (sk ... (id ... x)))
   183                 (if (equal? v x) (sk ... (id ...)) fk))))
   184    ))
   185
   186 ;; QUASIQUOTE patterns
   187
   188 (define-syntax match-quasiquote
   189  (syntax-rules (unquote unquote-splicing quasiquote)
   190    ((_ v (unquote p) g s sk fk i)
   191     (match-one v p g s sk fk i))
   192    ((_ v ((unquote-splicing p) . rest) g s sk fk i)
   193     (if (pair? v)
   194       (match-one v
   195                  (p . tmp)
   196                  (match-quasiquote tmp rest g s sk fk)
   197                  fk
   198                  i)
   199       fk))
   200    ((_ v (quasiquote p) g s sk fk i . depth)
   201     (match-quasiquote v p g s sk fk i #f . depth))
   202    ((_ v (unquote p) g s sk fk i x . depth)
   203     (match-quasiquote v p g s sk fk i . depth))
   204    ((_ v (unquote-splicing p) g s sk fk i x . depth)
   205     (match-quasiquote v p g s sk fk i . depth))
   206    ((_ v (p . q) g s sk fk i . depth)
   207     (if (pair? v)
   208       (let ((w (car v)) (x (cdr v)))
   209         (match-quasiquote
   210          w p g s
   211          (match-quasiquote-step x q g s sk fk depth)
   212          fk i . depth))
   213       fk))
   214    ((_ v #(elt ...) g s sk fk i . depth)
   215     (if (vector? v)
   216       (let ((ls (vector->list v)))
   217         (match-quasiquote ls (elt ...) g s sk fk i . depth))
   218       fk))
   219    ((_ v x g s sk fk i . depth)
   220     (match-one v 'x g s sk fk i))))
   221
   222 (define-syntax match-quasiquote-step
   223  (syntax-rules ()
   224    ((match-quasiquote-step x q g s sk fk depth i)
   225     (match-quasiquote x q g s sk fk i . depth))
   226    ))
   227
   228 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   229 ;; Utilities
   230
   231 ;; A CPS utility that takes two values and just expands into the
   232 ;; first.
   233 (define-syntax match-drop-ids
   234  (syntax-rules ()
   235    ((_ expr ids ...) expr)))
   236
   237 ;; Generating OR clauses just involves binding the success
   238 ;; continuation into a thunk which takes the identifiers common to
   239 ;; each OR clause, and trying each clause, calling the thunk as soon
   240 ;; as we succeed.
   241
   242 (define-syntax match-gen-or
   243  (syntax-rules ()
   244    ((_ v p g s (sk ...) fk (i ...) ((id id-ls) ...))
   245     (let ((sk2 (lambda (id ...) (sk ... (i ... id ...)))))
   246       (match-gen-or-step
   247        v p g s (match-drop-ids (sk2 id ...)) fk (i ...))))))
   248
   249 (define-syntax match-gen-or-step
   250  (syntax-rules ()
   251    ((_ v () g s sk fk i)
   252     ;; no OR clauses, call the failure continuation
   253     fk)
   254    ((_ v (p) g s sk fk i)
   255     ;; last (or only) OR clause, just expand normally
   256     (match-one v p g s sk fk i))
   257    ((_ v (p . q) g s sk fk i)
   258     ;; match one and try the remaining on failure
   259     (match-one v p g s sk (match-gen-or-step v q g s sk fk i) i))
   260    ))
   261
   262 ;; We match a pattern (p ...) by matching the pattern p in a loop on
   263 ;; each element of the variable, accumulating the bound ids into lists.
   264
   265 ;; Look at the body - it's just a named let loop, matching each
   266 ;; element in turn to the same pattern.  This illustrates the
   267 ;; simplicity of this generative-style pattern matching.  It would be
   268 ;; just as easy to implement a tree searching pattern.
   269
   270 (define-syntax match-gen-ellipses
   271  (syntax-rules ()
   272    ((_ v p () g s (sk ...) fk i ((id id-ls) ...))
   273     (match-check-identifier p
   274       ;; simplest case equivalent to ( . p), just bind the list
   275       (let ((p v))
   276         (if (list? p)
   277             (sk ... i)
   278             fk))
   279       ;; simple case, match all elements of the list
   280       (let loop ((ls v) (id-ls '()) ...)
   281         (cond
   282           ((null? ls)
   283            (let ((id (reverse id-ls)) ...) (sk ... i)))
   284           ((pair? ls)
   285            (let ((w (car ls)))
   286              (match-one w p (car ls) (set-car! ls)
   287                         (match-drop-ids (loop (cdr ls) (cons id id-ls) ...))
   288                         fk i)))
   289           (else
   290            fk)))))
   291    ((_ v p (r ...) g s (sk ...) fk i ((id id-ls) ...))
   292     ;; general case, trailing patterns to match
   293     (match-verify-no-ellipses
   294      (r ...)
   295      (let* ((tail-len (length '(r ...)))
   296             (ls v)
   297             (len (length ls)))
   298        (if (< len tail-len)
   299            fk
   300            (let loop ((ls ls) (n len) (id-ls '()) ...)
   301              (cond
   302                ((= n tail-len)
   303                 (let ((id (reverse id-ls)) ...)
   304                   (match-one ls (r ...) #f #f (sk ... i) fk i)))
   305                ((pair? ls)
   306                 (let ((w (car ls)))
   307                   (match-one w p (car ls) (set-car! ls)
   308                              (match-drop-ids
   309                               (loop (cdr ls) (- n 1) (cons id id-ls) ...))
   310                              fk
   311                              i)))
   312                (else
   313                 fk)))))))
   314    ))
   315
   316 (define-syntax match-verify-no-ellipses
   317  (syntax-rules ()
   318    ((_ (x . y) sk)
   319     (match-check-ellipse
   320      x
   321      (match-syntax-error
   322       "multiple ellipse patterns not allowed at same level")
   323      (match-verify-no-ellipses y sk)))
   324    ((_ x sk) sk)
   325    ))
   326
   327 ;; Vector patterns are just more of the same, with the slight
   328 ;; exception that we pass around the current vector index being
   329 ;; matched.
   330
   331 (define-syntax match-vector
   332  (syntax-rules (___)
   333    ((_ v n pats (p q) sk fk i)
   334     (match-check-ellipse q
   335                          (match-vector-ellipses v n pats p sk fk i)
   336                          (match-vector-two v n pats (p q) sk fk i)))
   337    ((_ v n pats (p ___) sk fk i)
   338     (match-vector-ellipses v n pats p sk fk i))
   339    ((_ . x)
   340     (match-vector-two . x))))
   341
   342 ;; Check the exact vector length, then check each element in turn.
   343
   344 (define-syntax match-vector-two
   345  (syntax-rules ()
   346    ((_ v n ((pat index) ...) () sk fk i)
   347     (if (vector? v)
   348       (let ((len (vector-length v)))
   349         (if (= len n)
   350           (match-vector-step v ((pat index) ...) sk fk i)
   351           fk))
   352       fk))
   353    ((_ v n (pats ...) (p . q) sk fk i)
   354     (match-vector v (+ n 1) (pats ... (p n)) q sk fk i))
   355    ))
   356
   357 (define-syntax match-vector-step
   358  (syntax-rules ()
   359    ((_ v () (sk ...) fk i) (sk ... i))
   360    ((_ v ((pat index) . rest) sk fk i)
   361     (let ((w (vector-ref v index)))
   362       (match-one w pat (vector-ref v index) (vector-set! v index)
   363                  (match-vector-step v rest sk fk)
   364                  fk i)))))
   365
   366 ;; With a vector ellipse pattern we first check to see if the vector
   367 ;; length is at least the required length.
   368
   369 (define-syntax match-vector-ellipses
   370  (syntax-rules ()
   371    ((_ v n ((pat index) ...) p sk fk i)
   372     (if (vector? v)
   373       (let ((len (vector-length v)))
   374         (if (>= len n)
   375           (match-vector-step v ((pat index) ...)
   376                              (match-vector-tail v p n len sk fk)
   377                              fk i)
   378           fk))
   379       fk))))
   380
   381 (define-syntax match-vector-tail
   382  (syntax-rules ()
   383    ((_ v p n len sk fk i)
   384     (match-extract-vars p (match-vector-tail-two v p n len sk fk i) i ()))))
   385
   386 (define-syntax match-vector-tail-two
   387  (syntax-rules ()
   388    ((_ v p n len (sk ...) fk i ((id id-ls) ...))
   389     (let loop ((j n) (id-ls '()) ...)
   390       (if (>= j len)
   391         (let ((id (reverse id-ls)) ...) (sk ... i))
   392         (let ((w (vector-ref v j)))
   393           (match-one w p (vector-ref v j) (vetor-set! v j)
   394                      (match-drop-ids (loop (+ j 1) (cons id id-ls) ...))
   395                      fk i)))))))
   396
   397 ;; Extract all identifiers in a pattern.  A little more complicated
   398 ;; than just looking for symbols, we need to ignore special keywords
   399 ;; and not pattern forms (such as the predicate expression in ?
   400 ;; patterns).
   401 ;;
   402 ;; (match-extract-vars pattern continuation (ids ...) (new-vars ...))
   403
   404 (define-syntax match-extract-vars
   405  (syntax-rules (_ ___ ? $ = quote quasiquote and or not get! set!)
   406    ((match-extract-vars (? pred . p) k i v)
   407     (match-extract-vars p k i v))
   408    ((match-extract-vars ($ rec . p) k i v)
   409     (match-extract-vars p k i v))
   410    ((match-extract-vars (= proc p) k i v)
   411     (match-extract-vars p k i v))
   412    ((match-extract-vars (quote x) (k ...) i v)
   413     (k ... v))
   414    ((match-extract-vars (quasiquote x) k i v)
   415     (match-extract-quasiquote-vars x k i v (#t)))
   416    ((match-extract-vars (and . p) k i v)
   417     (match-extract-vars p k i v))
   418    ((match-extract-vars (or . p) k i v)
   419     (match-extract-vars p k i v))
   420    ((match-extract-vars (not . p) k i v)
   421     (match-extract-vars p k i v))
   422    ;; A non-keyword pair, expand the CAR with a continuation to
   423    ;; expand the CDR.
   424    ((match-extract-vars (p q . r) k i v)
   425     (match-check-ellipse
   426      q
   427      (match-extract-vars (p . r) k i v)
   428      (match-extract-vars p (match-extract-vars-step (q . r) k i v) i ())))
   429    ((match-extract-vars (p . q) k i v)
   430     (match-extract-vars p (match-extract-vars-step q k i v) i ()))
   431    ((match-extract-vars #(p ...) k i v)
   432     (match-extract-vars (p ...) k i v))
   433    ((match-extract-vars _ (k ...) i v)    (k ... v))
   434    ((match-extract-vars ___ (k ...) i v)  (k ... v))
   435    ;; This is the main part, the only place where we might add a new
   436    ;; var if it's an unbound symbol.
   437    ((match-extract-vars p (k ...) (i ...) v)
   438     (let-syntax
   439         ((new-sym?
   440           (syntax-rules (i ...)
   441             ((new-sym? p sk fk) sk)
   442             ((new-sym? x sk fk) fk))))
   443       (new-sym? random-sym-to-match
   444                 (k ... ((p p-ls) . v))
   445                 (k ... v))))
   446    ))
   447
   448 ;; Stepper used in the above so it can expand the CAR and CDR
   449 ;; separately.
   450
   451 (define-syntax match-extract-vars-step
   452  (syntax-rules ()
   453    ((_ p k i v ((v2 v2-ls) ...))
   454     (match-extract-vars p k (v2 ... . i) ((v2 v2-ls) ... . v)))
   455    ))
   456
   457 (define-syntax match-extract-quasiquote-vars
   458  (syntax-rules (quasiquote unquote unquote-splicing)
   459    ((match-extract-quasiquote-vars (quasiquote x) k i v d)
   460     (match-extract-quasiquote-vars x k i v (#t . d)))
   461    ((match-extract-quasiquote-vars (unquote-splicing x) k i v d)
   462     (match-extract-quasiquote-vars (unquote x) k i v d))
   463    ((match-extract-quasiquote-vars (unquote x) k i v (#t))
   464     (match-extract-vars x k i v))
   465    ((match-extract-quasiquote-vars (unquote x) k i v (#t . d))
   466     (match-extract-quasiquote-vars x k i v d))
   467    ((match-extract-quasiquote-vars (x . y) k i v (#t . d))
   468     (match-extract-quasiquote-vars
   469      x
   470      (match-extract-quasiquote-vars-step y k i v d) i ()))
   471    ((match-extract-quasiquote-vars #(x ...) k i v (#t . d))
   472     (match-extract-quasiquote-vars (x ...) k i v d))
   473    ((match-extract-quasiquote-vars x (k ...) i v (#t . d))
   474     (k ... v))
   475    ))
   476
   477 (define-syntax match-extract-quasiquote-vars-step
   478  (syntax-rules ()
   479    ((_ x k i v d ((v2 v2-ls) ...))
   480     (match-extract-quasiquote-vars x k (v2 ... . i) ((v2 v2-ls) ... . v) d))
   481    ))
   482
   483
   484 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   485 ;; Gimme some sugar baby.
   486
   487 (define-syntax match-lambda
   488  (syntax-rules ()
   489    ((_ clause ...) (lambda (expr) (match expr clause ...)))))
   490
   491 (define-syntax match-lambda*
   492  (syntax-rules ()
   493    ((_ clause ...) (lambda expr (match expr clause ...)))))
   494
   495 (define-syntax match-let
   496  (syntax-rules ()
   497    ((_ (vars ...) . body)
   498     (match-let/helper let () () (vars ...) . body))
   499    ((_ loop . rest)
   500     (match-named-let loop () . rest))))
   501
   502 (define-syntax match-letrec
   503  (syntax-rules ()
   504    ((_ vars . body) (match-let/helper letrec () () vars . body))))
   505
   506 (define-syntax match-let/helper
   507  (syntax-rules ()
   508    ((_ let ((var expr) ...) () () . body)
   509     (let ((var expr) ...) . body))
   510    ((_ let ((var expr) ...) ((pat tmp) ...) () . body)
   511     (let ((var expr) ...)
   512       (match-let* ((pat tmp) ...)
   513         . body)))
   514    ((_ let (v ...) (p ...) (((a . b) expr) . rest) . body)
   515     (match-let/helper
   516      let (v ... (tmp expr)) (p ... ((a . b) tmp)) rest . body))
   517    ((_ let (v ...) (p ...) ((#(a ...) expr) . rest) . body)
   518     (match-let/helper
   519      let (v ... (tmp expr)) (p ... (#(a ...) tmp)) rest . body))
   520    ((_ let (v ...) (p ...) ((a expr) . rest) . body)
   521     (match-let/helper let (v ... (a expr)) (p ...) rest . body))
   522    ))
   523
   524 (define-syntax match-named-let
   525  (syntax-rules ()
   526    ((_ loop ((pat expr var) ...) () . body)
   527     (let loop ((var expr) ...)
   528       (match-let ((pat var) ...)
   529         . body)))
   530    ((_ loop (v ...) ((pat expr) . rest) . body)
   531     (match-named-let loop (v ... (pat expr tmp)) rest . body))))
   532
   533 (define-syntax match-let*
   534  (syntax-rules ()
   535    ((_ () . body)
   536     (begin . body))
   537    ((_ ((pat expr) . rest) . body)
   538     (match expr (pat (match-let* rest . body))))))
   539
   540
   541 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   542 ;; Otherwise COND-EXPANDed bits.
   543
   544 ;; This *should* work, but doesn't :(
   545 ;;   (define-syntax match-check-ellipse
   546 ;;     (syntax-rules (...)
   547 ;;       ((_ ... sk fk) sk)
   548 ;;       ((_ x sk fk) fk)))
   549
   550 ;; This is a little more complicated, and introduces a new let-syntax,
   551 ;; but should work portably in any R[56]RS Scheme.  Taylor Campbell
   552 ;; originally came up with the idea.
   553 (define-syntax match-check-ellipse
   554  (syntax-rules ()
   555    ;; these two aren't necessary but provide fast-case failures
   556    ((match-check-ellipse (a . b) success-k failure-k) failure-k)
   557    ((match-check-ellipse #(a ...) success-k failure-k) failure-k)
   558    ;; matching an atom
   559    ((match-check-ellipse id success-k failure-k)
   560     (let-syntax ((ellipse? (syntax-rules ()
   561                              ;; iff `id' is `...' here then this will
   562                              ;; match a list of any length
   563                              ((ellipse? (foo id) sk fk) sk)
   564                              ((ellipse? other sk fk) fk))))
   565       ;; this list of three elements will only many the (foo id) list
   566       ;; above if `id' is `...'
   567       (ellipse? (a b c) success-k failure-k)))))
   568
   569
   570 ;; This is portable but can be more efficient with non-portable
   571 ;; extensions.  This trick was originally discovered by Oleg Kiselyov.
   572
   573 (define-syntax match-check-identifier
   574  (syntax-rules ()
   575    ;; fast-case failures, lists and vectors are not identifiers
   576    ((_ (x . y) success-k failure-k) failure-k)
   577    ((_ #(x ...) success-k failure-k) failure-k)
   578    ;; x is an atom
   579    ((_ x success-k failure-k)
   580     (let-syntax
   581         ((sym?
   582           (syntax-rules ()
   583             ;; if the symbol `abracadabra' matches x, then x is a
   584             ;; symbol
   585             ((sym? x sk fk) sk)
   586             ;; otherwise x is a non-symbol datum
   587             ((sym? y sk fk) fk))))
   588       (sym? abracadabra success-k failure-k)))
   589    ))
   590
   591 (match (list 11 99)
   592       ((a b ) (display a)))

Reply | Threaded
Open this post in threaded view
|

Re: questions on libraries, pattern matching etc

Per Bothner
On 12/15/19 3:46 PM, Ben wrote:
> hi
> I'd like to test how I can use pattern match in Kawa. First I did try to use Kawas pattern matching function, but from what I saw it is a bit limited, for example there is no matching of lists.

Actually, there is matching of lists, but by matching them as general sequences:

#|kawa:1|# (! [a b c @rest] [1 2 3 4 5 6])
#|kawa:2|# (format "a: ~a b: ~a c: ~a rest: ~a~%" a b c rest)
a: 1 b: 2 c: 3 rest: #(4 5 6)

Implementing more general matching is mainly an issue of design including deciding on a syntax.
Fundamentally, should be syntax for matching a pair be:

(! (pat_car . pat_cdr) value)

or:

(! (cons pat_car pat_cdr) value)

or something else?
The latter is used in Racket, and is more flexible, I believe, but not as elegant -
which ties back to fundamental awkwardness with the Scheme evaluation model.

Of course once we/I decide on a syntax, then it needs to be implemented, but
should be fairly straight-forward, given the existing framework.
--
        --Per Bothner
[hidden email]   http://per.bothner.com/
Reply | Threaded
Open this post in threaded view
|

Re: questions on libraries, pattern matching etc

Duncan Mak
Hello Ben,

Did you figure out a way to get a pattern match library to work with Kawa?
Which one did you go with?

I came across this recently, and I'm gonna give it a try:
http://www.j-paine.org/match.html

I don't have particularly sophisticated needs, I'm hoping to find something
that will let me match on lists with some literals and some open slots, and
it'll be great if I can define optional elements also.


Duncan.

On Sun, Dec 15, 2019 at 7:59 PM Per Bothner <[hidden email]> wrote:

> On 12/15/19 3:46 PM, Ben wrote:
> > hi
> > I'd like to test how I can use pattern match in Kawa. First I did try to
> use Kawas pattern matching function, but from what I saw it is a bit
> limited, for example there is no matching of lists.
>
> Actually, there is matching of lists, but by matching them as general
> sequences:
>
> #|kawa:1|# (! [a b c @rest] [1 2 3 4 5 6])
> #|kawa:2|# (format "a: ~a b: ~a c: ~a rest: ~a~%" a b c rest)
> a: 1 b: 2 c: 3 rest: #(4 5 6)
>
> Implementing more general matching is mainly an issue of design including
> deciding on a syntax.
> Fundamentally, should be syntax for matching a pair be:
>
> (! (pat_car . pat_cdr) value)
>
> or:
>
> (! (cons pat_car pat_cdr) value)
>
> or something else?
> The latter is used in Racket, and is more flexible, I believe, but not as
> elegant -
> which ties back to fundamental awkwardness with the Scheme evaluation
> model.
>
> Of course once we/I decide on a syntax, then it needs to be implemented,
> but
> should be fairly straight-forward, given the existing framework.
> --
>         --Per Bothner
> [hidden email]   http://per.bothner.com/
>


--
Duncan.
Reply | Threaded
Open this post in threaded view
|

Re: questions on libraries, pattern matching etc

Kjetil Matheussen-2
I made this one a few years ago, which I think is pretty good:
https://github.com/kmatheussen/fedex2

I've used it a lot too, so it's well tested:
https://github.com/kmatheussen/radium/tree/master/bin/scheme
(might be some improvements in this repo)

It should only contain plain r4rs/r5rs scheme code (or thereabout),
except for the define-match macro, which looks like this:

(define-macro (define-match funcname . matchers)
  (create-matcher-func funcname matchers))

Example:

(define-match keep
  [        ] ____ :> '[]
  [A . Rest] Pred :> (cons A (keep Rest Pred)) :where (Pred A)
  [_ . Rest] Pred :> (keep Rest Pred))

(define-match quicksort
  []      :> '[]
  [A . R] :> (append (quicksort (keep R (lambda (B) (>= A B))))
                     (list A)
                     (quicksort (keep R (lambda (B) (< A B))))))

On Wed, Feb 19, 2020 at 10:39 PM Duncan Mak <[hidden email]> wrote:

>
> Hello Ben,
>
> Did you figure out a way to get a pattern match library to work with Kawa?
> Which one did you go with?
>
> I came across this recently, and I'm gonna give it a try:
> http://www.j-paine.org/match.html
>
> I don't have particularly sophisticated needs, I'm hoping to find something
> that will let me match on lists with some literals and some open slots, and
> it'll be great if I can define optional elements also.
>
>
> Duncan.
>
> On Sun, Dec 15, 2019 at 7:59 PM Per Bothner <[hidden email]> wrote:
>
> > On 12/15/19 3:46 PM, Ben wrote:
> > > hi
> > > I'd like to test how I can use pattern match in Kawa. First I did try to
> > use Kawas pattern matching function, but from what I saw it is a bit
> > limited, for example there is no matching of lists.
> >
> > Actually, there is matching of lists, but by matching them as general
> > sequences:
> >
> > #|kawa:1|# (! [a b c @rest] [1 2 3 4 5 6])
> > #|kawa:2|# (format "a: ~a b: ~a c: ~a rest: ~a~%" a b c rest)
> > a: 1 b: 2 c: 3 rest: #(4 5 6)
> >
> > Implementing more general matching is mainly an issue of design including
> > deciding on a syntax.
> > Fundamentally, should be syntax for matching a pair be:
> >
> > (! (pat_car . pat_cdr) value)
> >
> > or:
> >
> > (! (cons pat_car pat_cdr) value)
> >
> > or something else?
> > The latter is used in Racket, and is more flexible, I believe, but not as
> > elegant -
> > which ties back to fundamental awkwardness with the Scheme evaluation
> > model.
> >
> > Of course once we/I decide on a syntax, then it needs to be implemented,
> > but
> > should be fairly straight-forward, given the existing framework.
> > --
> >         --Per Bothner
> > [hidden email]   http://per.bothner.com/
> >
>
>
> --
> Duncan.