From f261eaf03a607a22f8092dc43592ee72190494a7 Mon Sep 17 00:00:00 2001
From: Andy Wingo <wingo@pobox.com>
Date: Thu, 23 Feb 2017 11:37:44 +0100
Subject: [PATCH] Fix guild compile --to=cps / --from=cps

* module/language/cps/spec.scm (read-cps, write-cps): Fix CPS
  serialization and parsing, so that "guild compile" works with --to=cps
  and --from=cps.
---
 module/language/cps/spec.scm | 20 +++++++++++++++++---
 1 file changed, 17 insertions(+), 3 deletions(-)

diff --git a/module/language/cps/spec.scm b/module/language/cps/spec.scm
index 7330885ab..e2c46d275 100644
--- a/module/language/cps/spec.scm
+++ b/module/language/cps/spec.scm
@@ -19,19 +19,33 @@
 ;;; Code:
 
 (define-module (language cps spec)
+  #:use-module (ice-9 match)
   #:use-module (system base language)
   #:use-module (language cps)
+  #:use-module (language cps intmap)
   #:use-module (language cps compile-bytecode)
   #:export (cps))
 
+(define (read-cps port env)
+  (let lp ((out empty-intmap))
+    (match (read port)
+      ((k exp) (lp (intmap-add! out k (parse-cps exp))))
+      ((? eof-object?)
+       (if (eq? out empty-intmap)
+           the-eof-object
+           (persistent-intmap out))))))
+
 (define* (write-cps exp #:optional (port (current-output-port)))
-  (write (unparse-cps exp) port))
+  (intmap-fold (lambda (k cps port)
+                 (write (list k (unparse-cps cps)) port)
+                 (newline port)
+                 port)
+               exp port))
 
 (define-language cps
   #:title	"CPS Intermediate Language"
-  #:reader	(lambda (port env) (read port))
+  #:reader	read-cps
   #:printer	write-cps
-  #:parser      parse-cps
   #:compilers   `((bytecode . ,compile-bytecode))
   #:for-humans? #f
   )