Add layer predicates.
original commit: 26cc2cf6dc81323463e0d448de890bbb2621a3ae
This commit is contained in:
parent
69b3ea5f28
commit
78767f809a
|
@ -92,7 +92,9 @@
|
|||
(when (and (not safe-to-opt?)
|
||||
(isoftype? this-syntax -Real))
|
||||
(log-close-call "binary, args all float-arg-expr, return type not Float"
|
||||
this-syntax))
|
||||
this-syntax
|
||||
(for/first ([x (in-list (syntax->list #'(f1 f2 fs ...)))])
|
||||
(not (subtypeof? x -Flonum)))))
|
||||
safe-to-opt?)
|
||||
#:with opt
|
||||
(begin (log-optimization "binary float" #'op)
|
||||
|
|
|
@ -4,13 +4,14 @@
|
|||
racket/dict syntax/id-table racket/syntax unstable/syntax
|
||||
"../utils/utils.rkt"
|
||||
(for-template scheme/base)
|
||||
(types type-table utils subtype)
|
||||
(types type-table utils subtype numeric-tower)
|
||||
(rep type-rep))
|
||||
|
||||
(provide *log-file* *log-to-log-file?* log-optimization *log-optimizations?*
|
||||
log-close-call *log-close-calls?*
|
||||
*show-optimized-code*
|
||||
subtypeof? isoftype?
|
||||
in-integer-layer? in-rational-layer? in-float-layer? in-real-layer?
|
||||
mk-unsafe-tbl
|
||||
n-ary->binary
|
||||
unboxed-gensym reset-unboxed-gensym
|
||||
|
@ -39,9 +40,16 @@
|
|||
;; This is meant to help users understand what hurts the performance of
|
||||
;; their programs.
|
||||
(define *log-close-calls?* (in-command-line? "--log-close-calls"))
|
||||
(define (log-close-call kind stx)
|
||||
(define (log-close-call kind stx [irritant #f])
|
||||
(when *log-close-calls?*
|
||||
(do-logging kind stx)))
|
||||
(do-logging (if irritant
|
||||
(format "~a - caused by: ~a - ~a - ~a - ~a"
|
||||
kind
|
||||
(syntax-source-file-name irritant)
|
||||
(syntax-line irritant) (syntax-column irritant)
|
||||
(syntax->datum irritant))
|
||||
kind)
|
||||
stx)))
|
||||
|
||||
;; if set to #t, the optimizer will dump its result to stdout before compilation
|
||||
(define *show-optimized-code* #f)
|
||||
|
@ -55,6 +63,20 @@
|
|||
(match (type-of s)
|
||||
[(tc-result1: (== t type-equal?)) #t] [_ #f]))
|
||||
|
||||
;; layer predicates
|
||||
;; useful in some cases where subtyping won't do
|
||||
(define (in-integer-layer? t)
|
||||
(subtypeof? t -Int))
|
||||
(define (in-rational-layer? t)
|
||||
(and (subtypeof? t -Rat)
|
||||
(not (subtypeof? t -Int))))
|
||||
(define (in-float-layer? t)
|
||||
(subtypeof? t -Flonum))
|
||||
(define (in-real-layer? t)
|
||||
(and (subtypeof? t -Real)
|
||||
(not (subtypeof? t -Rat))
|
||||
(not (subtypeof? t -Flonum))))
|
||||
|
||||
;; generates a table matching safe to unsafe promitives
|
||||
(define (mk-unsafe-tbl generic safe-pattern unsafe-pattern)
|
||||
(for/fold ([h (make-immutable-free-id-table)]) ([g generic])
|
||||
|
|
Loading…
Reference in New Issue
Block a user