diff options
author | Andy Wingo <wingo@pobox.com> | 2013-11-03 20:24:54 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2013-11-03 21:48:42 +0100 |
commit | 9ae9debbd35505ef4040c1a876f7bd64434d6d14 (patch) | |
tree | 8579e4d8ee4b99dcb226f3173f766a00359956b8 | |
parent | 92afe25d5c162c29d971c2c36bd04a5b9d0b29c5 (diff) | |
download | guile-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.scm | 30 |
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) |