Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-07-12 23:37:38 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

First working version

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

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

@ -1,6 +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))
;; TODO: scan sexp, is sym only called in tail-call position? ;; Scan sexp to determine if sym is only called in a tail-call position
(define (local-tail-call-only? sexp sym) (define (local-tail-call-only? sexp sym)
(call/cc (call/cc
(lambda (return) (lambda (return)
@ -32,11 +32,12 @@
(scan sexp #f) (scan sexp #f)
(return #t)))) (return #t))))
;; Transform all tail calls of sym in the sexp to just the value passed
(define (tail-calls->values sexp sym) (define (tail-calls->values sexp sym)
(call/cc (call/cc
(lambda (return) (lambda (return)
(define (scan exp) (define (scan exp)
(write `(DEBUG scan ,exp)) (newline) ;;(write `(DEBUG scan ,exp)) (newline)
(cond (cond
((ast:lambda? exp) ((ast:lambda? exp)
(return #f)) ;; Could be OK if not ref'd... (return #f)) ;; Could be OK if not ref'd...
@ -63,28 +64,33 @@
(return (return
(scan sexp))))) (scan sexp)))))
(define (find-local-vars sexp) ;; 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.
(define (opt:local-var-reduction sexp)
(define (scan exp) (define (scan exp)
(cond (cond
((ast:lambda? exp) ((ast:lambda? exp)
(for-each (ast:%make-lambda
scan (ast:lambda-id exp)
(ast:lambda-body exp))) (ast:lambda-args exp)
(map scan (ast:lambda-body exp))
(ast:lambda-has-cont exp)))
((quote? exp) exp) ((quote? exp) exp)
((const? exp) exp) ((const? exp) exp)
((ref? exp) exp) ((ref? exp) exp)
((define? exp) ((define? exp)
(for-each `(define
scan ,(define->var exp)
(define->exp exp))) ,(map scan (define->exp exp))))
((set!? exp) ((set!? exp)
(for-each `(set!
scan ,(set!->var exp)
(set!->exp exp))) ,(set!->exp exp)))
((if? exp) ((if? exp)
(scan (if->condition exp)) `(if ,(scan (if->condition exp))
(scan (if->then exp)) ,(scan (if->then exp))
(scan (if->else exp))) ,(scan (if->else exp))))
((app? exp) ((app? exp)
(cond (cond
((and ((and
@ -95,21 +101,21 @@
(local-tail-call-only? (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 ,(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 (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))))
(body (ast:lambda-body (cadr exp)))) (body (ast:lambda-body (cadr exp))))
`((let ((,var ,value)) `(let ((,var ,value))
,body)))) ,@body)))
(else (else
(map scan exp)))) (map scan exp))))
(else 'todo) (else (error "unknown expression type: " exp))
)) ))
(scan sexp)) (scan sexp))
@ -148,4 +154,5 @@
; (ast:sexp->ast sexp))) ; (ast:sexp->ast sexp)))
(pretty-print (pretty-print
(find-local-vars (ast:sexp->ast sexp))) (ast:ast->pp-sexp
(opt:local-var-reduction (ast:sexp->ast sexp))))