Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-07-11 23:17:34 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Using cond-expand for faster match-check-ellipsis and match-check-identifier in Chibi.

Browse source
This commit is contained in:
Alex Shinn 2013-04-05 20:36:40 +09:00
parent 242ab2c8e6
commit dcd65cc9da
1 changed files with 59 additions and 43 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

102
lib/chibi/match/match.scm
View file

@ -863,48 +863,64 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Otherwise COND-EXPANDed bits. ;; Otherwise COND-EXPANDed bits.
;; This *should* work, but doesn't :( (cond-expand
;; (define-syntax match-check-ellipsis (chibi
;; (syntax-rules (...) (define-syntax match-check-ellipsis
;; ((_ ... sk fk) sk) (er-macro-transformer
;; ((_ x sk fk) fk))) (lambda (expr rename compare)
(if (compare '... (cadr expr))
(car (cddr expr))
(cadr (cddr expr))))))
(define-syntax match-check-identifier
(er-macro-transformer
(lambda (expr rename compare)
(if (identifier? (cadr expr))
(car (cddr expr))
(cadr (cddr expr)))))))
;; This is a little more complicated, and introduces a new let-syntax, (else
;; but should work portably in any R[56]RS Scheme. Taylor Campbell ;; Portable versions
;; originally came up with the idea. ;;
(define-syntax match-check-ellipsis ;; This *should* work, but doesn't :(
(syntax-rules () ;; (define-syntax match-check-ellipsis
;; these two aren't necessary but provide fast-case failures ;; (syntax-rules (...)
((match-check-ellipsis (a . b) success-k failure-k) failure-k) ;; ((_ ... sk fk) sk)
((match-check-ellipsis #(a ...) success-k failure-k) failure-k) ;; ((_ x sk fk) fk)))
;; matching an atom ;;
((match-check-ellipsis id success-k failure-k) ;; This is a little more complicated, and introduces a new let-syntax,
(let-syntax ((ellipsis? (syntax-rules () ;; but should work portably in any R[56]RS Scheme. Taylor Campbell
;; iff `id' is `...' here then this will ;; originally came up with the idea.
;; match a list of any length (define-syntax match-check-ellipsis
((ellipsis? (foo id) sk fk) sk) (syntax-rules ()
((ellipsis? other sk fk) fk)))) ;; these two aren't necessary but provide fast-case failures
;; this list of three elements will only many the (foo id) list ((match-check-ellipsis (a . b) success-k failure-k) failure-k)
;; above if `id' is `...' ((match-check-ellipsis #(a ...) success-k failure-k) failure-k)
(ellipsis? (a b c) success-k failure-k))))) ;; matching an atom
((match-check-ellipsis id success-k failure-k)
(let-syntax ((ellipsis? (syntax-rules ()
;; iff `id' is `...' here then this will
;; match a list of any length
((ellipsis? (foo id) sk fk) sk)
((ellipsis? other sk fk) fk))))
;; this list of three elements will only many the (foo id) list
;; above if `id' is `...'
(ellipsis? (a b c) success-k failure-k)))))
;; This is portable but can be more efficient with non-portable
;; This is portable but can be more efficient with non-portable ;; extensions. This trick was originally discovered by Oleg Kiselyov.
;; extensions. This trick was originally discovered by Oleg Kiselyov. (define-syntax match-check-identifier
(syntax-rules ()
(define-syntax match-check-identifier ;; fast-case failures, lists and vectors are not identifiers
(syntax-rules () ((_ (x . y) success-k failure-k) failure-k)
;; fast-case failures, lists and vectors are not identifiers ((_ #(x ...) success-k failure-k) failure-k)
((_ (x . y) success-k failure-k) failure-k) ;; x is an atom
((_ #(x ...) success-k failure-k) failure-k) ((_ x success-k failure-k)
;; x is an atom (let-syntax
((_ x success-k failure-k) ((sym?
(let-syntax (syntax-rules ()
((sym? ;; if the symbol `abracadabra' matches x, then x is a
(syntax-rules () ;; symbol
;; if the symbol `abracadabra' matches x, then x is a ((sym? x sk fk) sk)
;; symbol ;; otherwise x is a non-symbol datum
((sym? x sk fk) sk) ((sym? y sk fk) fk))))
;; otherwise x is a non-symbol datum (sym? abracadabra success-k failure-k)))))))
((sym? y sk fk) fk))))
(sym? abracadabra success-k failure-k)))))