document compiler/zo-parse and compiler/decompile

svn: r12947

original commit: 7aec6b8761

collects/compiler/decompile.ss

@@ -23,7 +23,7 @@
                                 (close-output-port out)
                                 in)))])
         (let ([n (match v
-                   [(struct compilation-top (_ prefix (struct primitive (n)))) n]
+                   [(struct compilation-top (_ prefix (struct primval (n)))) n]
                    [else #f])])
           (hash-set! table n (car b)))))
     table))
@@ -77,7 +77,7 @@
                 lift-ids)
                (map (lambda (stx id)
                       `(define ,id ,(if stx
-                                        `(#%decode-syntax ,stx #;(stx-encoded stx))
+                                        `(#%decode-syntax ,(stx-encoded stx))
                                         #f)))
                     stxs stx-ids)))]
     [else (error 'decompile-prefix "huh?: ~e" a-prefix)]))
@@ -126,7 +126,7 @@
            `(let ()
              ,@defns
              ,(decompile-expr rhs globs '(#%globals) closed))))]
-    [(struct sequence (forms))
+    [(struct seq (forms))
      `(begin ,@(map (lambda (form)
                       (decompile-form form globs stack closed))
                     forms))]
@@ -179,7 +179,7 @@
            `(#%checked ,id)))]
     [(struct topsyntax (depth pos midpt))
      (list-ref/protect globs (+ midpt pos) 'topsyntax)]
-    [(struct primitive (id))
+    [(struct primval (id))
      (hash-ref primitive-table id)]
     [(struct assign (id rhs undef-ok?))
      `(set! ,(decompile-expr id globs stack closed)
@@ -249,7 +249,7 @@
     [(struct apply-values (proc args-expr))
      `(#%apply-values ,(decompile-expr proc globs stack closed) 
                       ,(decompile-expr args-expr globs stack closed))]
-    [(struct sequence (exprs))
+    [(struct seq (exprs))
      `(begin ,@(for/list ([expr (in-list exprs)])
                  (decompile-expr expr globs stack closed)))]
     [(struct beg0 (exprs))

collects/compiler/zo-parse.ss

@@ -7,11 +7,18 @@
 ;; ----------------------------------------
 ;;  Structures to represent bytecode
 
-(define-syntax-rule (define-form-struct id (field-id ...))
+(define-syntax-rule (define-form-struct* id id+par (field-id ...))
   (begin
-    (define-struct id (field-id ...) #:transparent)
+    (define-struct id+par (field-id ...) #:transparent)
     (provide (struct-out id))))
 
+(define-syntax define-form-struct
+  (syntax-rules ()
+    [(_ (id sup) . rest)
+     (define-form-struct* id (id sup) . rest)]
+    [(_ id . rest)
+     (define-form-struct* id id . rest)]))
+
 (define-form-struct compilation-top (max-let-depth prefix code)) ; compiled code always wrapped with this
 
 (define-form-struct prefix (num-lifts toplevels stxs))   ; sets up top-level and syntax-object array
@@ -21,43 +28,46 @@
 (define-form-struct module-variable (modidx sym pos phase)) ; direct access to exported id
 
 ;; In stxs of prefix:
-(define-form-struct stx (encoded)) ; todo: decode syntax objects
+(define-form-struct stx (encoded))
 
-(define-form-struct mod (name self-modidx prefix provides requires body syntax-body max-let-depth))
+(define-form-struct form ())
+(define-form-struct (expr form) ())
 
-(define-form-struct lam (name flags num-params rest? closure-map max-let-depth body)) ; `lambda'
+(define-form-struct (mod form) (name self-modidx prefix provides requires body syntax-body max-let-depth))
-(define-form-struct closure (code gen-id)) ; a static closure (nothing to close over)
-(define-form-struct case-lam (name clauses)) ; each clause is an lam
 
-(define-form-struct let-one (rhs body)) ; pushes one value onto stack
+(define-form-struct (lam expr) (name flags num-params rest? closure-map max-let-depth body)) ; `lambda'
-(define-form-struct let-void (count boxes? body)) ; create new stack slots
+(define-form-struct (closure expr) (code gen-id)) ; a static closure (nothing to close over)
-(define-form-struct install-value (count pos boxes? rhs body)) ; set existing stack slot(s)
+(define-form-struct (case-lam expr) (name clauses)) ; each clause is an lam
-(define-form-struct let-rec (procs body)) ; put `letrec'-bound closures into existing stack slots
-(define-form-struct boxenv (pos body)) ; box existing stack element
 
-(define-form-struct localref (unbox? offset clear?)) ; access local via stack
+(define-form-struct (let-one expr) (rhs body)) ; pushes one value onto stack
+(define-form-struct (let-void expr) (count boxes? body)) ; create new stack slots
+(define-form-struct (install-value expr) (count pos boxes? rhs body)) ; set existing stack slot(s)
+(define-form-struct (let-rec expr) (procs body)) ; put `letrec'-bound closures into existing stack slots
+(define-form-struct (boxenv expr) (pos body)) ; box existing stack element
 
-(define-form-struct toplevel (depth pos const? ready?))  ; access binding via prefix array (which is on stack)
+(define-form-struct (localref expr) (unbox? pos clear?)) ; access local via stack
-(define-form-struct topsyntax (depth pos midpt)) ; access syntax object via prefix array (which is on stack)
 
-(define-form-struct application (rator rands)) ; function call
+(define-form-struct (toplevel expr) (depth pos const? ready?))  ; access binding via prefix array (which is on stack)
-(define-form-struct branch (test then else)) ; `if'
+(define-form-struct (topsyntax expr) (depth pos midpt)) ; access syntax object via prefix array (which is on stack)
-(define-form-struct with-cont-mark (key val body)) ; `with-continuation-mark'
+
-(define-form-struct beg0 (seq)) ; `begin0'
+(define-form-struct (application expr) (rator rands)) ; function call
-(define-form-struct sequence (forms)) ; `begin'
+(define-form-struct (branch expr) (test then else)) ; `if'
-(define-form-struct splice (forms)) ; top-level `begin'
+(define-form-struct (with-cont-mark expr) (key val body)) ; `with-continuation-mark'
-(define-form-struct varref (toplevel)) ; `#%variable-reference'
+(define-form-struct (beg0 expr) (seq)) ; `begin0'
-(define-form-struct assign (id rhs undef-ok?)) ; top-level or module-level set!
+(define-form-struct (seq form) (forms)) ; `begin'
-(define-form-struct apply-values (proc args-expr)) ; `(call-with-values (lambda () ,args-expr) ,proc)
+(define-form-struct (splice form) (forms)) ; top-level `begin'
-(define-form-struct primitive (id)) ; direct preference to a kernel primitive
+(define-form-struct (varref expr) (toplevel)) ; `#%variable-reference'
+(define-form-struct (assign expr) (id rhs undef-ok?)) ; top-level or module-level set!
+(define-form-struct (apply-values expr) (proc args-expr)) ; `(call-with-values (lambda () ,args-expr) ,proc)
+(define-form-struct (primval expr) (id)) ; direct preference to a kernel primitive
 
 ;; Definitions (top level or within module):
-(define-form-struct def-values (ids rhs))
+(define-form-struct (def-values form) (ids rhs))
-(define-form-struct def-syntaxes (ids rhs prefix max-let-depth))
+(define-form-struct (def-syntaxes form) (ids rhs prefix max-let-depth))
-(define-form-struct def-for-syntax (ids rhs prefix max-let-depth))
+(define-form-struct (def-for-syntax form) (ids rhs prefix max-let-depth))
 
 ;; Top-level `require'
-(define-form-struct req (reqs dummy))
+(define-form-struct (req form) (reqs dummy))
 
 ;; A static closure can refer directly to itself, creating a cycle
 (define-struct indirect ([v #:mutable]) #:prefab)
@@ -145,7 +155,7 @@
      (make-with-cont-mark key val body)]))
 
 (define (read-sequence v) 
-  (make-sequence v))
+  (make-seq v))
 
 (define (read-define-values v)
   (make-def-values
@@ -173,7 +183,7 @@
 
 (define (read-begin0 v) 
   (match v
-    [(struct sequence (exprs))
+    [(struct seq (exprs))
      (make-beg0 exprs)]))
 
 (define (read-boxenv v)
@@ -429,9 +439,12 @@
 ;; Synatx unmarshaling
 
 (define-form-struct wrapped (datum wraps certs))
-(define-form-struct lexical-rename (alist))
+
-(define-form-struct phase-shift (amt src dest))
+(define-form-struct wrap ())
-(define-form-struct module-rename (phase kind set-id unmarshals renames mark-renames plus-kern?))
+(define-form-struct (lexical-rename wrap) (alist))
+(define-form-struct (phase-shift wrap) (amt src dest))
+(define-form-struct (module-rename wrap) (phase kind set-id unmarshals renames mark-renames plus-kern?))
+
 (define-form-struct all-from-module (path phase src-phase exceptions prefix))
 (define-form-struct module-binding (path mod-phase import-phase id nominal-path nominal-phase nominal-id))
 
@@ -696,7 +709,7 @@
                             [read-accept-quasiquote #t])
                (read (open-input-bytes s))))]
           [(reference)
-           (make-primitive (read-compact-number cp))]
+           (make-primval (read-compact-number cp))]
           [(small-list small-proper-list)
            (let* ([l (- ch cpt-start)]
                   [ppr (eq? cpt-tag 'small-proper-list)])