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

WIP

Browse source
This commit is contained in:
Justin Ethier 2018-05-30 18:51:35 -04:00
parent e63ee8f974
commit 74078d00b0
1 changed files with 37 additions and 78 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

115
find-direct-rec-calls.scm
View file

@ -8,78 +8,36 @@
) )
(define (find-direct-recursive-calls exp) (define (find-direct-recursive-calls exp)
(define (scan exp ?args?) (define (scan exp def-sym)
;;(cond (write `(scan ,def-sym ,exp)) (newline)
;; ((ast:lambda? exp) (cond
;; (let* ((id (ast:lambda-id exp)) ((ast:lambda? exp)
;; (has-cont (ast:lambda-has-cont exp)) #f)
;; (sym (string->symbol ((quote? exp) exp)
;; (string-append ((const? exp) exp)
;; "lambda-" ((ref? exp)
;; (number->string id) exp)
;; (if has-cont "-cont" "")))) ((define? exp) #f)
;; (args* (ast:lambda-args exp)) ((set!? exp) #f)
;; (args (if (null? args*) ((if? exp)
;; '() (scan (if->condition exp) def-sym)
;; (formals->list args*))) (scan (if->then exp) def-sym)
;; ) (scan (if->else exp) def-sym))
;; (when lp ((app? exp)
;; (for-each (when (equal? (car exp) def-sym)
;; (lambda (a) (write `(possible direct recursive call ,exp)))
;; (write `(,a defined in a loop)) )
;; (newline)) (else #f)))
;; args) (for-each
;; ) (lambda (exp)
;; `(,sym ,(ast:lambda-args exp) (cond
;; ,@(map (lambda (e) (scan e lp)) (ast:lambda-body exp)))) ((and-let* (((define? exp))
;; ) (def-exps (define->exp exp))
;; ((quote? exp) exp) (ast:lambda? (car def-exps))
;; ((const? exp) exp) )
;; ((ref? exp) (scan (car (ast:lambda-body (car def-exps))) (define->var exp))))
;; (when lp (else #f)))
;; (write `(found variable ,exp within a loop)) exp)
;; (newline))
;; exp)
;; ((define? exp)
;; `(define ,(define->var exp)
;; ,@(scan (define->exp exp) lp)))
;; ((set!? exp)
;; `(set! ,(set!->var exp)
;; ,(scan (set!->exp exp) lp)))
;; ((if? exp)
;; `(if ,(scan (if->condition exp) lp)
;; ,(scan (if->then exp) lp)
;; ,(scan (if->else exp) lp)))
;; ((app? exp)
;; (cond
;; ((and-let* (
;; ;; Find lambda with initial #f assignment
;; ((ast:lambda? (car exp)))
;; ((pair? (cdr exp)))
;; ((not (cadr exp)))
;; (= 1 (length (ast:lambda-args (car exp))))
;; ;; Get information for continuation
;; (loop-sym (car (ast:lambda-args (car exp))))
;; (inner-exp (car (ast:lambda-body (car exp))))
;; ((app? inner-exp))
;; ((ast: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 (ast:lambda-body (car inner-exp)))))
;; ((equal? (caar (ast:lambda-body (car inner-exp))) loop-sym))
;; )
;; (write `(found named lambda loop ,loop-sym))
;; ;; Continue scanning
;; (map (lambda (e) (scan e #t)) exp)
;; ))
;; (else
;; (map (lambda (e) (scan e lp)) exp))))
;; (else exp)))
)
(scan exp #f)
) )
;; TEST code: ;; TEST code:
@ -88,17 +46,17 @@
(define l12 #f) (define l12 #f)
(define l6 #f) (define l6 #f)
(define mas (define mas
(lambda-136-cont (lambda
(k$247 x$4$135 y$3$134 z$2$133) (k$247 x$4$135 y$3$134 z$2$133)
(shorterp (shorterp
(lambda-135 (lambda
(r$248) (r$248)
(if r$248 (if r$248
(mas (lambda-133 (mas (lambda
(r$249) (r$249)
(mas (lambda-131 (mas (lambda
(r$250) (r$250)
(mas (lambda-129 (mas (lambda
(r$251) (r$251)
(mas k$247 r$249 r$250 r$251)) (mas k$247 r$249 r$250 r$251))
(cdr z$2$133) (cdr z$2$133)
@ -114,7 +72,7 @@
y$3$134 y$3$134
x$4$135))) x$4$135)))
(define shorterp (define shorterp
(lambda-128-cont (lambda
(k$240 x$6$131 y$5$130) (k$240 x$6$131 y$5$130)
(if (null? y$5$130) (if (null? y$5$130)
(k$240 #f) (k$240 #f)
@ -123,5 +81,6 @@
(shorterp k$240 (cdr x$6$131) (cdr y$5$130)))))) (shorterp k$240 (cdr x$6$131) (cdr y$5$130))))))
)) ))
;(pretty-print (ast:sexp->ast sexp))
(find-direct-recursive-calls (find-direct-recursive-calls
(ast:sexp->ast sexp)) (ast:sexp->ast sexp))