mirror of
https://github.com/justinethier/cyclone.git
synced 2025-07-15 16:57:35 +02:00
WIP
This commit is contained in:
parent
5cfcf88a37
commit
d8b46a019a
1 changed files with 40 additions and 21 deletions
|
@ -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))))
|
||||||
|
|
Loading…
Add table
Reference in a new issue