summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2013-11-03 20:24:54 +0100
committerAndy Wingo <wingo@pobox.com>2013-11-03 21:48:42 +0100
commit9ae9debbd35505ef4040c1a876f7bd64434d6d14 (patch)
tree8579e4d8ee4b99dcb226f3173f766a00359956b8
parent92afe25d5c162c29d971c2c36bd04a5b9d0b29c5 (diff)
downloadguile-9ae9debbd35505ef4040c1a876f7bd64434d6d14.tar.gz
struct-set! returns a value, yuck
* module/language/cps/arities.scm (fix-clause-arities): Add a hack to ensure that (struct-set! OBJ POS VAL) evaluates to VAL. Yuck.
-rw-r--r--module/language/cps/arities.scm30
1 files changed, 30 insertions, 0 deletions
diff --git a/module/language/cps/arities.scm b/module/language/cps/arities.scm
index 51b1892a1..fb888fdbe 100644
--- a/module/language/cps/arities.scm
+++ b/module/language/cps/arities.scm
@@ -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)