public inbox for kawa@sourceware.org
 help / color / mirror / Atom feed
* questions on libraries, pattern matching etc
@ 2019-12-15 23:47 Ben
  2019-12-16  0:59 ` Per Bothner
  0 siblings, 1 reply; 9+ messages in thread
From: Ben @ 2019-12-15 23:47 UTC (permalink / raw)
  To: kawa

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)))

^ permalink raw reply	[flat|nested] 9+ messages in thread

* Re: questions on libraries, pattern matching etc
  2019-12-15 23:47 questions on libraries, pattern matching etc Ben
@ 2019-12-16  0:59 ` Per Bothner
  2020-02-19 21:39   ` Duncan Mak
  2020-06-29 20:50   ` Duncan Mak
  0 siblings, 2 replies; 9+ messages in thread
From: Per Bothner @ 2019-12-16  0:59 UTC (permalink / raw)
  To: Ben, kawa

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
per@bothner.com   http://per.bothner.com/

^ permalink raw reply	[flat|nested] 9+ messages in thread

* Re: questions on libraries, pattern matching etc
  2019-12-16  0:59 ` Per Bothner
@ 2020-02-19 21:39   ` Duncan Mak
  2020-02-20 11:00     ` Kjetil Matheussen
  2020-06-29 20:50   ` Duncan Mak
  1 sibling, 1 reply; 9+ messages in thread
From: Duncan Mak @ 2020-02-19 21:39 UTC (permalink / raw)
  To: Per Bothner; +Cc: Ben, kawa mailing list

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 <per@bothner.com> 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
> per@bothner.com   http://per.bothner.com/
>


-- 
Duncan.

^ permalink raw reply	[flat|nested] 9+ messages in thread

* Re: questions on libraries, pattern matching etc
  2020-02-19 21:39   ` Duncan Mak
@ 2020-02-20 11:00     ` Kjetil Matheussen
  0 siblings, 0 replies; 9+ messages in thread
From: Kjetil Matheussen @ 2020-02-20 11:00 UTC (permalink / raw)
  To: Duncan Mak; +Cc: Per Bothner, Ben, kawa mailing list

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 <duncanmak@gmail.com> 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 <per@bothner.com> 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
> > per@bothner.com   http://per.bothner.com/
> >
>
>
> --
> Duncan.

^ permalink raw reply	[flat|nested] 9+ messages in thread

* Re: questions on libraries, pattern matching etc
  2019-12-16  0:59 ` Per Bothner
  2020-02-19 21:39   ` Duncan Mak
@ 2020-06-29 20:50   ` Duncan Mak
  2020-06-29 21:49     ` Per Bothner
  1 sibling, 1 reply; 9+ messages in thread
From: Duncan Mak @ 2020-06-29 20:50 UTC (permalink / raw)
  To: Per Bothner; +Cc: kawa mailing list

Hello Per,

About the syntax for a match macro, work on SRFI 200 (draft) just started:

https://srfi.schemers.org/srfi-200/srfi-200.html

What do you think about adopting the syntax for the Wright-Cartwright-Shinn
matcher?

I've been trying to use match.scm (and its variants) in Kawa and simple
patterns kinda work, but I see that:

- matching records
- matching quasiquotes

These two parts don't seem to be working.

For now, I've backed out of using match.scm due to the missing features,
but it'd really be nice to have a match macro that comes with Kawa scheme,
following one of the grammar listed in the SRFI.

Going a different direction, this design for a CASE* macro is also
interesting,
https://github.com/axch/pattern-case/blob/master/pattern-matching.txt


Duncan.

On Sun, Dec 15, 2019 at 7:59 PM Per Bothner <per@bothner.com> 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
> per@bothner.com   http://per.bothner.com/
>


-- 
Duncan.

^ permalink raw reply	[flat|nested] 9+ messages in thread

