From 9ae9debbd35505ef4040c1a876f7bd64434d6d14 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Sun, 3 Nov 2013 20:24:54 +0100 Subject: [PATCH] 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. --- module/language/cps/arities.scm | 30 ++++++++++++++++++++++++++++++ 1 file changed, 30 insertions(+) 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)