From 99b4da8fb2098762c9d51ee5cc92b1db971bbe1d Mon Sep 17 00:00:00 2001
From: Andy Wingo <wingo@pobox.com>
Date: Tue, 28 May 2013 11:07:02 -0400
Subject: [PATCH] Rewrite tree-il pre-post-order in terms of (ice-9 match)

* module/language/tree-il.scm (pre-post-order): Re-implement in terms
  of (ice-9 match), so that we standardize on one matcher (more or
  less).
---
 module/language/tree-il.scm | 55 +++++++++++++++++++------------------
 1 file changed, 28 insertions(+), 27 deletions(-)

diff --git a/module/language/tree-il.scm b/module/language/tree-il.scm
index 0a5b72ae9..4e01df933 100644
--- a/module/language/tree-il.scm
+++ b/module/language/tree-il.scm
@@ -19,6 +19,7 @@
 (define-module (language tree-il)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
+  #:use-module (ice-9 match)
   #:use-module (system base pmatch)
   #:use-module (system base syntax)
   #:export (tree-il-src
@@ -532,85 +533,85 @@ This is an implementation of `foldts' as described by Andy Wingo in
 (define (pre-post-order pre post x)
   (let lp ((x x))
     (post
-     (record-case (pre x)
-       ((<void> src)
+     (match (pre x)
+       (($ <void> src)
         (make-void src))
 
-       ((<const> src exp)
+       (($ <const> src exp)
         (make-const src exp))
 
-       ((<primitive-ref> src name)
+       (($ <primitive-ref> src name)
         (make-primitive-ref src name))
 
-       ((<lexical-ref> src name gensym)
+       (($ <lexical-ref> src name gensym)
         (make-lexical-ref src name gensym))
 
-       ((<lexical-set> src name gensym exp)
+       (($ <lexical-set> src name gensym exp)
         (make-lexical-set src name gensym (lp exp)))
 
-       ((<module-ref> src mod name public?)
+       (($ <module-ref> src mod name public?)
         (make-module-ref src mod name public?))
 
-       ((<module-set> src mod name public? exp)
+       (($ <module-set> src mod name public? exp)
         (make-module-set src mod name public? (lp exp)))
 
-       ((<toplevel-ref> src name)
+       (($ <toplevel-ref> src name)
         (make-toplevel-ref src name))
 
-       ((<toplevel-set> src name exp)
+       (($ <toplevel-set> src name exp)
         (make-toplevel-set src name (lp exp)))
 
-       ((<toplevel-define> src name exp)
+       (($ <toplevel-define> src name exp)
         (make-toplevel-define src name (lp exp)))
 
-       ((<conditional> src test consequent alternate)
+       (($ <conditional> src test consequent alternate)
         (make-conditional src (lp test) (lp consequent) (lp alternate)))
 
-       ((<call> src proc args)
+       (($ <call> src proc args)
         (make-call src (lp proc) (map lp args)))
 
-       ((<primcall> src name args)
+       (($ <primcall> src name args)
         (make-primcall src name (map lp args)))
 
-       ((<seq> src head tail)
+       (($ <seq> src head tail)
         (make-seq src (lp head) (lp tail)))
       
-       ((<lambda> src meta body)
+       (($ <lambda> src meta body)
         (make-lambda src meta (and body (lp body))))
 
-       ((<lambda-case> src req opt rest kw inits gensyms body alternate)
+       (($ <lambda-case> src req opt rest kw inits gensyms body alternate)
         (make-lambda-case src req opt rest kw (map lp inits) gensyms (lp body)
                           (and alternate (lp alternate))))
 
-       ((<let> src names gensyms vals body)
+       (($ <let> src names gensyms vals body)
         (make-let src names gensyms (map lp vals) (lp body)))
 
-       ((<letrec> src in-order? names gensyms vals body)
+       (($ <letrec> src in-order? names gensyms vals body)
         (make-letrec src in-order? names gensyms (map lp vals) (lp body)))
 
-       ((<fix> src names gensyms vals body)
+       (($ <fix> src names gensyms vals body)
         (make-fix src names gensyms (map lp vals) (lp body)))
 
-       ((<let-values> src exp body)
+       (($ <let-values> src exp body)
         (make-let-values src (lp exp) (lp body)))
 
-       ((<dynwind> src winder pre body post unwinder)
+       (($ <dynwind> src winder pre body post unwinder)
         (make-dynwind src
                       (lp winder) (lp pre) (lp body) (lp post) (lp unwinder)))
 
-       ((<dynlet> src fluids vals body)
+       (($ <dynlet> src fluids vals body)
         (make-dynlet src (map lp fluids) (map lp vals) (lp body)))
 
-       ((<dynref> src fluid)
+       (($ <dynref> src fluid)
         (make-dynref src (lp fluid)))
 
-       ((<dynset> src fluid exp)
+       (($ <dynset> src fluid exp)
         (make-dynset src (lp fluid) (lp exp)))
 
-       ((<prompt> src tag body handler)
+       (($ <prompt> src tag body handler)
         (make-prompt src (lp tag) (lp body) (lp handler)))
 
-       ((<abort> src tag args tail)
+       (($ <abort> src tag args tail)
         (make-abort src (lp tag) (map lp args) (lp tail)))))))
 
 (define (post-order f x)