This commit is contained in:
Justin Ethier 2018-11-09 17:28:49 -05:00
parent 5cfcf88a37
commit d8b46a019a

View file

@ -1,5 +1,37 @@
(import (scheme base) (scheme write) (scheme cyclone ast) (scheme cyclone util) (scheme cyclone pretty-print)) (import (scheme base) (scheme write) (scheme cyclone ast) (scheme cyclone util) (scheme cyclone pretty-print))
;; TODO: scan sexp, is sym only called in tail-call position?
(define (local-tail-call-only? sexp sym)
(call/cc
(lambda (return)
(define (scan exp fail?)
(cond
((ast:lambda? exp)
(return #f)) ;; Could be OK if not ref'd...
;((quote? exp) exp)
;((const? exp) exp)
((ref? exp)
(if (equal? exp sym)
(return #f))) ;; Assume not a tail call
((define? exp)
(return #f)) ;; Fail fast
((set!? exp)
(return #f)) ;; Fail fast
((if? exp)
(scan (if->condition exp) #t) ;; fail if found under here
(scan (if->then exp) fail?)
(scan (if->else exp) fail?))
((app? exp)
(cond
((and (equal? (car exp) sym)
(not fail?))
(map (lambda (e) (scan e fail?)) (cdr exp))) ;; Sym is OK, skip
(else
(map (lambda (e) (scan e fail?)) exp))))
(else exp)))
(scan sexp #f)
(return #t))))
(define (find-local-vars sexp) (define (find-local-vars sexp)
(define (scan exp) (define (scan exp)
(cond (cond
@ -24,27 +56,14 @@
(scan (if->else exp))) (scan (if->else exp)))
((app? exp) ((app? exp)
(cond (cond
((ast:lambda? (car exp)) ((and
;; TODO: want to find this: (ast:lambda? (car exp))
;; ((lambda (equal? (length exp) 2)
;; (k$1080) (ast:lambda? (cadr exp))
;; (if (Cyc-fast-eq (local-tail-call-only?
;; (car first$89$683) (ast:lambda-body (car exp))
;; (car row$90$684)) (car (ast:lambda-args (car exp)))))
;; (k$1080 if-equal$76$674) (write `(tail-call-only? passed for ,exp)) (newline)
;; (k$1080 if-different$77$675)))
;; (lambda
;; (r$1079)
;; (Cyc-seq
;; (vector-set!
;; vec$79$677
;; i$88$682
;; r$1079)
;; ((cell-get lp$80$87$681)
;; k$1073
;; (Cyc-fast-plus i$88$682 1)
;; (cdr first$89$683)
;; (cdr row$90$684))))))))
'TODO) 'TODO)
(else (else
(map scan exp)))) (map scan exp))))