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

Working version

Browse source
This commit is contained in:
Justin Ethier 2018-10-31 13:09:14 -04:00
parent 9ba8467ba0
commit d4e4f3ddf4
1 changed files with 30 additions and 14 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

44
flatten-seq.scm
View file

@ -1,4 +1,4 @@
(import (scheme base) (scheme write) (scheme cyclone util)) (import (scheme base) (scheme write) (scheme cyclone util) (scheme cyclone pretty-print))
(define sexp (define sexp
'(Cyc-seq '(Cyc-seq
@ -8,21 +8,37 @@
((Cyc-seq ((Cyc-seq
(set-cdr! a '(2)))))))) (set-cdr! a '(2))))))))
;; TODO: goal is a single cyc-seq containing all expressions as a single list ;; Flatten a list containing subcalls of a given symbol.
(define (convert sexp) ;; For example, the expression:
;;
;; '(Cyc-seq
;; (set! b '(#f . #f))
;; ((Cyc-seq
;; (set-car! a 1)
;; ((Cyc-seq
;; (set-cdr! a '(2)))))))
;;
;; becomes:
;;
;; '(Cyc-seq
;; (set! b '(#f . #f))
;; (set-car! a 1)
;; (set-cdr! a '(2)))
;;
(define (flatten-subcalls sexp sym)
(define (flat sexp acc) (define (flat sexp acc)
(write `(flat ,sexp)) (newline)
(cond (cond
((null? sexp) acc) ((not (pair? sexp))
((tagged-list? 'Cyc-seq sexp) acc)
(flat (cdr sexp) acc)) ((and (app? (car sexp))
((and (app? sexp) (app? (caar sexp))
(tagged-list? 'Cyc-seq (car sexp))) (tagged-list? sym (caar sexp)))
(flat (cdar sexp) acc)) (flat (cdaar sexp) acc))
(else (else ;;(pair? sexp)
(flat (cdr sexp) (cons sexp acc)))) (flat (cdr sexp) (cons (car sexp) acc))))
) )
(reverse (reverse
(flat sexp '(Cyc-seq)))) (flat sexp '())))
(write (convert sexp)) (pretty-print (flatten-subcalls sexp 'Cyc-seq))
(pretty-print (flatten-subcalls '(a b c d e (f (g))) 'Cyc-seq))