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

Optimize calls to (list)

Browse source
This commit is contained in:
Justin Ethier 2018-06-19 18:06:18 -04:00
parent f2704eb5e4
commit b611520274
2 changed files with 30 additions and 21 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

12
include/cyclone/types.h
View file

@ -1069,18 +1069,18 @@ typedef pair_type *pair;
#define make_list_2(l, a1, a2) \
make_pair(l##__2, a2, NULL); \
make_pair(l, a1, l##__2);
make_pair(l, a1, &l##__2);
#define make_list_3(l, a1, a2, a3) \
make_pair(l##__3, a3, NULL); \
make_pair(l##__2, a2, l##__3); \
make_pair(l, a1, l##__2);
make_pair(l##__2, a2, &l##__3); \
make_pair(l, a1, &l##__2);
#define make_list_4(l, a1, a2, a3, a4) \
make_pair(l##__4, a4, NULL); \
make_pair(l##__3, a3, l##__4); \
make_pair(l##__2, a2, l##__3); \
make_pair(l, a1, l##__2);
make_pair(l##__3, a3, &l##__4); \
make_pair(l##__2, a2, &l##__3); \
make_pair(l, a1, &l##__2);
/**
* Create a pair with a single value.

39
scheme/cyclone/transforms.sld
View file

@ -913,21 +913,30 @@
(append a-lookup defines-a-lookup renamed))
(map (lambda (p) (cdr p)) defines-a-lookup)))))
((app? ast)
(cond
;; Special case, convert these to primitives if possible
((and (eq? (car ast) 'member)
(not (assoc (car ast) renamed))
(= (length ast) 3))
(cons 'Cyc-fast-member
(map (lambda (a) (convert a renamed)) (cdr ast))))
((and (eq? (car ast) 'assoc)
(not (assoc (car ast) renamed))
(= (length ast) 3))
(cons 'Cyc-fast-assoc
(map (lambda (a) (convert a renamed)) (cdr ast))))
;; Regular case, alpha convert everything
(else
(map (lambda (a) (convert a renamed)) ast))))
(let ((regular-case
(lambda ()
;; Regular case, alpha convert everything
(map (lambda (a) (convert a renamed)) ast))))
(cond
;; If identifier is renamed it is not a special case
((assoc (car ast) renamed)
(regular-case))
;; Special case, convert these to primitives if possible
((and (eq? (car ast) 'member) (= (length ast) 3))
(cons 'Cyc-fast-member (map (lambda (a) (convert a renamed)) (cdr ast))))
((and (eq? (car ast) 'assoc) (= (length ast) 3))
(cons 'Cyc-fast-assoc (map (lambda (a) (convert a renamed)) (cdr ast))))
((and (eq? (car ast) 'list) (= (length ast) 2))
(cons 'Cyc-fast-list-1 (map (lambda (a) (convert a renamed)) (cdr ast))))
((and (eq? (car ast) 'list) (= (length ast) 3))
(cons 'Cyc-fast-list-2 (map (lambda (a) (convert a renamed)) (cdr ast))))
((and (eq? (car ast) 'list) (= (length ast) 4))
(cons 'Cyc-fast-list-3 (map (lambda (a) (convert a renamed)) (cdr ast))))
((and (eq? (car ast) 'list) (= (length ast) 5))
(cons 'Cyc-fast-list-4 (map (lambda (a) (convert a renamed)) (cdr ast))))
;; Regular case, alpha convert everything
(else
(regular-case)))))
(else
(error "unhandled expression: " ast))))