Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-07-04 11:46:35 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Relocate wrap-mutables

Browse source
This commit is contained in:
Justin Ethier 2019-09-16 21:33:17 -04:00
parent b6732b988a
commit 82dd4cb5c3
2 changed files with 213 additions and 209 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

213
scheme/cyclone/cps-optimizations.sld
View file

@ -110,6 +110,12 @@
adbf:set-vars-mutated-by-set! adbf:set-vars-mutated-by-set!
with-fnc with-fnc
with-fnc! with-fnc!
;; Wrap mutables
clear-mutables
mark-mutable
is-mutable?
analyze-mutable-variables
wrap-mutables
) )
(include "cps-opt-local-var-redux.scm") (include "cps-opt-local-var-redux.scm")
(include "cps-opt-analyze-call-graph.scm") (include "cps-opt-analyze-call-graph.scm")
@ -2453,4 +2459,211 @@
(close-port p) (close-port p)
result))) result)))
;; Mutable variable analysis and elimination.
;; Mutables variables analysis and elimination happens
;; on a desugared Intermediate Language (1).
;; Mutable variable analysis turns mutable variables
;; into heap-allocated cells:
;; For any mutable variable mvar:
;; (lambda (... mvar ...) body)
;; =>
;; (lambda (... $v ...)
;; (let ((mvar (cell $v)))
;; body))
;; (set! mvar value) => (set-cell! mvar value)
;; mvar => (cell-get mvar)
; mutable-variables : list[symbol]
(define mutable-variables '())
(define (clear-mutables)
(set! mutable-variables '()))
; mark-mutable : symbol -> void
(define (mark-mutable symbol)
(set! mutable-variables (cons symbol mutable-variables)))
; is-mutable? : symbol -> boolean
(define (is-mutable? symbol)
(define (is-in? S)
(if (not (pair? S))
#f
(if (eq? (car S) symbol)
#t
(is-in? (cdr S)))))
(is-in? mutable-variables))
(define mutated-loop-vars '())
(define (mark-mutated-loop-var sym)
(set! mutated-loop-vars (cons sym mutated-loop-vars)))
(define (mutated-loop-var? sym)
(member sym mutated-loop-var))
; analyze-mutable-variables : exp -> void
(define (analyze-mutable-variables exp)
(cond
; Core forms:
((ast:lambda? exp)
(map analyze-mutable-variables (ast:lambda-body exp))
(void))
((const? exp) (void))
((prim? exp) (void))
((ref? exp) (void))
((quote? exp) (void))
((lambda? exp)
(map analyze-mutable-variables (lambda->exp exp))
(void))
((set!? exp)
(mark-mutable (set!->var exp))
(analyze-mutable-variables (set!->exp exp)))
((if? exp)
(analyze-mutable-variables (if->condition exp))
(analyze-mutable-variables (if->then exp))
(analyze-mutable-variables (if->else exp)))
; Application:
((app? exp)
(map analyze-mutable-variables exp)
;; Check if the application is a sentinel indicating the
;; var may be used for a recursive loop.
;(when (and (= 2 (length exp))
; (ast:lambda? (car exp))
; (not (cadr exp)))
; ;; Candidate, see if the var is set to a lambda
; (with-var
;)
(void))
(else
(error "unknown expression type: " exp))))
; wrap-mutables : exp -> exp
(define (wrap-mutables exp globals)
(define (wrap-mutable-formals id formals body-exp has-cont)
(if (not (pair? formals))
body-exp
;(list body-exp)
(if (is-mutable? (car formals))
(list
(list ;(ast:%make-lambda
; id
(ast:make-lambda
(list (car formals))
(wrap-mutable-formals id (cdr formals) body-exp has-cont)
has-cont)
`(cell ,(car formals))))
(wrap-mutable-formals id (cdr formals) body-exp has-cont))))
(cond
; Core forms:
((ast:lambda? exp)
(ast:%make-lambda
(ast:lambda-id exp)
(ast:lambda-args exp)
(wrap-mutable-formals
(ast:lambda-id exp)
(ast:lambda-formals->list exp)
(list (wrap-mutables (car (ast:lambda-body exp)) globals))
(ast:lambda-has-cont exp))
(ast:lambda-has-cont exp)
)) ;; Assume single expr in lambda body, since after CPS phase
((const? exp) exp)
((ref? exp) (if (and (not (member exp globals))
(is-mutable? exp))
`(cell-get ,exp)
exp))
((prim? exp) exp)
((quote? exp) exp)
((lambda? exp) (error `(Unexpected lambda in wrap-mutables ,exp)))
((set!? exp) `(,(if (member (set!->var exp) globals)
'set-global!
'set-cell!)
,(set!->var exp)
,(wrap-mutables (set!->exp exp) globals)))
((if? exp) `(if ,(wrap-mutables (if->condition exp) globals)
,(wrap-mutables (if->then exp) globals)
,(wrap-mutables (if->else exp) globals)))
; Application:
((app? exp)
;; Easy place to clean up nested Cyc-seq expressions
(when (tagged-list? 'Cyc-seq exp)
(set! exp (flatten-sequence exp)))
(let ((result (map (lambda (e) (wrap-mutables e globals)) exp)))
;; This code can eliminate a lambda definition. But typically
;; the code that would have such a definition has a recursive
;; inner loop, so there is not much savings to eliminating the
;; single outer lambda:
;;
;;(cond
;; ((and (lambda? (car result))
;; (equal? (cdr result) '(#f))
;; (app? (car (lambda->exp (car result))))
;; (lambda? (car (car (lambda->exp (car result))))))
;; (let* ((inner-lambda (car (car (lambda->exp (car result)))))
;; (inner-formals (lambda-formals->list inner-lambda))
;; (inner-args (cdr (car (lambda->exp (car result)))))
;; (outer-formals (lambda-formals->list (car result)))
;; (opt? (and (pair? outer-formals)
;; (is-mutable? (car outer-formals))
;; (equal? outer-formals inner-formals)
;; (equal? inner-args `((cell ,(car inner-formals))))
;; )))
;; (trace:error `(DEBUG ,opt? ,outer-formals ,inner-formals ,inner-args))
;; ;result
;; (if opt?
;; `(,inner-lambda (cell #f))
;; result)
;; ))
;; (else result))))
result))
(else (error "unknown expression type: " exp))))
;; Flatten a list containing subcalls of a given symbol.
;; For example, the expression:
;;
;; '(Cyc-seq
;; (set! b '(#f . #f))
;; (Cyc-seq
;; (set-car! a 1)
;; (Cyc-seq
;; (set-cdr! a '(2))
;; ((fnc a1 a2 a3)))))
;;
;; becomes:
;;
;; '(Cyc-seq
;; (set! b '(#f . #f))
;; (set-car! a 1)
;; (set-cdr! a '(2))
;; ((fnc a1 a2 a3)))
;;
(define (flatten-sequence sexp)
(define (flat sexp acc)
(cond
((not (pair? sexp)) ;; Stop at end of sexp
acc)
((and (tagged-list? 'Cyc-seq (car sexp))) ;; Flatten nexted sequences
(flat (cdar sexp) acc))
((and (ref? (car sexp)) ;; Remove unused identifiers
(not (equal? 'Cyc-seq (car sexp))))
(flat (cdr sexp) acc))
(else ;;(pair? sexp)
(flat (cdr sexp) (cons (car sexp) acc))))
)
(reverse
(flat sexp '())))
(cond-expand
(cyclone
; void : -> void
(define (void) (if #f #t)))
(else #f))
)) ))

209
scheme/cyclone/transforms.sld
View file

@ -88,11 +88,6 @@
global-vars global-vars
filter-unused-variables filter-unused-variables
free-vars free-vars
clear-mutables
mark-mutable
is-mutable?
analyze-mutable-variables
wrap-mutables
alpha-convert alpha-convert
cps-convert cps-convert
prim-convert prim-convert
@ -737,210 +732,6 @@ if (acc) {
;; Mutable variable analysis and elimination.
;; Mutables variables analysis and elimination happens
;; on a desugared Intermediate Language (1).
;; Mutable variable analysis turns mutable variables
;; into heap-allocated cells:
;; For any mutable variable mvar:
;; (lambda (... mvar ...) body)
;; =>
;; (lambda (... $v ...)
;; (let ((mvar (cell $v)))
;; body))
;; (set! mvar value) => (set-cell! mvar value)
;; mvar => (cell-get mvar)
; mutable-variables : list[symbol]
(define mutable-variables '())
(define (clear-mutables)
(set! mutable-variables '()))
; mark-mutable : symbol -> void
(define (mark-mutable symbol)
(set! mutable-variables (cons symbol mutable-variables)))
; is-mutable? : symbol -> boolean
(define (is-mutable? symbol)
(define (is-in? S)
(if (not (pair? S))
#f
(if (eq? (car S) symbol)
#t
(is-in? (cdr S)))))
(is-in? mutable-variables))
(define mutated-loop-vars '())
(define (mark-mutated-loop-var sym)
(set! mutated-loop-vars (cons sym mutated-loop-vars)))
(define (mutated-loop-var? sym)
(member sym mutated-loop-var))
; analyze-mutable-variables : exp -> void
(define (analyze-mutable-variables exp)
(cond
; Core forms:
((ast:lambda? exp)
(map analyze-mutable-variables (ast:lambda-body exp))
(void))
((const? exp) (void))
((prim? exp) (void))
((ref? exp) (void))
((quote? exp) (void))
((lambda? exp)
(map analyze-mutable-variables (lambda->exp exp))
(void))
((set!? exp)
(mark-mutable (set!->var exp))
(analyze-mutable-variables (set!->exp exp)))
((if? exp)
(analyze-mutable-variables (if->condition exp))
(analyze-mutable-variables (if->then exp))
(analyze-mutable-variables (if->else exp)))
; Application:
((app? exp)
(map analyze-mutable-variables exp)
;; Check if the application is a sentinel indicating the
;; var may be used for a recursive loop.
;(when (and (= 2 (length exp))
; (ast:lambda? (car exp))
; (not (cadr exp)))
; ;; Candidate, see if the var is set to a lambda
; (with-var
;)
(void))
(else
(error "unknown expression type: " exp))))
; wrap-mutables : exp -> exp
(define (wrap-mutables exp globals)
(define (wrap-mutable-formals id formals body-exp has-cont)
(if (not (pair? formals))
body-exp
;(list body-exp)
(if (is-mutable? (car formals))
(list
(list ;(ast:%make-lambda
; id
(ast:make-lambda
(list (car formals))
(wrap-mutable-formals id (cdr formals) body-exp has-cont)
has-cont)
`(cell ,(car formals))))
(wrap-mutable-formals id (cdr formals) body-exp has-cont))))
(cond
; Core forms:
((ast:lambda? exp)
(ast:%make-lambda
(ast:lambda-id exp)
(ast:lambda-args exp)
(wrap-mutable-formals
(ast:lambda-id exp)
(ast:lambda-formals->list exp)
(list (wrap-mutables (car (ast:lambda-body exp)) globals))
(ast:lambda-has-cont exp))
(ast:lambda-has-cont exp)
)) ;; Assume single expr in lambda body, since after CPS phase
((const? exp) exp)
((ref? exp) (if (and (not (member exp globals))
(is-mutable? exp))
`(cell-get ,exp)
exp))
((prim? exp) exp)
((quote? exp) exp)
((lambda? exp) (error `(Unexpected lambda in wrap-mutables ,exp)))
((set!? exp) `(,(if (member (set!->var exp) globals)
'set-global!
'set-cell!)
,(set!->var exp)
,(wrap-mutables (set!->exp exp) globals)))
((if? exp) `(if ,(wrap-mutables (if->condition exp) globals)
,(wrap-mutables (if->then exp) globals)
,(wrap-mutables (if->else exp) globals)))
; Application:
((app? exp)
;; Easy place to clean up nested Cyc-seq expressions
(when (tagged-list? 'Cyc-seq exp)
(set! exp (flatten-sequence exp)))
(let ((result (map (lambda (e) (wrap-mutables e globals)) exp)))
;; This code can eliminate a lambda definition. But typically
;; the code that would have such a definition has a recursive
;; inner loop, so there is not much savings to eliminating the
;; single outer lambda:
;;
;;(cond
;; ((and (lambda? (car result))
;; (equal? (cdr result) '(#f))
;; (app? (car (lambda->exp (car result))))
;; (lambda? (car (car (lambda->exp (car result))))))
;; (let* ((inner-lambda (car (car (lambda->exp (car result)))))
;; (inner-formals (lambda-formals->list inner-lambda))
;; (inner-args (cdr (car (lambda->exp (car result)))))
;; (outer-formals (lambda-formals->list (car result)))
;; (opt? (and (pair? outer-formals)
;; (is-mutable? (car outer-formals))
;; (equal? outer-formals inner-formals)
;; (equal? inner-args `((cell ,(car inner-formals))))
;; )))
;; (trace:error `(DEBUG ,opt? ,outer-formals ,inner-formals ,inner-args))
;; ;result
;; (if opt?
;; `(,inner-lambda (cell #f))
;; result)
;; ))
;; (else result))))
result))
(else (error "unknown expression type: " exp))))
;; Flatten a list containing subcalls of a given symbol.
;; For example, the expression:
;;
;; '(Cyc-seq
;; (set! b '(#f . #f))
;; (Cyc-seq
;; (set-car! a 1)
;; (Cyc-seq
;; (set-cdr! a '(2))
;; ((fnc a1 a2 a3)))))
;;
;; becomes:
;;
;; '(Cyc-seq
;; (set! b '(#f . #f))
;; (set-car! a 1)
;; (set-cdr! a '(2))
;; ((fnc a1 a2 a3)))
;;
(define (flatten-sequence sexp)
(define (flat sexp acc)
(cond
((not (pair? sexp)) ;; Stop at end of sexp
acc)
((and (tagged-list? 'Cyc-seq (car sexp))) ;; Flatten nexted sequences
(flat (cdar sexp) acc))
((and (ref? (car sexp)) ;; Remove unused identifiers
(not (equal? 'Cyc-seq (car sexp))))
(flat (cdr sexp) acc))
(else ;;(pair? sexp)
(flat (cdr sexp) (cons (car sexp) acc))))
)
(reverse
(flat sexp '())))
;; Alpha conversion ;; Alpha conversion
;; (aka alpha renaming) ;; (aka alpha renaming)
;; ;;