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

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

@ -863,16 +863,34 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 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 :(
;; (define-syntax match-check-ellipsis
;; (syntax-rules (...)
;; ((_ ... sk fk) sk)
;; ((_ x sk fk) fk)))
;;
;; This is a little more complicated, and introduces a new let-syntax,
;; but should work portably in any R[56]RS Scheme. Taylor Campbell
;; originally came up with the idea.
(define-syntax match-check-ellipsis
(syntax-rules () (syntax-rules ()
;; these two aren't necessary but provide fast-case failures ;; these two aren't necessary but provide fast-case failures
((match-check-ellipsis (a . b) success-k failure-k) failure-k) ((match-check-ellipsis (a . b) success-k failure-k) failure-k)
@ -888,11 +906,9 @@
;; above if `id' is `...' ;; above if `id' is `...'
(ellipsis? (a b c) success-k failure-k))))) (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
(define-syntax match-check-identifier
(syntax-rules () (syntax-rules ()
;; fast-case failures, lists and vectors are not identifiers ;; fast-case failures, lists and vectors are not identifiers
((_ (x . y) success-k failure-k) failure-k) ((_ (x . y) success-k failure-k) failure-k)
@ -907,4 +923,4 @@
((sym? x sk fk) sk) ((sym? x sk fk) sk)
;; otherwise x is a non-symbol datum ;; otherwise x is a non-symbol datum
((sym? y sk fk) fk)))) ((sym? y sk fk) fk))))
(sym? abracadabra success-k failure-k))))) (sym? abracadabra success-k failure-k)))))))