[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 07/11: Simplify $branch to always take a $primcall
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] 07/11: Simplify $branch to always take a $primcall |
|
Date: |
Sun, 29 Oct 2017 05:09:40 -0400 (EDT) |
wingo pushed a commit to branch master
in repository guile.
commit c119623e458fcc5c59d6be266b0f5608197e0268
Author: Andy Wingo <address@hidden>
Date: Fri Oct 27 15:19:21 2017 +0200
Simplify $branch to always take a $primcall
* module/language/tree-il/compile-cps.scm (convert): Lower (if foo A B)
to (if (false? foo) B A).
* module/language/cps/specialize-numbers.scm:
* module/language/cps/closure-conversion.scm:
* module/language/cps/contification.scm:
* module/language/cps/cse.scm:
* module/language/cps/dce.scm:
* module/language/cps/peel-loops.scm:
* module/language/cps/rotate-loops.scm:
* module/language/cps/self-references.scm:
* module/language/cps/simplify.scm:
* module/language/cps/slot-allocation.scm:
* module/language/cps/split-rec.scm:
* module/language/cps/type-fold.scm:
* module/language/cps/types.scm:
* module/language/cps/verify.scm: Adapt.
* module/language/cps/compile-bytecode.scm: Add support for new-style
false? instruction for false? primcall.
---
module/language/cps/closure-conversion.scm | 16 +---------------
module/language/cps/compile-bytecode.scm | 12 +-----------
module/language/cps/contification.scm | 4 +---
module/language/cps/cse.scm | 3 +--
module/language/cps/dce.scm | 4 +---
module/language/cps/peel-loops.scm | 4 +---
module/language/cps/rotate-loops.scm | 4 +---
module/language/cps/self-references.scm | 4 +---
module/language/cps/simplify.scm | 10 +++-------
module/language/cps/slot-allocation.scm | 4 +---
module/language/cps/specialize-numbers.scm | 2 --
module/language/cps/split-rec.scm | 4 +---
module/language/cps/type-fold.scm | 5 -----
module/language/cps/types.scm | 7 -------
module/language/cps/verify.scm | 5 +----
module/language/tree-il/compile-cps.scm | 8 ++++----
16 files changed, 18 insertions(+), 78 deletions(-)
diff --git a/module/language/cps/closure-conversion.scm
b/module/language/cps/closure-conversion.scm
index 2fe4d80..fb07061 100644
--- a/module/language/cps/closure-conversion.scm
+++ b/module/language/cps/closure-conversion.scm
@@ -1,6 +1,6 @@
;;; Continuation-passing style (CPS) intermediate language (IL)
-;; Copyright (C) 2013, 2014, 2015 Free Software Foundation, Inc.
+;; Copyright (C) 2013, 2014, 2015, 2017 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
@@ -89,8 +89,6 @@ conts."
(add-uses args uses))
(($ $call proc args)
(add-uses args uses))
- (($ $branch kt ($ $values (arg)))
- (add-use arg uses))
(($ $branch kt ($ $primcall name args))
(add-uses args uses))
(($ $primcall name args)
@@ -249,8 +247,6 @@ shared closures to use the appropriate 'self' variable, if
possible."
((closure . label) ($callk label closure ,args)))))
(($ $primcall name args)
($primcall name ,(map subst args)))
- (($ $branch k ($ $values (arg)))
- ($branch k ($values ((subst arg)))))
(($ $branch k ($ $primcall name args))
($branch k ($primcall name ,(map subst args))))
(($ $values args)
@@ -373,8 +369,6 @@ references."
(add-use proc (add-uses args uses)))
(($ $callk label proc args)
(add-use proc (add-uses args uses)))
- (($ $branch kt ($ $values (arg)))
- (add-use arg uses))
(($ $branch kt ($ $primcall name args))
(add-uses args uses))
(($ $primcall name args)
@@ -778,14 +772,6 @@ bound to @var{var}, and continue to @var{k}."
($continue k src
($branch kt ($primcall name args))))))))
- (($ $continue k src ($ $branch kt ($ $values (arg))))
- (convert-arg cps arg
- (lambda (cps arg)
- (with-cps cps
- (build-term
- ($continue k src
- ($branch kt ($values (arg)))))))))
-
(($ $continue k src ($ $values args))
(convert-args cps args
(lambda (cps args)
diff --git a/module/language/cps/compile-bytecode.scm
b/module/language/cps/compile-bytecode.scm
index c85fbd8..5dcd6e2 100644
--- a/module/language/cps/compile-bytecode.scm
+++ b/module/language/cps/compile-bytecode.scm
@@ -394,16 +394,6 @@
;; Otherwise prefer a backwards
;; branch or a near jump.
(< kt kf)))
- (define (unary/old op sym)
- (cond
- ((eq? kt next-label)
- (op asm (from-sp (slot sym)) #t kf))
- ((eq? kf next-label)
- (op asm (from-sp (slot sym)) #f kt))
- (else
- (let ((invert? (not (prefer-true?))))
- (op asm (from-sp (slot sym)) invert? (if invert? kf kt))
- (emit-j asm (if invert? kt kf))))))
(define (emit-branch-for-test)
(cond
((eq? kt next-label)
@@ -431,10 +421,10 @@
(if invert? kf kt))
(emit-j asm (if invert? kt kf))))))
(match exp
- (($ $values (sym)) (unary/old emit-br-if-true sym))
(($ $primcall 'heap-object? (a)) (unary emit-heap-object? a))
(($ $primcall 'null? (a)) (unary emit-null? a))
(($ $primcall 'nil? (a)) (unary emit-nil? a))
+ (($ $primcall 'false? (a)) (unary emit-false? a))
(($ $primcall 'pair? (a)) (unary emit-pair? a))
(($ $primcall 'struct? (a)) (unary emit-struct? a))
(($ $primcall 'char? (a)) (unary emit-char? a))
diff --git a/module/language/cps/contification.scm
b/module/language/cps/contification.scm
index f5727f8..3fbfb36 100644
--- a/module/language/cps/contification.scm
+++ b/module/language/cps/contification.scm
@@ -1,6 +1,6 @@
;;; Continuation-passing style (CPS) intermediate language (IL)
-;; Copyright (C) 2013, 2014, 2015 Free Software Foundation, Inc.
+;; Copyright (C) 2013, 2014, 2015, 2017 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
@@ -188,8 +188,6 @@ $call, and are always called with a compatible arity."
(exclude-vars functions (cons proc args)))
(($ $branch kt ($ $primcall name args))
(exclude-vars functions args))
- (($ $branch kt ($ $values (arg)))
- (exclude-var functions arg))
(($ $primcall name args)
(exclude-vars functions args))
(($ $prompt escape? tag handler)
diff --git a/module/language/cps/cse.scm b/module/language/cps/cse.scm
index e37e8d4..fb27635 100644
--- a/module/language/cps/cse.scm
+++ b/module/language/cps/cse.scm
@@ -1,6 +1,6 @@
;;; Continuation-passing style (CPS) intermediate language (IL)
-;; Copyright (C) 2013, 2014, 2015 Free Software Foundation, Inc.
+;; Copyright (C) 2013, 2014, 2015, 2017 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
@@ -253,7 +253,6 @@ false. It could be that both true and false proofs are
available."
(cons* 'primcall name (subst-vars var-substs args)))
(($ $branch _ ($ $primcall name args))
(cons* 'primcall name (subst-vars var-substs args)))
- (($ $branch) #f)
(($ $values args) #f)
(($ $prompt escape? tag handler) #f)))
diff --git a/module/language/cps/dce.scm b/module/language/cps/dce.scm
index 52bd708..2330d42 100644
--- a/module/language/cps/dce.scm
+++ b/module/language/cps/dce.scm
@@ -1,6 +1,6 @@
;;; Continuation-passing style (CPS) intermediate language (IL)
-;; Copyright (C) 2013, 2014, 2015 Free Software Foundation, Inc.
+;; Copyright (C) 2013, 2014, 2015, 2017 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
@@ -153,8 +153,6 @@ sites."
(values live-labels (adjoin-vars args live-vars)))
(($ $branch k ($ $primcall name args))
(values live-labels (adjoin-vars args live-vars)))
- (($ $branch k ($ $values (arg)))
- (values live-labels (adjoin-var arg live-vars)))
(($ $values args)
(values live-labels
(match (cont-defs k)
diff --git a/module/language/cps/peel-loops.scm
b/module/language/cps/peel-loops.scm
index a1b04a4..e73c6c7 100644
--- a/module/language/cps/peel-loops.scm
+++ b/module/language/cps/peel-loops.scm
@@ -1,6 +1,6 @@
;;; Continuation-passing style (CPS) intermediate language (IL)
-;; Copyright (C) 2013, 2014, 2015 Free Software Foundation, Inc.
+;; Copyright (C) 2013, 2014, 2015, 2017 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
@@ -141,8 +141,6 @@
($call (rename-var proc) ,(map rename-var args)))
(($ $callk k proc args)
($callk k (rename-var proc) ,(map rename-var args)))
- (($ $branch kt ($ $values (arg)))
- ($branch (rename-label kt) ($values ((rename-var arg)))))
(($ $branch kt ($ $primcall name args))
($branch (rename-label kt) ($primcall name ,(map rename-var args))))
(($ $primcall name args)
diff --git a/module/language/cps/rotate-loops.scm
b/module/language/cps/rotate-loops.scm
index 09c1332..3abd50f 100644
--- a/module/language/cps/rotate-loops.scm
+++ b/module/language/cps/rotate-loops.scm
@@ -1,6 +1,6 @@
;;; Continuation-passing style (CPS) intermediate language (IL)
-;; Copyright (C) 2013, 2014, 2015 Free Software Foundation, Inc.
+;; Copyright (C) 2013, 2014, 2015, 2017 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
@@ -108,8 +108,6 @@
($call (rename-var proc) ,(map rename-var args)))
(($ $callk k proc args)
($callk k (rename-var proc) ,(map rename-var args)))
- (($ $branch kt ($ $values (arg)))
- ($branch kt ($values ((rename-var arg)))))
(($ $branch kt ($ $primcall name args))
($branch kt ($primcall name ,(map rename-var args))))
(($ $primcall name args)
diff --git a/module/language/cps/self-references.scm
b/module/language/cps/self-references.scm
index cbdaaa1..5b4d6e7 100644
--- a/module/language/cps/self-references.scm
+++ b/module/language/cps/self-references.scm
@@ -1,6 +1,6 @@
;;; Continuation-passing style (CPS) intermediate language (IL)
-;; Copyright (C) 2013, 2014, 2015 Free Software Foundation, Inc.
+;; Copyright (C) 2013, 2014, 2015, 2017 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
@@ -45,8 +45,6 @@
($callk k (subst proc) ,(map subst args)))
(($ $primcall name args)
($primcall name ,(map subst args)))
- (($ $branch k ($ $values (arg)))
- ($branch k ($values ((subst arg)))))
(($ $branch k ($ $primcall name args))
($branch k ($primcall name ,(map subst args))))
(($ $values args)
diff --git a/module/language/cps/simplify.scm b/module/language/cps/simplify.scm
index 280e257..f3ff835 100644
--- a/module/language/cps/simplify.scm
+++ b/module/language/cps/simplify.scm
@@ -1,6 +1,6 @@
;;; Continuation-passing style (CPS) intermediate language (IL)
-;; Copyright (C) 2013, 2014, 2015 Free Software Foundation, Inc.
+;; Copyright (C) 2013, 2014, 2015, 2017 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
@@ -78,8 +78,6 @@
(ref* args))
(($ $values args)
(ref* args))
- (($ $branch kt ($ $values (var)))
- (ref var))
(($ $branch kt ($ $primcall name args))
(ref* args))
(($ $prompt escape? tag handler)
@@ -154,10 +152,10 @@
(($ $kargs (_)
((? (lambda (var) (intset-ref singly-used var))
var))
- ($ $continue kf _ ($ $branch kt ($ $values (var)))))
+ ($ $continue kf _ ($ $branch kt ($ $primcall 'false?
(var)))))
(build-cont
($kargs names syms
- ($continue (subst (if val kt kf)) src ($values ())))))
+ ($continue (subst (if val kf kt)) src ($values ())))))
(_
(build-cont
($kargs names syms
@@ -255,8 +253,6 @@
($primcall name ,(map subst args)))
(($ $values args)
($values ,(map subst args)))
- (($ $branch kt ($ $values (var)))
- ($branch kt ($values ((subst var)))))
(($ $branch kt ($ $primcall name args))
($branch kt ($primcall name ,(map subst args))))
(($ $prompt escape? tag handler)
diff --git a/module/language/cps/slot-allocation.scm
b/module/language/cps/slot-allocation.scm
index 6813a51..abde300 100644
--- a/module/language/cps/slot-allocation.scm
+++ b/module/language/cps/slot-allocation.scm
@@ -1,6 +1,6 @@
;; Continuation-passing style (CPS) intermediate language (IL)
-;; Copyright (C) 2013, 2014, 2015 Free Software Foundation, Inc.
+;; Copyright (C) 2013, 2014, 2015, 2017 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
@@ -176,8 +176,6 @@ by a label, respectively."
(return (get-defs k) (vars->intset args)))
(($ $branch kt ($ $primcall name args))
(return empty-intset (vars->intset args)))
- (($ $branch kt ($ $values args))
- (return empty-intset (vars->intset args)))
(($ $values args)
(return (get-defs k) (vars->intset args)))
(($ $prompt escape? tag handler)
diff --git a/module/language/cps/specialize-numbers.scm
b/module/language/cps/specialize-numbers.scm
index 7c86bcf..67aea82 100644
--- a/module/language/cps/specialize-numbers.scm
+++ b/module/language/cps/specialize-numbers.scm
@@ -263,8 +263,6 @@ BITS indicating the significant bits needed for a variable.
BITS may be
(add-unknown-use (add-unknown-uses out args) proc))
(($ $callk label proc args)
(add-unknown-use (add-unknown-uses out args) proc))
- (($ $branch kt ($ $values (arg)))
- (add-unknown-use out arg))
(($ $branch kt ($ $primcall name args))
(add-unknown-uses out args))
(($ $primcall name args)
diff --git a/module/language/cps/split-rec.scm
b/module/language/cps/split-rec.scm
index 2551ac6..5a8119b 100644
--- a/module/language/cps/split-rec.scm
+++ b/module/language/cps/split-rec.scm
@@ -1,6 +1,6 @@
;;; Continuation-passing style (CPS) intermediate language (IL)
-;; Copyright (C) 2013, 2014, 2015 Free Software Foundation, Inc.
+;; Copyright (C) 2013, 2014, 2015, 2017 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
@@ -87,8 +87,6 @@ references."
(add-uses args uses))
(($ $call proc args)
(add-use proc (add-uses args uses)))
- (($ $branch kt ($ $values (arg)))
- (add-use arg uses))
(($ $branch kt ($ $primcall name args))
(add-uses args uses))
(($ $primcall name args)
diff --git a/module/language/cps/type-fold.scm
b/module/language/cps/type-fold.scm
index b811ad3..2824625 100644
--- a/module/language/cps/type-fold.scm
+++ b/module/language/cps/type-fold.scm
@@ -448,11 +448,6 @@
((x y)
(or (fold-binary-branch cps label names vars k kt src name x y)
cps))))
- (($ $branch kt ($ $values (arg)))
- ;; We might be able to fold a branch on the false? primcall.
- ;; Note inverted true and false continuations.
- (or (fold-unary-branch cps label names vars kt k src 'false? arg)
- cps))
(_ cps)))
(let lp ((label start) (cps cps))
(if (<= label end)
diff --git a/module/language/cps/types.scm b/module/language/cps/types.scm
index 2217daa..e07bb92 100644
--- a/module/language/cps/types.scm
+++ b/module/language/cps/types.scm
@@ -1655,13 +1655,6 @@ maximum, where type is a bitset as a fixnum."
(values (append changed0 changed1) typev)))
;; Each of these branches must propagate to its successors.
(match exp
- (($ $branch kt ($ $values args))
- ;; In the future a branch on $values will be replaced by a
- ;; primcall to 'false?; manually do that here. Note that the
- ;; sense of the test is reversed.
- (let ((kt-types (infer-primcall types 0 'false? args #f))
- (kf-types (infer-primcall types 1 'false? args #f)))
- (propagate2 k kf-types kt kt-types)))
(($ $branch kt ($ $primcall name args))
;; The "normal" continuation is the #f branch.
(let ((kf-types (infer-primcall types 0 name args #f))
diff --git a/module/language/cps/verify.scm b/module/language/cps/verify.scm
index 1a9eb72..f41d8e3 100644
--- a/module/language/cps/verify.scm
+++ b/module/language/cps/verify.scm
@@ -1,5 +1,5 @@
;;; Diagnostic checker for CPS
-;;; Copyright (C) 2014, 2015 Free Software Foundation, Inc.
+;;; Copyright (C) 2014, 2015, 2017 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
@@ -160,9 +160,6 @@ definitions that are available at LABEL."
(check-use proc)
(for-each check-use args)
(visit-first-order kfun))
- (($ $branch kt ($ $values (arg)))
- (check-use arg)
- first-order)
(($ $branch kt ($ $primcall name args))
(for-each check-use args)
first-order)
diff --git a/module/language/tree-il/compile-cps.scm
b/module/language/tree-il/compile-cps.scm
index 5f5cad8..cc5f9c5 100644
--- a/module/language/tree-il/compile-cps.scm
+++ b/module/language/tree-il/compile-cps.scm
@@ -548,8 +548,8 @@
(let$ k (adapt-arity k src 1))
(letk kt ($kargs () () ($continue k src ($const #f))))
(letk kf ($kargs () () ($continue k src ($const #t))))
- (build-term ($continue kf src
- ($branch kt ($values args))))))))
+ (build-term ($continue kt src
+ ($branch kf ($primcall 'false? args))))))))
((and (eq? name 'list)
(and-map (match-lambda
((or ($ <const>)
@@ -820,8 +820,8 @@
(_ (convert-arg cps test
(lambda (cps test)
(with-cps cps
- (build-term ($continue kf src
- ($branch kt ($values (test)))))))))))
+ (build-term ($continue kt src
+ ($branch kf ($primcall 'false? (test)))))))))))
(with-cps cps
(let$ t (convert consequent k subst))
(let$ f (convert alternate k subst))
- [Guile-commits] 02/11: Use tag visitors to generate assemblers, disassembly annotations, (continued)
- [Guile-commits] 02/11: Use tag visitors to generate assemblers, disassembly annotations, Andy Wingo, 2017/10/29
- [Guile-commits] 05/11: Emit char? instead of br-if-char, Andy Wingo, 2017/10/29
- [Guile-commits] 04/11: Emit new instructions for heap object type tests, Andy Wingo, 2017/10/29
- [Guile-commits] 08/11: Emit new eq? instruction, Andy Wingo, 2017/10/29
- [Guile-commits] 10/11: Use new instructions for u64 comparisons., Andy Wingo, 2017/10/29
- [Guile-commits] 09/11: Use new instructions for less-than, etc, Andy Wingo, 2017/10/29
- [Guile-commits] 11/11: Use new instructions for f64 comparisons, Andy Wingo, 2017/10/29
- [Guile-commits] 03/11: Heap type predicates preceded by heap-object?, Andy Wingo, 2017/10/29
- [Guile-commits] 01/11: Refactor (system base types internal) to use more macros, Andy Wingo, 2017/10/29
- [Guile-commits] 06/11: Use new instructions for null?, nil?, Andy Wingo, 2017/10/29
- [Guile-commits] 07/11: Simplify $branch to always take a $primcall,
Andy Wingo <=