idris-lang/Idris2
1
1
Fork 0
mirror of https://github.com/idris-lang/Idris2.git synced 2024-09-11 13:36:08 +03:00
Code Issues Projects Releases Wiki Activity

[ performance ] bitops arithmetic speedup (#2081)

Browse Source
This commit is contained in:
Ben Hormann 2021-11-17 12:54:19 +01:00 committed by GitHub
parent a4eb8b2ec3
commit d1e90a5b8e
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
6 changed files with 71 additions and 97 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
src/Compiler/Scheme/Racket.idr
View File

@ -49,6 +49,7 @@ schHeader prof libs = """
(require racket/future) ; for parallelism/concurrency
(require racket/math) ; for math ops
(require racket/system) ; for system
(require racket/unsafe/ops) ; for fast fixnum ops
(require rnrs/bytevectors-6) ; for buffers
(require rnrs/io/ports-6) ; for files
(require srfi/19) ; for file handling and data

14
support/chez/ct-support.ss
View File

@ -60,15 +60,13 @@
default))
; primitives
(define ct-toSignedInt
(lambda (x bits)
(if (logbit? bits x)
(logor x (ash (- 1) bits))
(logand x (- (ash 1 bits) 1)))))
(define (ct-toSignedInt x bits)
(if (logbit? bits x)
(logor x (ash -1 bits))
(logand x (sub1 (ash 1 bits)))))
(define ct-toUnsignedInt
(lambda (x bits)
(modulo x (ash 1 bits))))
(define (ct-toUnsignedInt x bits)
(logand x (sub1 (ash 1 bits))))
(define ct-u+ (lambda (x y bits)
(let [(tag (vector-ref x 0))

43
support/chez/support.ss
View File

@ -19,15 +19,13 @@
(void))
res))))
(define blodwen-toSignedInt
(lambda (x bits)
(if (logbit? bits x)
(logor x (ash (- 1) bits))
(logand x (- (ash 1 bits) 1)))))
(define (blodwen-toSignedInt x bits)
(if (logbit? bits x)
(logor x (ash -1 bits))
(logand x (sub1 (ash 1 bits)))))
(define blodwen-toUnsignedInt
(lambda (x bits)
(modulo x (ash 1 bits))))
(define (blodwen-toUnsignedInt x bits)
(logand x (sub1 (ash 1 bits))))
(define bu+ (lambda (x y bits) (blodwen-toUnsignedInt (+ x y) bits)))
@ -40,26 +38,21 @@
(define bs* (lambda (x y bits) (blodwen-toSignedInt (* x y) bits)))
(define bs/ (lambda (x y bits) (blodwen-toSignedInt (quotient x y) bits)))
(define b+ (lambda (x y bits) (remainder (+ x y) (ash 1 bits))))
(define b- (lambda (x y bits) (remainder (- x y) (ash 1 bits))))
(define b* (lambda (x y bits) (remainder (* x y) (ash 1 bits))))
(define b/ (lambda (x y bits) (remainder (exact-floor (/ x y)) (ash 1 bits))))
(define (integer->bits8 x) (logand x (sub1 (ash 1 8))))
(define (integer->bits16 x) (logand x (sub1 (ash 1 16))))
(define (integer->bits32 x) (logand x (sub1 (ash 1 32))))
(define (integer->bits64 x) (logand x (sub1 (ash 1 64))))
(define integer->bits8 (lambda (x) (modulo x (expt 2 8))))
(define integer->bits16 (lambda (x) (modulo x (expt 2 16))))
(define integer->bits32 (lambda (x) (modulo x (expt 2 32))))
(define integer->bits64 (lambda (x) (modulo x (expt 2 64))))
(define (bits16->bits8 x) (logand x (sub1 (ash 1 8))))
(define (bits32->bits8 x) (logand x (sub1 (ash 1 8))))
(define (bits64->bits8 x) (logand x (sub1 (ash 1 8))))
(define (bits32->bits16 x) (logand x (sub1 (ash 1 16))))
(define (bits64->bits16 x) (logand x (sub1 (ash 1 16))))
(define (bits64->bits32 x) (logand x (sub1 (ash 1 32))))
(define bits16->bits8 (lambda (x) (modulo x (expt 2 8))))
(define bits32->bits8 (lambda (x) (modulo x (expt 2 8))))
(define bits32->bits16 (lambda (x) (modulo x (expt 2 16))))
(define bits64->bits8 (lambda (x) (modulo x (expt 2 8))))
(define bits64->bits16 (lambda (x) (modulo x (expt 2 16))))
(define bits64->bits32 (lambda (x) (modulo x (expt 2 32))))
(define (blodwen-bits-shl-signed x y bits) (blodwen-toSignedInt (ash x y) bits))
(define blodwen-bits-shl-signed (lambda (x y bits) (blodwen-toSignedInt (ash x y) bits)))
(define blodwen-bits-shl (lambda (x y bits) (remainder (ash x y) (ash 1 bits))))
(define (blodwen-bits-shl x y bits) (logand (ash x y) (sub1 (ash 1 bits))))
(define blodwen-shl (lambda (x y) (ash x y)))
(define blodwen-shr (lambda (x y) (ash x (- y))))

55
support/gambit/support.scm
View File

@ -25,15 +25,13 @@
(void))
res))))
(define blodwen-toSignedInt
(lambda (x bits)
(if (bit-set? bits x)
(bitwise-ior x (arithmetic-shift (- 1) bits))
(bitwise-and x (- (arithmetic-shift 1 bits) 1)))))
(define (blodwen-toSignedInt x bits)
(if (bit-set? bits x)
(bitwise-ior x (arithmetic-shift -1 bits))
(bitwise-and x (- (arithmetic-shift 1 bits) 1))))
(define blodwen-toUnsignedInt
(lambda (x bits)
(modulo x (arithmetic-shift 1 bits))))
(define (blodwen-toUnsignedInt x bits)
(bitwise-and x (sub1 (arithmetic-shift 1 bits))))
(define bu+ (lambda (x y bits) (blodwen-toUnsignedInt (+ x y) bits)))
(define bu- (lambda (x y bits) (blodwen-toUnsignedInt (- x y) bits)))
@ -45,34 +43,23 @@
(define bs* (lambda (x y bits) (blodwen-toSignedInt (* x y) bits)))
(define bs/ (lambda (x y bits) (blodwen-toSignedInt (quotient x y) bits)))
(define-macro (b+ x y bits)
(if (exact-integer? bits)
`(remainder (+ ,x ,y) ,(arithmetic-shift 1 bits))
`(remainder (+ ,x ,y) (arithmetic-shift 1 ,bits))))
(define-macro (b- x y bits)
(if (exact-integer? bits)
`(remainder (- ,x ,y) ,(arithmetic-shift 1 bits))
`(remainder (- ,x ,y) (arithmetic-shift 1 ,bits))))
(define-macro (b* x y bits)
(if (exact-integer? bits)
`(remainder (* ,x ,y) ,(arithmetic-shift 1 bits))
`(remainder (* ,x ,y) (arithmetic-shift 1 ,bits))))
(define-macro (b/ x y bits)
(if (exact-integer? bits)
`(remainder (floor (/ ,x ,y)) ,(arithmetic-shift 1 bits))
`(remainder (floor (/ ,x ,y)) (arithmetic-shift 1 ,bits))))
; To match Chez
(define (add1 x) (+ x 1))
(define (sub1 x) (- x 1))
(define (fxsub1 x) (fx- x 1))
(define (fxsub1 x) (fx- x 1))
(define integer->bits8 (lambda (x) (modulo x (expt 2 8))))
(define integer->bits16 (lambda (x) (modulo x (expt 2 16))))
(define integer->bits32 (lambda (x) (modulo x (expt 2 32))))
(define integer->bits64 (lambda (x) (modulo x (expt 2 64))))
(define (integer->bits8 x) (bitwise-and x #xff))
(define (integer->bits16 x) (bitwise-and x #xffff))
(define (integer->bits32 x) (bitwise-and x #xffffffff))
(define (integer->bits64 x) (bitwise-and x #xffffffffffffffff))
(define bits16->bits8 (lambda (x) (modulo x (expt 2 8))))
(define bits32->bits8 (lambda (x) (modulo x (expt 2 8))))
(define bits32->bits16 (lambda (x) (modulo x (expt 2 16))))
(define bits64->bits8 (lambda (x) (modulo x (expt 2 8))))
(define bits64->bits16 (lambda (x) (modulo x (expt 2 16))))
(define bits64->bits32 (lambda (x) (modulo x (expt 2 32))))
(define (bits16->bits8 x) (bitwise-and x #xff))
(define (bits32->bits8 x) (bitwise-and x #xff))
(define (bits64->bits8 x) (bitwise-and x #xff))
(define (bits32->bits16 x) (bitwise-and x #xffff))
(define (bits64->bits16 x) (bitwise-and x #xffff))
(define (bits64->bits32 x) (bitwise-and x #xffffffff))
(define blodwen-bits-shl-signed
(lambda (x y bits) (blodwen-toSignedInt (arithmetic-shift x y) bits)))

14
support/racket/ct-support.rkt
View File

@ -60,15 +60,13 @@
default))
; primitives
(define ct-toSignedInt
(lambda (x bits)
(if (bitwise-bit-set? x bits)
(bitwise-ior x (arithmetic-shift (- 1) bits))
(bitwise-and x (- (arithmetic-shift 1 bits) 1)))))
(define (ct-toSignedInt x bits)
(if (bitwise-bit-set? x bits)
(bitwise-ior x (arithmetic-shift (- 1) bits))
(bitwise-and x (sub1 (arithmetic-shift 1 bits)))))
(define ct-toUnsignedInt
(lambda (x bits)
(modulo x (arithmetic-shift 1 bits))))
(define (ct-toUnsignedInt x bits)
(bitwise-and x (sub1 (arithmetic-shift 1 bits))))
(define ct-u+ (lambda (x y bits)
(let [(tag (vector-ref x 0))

41
support/racket/support.rkt
View File

@ -16,15 +16,13 @@
(void))
res))))
(define blodwen-toSignedInt
(lambda (x bits)
(if (bitwise-bit-set? x bits)
(bitwise-ior x (arithmetic-shift (- 1) bits))
(bitwise-and x (- (arithmetic-shift 1 bits) 1)))))
(define (blodwen-toSignedInt x bits)
(if (bitwise-bit-set? x bits)
(bitwise-ior x (arithmetic-shift (- 1) bits))
(bitwise-and x (sub1 (arithmetic-shift 1 bits)))))
(define blodwen-toUnsignedInt
(lambda (x bits)
(modulo x (arithmetic-shift 1 bits))))
(define (blodwen-toUnsignedInt x bits)
(bitwise-and x (sub1 (arithmetic-shift 1 bits))))
(define bu+ (lambda (x y bits) (blodwen-toUnsignedInt (+ x y) bits)))
(define bu- (lambda (x y bits) (blodwen-toUnsignedInt (- x y) bits)))
@ -36,22 +34,21 @@
(define bs* (lambda (x y bits) (blodwen-toSignedInt (* x y) bits)))
(define bs/ (lambda (x y bits) (blodwen-toSignedInt (quotient x y) bits)))
(define b+ (lambda (x y bits) (remainder (+ x y) (arithmetic-shift 1 bits))))
(define b- (lambda (x y bits) (remainder (- x y) (arithmetic-shift 1 bits))))
(define b* (lambda (x y bits) (remainder (* x y) (arithmetic-shift 1 bits))))
(define b/ (lambda (x y bits) (remainder (exact-floor (/ x y)) (arithmetic-shift 1 bits))))
; To match Chez
(define (fxadd1 x) (unsafe-fx+ x 1))
(define (fxsub1 x) (unsafe-fx- x 1))
(define integer->bits8 (lambda (x) (modulo x (expt 2 8))))
(define integer->bits16 (lambda (x) (modulo x (expt 2 16))))
(define integer->bits32 (lambda (x) (modulo x (expt 2 32))))
(define integer->bits64 (lambda (x) (modulo x (expt 2 64))))
(define (integer->bits8 x) (bitwise-and x #xff))
(define (integer->bits16 x) (bitwise-and x #xffff))
(define (integer->bits32 x) (bitwise-and x #xffffffff))
(define (integer->bits64 x) (bitwise-and x #xffffffffffffffff))
(define bits16->bits8 (lambda (x) (modulo x (expt 2 8))))
(define bits32->bits8 (lambda (x) (modulo x (expt 2 8))))
(define bits32->bits16 (lambda (x) (modulo x (expt 2 16))))
(define bits64->bits8 (lambda (x) (modulo x (expt 2 8))))
(define bits64->bits16 (lambda (x) (modulo x (expt 2 16))))
(define bits64->bits32 (lambda (x) (modulo x (expt 2 32))))
(define (bits16->bits8 x) (bitwise-and x #xff))
(define (bits32->bits8 x) (bitwise-and x #xff))
(define (bits64->bits8 x) (bitwise-and x #xff))
(define (bits32->bits16 x) (bitwise-and x #xffff))
(define (bits64->bits16 x) (bitwise-and x #xffff))
(define (bits64->bits32 x) (bitwise-and x #xffffffff))
(define blodwen-bits-shl (lambda (x y bits) (remainder (arithmetic-shift x y) (arithmetic-shift 1 bits))))
(define blodwen-shl (lambda (x y) (arithmetic-shift x y)))