From d1c69b5c9546b04fc5040f3deb2ee0fce0868083 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Sun, 29 Oct 2017 21:02:56 +0100 Subject: [PATCH] Remove compiler support for u64-scm comparisons * module/language/cps/compile-bytecode.scm (compile-function): * module/language/cps/effects-analysis.scm: * module/language/cps/primitives.scm (*comparisons*): * module/language/cps/type-fold.scm: * module/language/cps/types.scm: Remove compiler support for u64-scm comparisons, as this is now inlined. --- module/language/cps/compile-bytecode.scm | 5 ----- module/language/cps/effects-analysis.scm | 5 ----- module/language/cps/primitives.scm | 5 ----- module/language/cps/type-fold.scm | 5 ----- module/language/cps/types.scm | 28 ------------------------ 5 files changed, 48 deletions(-) diff --git a/module/language/cps/compile-bytecode.scm b/module/language/cps/compile-bytecode.scm index ea46f68e4..f580551a5 100644 --- a/module/language/cps/compile-bytecode.scm +++ b/module/language/cps/compile-bytecode.scm @@ -471,11 +471,6 @@ (($ $primcall 'f64-= (a b)) (binary-test emit-f64=? a b)) (($ $primcall 'f64->= (a b)) (binary* emit-f64 (a b)) (binary* emit-f64=-scm (a b)) (binary emit-br-if-u64->=-scm a b)) - (($ $primcall 'u64->-scm (a b)) (binary emit-br-if-u64->-scm a b)) (($ $primcall 'logtest (a b)) (binary emit-br-if-logtest a b)))) (define (compile-trunc label k exp nreq rest-var) diff --git a/module/language/cps/effects-analysis.scm b/module/language/cps/effects-analysis.scm index 675b5241d..be97788b0 100644 --- a/module/language/cps/effects-analysis.scm +++ b/module/language/cps/effects-analysis.scm @@ -447,11 +447,6 @@ is or might be a read or a write to the same location as A." ((u64-> . _)) ((u64-<= . _)) ((u64->= . _)) - ((u64-<-scm . _) &type-check) - ((u64-<=-scm . _) &type-check) - ((u64-=-scm . _) &type-check) - ((u64->=-scm . _) &type-check) - ((u64->-scm . _) &type-check) ((s64-= . _)) ((s64-< . _)) ((s64-> . _)) diff --git a/module/language/cps/primitives.scm b/module/language/cps/primitives.scm index f5966a54c..c807472e4 100644 --- a/module/language/cps/primitives.scm +++ b/module/language/cps/primitives.scm @@ -145,9 +145,6 @@ before it is lowered to CPS?" ;; FIXME: Expand these. logtest - u64-<-scm - u64-<=-scm - u64-=-scm ;; FIXME: Remove these. > @@ -156,8 +153,6 @@ before it is lowered to CPS?" u64->= s64-> s64->= - u64->=-scm - u64->-scm f64-> f64->=)) diff --git a/module/language/cps/type-fold.scm b/module/language/cps/type-fold.scm index 75c8deae0..5a79a7b24 100644 --- a/module/language/cps/type-fold.scm +++ b/module/language/cps/type-fold.scm @@ -146,7 +146,6 @@ (else (values #f #f)))) (define-branch-folder-alias u64-< <) (define-branch-folder-alias s64-< <) -(define-branch-folder-alias u64-<-scm <) ;; We currently cannot define branch folders for floating point ;; comparison ops like the commented one below because we can't prove ;; there are no nans involved. @@ -160,7 +159,6 @@ (else (values #f #f)))) (define-branch-folder-alias u64-<= <=) (define-branch-folder-alias s64-<= <=) -(define-branch-folder-alias u64-<=-scm <=) (define-binary-branch-folder (= type0 min0 max0 type1 min1 max1) (case (compare-ranges type0 min0 max0 type1 min1 max1) @@ -169,7 +167,6 @@ (else (values #f #f)))) (define-branch-folder-alias u64-= =) (define-branch-folder-alias s64-= =) -(define-branch-folder-alias u64-=-scm =) (define-binary-branch-folder (>= type0 min0 max0 type1 min1 max1) (case (compare-ranges type0 min0 max0 type1 min1 max1) @@ -178,7 +175,6 @@ (else (values #f #f)))) (define-branch-folder-alias u64->= >=) (define-branch-folder-alias s64->= >=) -(define-branch-folder-alias u64->=-scm >=) (define-binary-branch-folder (> type0 min0 max0 type1 min1 max1) (case (compare-ranges type0 min0 max0 type1 min1 max1) @@ -187,7 +183,6 @@ (else (values #f #f)))) (define-branch-folder-alias u64-> >) (define-branch-folder-alias s64-> >) -(define-branch-folder-alias u64->-scm >) (define-binary-branch-folder (logtest type0 min0 max0 type1 min1 max1) (define (logand-min a b) diff --git a/module/language/cps/types.scm b/module/language/cps/types.scm index 690595958..f1948494e 100644 --- a/module/language/cps/types.scm +++ b/module/language/cps/types.scm @@ -991,34 +991,6 @@ minimum, and maximum." (restrict! a &u64 min max) (restrict! b &u64 min max)))) -(define-simple-type-checker (u64-=-scm &u64 &real)) -(define-predicate-inferrer (u64-=-scm a b true?) - (when (and true? (zero? (logand (&type b) (lognot &real)))) - (let ((min (max (&min/0 a) (&min/0 b))) - (max (min (&max/u64 a) (&max/u64 b)))) - (restrict! a &u64 min max) - (restrict! b &real min max)))) - -(define-simple-type-checker (u64-<-scm &u64 &real)) -(define-predicate-inferrer (u64-<-scm a b true?) - (when (and true? (zero? (logand (&type b) (lognot &real)))) - (true-comparison-restrictions '< a b &u64 &real))) - -(define-simple-type-checker (u64-<=-scm &u64 &real)) -(define-predicate-inferrer (u64-<=-scm a b true?) - (when (and true? (zero? (logand (&type b) (lognot &real)))) - (true-comparison-restrictions '<= a b &u64 &real))) - -(define-simple-type-checker (u64->=-scm &u64 &real)) -(define-predicate-inferrer (u64->=-scm a b true?) - (when (and true? (zero? (logand (&type b) (lognot &real)))) - (true-comparison-restrictions '>= a b &u64 &real))) - -(define-simple-type-checker (u64->-scm &u64 &real)) -(define-predicate-inferrer (u64->-scm a b true?) - (when (and true? (zero? (logand (&type b) (lognot &real)))) - (true-comparison-restrictions '> a b &u64 &real))) - (define (infer-u64-comparison-ranges op min0 max0 min1 max1) (match op ('< (values min0 (min max0 (1- max1)) (max (1+ min0) min1) max1))