mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-10 14:00:21 +02:00
Code Activity

struct-set! returns a value, yuck

Browse source 
* module/language/cps/arities.scm (fix-clause-arities): Add a hack to
  ensure that (struct-set! OBJ POS VAL) evaluates to VAL.  Yuck.
This commit is contained in:
Andy Wingo 2013-11-03 20:24:54 +01:00
parent 92afe25d5c
commit 9ae9debbd3
1 changed files with 30 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

30
module/language/cps/arities.scm
View file

@ -134,6 +134,36 @@
(and (not (prim-rtl-instruction name))
(not (branching-primitive? name))))))
($continue k ,exp))
(($ $primcall 'struct-set! (obj pos val))
;; Unhappily, and undocumentedly, struct-set! returns the value
;; that was set. There is code that relies on this. Hackety
;; hack...
,(rewrite-cps-term (lookup-cont k conts)
(($ $ktail)
,(let-gensyms (kvoid)
(build-cps-term
($letk* ((kvoid #f ($kargs () ()
($continue ktail
($primcall 'return (val))))))
($continue kvoid ,exp)))))
(($ $ktrunc arity kargs)
,(rewrite-cps-term arity
(($ $arity () () #f () #f)
($continue kargs ,exp))
(_
,(let-gensyms (kvoid)
(build-cps-term
($letk* ((kvoid #f ($kargs () ()
($continue k
($primcall 'values (val))))))
($continue kvoid ,exp)))))))
(($ $kargs () () _)
($continue k ,exp))
(_
,(let-gensyms (k*)
(build-cps-term
($letk ((k* #f ($kargs () () ($continue k ($var val)))))
($continue k* ,exp)))))))
(($ $primcall name args)
,(match (prim-arity name)
((out . in)