Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-07-05 20:26: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

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

@ -573,10 +573,20 @@
(inline-ok? (if->then exp) ivars args arg-used return)
(inline-ok? (if->else exp) ivars args arg-used return))
((app? exp)
(for-each
(lambda (e)
(inline-ok? e ivars args arg-used return))
(reverse exp))) ;; Ensure args are examined before function
(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
(lambda (e)
(inline-ok? e ivars args arg-used return))
(reverse exp))))) ;; Ensure args are examined before function
(else
(error `(Unexpected expression passed to inline prim check ,exp)))))

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

@ -98,57 +98,116 @@
; 3))))
; 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
'(#((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 in-port:read-buf!
#((record-marker)
#((record-marker) #f (id args body))
#(621
(k$807 ptbl$260)
((#((record-marker)
#((record-marker) #f (id args body))
#(619
(result$261)
((in-port:set-buf!
#((record-marker)
#((record-marker) #f (id args body))
#(618 (r$809) ((k$807 result$261))))
ptbl$260
#f))))
(cadr ptbl$260)))))))
)
;(define code
;'((define in-port:read-buf!
;'((define and
; #((record-marker)
; #((record-marker) #f (id args body))
; #(621
; (k$807 ptbl$260)
; #(2835
; (k$3825 expr$1082 rename$1081 compare$1080)
; ((#((record-marker)
; #((record-marker) #f (id args body))
; #(619
; (result$261)
; ((in-port:set-buf!
; #((record-marker)
; #((record-marker) #f (id args body))
; #(618 (r$809) ((k$807 result$261))))
; ptbl$260
; #f))))
; (cadr ptbl$260)))))))
;)
; #(2834
; (r$3836)
; ((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) #f (id args body))
; #(2828
; (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))))
; r$3833))))
; 'and))))
; (cadr expr$1082)))))
; r$3834))))
; 'if)))))
; (cddr expr$1082))))))
; (cdr expr$1082))))))
;))
(pretty-print
(optimize-cps code))