diff options
author | Andy Wingo <wingo@pobox.com> | 2009-12-11 12:20:55 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2009-12-11 12:20:55 +0100 |
commit | 349d5c442834ee467fd2dbf4caed778310f96932 (patch) | |
tree | 6e6c54aaaac7982cedce84fad7f30fdcadf4574d | |
parent | b6d93b118271409c6c1b3d163a3b3cf329c77b17 (diff) | |
download | guile-349d5c442834ee467fd2dbf4caed778310f96932.tar.gz |
inline calls to (memv foo CONSTANT-LIST)
* module/language/tree-il/primitives.scm
(*interesting-primitive-names*): Recognize memv and memq as well.
* module/language/tree-il/inline.scm (inline!): Inline calls to memq and
memv where the list is a constant.
-rw-r--r-- | module/language/tree-il/inline.scm | 64 | ||||
-rw-r--r-- | module/language/tree-il/primitives.scm | 1 |
2 files changed, 45 insertions, 20 deletions
diff --git a/module/language/tree-il/inline.scm b/module/language/tree-il/inline.scm index 841429fbb..517ff1bd5 100644 --- a/module/language/tree-il/inline.scm +++ b/module/language/tree-il/inline.scm @@ -50,27 +50,51 @@ (or (inline1 x) x)) (lp alternate))))))) - ;; (call-with-values (lambda () foo) (lambda (a b . c) bar)) - ;; => (let-values (((a b . c) foo)) bar) - ;; - ;; Note that this is a singly-binding form of let-values. Also - ;; note that Scheme's let-values expands into call-with-values, - ;; then here we reduce it to tree-il's let-values. ((<primitive-ref> name) - (and (eq? name '@call-with-values) - (pmatch args - ((,producer ,consumer) - (guard (lambda? consumer) - (lambda-case? (lambda-body consumer)) - (not (lambda-case-opt (lambda-body consumer))) - (not (lambda-case-kw (lambda-body consumer))) - (not (lambda-case-alternate (lambda-body consumer)))) - (make-let-values - src - (let ((x (make-application src producer '()))) - (or (inline1 x) x)) - (lambda-body consumer))) - (else #f)))) + (case name + ((@call-with-values) + (pmatch args + ;; (call-with-values (lambda () foo) (lambda (a b . c) bar)) + ;; => (let-values (((a b . c) foo)) bar) + ;; + ;; Note that this is a singly-binding form of let-values. + ;; Also note that Scheme's let-values expands into + ;; call-with-values, then here we reduce it to tree-il's + ;; let-values. + ((,producer ,consumer) + (guard (lambda? consumer) + (lambda-case? (lambda-body consumer)) + (not (lambda-case-opt (lambda-body consumer))) + (not (lambda-case-kw (lambda-body consumer))) + (not (lambda-case-alternate (lambda-body consumer)))) + (make-let-values + src + (let ((x (make-application src producer '()))) + (or (inline1 x) x)) + (lambda-body consumer))) + (else #f))) + + ((memq memv) + (pmatch args + ((,k ,l) (guard (const? l) (list? (const-exp l))) + (let lp ((elts (const-exp l))) + (if (null? elts) + (make-const #f #f) + (make-conditional + src + (make-application + #f + (make-primitive-ref #f (case name + ((memq) 'eq?) + ((memv) 'eqv?) + (else (error "what")))) + (list k (make-const #f (car elts)))) + (make-const #f #t) + (lp (cdr elts)))))) + + (else #f))) + + (else #f))) (else #f))) diff --git a/module/language/tree-il/primitives.scm b/module/language/tree-il/primitives.scm index 07d4a5561..a8767aef8 100644 --- a/module/language/tree-il/primitives.scm +++ b/module/language/tree-il/primitives.scm @@ -34,6 +34,7 @@ call/cc values eq? eqv? equal? + memq memv = < > <= >= zero? + * - / 1- 1+ quotient remainder modulo ash logand logior logxor |