Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-05-24 20:45:06 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Cleanup

Browse source
This commit is contained in:
Justin Ethier 2018-11-10 06:28:54 -05:00
parent c70c6f7338
commit 7d52c4de35
1 changed files with 70 additions and 67 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

137
test-find-local-vars.scm
View file

@ -1,69 +1,6 @@
(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))
;; Scan sexp to determine if sym is only called in a tail-call position ;; Local variable reduction:
(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)))))
;; Reduce given sexp by replacing certain lambda calls with a let containing ;; Reduce given sexp by replacing certain lambda calls with a let containing
;; local variables. Based on the way cyclone transforms code, this will ;; local variables. Based on the way cyclone transforms code, this will
;; typically be limited to if expressions embedded in other expressions. ;; typically be limited to if expressions embedded in other expressions.
@ -98,15 +35,15 @@
(equal? (length exp) 2) (equal? (length exp) 2)
(ast:lambda? (cadr exp)) (ast:lambda? (cadr exp))
(equal? 1 (length (ast:lambda-args (cadr exp)))) (equal? 1 (length (ast:lambda-args (cadr exp))))
(local-tail-call-only? (lvr:local-tail-call-only?
(ast:lambda-body (car exp)) (ast:lambda-body (car exp))
(car (ast:lambda-args (car exp))))) (car (ast:lambda-args (car exp)))))
;;(write `(tail-call-only? passed for ,exp)) (newline) ;;(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-body (car exp)))
;; (car (ast:lambda-args (car exp)))))) ;; (car (ast:lambda-args (car exp))))))
;;(newline) ;;(newline)
(let ((value (tail-calls->values (let ((value (lvr:tail-calls->values
(car (ast:lambda-body (car exp))) (car (ast:lambda-body (car exp)))
(car (ast:lambda-args (car exp))))) (car (ast:lambda-args (car exp)))))
(var (car (ast:lambda-args (cadr exp)))) (var (car (ast:lambda-args (cadr exp))))
@ -119,6 +56,72 @@
)) ))
(scan sexp)) (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 (define sexp
'(lambda '(lambda
(k$1073 i$88$682 first$89$683 row$90$684) (k$1073 i$88$682 first$89$683 row$90$684)