mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-18 10:10:23 +02:00
Code Activity

Use immediate primcalls when unfolding constructors

Browse source 
* module/language/cps/constructors.scm (inline-vector): Use immediate
  primcalls.
This commit is contained in:
Andy Wingo 2017-11-09 14:14:35 +01:00
parent b27065fdf2
commit 7bfdd46ea5
1 changed files with 7 additions and 15 deletions
Download patch file Download diff file Expand all files Collapse all files

22
module/language/cps/constructors.scm
View file

@ -61,25 +61,17 @@
(with-cps out (with-cps out
(let$ next (initialize vec args (1+ n))) (let$ next (initialize vec args (1+ n)))
(letk knext ($kargs () () ,next)) (letk knext ($kargs () () ,next))
(letv u64) (build-term
(letk kunbox ($kargs ('idx) (u64) ($continue knext src
($continue knext src ($primcall 'vector-set!/immediate n (vec arg))))))))
($primcall 'vector-set! #f (vec u64 arg)))))
($ (with-cps-constants ((idx n))
(build-term ($continue kunbox src
($primcall 'scm->u64 #f (idx))))))))))
(with-cps out (with-cps out
(letv vec) (letv vec)
(let$ body (initialize vec args 0)) (let$ body (initialize vec args 0))
(letk kalloc ($kargs ('vec) (vec) ,body)) (letk kalloc ($kargs ('vec) (vec) ,body))
($ (with-cps-constants ((len (length args)) ($ (with-cps-constants ((init #f))
(init #f)) (build-term
(letv u64) ($continue kalloc src
(letk kunbox ($kargs ('len) (u64) ($primcall 'make-vector/immediate (length args) (init))))))))
($continue kalloc src
($primcall 'make-vector #f (u64 init)))))
(build-term ($continue kunbox src
($primcall 'scm->u64 #f (len))))))))
(define (find-constructor-inliner name) (define (find-constructor-inliner name)
(match name (match name