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

WIP, works with regular sexp's

Browse source
This commit is contained in:
Justin Ethier 2018-05-21 18:12:16 -04:00
parent b31843c82c
commit fcf2a4b4e0
1 changed files with 37 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

42
find-named-lets.scm
View file

@ -1,7 +1,10 @@
(import (import
(scheme base) (scheme base)
(scheme cyclone ast) (scheme cyclone ast)
(scheme cyclone util)
(scheme cyclone pretty-print)
(scheme write) (scheme write)
(srfi 2)
) )
;; TODO: can we scan the ast to find loops created by named lets? ;; TODO: can we scan the ast to find loops created by named lets?
@ -43,21 +46,46 @@
,(scan (if->then exp)) ,(scan (if->then exp))
,(scan (if->else exp)))) ,(scan (if->else exp))))
((app? exp) ((app? exp)
(map scan exp)) (cond
((and-let* (
;; Find lambda with initial #f assignment
((lambda? (car exp)))
((pair? (cdr exp)))
((not (cadr exp)))
(= 1 (length (lambda->formals (car exp))))
;; Get information for continuation
(loop-sym (car (lambda->formals (car exp))))
(inner-exp (car (lambda->exp (car exp))))
((app? inner-exp))
((lambda? (car inner-exp)))
;; Find the set (assumes CPS conversion)
((pair? (cdr inner-exp)))
((set!? (cadr inner-exp)))
((equal? (set!->var (cadr inner-exp)) loop-sym))
;; Check the set's continuation
((app? (car (lambda->exp (car inner-exp)))))
((equal? (caar (lambda->exp (car inner-exp))) loop-sym))
)
(write `(found named lambda loop ,loop-sym))
;; Continue scanning
(map scan exp)
))
(else
(map scan exp))))
(else exp))) (else exp)))
;; Test code follows: ;; Test code follows:
(define sexp (define sexp
'(define count '(define count
(lambda-165-cont (lambda
(k$296 r$5$163 (k$296 r$5$163
i$4$162 i$4$162
step$3$161 step$3$161
x$2$160 x$2$160
y$1$159) y$1$159)
((lambda-155 ((lambda
(loop$14$171) (loop$14$171)
((lambda-139 ((lambda
(r$299) (r$299)
(loop$14$171 (loop$14$171
k$296 k$296
@ -73,7 +101,7 @@
step$3$161)) step$3$161))
0)) 0))
(set! loop$14$171 (set! loop$14$171
(lambda-154-cont (lambda
(k$301 zr$17$174 zi$16$173 c$15$172) (k$301 zr$17$174 zi$16$173 c$15$172)
(if (Cyc-fast-eq c$15$172 64) (if (Cyc-fast-eq c$15$172 64)
(k$301 c$15$172) (k$301 c$15$172)
@ -106,3 +134,7 @@
(Cyc-fast-plus c$15$172 1)))))))) (Cyc-fast-plus c$15$172 1))))))))
#f)))) #f))))
(scan
;(ast:sexp->ast
sexp);)