Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-07-08 05:27:33 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Optimized versions of (map) and (for-each)

Browse source 
These versions are optimized for when the function is being called with two list arguments.
This commit is contained in:
Justin Ethier 2019-08-09 16:00:46 -04:00
parent f211d350e0
commit f3c83e42a4
2 changed files with 15 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

11
scheme/base.sld
View file

@ -85,7 +85,9 @@
list-copy list-copy
map map
Cyc-map-loop-1 Cyc-map-loop-1
Cyc-map-loop-2
Cyc-for-each-loop-1 Cyc-for-each-loop-1
Cyc-for-each-loop-2
for-each for-each
list-tail list-tail
list-ref list-ref
@ -807,11 +809,20 @@
(if (null? lst) (if (null? lst)
'() '()
(cons (f (car lst)) (Cyc-map-loop-1 f (cdr lst))))) (cons (f (car lst)) (Cyc-map-loop-1 f (cdr lst)))))
(define (Cyc-map-loop-2 f lst1 lst2)
(if (or (null? lst1) (null? lst2))
'()
(cons (f (car lst1) (car lst2)) (Cyc-map-loop-2 f (cdr lst1) (cdr lst2)))))
(define (Cyc-for-each-loop-1 f lst) (define (Cyc-for-each-loop-1 f lst)
(if (null? lst) (if (null? lst)
'() '()
(begin (f (car lst)) (begin (f (car lst))
(Cyc-for-each-loop-1 f (cdr lst))))) (Cyc-for-each-loop-1 f (cdr lst)))))
(define (Cyc-for-each-loop-2 f lst1 lst2)
(if (or (null? lst1) (null? lst2))
'()
(begin (f (car lst1) (car lst2))
(Cyc-for-each-loop-2 f (cdr lst1) (cdr lst2)))))
(define (for-each f lis1 . lists) (define (for-each f lis1 . lists)
(if (not (null? lis1)) (if (not (null? lis1))

4
scheme/cyclone/transforms.sld
View file

@ -1115,8 +1115,12 @@ if (acc) {
(cons 'Cyc-fast-list-4 (map (lambda (a) (convert a renamed)) (cdr ast)))) (cons 'Cyc-fast-list-4 (map (lambda (a) (convert a renamed)) (cdr ast))))
((and (eq? (car ast) 'for-each) (= (length ast) 3)) ((and (eq? (car ast) 'for-each) (= (length ast) 3))
(cons 'Cyc-for-each-loop-1 (map (lambda (a) (convert a renamed)) (cdr ast)))) (cons 'Cyc-for-each-loop-1 (map (lambda (a) (convert a renamed)) (cdr ast))))
((and (eq? (car ast) 'for-each) (= (length ast) 4))
(cons 'Cyc-for-each-loop-2 (map (lambda (a) (convert a renamed)) (cdr ast))))
((and (eq? (car ast) 'map) (= (length ast) 3)) ((and (eq? (car ast) 'map) (= (length ast) 3))
(cons 'Cyc-map-loop-1 (map (lambda (a) (convert a renamed)) (cdr ast)))) (cons 'Cyc-map-loop-1 (map (lambda (a) (convert a renamed)) (cdr ast))))
((and (eq? (car ast) 'map) (= (length ast) 4))
(cons 'Cyc-map-loop-2 (map (lambda (a) (convert a renamed)) (cdr ast))))
;; Regular case, alpha convert everything ;; Regular case, alpha convert everything
(else (else
(regular-case))))) (regular-case)))))