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
'(Cyc-seq
@ -8,21 +8,37 @@
((Cyc-seq
(set-cdr! a '(2))))))))
;; TODO: goal is a single cyc-seq containing all expressions as a single list
(define (convert sexp)
;; Flatten a list containing subcalls of a given symbol.
;; 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)
(write `(flat ,sexp)) (newline)
(cond
((null? sexp) acc)
((tagged-list? 'Cyc-seq sexp)
(flat (cdr sexp) acc))
((and (app? sexp)
(tagged-list? 'Cyc-seq (car sexp)))
(flat (cdar sexp) acc))
(else
(flat (cdr sexp) (cons sexp acc))))
((not (pair? sexp))
acc)
((and (app? (car sexp))
(app? (caar sexp))
(tagged-list? sym (caar sexp)))
(flat (cdaar sexp) acc))
(else ;;(pair? sexp)
(flat (cdr sexp) (cons (car sexp) acc))))
)
(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))