[Guile-commits] 20/25: Remove special optimizer and backend support for pairs

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit abfe04835b292b326f75faf61fdae4a795d1039c
Author: Andy Wingo <address@hidden>
Date:   Sun Jan 7 18:24:15 2018 +0100

    Remove special optimizer and backend support for pairs
    
    * module/language/cps/compile-bytecode.scm (compile-function):
    * module/language/cps/cse.scm (compute-equivalent-subexpressions):
    * module/language/cps/dce.scm (compute-live-code):
    * module/language/cps/effects-analysis.scm:
    * module/language/cps/types.scm: Remove support for cons, car, etc
      primcalls.
    * module/language/cps/effects-analysis.scm (&car, &cdr): Remove
      undefined exports.
    * module/system/vm/assembler.scm: Remove emit-cons, etc exports.
---
 module/language/cps/compile-bytecode.scm |  4 ----
 module/language/cps/cse.scm              |  5 +----
 module/language/cps/dce.scm              |  3 +--
 module/language/cps/effects-analysis.scm | 15 ---------------
 module/language/cps/types.scm            | 14 --------------
 module/system/vm/assembler.scm           |  5 -----
 6 files changed, 2 insertions(+), 44 deletions(-)

diff --git a/module/language/cps/compile-bytecode.scm 
b/module/language/cps/compile-bytecode.scm
index 5978492..12ef69b 100644
--- a/module/language/cps/compile-bytecode.scm
+++ b/module/language/cps/compile-bytecode.scm
@@ -327,10 +327,6 @@
         (($ $primcall 'string-set! #f (string index char))
          (emit-string-set! asm (from-sp (slot string)) (from-sp (slot index))
                            (from-sp (slot char))))
-        (($ $primcall 'set-car! #f (pair value))
-         (emit-set-car! asm (from-sp (slot pair)) (from-sp (slot value))))
-        (($ $primcall 'set-cdr! #f (pair value))
-         (emit-set-cdr! asm (from-sp (slot pair)) (from-sp (slot value))))
         (($ $primcall 'push-fluid #f (fluid val))
          (emit-push-fluid asm (from-sp (slot fluid)) (from-sp (slot val))))
         (($ $primcall 'pop-fluid #f ())
diff --git a/module/language/cps/cse.scm b/module/language/cps/cse.scm
index f3c333c..17a6489 100644
--- a/module/language/cps/cse.scm
+++ b/module/language/cps/cse.scm
@@ -253,16 +253,13 @@ false.  It could be that both true and false proofs are 
available."
           (add-definitions
            ((b <- box #f o)                  (o <- box-ref #f b))
            ((box-set! #f b o)                (o <- box-ref #f b))
-           ((o <- cons #f x y)               (x <- car #f o)
-                                             (y <- cdr #f o))
+
            ((scm-set! p s i x)               (x <- scm-ref p s i))
            ((scm-set!/tag p s x)             (x <- scm-ref/tag p s))
            ((scm-set!/immediate p s x)       (x <- scm-ref/immediate p s))
            ((word-set! p s i x)              (x <- word-ref p s i))
            ((word-set!/immediate p s x)      (x <- word-ref/immediate p s))
 
-           ((set-car! #f o x)                (x <- car #f o))
-           ((set-cdr! #f o y)                (y <- cdr #f o))
            ((s <- allocate-struct #f v n)    (v <- struct-vtable #f s))
            ((s <- allocate-struct/immediate n v) (v <- struct-vtable #f s))
            ((struct-set! #f s i x)           (x <- struct-ref #f s i))
diff --git a/module/language/cps/dce.scm b/module/language/cps/dce.scm
index 0a3a311..2a054d7 100644
--- a/module/language/cps/dce.scm
+++ b/module/language/cps/dce.scm
@@ -188,8 +188,7 @@ sites."
            (and (causes-effect? fx &write)
                 (match exp
                   (($ $primcall
-                      (or 'set-car! 'set-cdr!
-                          'box-set!
+                      (or 'box-set!
                           'scm-set! 'scm-set!/tag 'scm-set!/immediate
                           'word-set! 'word-set!/immediate) _
                       (obj . _))
diff --git a/module/language/cps/effects-analysis.scm 
b/module/language/cps/effects-analysis.scm
index e180102..f2335b4 100644
--- a/module/language/cps/effects-analysis.scm
+++ b/module/language/cps/effects-analysis.scm
@@ -56,8 +56,6 @@
 
             &fluid
             &prompt
-            &car
-            &cdr
             &vector
             &box
             &module
@@ -383,19 +381,6 @@ the LABELS that are clobbered by the effects of LABEL."
                                       (&write-field
                                        (annotation->memory-kind ann) idx)))))
 
-;; Pairs.
-(define-primitive-effects
-  ((cons a b)                      (&allocate &pair))
-  ((list . _)                      (&allocate &pair))
-  ((car x)                         (&read-field &pair 0)       &type-check)
-  ((set-car! x y)                  (&write-field &pair 0)      &type-check)
-  ((cdr x)                         (&read-field &pair 1)       &type-check)
-  ((set-cdr! x y)                  (&write-field &pair 1)      &type-check)
-  ((memq x y)                      (&read-object &pair)        &type-check)
-  ((memv x y)                      (&read-object &pair)        &type-check)
-  ((list? arg)                     (&read-field &pair 1))
-  ((length l)                      (&read-field &pair 1)       &type-check))
-
 ;; Variables.
 (define-primitive-effects
   ((box v)                         (&allocate &box))
diff --git a/module/language/cps/types.scm b/module/language/cps/types.scm
index dfd7b92..eab830a 100644
--- a/module/language/cps/types.scm
+++ b/module/language/cps/types.scm
@@ -815,20 +815,6 @@ minimum, and maximum."
 
 
 ;;;
-;;; Pairs.
-;;;
-
-(define-simple-types
-  ((cons &all-types &all-types) &pair)
-  ((car &pair) &all-types)
-  ((set-car! &pair &all-types))
-  ((cdr &pair) &all-types)
-  ((set-cdr! &pair &all-types)))
-
-
-
-
-;;;
 ;;; Variables.
 ;;;
 
diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm
index 46c0ed3..66555fe 100644
--- a/module/system/vm/assembler.scm
+++ b/module/system/vm/assembler.scm
@@ -200,11 +200,6 @@
             emit-string->number
             emit-string->symbol
             emit-symbol->keyword
-            emit-cons
-            emit-car
-            emit-cdr
-            emit-set-car!
-            emit-set-cdr!
             emit-add
             emit-add/immediate
             emit-sub