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

Cleanup, remove unused identifiers from sequences

Browse source
This commit is contained in:
Justin Ethier 2018-11-01 13:40:57 -04:00
parent 5868cd448c
commit 8aac3163af
1 changed files with 7 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

11
scheme/cyclone/transforms.sld
View file

@ -778,7 +778,7 @@
((app? exp) ((app? exp)
;; Easy place to clean up nested Cyc-seq expressions ;; Easy place to clean up nested Cyc-seq expressions
(when (tagged-list? 'Cyc-seq exp) (when (tagged-list? 'Cyc-seq exp)
(set! exp (flatten-subcalls exp 'Cyc-seq))) (set! exp (flatten-sequence exp)))
(let ((result (map (lambda (e) (wrap-mutables e globals)) exp))) (let ((result (map (lambda (e) (wrap-mutables e globals)) exp)))
;; This code can eliminate a lambda definition. But typically ;; This code can eliminate a lambda definition. But typically
;; the code that would have such a definition has a recursive ;; the code that would have such a definition has a recursive
@ -828,13 +828,16 @@
;; (set-cdr! a '(2)) ;; (set-cdr! a '(2))
;; ((fnc a1 a2 a3))) ;; ((fnc a1 a2 a3)))
;; ;;
(define (flatten-subcalls sexp sym) (define (flatten-sequence sexp)
(define (flat sexp acc) (define (flat sexp acc)
(cond (cond
((not (pair? sexp)) ((not (pair? sexp)) ;; Stop at end of sexp
acc) acc)
((and (tagged-list? sym (car sexp))) ((and (tagged-list? 'Cyc-seq (car sexp))) ;; Flatten nexted sequences
(flat (cdar sexp) acc)) (flat (cdar sexp) acc))
((and (ref? (car sexp)) ;; Remove unused identifiers
(not (equal? 'Cyc-seq (car sexp))))
(flat (cdr sexp) acc))
(else ;;(pair? sexp) (else ;;(pair? sexp)
(flat (cdr sexp) (cons (car sexp) acc)))) (flat (cdr sexp) (cons (car sexp) acc))))
) )