From ba4152303680f16b1b65e466a5a3d3d1e67ac6a4 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Tue, 19 Aug 2008 00:50:52 +0000
Subject: [PATCH] document 'mzc --decompile'

svn: r11317

original commit: 76cf25fc12ea4bf1ce9c9fdb450e74b96873082f
---
 collects/compiler/decompile.ss | 60 ++++++++++++++++++++--------------
 collects/compiler/zo-parse.ss  |  2 +-
 2 files changed, 36 insertions(+), 26 deletions(-)

diff --git a/collects/compiler/decompile.ss b/collects/compiler/decompile.ss
index 95aab6ec6a..3beb726fbd 100644
--- a/collects/compiler/decompile.ss
+++ b/collects/compiler/decompile.ss
@@ -115,7 +115,7 @@
         ,(let-values ([(globs defns) (decompile-prefix prefix)])
            `(let ()
               ,@defns
-              ,(decompile-expr rhs globs '(#%globals)))))]
+              ,(decompile-form rhs globs '(#%globals)))))]
     [(struct def-for-syntax (ids rhs prefix max-let-depth))
      `(define-values-for-syntax ,ids
         ,(let-values ([(globs defns) (decompile-prefix prefix)])
@@ -188,24 +188,13 @@
          (if clear?
              `(#%sfs-clear ,e)
              e)))]
-    [(struct lam (name flags num-params rest? closure-map max-let-depth body))
-     (let ([vars (for/list ([i (in-range num-params)]) 
-                   (gensym (format "arg~a-" i)))]
-           [rest-vars (if rest? (list (gensym 'rest)) null)]
-           [captures (map (lambda (v)
-                            (list-ref/protect stack v))
-                          (vector->list closure-map))])
-       `(lambda (,@vars . ,(if rest?
-                               (car rest-vars)
-                               null))
-          ,@(if name
-                `(',name)
-                null)
-          ,@(if (null? captures)
-                null
-                `('(captures: ,@captures)))
-          ,(decompile-expr body globs (append captures
-                                              (append vars rest-vars)))))]
+    [(? lam?)
+     `(lambda . ,(decompile-lam expr globs stack))]
+    [(struct case-lam (name lams))
+     `(case-lambda
+       ,@(map (lambda (lam)
+                (decompile-lam lam globs stack))
+              lams))]
     [(struct let-one (rhs body))
      (let ([id (or (extract-id rhs)
                    (gensym 'local))])
@@ -222,12 +211,12 @@
             ,(decompile-expr body globs (append vars stack)))))]
     [(struct let-rec (procs body))
      `(begin
-        (set!-rec-values ,(for/list ([p (in-list procs)]
-                                     [i (in-naturals)])
-                            (list-ref/protect stack i))
-                         ,@(map (lambda (proc)
-                                  (decompile-expr proc globs stack))
-                                procs))
+        (#%set!-rec-values ,(for/list ([p (in-list procs)]
+                                       [i (in-naturals)])
+                              (list-ref/protect stack i))
+                           ,@(map (lambda (proc)
+                                    (decompile-expr proc globs stack))
+                                  procs))
         ,(decompile-expr body globs stack))]
     [(struct install-value (count pos boxes? rhs body))
      `(begin
@@ -274,6 +263,27 @@
          '???)]
     [else `(quote ,expr)]))
 
+(define (decompile-lam expr globs stack)
+  (match expr
+    [(struct lam (name flags num-params rest? closure-map max-let-depth body))
+     (let ([vars (for/list ([i (in-range num-params)]) 
+                   (gensym (format "arg~a-" i)))]
+           [rest-vars (if rest? (list (gensym 'rest)) null)]
+           [captures (map (lambda (v)
+                            (list-ref/protect stack v))
+                          (vector->list closure-map))])
+       `((,@vars . ,(if rest?
+                        (car rest-vars)
+                        null))
+         ,@(if (and name (not (null? name)))
+               `(',name)
+               null)
+         ,@(if (null? captures)
+               null
+               `('(captures: ,@captures)))
+         ,(decompile-expr body globs (append captures
+                                             (append vars rest-vars)))))]))
+
 ;; ----------------------------------------
 
 #;
diff --git a/collects/compiler/zo-parse.ss b/collects/compiler/zo-parse.ss
index 98528bbfa4..7bcefcbde9 100644
--- a/collects/compiler/zo-parse.ss
+++ b/collects/compiler/zo-parse.ss
@@ -235,7 +235,7 @@
       [(0) (read-define-values v)]
       [(1) (read-define-syntax v)]
       [(2) (read-set! v)]
-      [(3) (read-case-lambda v)]
+      [(3) v] ; a case-lam already
       [(4) (read-begin0 v)]
       [(5) (read-boxenv v)]
       [(6) (read-module-wrap v)]