[Guile-commits] 04/04: Fix guild compile --to=cps / --from=cps

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit f261eaf03a607a22f8092dc43592ee72190494a7
Author: Andy Wingo <address@hidden>
Date:   Thu Feb 23 11:37:44 2017 +0100

    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 7330885..e2c46d2 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
   )