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

Allow optimizing non-mutating prims

Browse source
This commit is contained in:
Justin Ethier 2016-06-09 00:04:30 -04:00
parent 19a8080103
commit 7fa4cd4ebd
2 changed files with 116 additions and 47 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -573,10 +573,20 @@
(inline-ok? (if->then exp) ivars args arg-used return) (inline-ok? (if->then exp) ivars args arg-used return)
(inline-ok? (if->else exp) ivars args arg-used return)) (inline-ok? (if->else exp) ivars args arg-used return))
((app? exp) ((app? exp)
(cond
((and (prim? (car exp))
(not (prim:mutates? (car exp))))
;; If primitive does not mutate its args, ignore if ivar is used
(for-each
(lambda (e)
(if (not (ref? e))
(inline-ok? e ivars args arg-used return)))
(reverse (cdr exp))))
(else
(for-each (for-each
(lambda (e) (lambda (e)
(inline-ok? e ivars args arg-used return)) (inline-ok? e ivars args arg-used return))
(reverse exp))) ;; Ensure args are examined before function (reverse exp))))) ;; Ensure args are examined before function
(else (else
(error `(Unexpected expression passed to inline prim check ,exp))))) (error `(Unexpected expression passed to inline prim check ,exp)))))

131
scheme/cyclone/test-cps.scm
View file

@ -98,57 +98,116 @@
; 3)))) ; 3))))
; 0))))) ; 0)))))
;(define code
;'(#((record-marker)
; #((record-marker) #f (id args body))
; #(6
; ()
; ((#((record-marker)
; #((record-marker) #f (id args body))
; #(5
; (r$2)
; ((#((record-marker)
; #((record-marker) #f (id args body))
; #(4
; (x$3 y$2 z$1)
; ((#((record-marker)
; #((record-marker) #f (id args body))
; #(3
; (r$4)
; ((#((record-marker)
; #((record-marker) #f (id args body))
; #(2
; (r$3)
; ((write #((record-marker)
; #((record-marker) #f (id args body))
; #(1 (r$1) ((r$1 %halt))))
; r$3))))
; (cons x$3 r$4)))))
; (cons y$2 z$1)))))
; 1
; 2
; 3))))
; 0)))))
;)
(define code (define code
'(#((record-marker) '((define in-port:read-buf!
#((record-marker)
#((record-marker) #f (id args body)) #((record-marker) #f (id args body))
#(6 #(621
() (k$807 ptbl$260)
((#((record-marker) ((#((record-marker)
#((record-marker) #f (id args body)) #((record-marker) #f (id args body))
#(5 #(619
(r$2) (result$261)
((#((record-marker) ((in-port:set-buf!
#((record-marker)
#((record-marker) #f (id args body)) #((record-marker) #f (id args body))
#(4 #(618 (r$809) ((k$807 result$261))))
(x$3 y$2 z$1) ptbl$260
((#((record-marker) #f))))
#((record-marker) #f (id args body)) (cadr ptbl$260)))))))
#(3
(r$4)
((#((record-marker)
#((record-marker) #f (id args body))
#(2
(r$3)
((write #((record-marker)
#((record-marker) #f (id args body))
#(1 (r$1) ((r$1 %halt))))
r$3))))
(cons x$3 r$4)))))
(cons y$2 z$1)))))
1
2
3))))
0)))))
) )
;(define code ;(define code
;'((define in-port:read-buf! ;'((define and
; #((record-marker) ; #((record-marker)
; #((record-marker) #f (id args body)) ; #((record-marker) #f (id args body))
; #(621 ; #(2835
; (k$807 ptbl$260) ; (k$3825 expr$1082 rename$1081 compare$1080)
; ((#((record-marker) ; ((#((record-marker)
; #((record-marker) #f (id args body)) ; #((record-marker) #f (id args body))
; #(619 ; #(2834
; (result$261) ; (r$3836)
; ((in-port:set-buf! ; ((if (null? r$3836)
; (k$3825 #t)
; (#((record-marker)
; #((record-marker) #f (id args body))
; #(2832
; (r$3835)
; ((if (null? r$3835)
; (k$3825 (cadr expr$1082))
; (#((record-marker)
; #((record-marker) #f (id args body))
; #(2829
; (r$3834)
; ((rename$1081
; #((record-marker) ; #((record-marker)
; #((record-marker) #f (id args body)) ; #((record-marker) #f (id args body))
; #(618 (r$809) ((k$807 result$261)))) ; #(2828
; ptbl$260 ; (r$3828)
; ((#((record-marker)
; #((record-marker) #f (id args body))
; #(2827
; (r$3829)
; ((#((record-marker)
; #((record-marker)
; #f
; (id args body))
; #(2826
; (r$3833)
; ((rename$1081
; #((record-marker)
; #((record-marker)
; #f
; (id args body))
; #(2825
; (r$3831)
; ((list k$3825
; r$3828
; r$3829
; (cons r$3831
; (cddr expr$1082))
; #f)))) ; #f))))
; (cadr ptbl$260))))))) ; r$3833))))
;) ; 'and))))
; (cadr expr$1082)))))
; r$3834))))
; 'if)))))
; (cddr expr$1082))))))
; (cdr expr$1082))))))
;))
(pretty-print (pretty-print
(optimize-cps code)) (optimize-cps code))