* Re: questions on libraries, pattern matching etc
  2020-06-29 20:50   ` Duncan Mak
@ 2020-06-29 21:49     ` Per Bothner
  2020-06-30  4:38       ` Duncan Mak
  0 siblings, 1 reply; 9+ messages in thread
From: Per Bothner @ 2020-06-29 21:49 UTC (permalink / raw)
  To: Duncan Mak; +Cc: kawa mailing list

On 6/29/20 1:50 PM, Duncan Mak wrote:
> Hello Per,
> 
> About the syntax for a match macro, work on SRFI 200 (draft) just started:
> 
> https://srfi.schemers.org/srfi-200/srfi-200.html

I haven't read it in detail, but it looks like the proposed pattern syntax
is more-or-less compatible with Kawa.

(There are lots of SRFIs coming out, and I've given up trying to pay close
attention, especially since may of them are philosophically incompatible
with Kawa.  For example, Kawa has a consistent and powerful "sequence"
concept and I think it's a mistake to define a large library of procedures
for every sequence type, as seems to be the direction of R7RS-large.)

The key thing about patterns in Kawa is they are integrated in the
standard syntax forms, rather than being a pure "add-on" library feature.
For example, the "variable" defined in a LET form can be a pattern.

Also, not that in Kawa patterns and type-specifiers are integrated:  a PATTERN
can be:
   PATTERN ::TYPE

To extend the syntax of Kawa patterns (which is highly deirable,
and could plausible be done in the style of SRFI-200) one would need
to extend kawa/lang/BindDecls.java, primarily.
Not completely trivial, but not impossible either :-)

> What do you think about adopting the syntax for the Wright-Cartwright-Shinn matcher?
> 
> I've been trying to use match.scm (and its variants) in Kawa and simple patterns kinda work, but I see that:
> 
> - matching records
> - matching quasiquotes
> 
> These two parts don't seem to be working.
> 
> For now, I've backed out of using match.scm due to the missing features, but it'd really be nice to have a match macro that comes with Kawa scheme, following one of the grammar listed in the SRFI.
> 
> Going a different direction, this design for a CASE* macro is also interesting, https://github.com/axch/pattern-case/blob/master/pattern-matching.txt

While I'm OK with adding verious SRFI libraries for cmpatibility, patterns in
the core part of Kawa should follow (and extend) the design in:
https://www.gnu.org/software/kawa/Variables-and-Patterns.html#meta-pattern
https://www.gnu.org/software/kawa/Definitions.html
https://www.gnu.org/software/kawa/Local-binding-constructs.html
-- 
	--Per Bothner
per@bothner.com   http://per.bothner.com/

^ permalink raw reply	[flat|nested] 9+ messages in thread

* Re: questions on libraries, pattern matching etc
  2020-06-29 21:49     ` Per Bothner
