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

Pre-sort the list of globals

Browse source 
This cuts down on the amount of work that must be done by the alpha conversion.
This commit is contained in:
Justin Ethier 2018-12-18 16:33:24 -05:00
parent e864049136
commit a46a9e92d3
2 changed files with 18 additions and 52 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
cyclone.scm
View file

@ -267,6 +267,7 @@
; set!'s below, since all remaining phases operate on set!, not define.
;
; TODO: consider moving some of this alpha-conv logic below back into trans?
(set! globals (union globals '())) ;; Ensure list is sorted
(set! input-program
(map
(lambda (expr)

53
scheme/cyclone/transforms.sld
View file

@ -207,6 +207,7 @@
; ((eq? sym (car S)) S)
; ((symbol<? sym (car S)) (cons sym S))
; (else (cons (car S) (insert sym (cdr S)))))))
;
(define-c insert
"(void *data, int argc, closure _,object k_7318, object sym_731_7312, object S_732_7313)"
"
@ -268,47 +269,11 @@ if (acc) {
(cons (car S) (remove sym (cdr S))))))
; union : sorted-set[symbol] sorted-set[symbol] -> sorted-set[symbol]
;(define (union set1 set2)
(define (sort+uniq set1 set2) ;; Sorts set1 and removes duplicates from it
(define (union set1 set2)
; NOTE: This should be implemented as merge for efficiency.
(if (not (pair? set1))
set2
(insert (car set1) (sort+uniq (cdr set1) set2))))
;(define (union x y)
; (let ((result (my-union x y)))
; (trace:error `(union ,x ,y ,result ,(old-union x y)))
; result))
;
;; TODO: can use the old union to sort a list, EG:
;; cyclone> (union '(x d e d d g e c g a c be) '())
;; (a be c d e g x)
;; see if we can combine that (EG: sorting globals) along with the below (which we can then convert to C)
;; to speed things up
;;
(define (union l1 l2)
(trace:error `(union ,l1 ,l2))
(inner-union #f l1 l2))
(define inner-union
(lambda (last l1 l2)
(if (null? l1)
(next last l2)
(if (null? l2)
(next last l1)
;; TODO: also have an eq? check to eliminate duplicates
(if (symbol<? (car l1) (car l2))
(if (eq? last (car l1))
(inner-union last (cdr l1) l2)
(cons (car l1) (inner-union (car l1) (cdr l1) l2)))
(if (eq? last (car l2))
(inner-union last l1 (cdr l2))
(cons (car l2) (inner-union (car l2) l1 (cdr l2)))))))))
(define (next sym lis)
(if (and (pair? lis) (eq? sym (car lis)))
(next sym (cdr lis))
lis))
(insert (car set1) (union (cdr set1) set2))))
; difference : sorted-set[symbol] sorted-set[symbol] -> sorted-set[symbol]
(define (difference set1 set2)
@ -737,7 +702,7 @@ if (acc) {
(cond
; Core forms:
((ast:lambda? exp)
(difference (sort+uniq (reduce union (map search (ast:lambda-body exp)) '()) '())
(difference (reduce union (map search (ast:lambda-body exp)) '())
(ast:lambda-formals->list exp)))
((const? exp) '())
((prim? exp) '())
@ -747,7 +712,7 @@ if (acc) {
'()
(if bound-only? '() (list exp))))
((lambda? exp)
(difference (sort+uniq (reduce union (map search (lambda->exp exp)) '()) '())
(difference (reduce union (map search (lambda->exp exp)) '())
(lambda-formals->list exp)))
((if-syntax? exp) (union (search (if->condition exp))
(union (search (if->then exp))
@ -763,7 +728,7 @@ if (acc) {
; Application:
((app? exp) (reduce union (map search exp) '()))
(else (error "unknown expression: " exp))))
(sort+uniq (search ast) '()))
(search ast))
@ -1147,9 +1112,9 @@ if (acc) {
(else
(error "unhandled expression: " ast))))
(let* ((fv (difference (sort+uniq (free-vars ast) '()) globals))
(let* ((fv (difference (free-vars ast) globals))
;; Only find set! and lambda vars
(bound-vars (union (sort+uniq globals '()) (free-vars ast #t)))
(bound-vars (union (free-vars ast #t) globals))
;; vars never bound in prog, but could be built-in
(unbound-vars (difference fv bound-vars))
;; vars we know nothing about - error!
@ -1196,7 +1161,7 @@ if (acc) {
(map (lambda (p) (cdr p)) a-lookup)
ltype)
,@(convert (let ((fv* (union
(sort+uniq define-vars '())
define-vars
(difference fv (built-in-syms))))
(ast* (lambda->exp body)))
(if (> (length fv*) 0)