1 files changed, 0 insertions, 109 deletions
diff --git a/module/language/cps/elide-values.scm b/module/language/cps/elide-values.scm
deleted file mode 100644
index dadbd403a..000000000
--- a/module/language/cps/elide-values.scm
+++ /dev/null
@@ -1,109 +0,0 @@
-;;; Continuation-passing style (CPS) intermediate language (IL)
-
-;; Copyright (C) 2013, 2014, 2015 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
-
-;;; Commentary:
-;;;
-;;; Primcalls that don't correspond to VM instructions are treated as if
-;;; they are calls, and indeed the later reify-primitives pass turns
-;;; them into calls.  Because no return arity checking is done for these
-;;; primitives, if a later optimization pass simplifies the primcall to
-;;; a VM operation, the tail of the simplification has to be a
-;;; primcall to 'values.  Most of these primcalls can be elided, and
-;;; that is the job of this pass.
-;;;
-;;; Code:
-
-(define-module (language cps elide-values)
-  #:use-module (ice-9 match)
-  #:use-module (srfi srfi-26)
-  #:use-module (language cps)
-  #:use-module (language cps dfg)
-  #:export (elide-values))
-
-(define (elide-values* fun conts)
-  (define (visit-cont cont)
-    (rewrite-cps-cont cont
-      (($ $cont sym ($ $kargs names syms body))
-       (sym ($kargs names syms ,(visit-term body))))
-      (($ $cont sym ($ $kfun src meta self tail clause))
-       (sym ($kfun src meta self ,tail ,(and clause (visit-cont clause)))))
-      (($ $cont sym ($ $kclause arity body alternate))
-       (sym ($kclause ,arity ,(visit-cont body)
-                      ,(and alternate (visit-cont alternate)))))
-      (($ $cont)
-       ,cont)))
-  (define (visit-term term)
-    (rewrite-cps-term term
-      (($ $letk conts body)
-       ($letk ,(map visit-cont conts)
-         ,(visit-term body)))
-      (($ $continue k src ($ $primcall 'values vals))
-       ,(rewrite-cps-term (vector-ref conts k)
-          (($ $ktail)
-           ($continue k src ($values vals)))
-          (($ $kreceive ($ $arity req () rest () #f) kargs)
-           ,(cond
-             ((and (not rest) (= (length vals) (length req)))
-              (build-cps-term
-                ($continue kargs src ($values vals))))
-             ((and rest (>= (length vals) (length req)))
-              (let-fresh (krest) (rest)
-                (let ((vals* (append (list-head vals (length req))
-                                     (list rest))))
-                  (build-cps-term
-                    ($letk ((krest ($kargs ('rest) (rest)
-                                     ($continue kargs src
-                                       ($values vals*)))))
-                      ,(let lp ((tail (list-tail vals (length req)))
-                                (k krest))
-                         (match tail
-                           (()
-                            (build-cps-term ($continue k src
-                                              ($const '()))))
-                           ((v . tail)
-                            (let-fresh (krest) (rest)
-                              (build-cps-term
-                                ($letk ((krest ($kargs ('rest) (rest)
-                                                 ($continue k src
-                                                   ($primcall 'cons
-                                                              (v rest))))))
-                                  ,(lp tail krest))))))))))))
-             (else term)))
-          (($ $kargs args)
-           ,(if (< (length vals) (length args))
-                term
-                (let ((vals (list-head vals (length args))))
-                  (build-cps-term
-                    ($continue k src ($values vals))))))))
-      (($ $continue k src (and fun ($ $fun)))
-       ($continue k src ,(visit-fun fun)))
-      (($ $continue k src ($ $rec names syms funs))
-       ($continue k src ($rec names syms (map visit-fun funs))))
-      (($ $continue)
-       ,term)))
-  (define (visit-fun fun)
-    (rewrite-cps-exp fun
-      (($ $fun cont)
-       ($fun ,(visit-cont cont)))))
-
-  (visit-cont fun))
-
-(define (elide-values fun)
-  (with-fresh-name-state fun
-    (let ((conts (build-cont-table fun)))
-      (elide-values* fun conts))))