[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.7-121-gc085589

[Andy Wingo]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=c085589b1c34fa88d28c23cb5e3659fecdb09f33

The branch, stable-2.0 has been updated
       via  c085589b1c34fa88d28c23cb5e3659fecdb09f33 (commit)
      from  72ad03fcbddb3b87de5577b7225f6dc6f892ac93 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit c085589b1c34fa88d28c23cb5e3659fecdb09f33
Author: Andy Wingo <address@hidden>
Date:   Sun Feb 24 15:45:26 2013 +0100

    remove language/glil/decompile-assembly.scm
    
    * module/language/glil/decompile-assembly.scm: Remove.  This module
      never worked, and even failed to compile.
    
    * module/language/glil/spec.scm:
    * module/Makefile.am: Remove references to (language glil
      decompile-assembly).

-----------------------------------------------------------------------

Summary of changes:
 module/Makefile.am                          |    3 +-
 module/language/glil/decompile-assembly.scm |  191 ---------------------------
 module/language/glil/spec.scm               |    2 -
 3 files changed, 1 insertions(+), 195 deletions(-)
 delete mode 100644 module/language/glil/decompile-assembly.scm

diff --git a/module/Makefile.am b/module/Makefile.am
index 472bc48..79957c1 100644
--- a/module/Makefile.am
+++ b/module/Makefile.am
@@ -112,8 +112,7 @@ TREE_IL_LANG_SOURCES =                                      
        \
   language/tree-il/spec.scm
 
 GLIL_LANG_SOURCES =                                            \
-  language/glil/spec.scm language/glil/compile-assembly.scm    \
-  language/glil/decompile-assembly.scm
+  language/glil/spec.scm language/glil/compile-assembly.scm
 
 ASSEMBLY_LANG_SOURCES =                                \
   language/assembly/spec.scm                   \
diff --git a/module/language/glil/decompile-assembly.scm 
b/module/language/glil/decompile-assembly.scm
deleted file mode 100644
index a50b640..0000000
--- a/module/language/glil/decompile-assembly.scm
+++ /dev/null
@@ -1,191 +0,0 @@
-;;; Guile VM code converters
-
-;; Copyright (C) 2001, 2009, 2010 Free Software Foundation, Inc.
-
-;;;; This library is free software; you can redistribute it and/or
-;;;; modify it under the terms of the GNU Lesser General Public
-;;;; License as published by the Free Software Foundation; either
-;;;; version 3 of the License, or (at your option) any later version.
-;;;; 
-;;;; This library is distributed in the hope that it will be useful,
-;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;;;; Lesser General Public License for more details.
-;;;; 
-;;;; You should have received a copy of the GNU Lesser General Public
-;;;; License along with this library; if not, write to the Free Software
-;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 
USA
-
-;;; Code:
-
-(define-module (language glil decompile-assembly)
-  #:use-module (system base pmatch)
-  #:use-module (system vm program)
-  #:use-module (language assembly)
-  #:use-module (language glil)
-  #:export (decompile-assembly))
-
-(define (decompile-assembly x env opts)
-  (values (decompile-toplevel x)
-          env))
-
-(define (decompile-toplevel x)
-  (pmatch x
-    ((load-program ,labels ,len ,meta . ,body)
-     (decompile-load-program (decompile-meta meta)
-                             body labels #f))
-    (else
-     (error "invalid assembly" x))))
-
-(define (decompile-meta meta)
-  (and meta
-      (let ((prog (decompile-toplevel meta)))
-        (if (and (glil-program? prog)
-                 (= (length (glil-program-body prog)) 2)
-                 (glil-const? (car (glil-program-body prog))))
-            (glil-const-obj (car (glil-program-body prog)))
-            (error "metadata not a thunk returning a const" prog)))))
-
-(define *placeholder* (list 'placeholder))
-
-(define (emit-constants l out)
-  (let lp ((in (reverse l)) (out out))
-    (cond ((null? in) out)
-          ((eq? (car in) *placeholder*) (lp (cdr in) out))
-          ((glil-program? (car in)) (lp (cdr in) (cons (car in) out)))
-          (else (lp (cdr in) (cons (make-glil-const (car l)) out))))))
-
-(define (decompile-load-program meta body labels
-                                objects)
-  (let ((glil-labels (sort (map (lambda (x)
-                                  (cons (cdr x) (make-glil-label (car x))))
-                                labels)
-                           (lambda (x y) (< (car x) (car y)))))
-        (bindings (sort (if meta (car meta) '())
-                        (lambda (x y) (< (binding:start x) (binding:start 
y)))))
-        (unbindings (sort (if meta (car meta) '())
-                          (lambda (x y) (< (binding:end x) (binding:end y)))))
-        (sources (if meta (cadr meta) '()))
-        (filename #f)
-        (props (if meta (cddr meta) '())))
-    (define (pop-bindings! addr)
-      (let lp ((in bindings) (out '()))
-        (if (or (null? in) (> (binding:start (car in)) addr))
-            (begin
-              (set! bindings in)
-              (if (null? out) #f (reverse out)))
-            (lp (cdr in) (cons (car in) out)))))
-    (define (pop-unbindings! addr)
-      (let lp ((in unbindings) (out '()))
-        (if (or (null? in) (> (binding:end (car in)) addr))
-            (begin
-              (set! unbindings in)
-              (if (null? out) #f (reverse out)))
-            (lp (cdr in) (cons (car in) out)))))
-    (define (pop-source! addr)
-      ;; a fragile algorithm.
-      (cond ((null? sources) #f)
-            ((eq? (caar sources) 'filename)
-             (set! filename (cdar sources))
-             (pop-source! addr))
-            ((eqv? (caar sources) addr)
-             (let ((x (car sources)))
-               (set! sources (cdr sources))
-               `((filename . ,filename)
-                 (line . ,(cadr x))
-                 (column . ,(cddr x)))))
-            (else #f)))
-    (let lp ((in body) (stack '()) (out '()) (pos 0))
-      (cond
-       ((null? in)
-        (or (null? stack) (error "leftover stack insts" stack body))
-        (make-glil-program props (reverse out)))
-       ((pop-bindings! pos)
-        => (lambda (bindings)
-             (lp in stack
-                 (cons (make-glil-bind bindings)
-                       out)
-                 pos)))
-       ((pop-unbindings! pos)
-        => (lambda (bindings)
-             (lp in stack (cons (make-glil-unbind) out) pos)))
-       ((pop-source! pos)
-        => (lambda (s)
-             (lp in stack (cons (make-glil-source s) out) pos)))
-       ((and (or (null? out) (not (glil-label? (car out))))
-             (assv-ref glil-labels pos))
-        => (lambda (label)
-             (lp in stack (cons label out) pos)))
-       (else
-        (pmatch (car in)
-          ((nop)
-           (lp (cdr in) stack out (1+ pos)))
-          ((make-false)
-           (lp (cdr in) (cons #f stack) out (1+ pos)))
-          ((make-nil)
-           (lp (cdr in) (cons #nil stack) out (1+ pos)))
-          ((load-program ,labels ,sublen ,meta . ,body)
-           (lp (cdr in)
-               (cons (decompile-load-program (decompile-meta meta)
-                                             body labels (car stack))
-                     (cdr stack))
-               out
-               (+ pos (byte-length (car in)))))
-          ((load-symbol ,str)
-           (lp (cdr in) (cons (string->symbol str) stack) out
-               (+ pos 1 (string-length str))))
-          ((make-int8:0)
-           (lp (cdr in) (cons 0 stack) out (1+ pos)))
-          ((make-int8:1)
-           (lp (cdr in) (cons 1 stack) out (1+ pos)))
-          ((make-int8 ,n)
-           (lp (cdr in) (cons n stack) out (+ pos 2)))
-          ((cons)
-           (let ((head (list-head stack 2))
-                 (stack (list-tail stack 2)))
-             (if (memq *placeholder* head)
-                 (lp (cdr in) (cons *placeholder* stack)
-                     (cons (make-glil-call 'cons 2) (emit-constants head out))
-                     (+ pos 1))
-                 (lp (cdr in) (cons (cons (cadr head) (car head)) stack)
-                     out (+ pos 3)))))
-          ((list ,a ,b)
-           (let* ((len (+ (ash a 8) b))
-                  (head (list-head stack len))
-                  (stack (list-tail stack len)))
-             (if (memq *placeholder* head)
-                 (lp (cdr in) (cons *placeholder* stack)
-                     (cons (make-glil-call 'list len) (emit-constants head 
out))
-                     (+ pos 3))
-                 (lp (cdr in) (cons (reverse head) stack) out (+ pos 3)))))
-          ((make-eol)
-           (lp (cdr in) (cons '() stack) out (1+ pos)))
-          ((return)
-           (lp (cdr in) (cdr stack)
-               (cons (make-glil-call 'return 1)
-                     (emit-constants (list-head stack 1) out))
-               (1+ pos)))
-          ((local-ref ,n)
-           (lp (cdr in) (cons *placeholder* stack)
-               (cons (make-glil-local 'ref n)
-                     out) (+ pos 2)))
-          ((local-set ,n)
-           (lp (cdr in) (cdr stack)
-               (cons (make-glil-local 'set n)
-                     (emit-constants (list-head stack 1) out))
-               (+ pos 2)))
-          ((br-if-not ,l)
-           (lp (cdr in) (cdr stack)
-               (cons (make-glil-branch 'br-if-not l) out)
-               (+ pos 3)))
-          ((mul)
-           (lp (cdr in) (cons *placeholder* (cddr stack))
-               (cons (make-glil-call 'mul 2)
-                     (emit-constants (list-head stack 2) out))
-               (+ pos 1)))
-          ((tail-call ,n)
-           (lp (cdr in) (list-tail stack (1+ n))
-               (cons (make-glil-call 'tail-call n)
-                     (emit-constants (list-head stack (1+ n)) out))
-               (+ pos 2)))
-          (else (error "unsupported decompilation" (car in)))))))))
diff --git a/module/language/glil/spec.scm b/module/language/glil/spec.scm
index 3679e21..81e06af 100644
--- a/module/language/glil/spec.scm
+++ b/module/language/glil/spec.scm
@@ -22,7 +22,6 @@
   #:use-module (system base language)
   #:use-module (language glil)
   #:use-module (language glil compile-assembly)
-  #:use-module (language glil decompile-assembly)
   #:export (glil))
 
 (define (write-glil exp . port)
@@ -37,6 +36,5 @@
   #:printer    write-glil
   #:parser      parse-glil
   #:compilers   `((assembly . ,compile-asm))
-  #:decompilers `((assembly . ,decompile-assembly))
   #:for-humans? #f
   )


hooks/post-receive
-- 
GNU Guile