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

Cleaner flattening now that code generation has been fixed

Browse source
This commit is contained in:
Justin Ethier 2018-11-01 13:20:20 -04:00
parent 61d265c512
commit 5868cd448c
2 changed files with 22 additions and 21 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

25
flatten-seq.scm
View file

@ -3,37 +3,38 @@
(define sexp
'(Cyc-seq
(set! b '(#f . #f))
((Cyc-seq
(Cyc-seq
(set-car! a 1)
((Cyc-seq
(set-cdr! a '(2))))))))
(Cyc-seq
(set-cdr! a '(2))
((fnc a1 a2 a3))))))
;; Flatten a list containing subcalls of a given symbol.
;; For example, the expression:
;;
;; '(Cyc-seq
;; (set! b '(#f . #f))
;; ((Cyc-seq
;; (Cyc-seq
;; (set-car! a 1)
;; ((Cyc-seq
;; (set-cdr! a '(2)))))))
;; (Cyc-seq
;; (set-cdr! a '(2))
;; ((fnc a1 a2 a3)))))
;;
;; becomes:
;;
;; '(Cyc-seq
;; (set! b '(#f . #f))
;; (set-car! a 1)
;; (set-cdr! a '(2)))
;; (set-car! a 1)
;; (set-cdr! a '(2))
;; ((fnc a1 a2 a3)))
;;
(define (flatten-subcalls sexp sym)
(define (flat sexp acc)
(cond
((not (pair? sexp))
acc)
((and (app? (car sexp))
(app? (caar sexp))
(tagged-list? sym (caar sexp)))
(flat (cdaar sexp) acc))
((and (tagged-list? sym (car sexp)))
(flat (cdar sexp) acc))
(else ;;(pair? sexp)
(flat (cdr sexp) (cons (car sexp) acc))))
)

18
scheme/cyclone/transforms.sld
View file

@ -814,27 +814,27 @@
;;
;; '(Cyc-seq
;; (set! b '(#f . #f))
;; ((Cyc-seq
;; (Cyc-seq
;; (set-car! a 1)
;; ((Cyc-seq
;; (set-cdr! a '(2)))))))
;; (Cyc-seq
;; (set-cdr! a '(2))
;; ((fnc a1 a2 a3)))))
;;
;; becomes:
;;
;; '(Cyc-seq
;; (set! b '(#f . #f))
;; (set-car! a 1)
;; (set-cdr! a '(2)))
;; (set-car! a 1)
;; (set-cdr! a '(2))
;; ((fnc a1 a2 a3)))
;;
(define (flatten-subcalls sexp sym)
(define (flat sexp acc)
(cond
((not (pair? sexp))
acc)
((and (app? (car sexp))
(app? (caar sexp))
(tagged-list? sym (caar sexp)))
(flat (cdaar sexp) acc))
((and (tagged-list? sym (car sexp)))
(flat (cdar sexp) acc))
(else ;;(pair? sexp)
(flat (cdr sexp) (cons (car sexp) acc))))
)