mirror of
https://github.com/justinethier/cyclone.git
synced 2025-05-23 20:15:05 +02:00
Cleanup
This commit is contained in:
parent
c70c6f7338
commit
7d52c4de35
1 changed files with 70 additions and 67 deletions
|
@ -1,69 +1,6 @@
|
|||
(import (scheme base) (scheme write) (scheme cyclone ast) (scheme cyclone util) (scheme cyclone pretty-print))
|
||||
|
||||
;; Scan sexp to determine if sym is only called in a 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))))
|
||||
|
||||
;; Transform all tail calls of sym in the sexp to just the value passed
|
||||
(define (tail-calls->values sexp sym)
|
||||
(call/cc
|
||||
(lambda (return)
|
||||
(define (scan exp)
|
||||
;;(write `(DEBUG scan ,exp)) (newline)
|
||||
(cond
|
||||
((ast:lambda? exp)
|
||||
(return #f)) ;; Could be OK if not ref'd...
|
||||
((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)
|
||||
`(if ,(if->condition exp)
|
||||
,(scan (if->then exp))
|
||||
,(scan (if->else exp))))
|
||||
((app? exp)
|
||||
(cond
|
||||
((and (equal? (car exp) sym)
|
||||
(= (length exp) 2)
|
||||
)
|
||||
(cadr exp))
|
||||
(else
|
||||
(return #f))))
|
||||
(else exp)))
|
||||
(return
|
||||
(scan sexp)))))
|
||||
|
||||
;; Local variable reduction:
|
||||
;; Reduce given sexp by replacing certain lambda calls with a let containing
|
||||
;; local variables. Based on the way cyclone transforms code, this will
|
||||
;; typically be limited to if expressions embedded in other expressions.
|
||||
|
@ -98,15 +35,15 @@
|
|||
(equal? (length exp) 2)
|
||||
(ast:lambda? (cadr exp))
|
||||
(equal? 1 (length (ast:lambda-args (cadr exp))))
|
||||
(local-tail-call-only?
|
||||
(lvr:local-tail-call-only?
|
||||
(ast:lambda-body (car exp))
|
||||
(car (ast:lambda-args (car exp)))))
|
||||
;;(write `(tail-call-only? passed for ,exp)) (newline)
|
||||
;;(write `(replace with ,(tail-calls->values
|
||||
;;(write `(replace with ,(lvr:tail-calls->values
|
||||
;; (car (ast:lambda-body (car exp)))
|
||||
;; (car (ast:lambda-args (car exp))))))
|
||||
;;(newline)
|
||||
(let ((value (tail-calls->values
|
||||
(let ((value (lvr:tail-calls->values
|
||||
(car (ast:lambda-body (car exp)))
|
||||
(car (ast:lambda-args (car exp)))))
|
||||
(var (car (ast:lambda-args (cadr exp))))
|
||||
|
@ -119,6 +56,72 @@
|
|||
))
|
||||
(scan sexp))
|
||||
|
||||
;; Local variable reduction helper:
|
||||
;; Scan sexp to determine if sym is only called in a tail-call position
|
||||
(define (lvr: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))))
|
||||
|
||||
;; Local variable reduction helper:
|
||||
;; Transform all tail calls of sym in the sexp to just the value passed
|
||||
(define (lvr:tail-calls->values sexp sym)
|
||||
(call/cc
|
||||
(lambda (return)
|
||||
(define (scan exp)
|
||||
;;(write `(DEBUG scan ,exp)) (newline)
|
||||
(cond
|
||||
((ast:lambda? exp)
|
||||
(return #f)) ;; Could be OK if not ref'd...
|
||||
((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)
|
||||
`(if ,(if->condition exp)
|
||||
,(scan (if->then exp))
|
||||
,(scan (if->else exp))))
|
||||
((app? exp)
|
||||
(cond
|
||||
((and (equal? (car exp) sym)
|
||||
(= (length exp) 2)
|
||||
)
|
||||
(cadr exp))
|
||||
(else
|
||||
(return #f))))
|
||||
(else exp)))
|
||||
(return
|
||||
(scan sexp)))))
|
||||
|
||||
(define sexp
|
||||
'(lambda
|
||||
(k$1073 i$88$682 first$89$683 row$90$684)
|
||||
|
|
Loading…
Add table
Reference in a new issue