@ 2020-06-30  4:38       ` Duncan Mak
  2020-06-30  5:48         ` Per Bothner
  2020-07-01  4:52         ` Per Bothner
  0 siblings, 2 replies; 9+ messages in thread
From: Duncan Mak @ 2020-06-30  4:38 UTC (permalink / raw)
  To: Per Bothner; +Cc: kawa mailing list

Hello Per,

So I'm trying to really learn the Kawa pattern language, but I couldn't
figure out how to match a literal.

While it was encouraging to see that this seems to work:

#|kawa:17|# (match '(foo 1 2) ([foo a b] (+ a b)))
3


But not this:

#|kawa:18|# (match '(foo 1 2) (['foo a b] (+ a b)))
java.lang.NullPointerException


So how do I match against a form like '(foo x y) and make sure that the
first element of the list is the literal symbol 'foo?

Also, this is more akin to destructuring, but is there a way to use the
match macro against a record?

Thanks!


Duncan.

On Mon, Jun 29, 2020 at 5:50 PM Per Bothner <per@bothner.com> wrote:

> On 6/29/20 1:50 PM, Duncan Mak wrote:
> > Hello Per,
> >
> > About the syntax for a match macro, work on SRFI 200 (draft) just
> started:
> >
> > https://srfi.schemers.org/srfi-200/srfi-200.html
>
> I haven't read it in detail, but it looks like the proposed pattern syntax
> is more-or-less compatible with Kawa.
>
> (There are lots of SRFIs coming out, and I've given up trying to pay close
> attention, especially since may of them are philosophically incompatible
> with Kawa.  For example, Kawa has a consistent and powerful "sequence"
> concept and I think it's a mistake to define a large library of procedures
> for every sequence type, as seems to be the direction of R7RS-large.)
>
> The key thing about patterns in Kawa is they are integrated in the
> standard syntax forms, rather than being a pure "add-on" library feature.
> For example, the "variable" defined in a LET form can be a pattern.
>
> Also, not that in Kawa patterns and type-specifiers are integrated:  a
> PATTERN
> can be:
>    PATTERN ::TYPE
>
> To extend the syntax of Kawa patterns (which is highly deirable,
> and could plausible be done in the style of SRFI-200) one would need
> to extend kawa/lang/BindDecls.java, primarily.
> Not completely trivial, but not impossible either :-)
>
> > What do you think about adopting the syntax for the
> Wright-Cartwright-Shinn matcher?
> >
> > I've been trying to use match.scm (and its variants) in Kawa and simple
> patterns kinda work, but I see that:
> >
> > - matching records
> > - matching quasiquotes
> >
> > These two parts don't seem to be working.
> >
> > For now, I've backed out of using match.scm due to the missing features,
> but it'd really be nice to have a match macro that comes with Kawa scheme,
> following one of the grammar listed in the SRFI.
> >
> > Going a different direction, this design for a CASE* macro is also
> interesting,
> https://github.com/axch/pattern-case/blob/master/pattern-matching.txt
>
> While I'm OK with adding verious SRFI libraries for cmpatibility, patterns
> in
> the core part of Kawa should follow (and extend) the design in:
> https://www.gnu.org/software/kawa/Variables-and-Patterns.html#meta-pattern
> https://www.gnu.org/software/kawa/Definitions.html
> https://www.gnu.org/software/kawa/Local-binding-constructs.html
> --
>         --Per Bothner
> per@bothner.com   http://per.bothner.com/
>


-- 
Duncan.

^ permalink raw reply	[flat|nested] 9+ messages in thread

* Re: questions on libraries, pattern matching etc
  2020-06-30  4:38       ` Duncan Mak
@ 2020-06-30  5:48         ` Per Bothner
  2020-07-01  4:52         ` Per Bothner
  1 sibling, 0 replies; 9+ messages in thread
From: Per Bothner @ 2020-06-30  5:48 UTC (permalink / raw)
  To: Duncan Mak; +Cc: kawa mailing list

On 6/29/20 9:38 PM, Duncan Mak wrote:
> But not this:
> 
>     #|kawa:18|# (match '(foo 1 2) (['foo a b] (+ a b)))
>     java.lang.NullPointerException

That looks like a compiler bug.  I'll look into it in the morning.
-- 
	--Per Bothner
per@bothner.com   http://per.bothner.com/

^ permalink raw reply	[flat|nested] 9+ messages in thread

* Re: questions on libraries, pattern matching etc
  2020-06-30  4:38       ` Duncan Mak
  2020-06-30  5:48         ` Per Bothner
@ 2020-07-01  4:52         ` Per Bothner
  1 sibling, 0 replies; 9+ messages in thread
From: Per Bothner @ 2020-07-01  4:52 UTC (permalink / raw)
  To: Duncan Mak; +Cc: kawa mailing list

On 6/29/20 9:38 PM, Duncan Mak wrote:
> But not this:
> 
>     #|kawa:18|# (match '(foo 1 2) (['foo a b] (+ a b)))
>     java.lang.NullPointerException

I checked in a fix for this.
-- 
	--Per Bothner
per@bothner.com   http://per.bothner.com/

^ permalink raw reply	[flat|nested] 9+ messages in thread

end of thread, other threads:[~2020-07-01  4:52 UTC | newest]

Thread overview: 9+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2019-12-15 23:47 questions on libraries, pattern matching etc Ben
2019-12-16  0:59 ` Per Bothner
2020-02-19 21:39   ` Duncan Mak
2020-02-20 11:00     ` Kjetil Matheussen
2020-06-29 20:50   ` Duncan Mak
2020-06-29 21:49     ` Per Bothner
2020-06-30  4:38       ` Duncan Mak
2020-06-30  5:48         ` Per Bothner
2020-07-01  4:52         ` Per Bothner

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).