From e5625725f99c80387d05950b2758d424a4a7dca2 Mon Sep 17 00:00:00 2001 From: LemonBoy Date: Wed, 5 Jul 2017 13:29:23 +0200 Subject: [PATCH] Elide pointless type checks in the lfa2 pass Some (but not all!) C_i_foreign_*_argumentp functions can be safely elided if we can prove the arguments have the correct type. All ranged integer checks can't be removed because the type system currently does not represent any range info. Signed-off-by: Peter Bex --- lfa2.scm | 27 +++++++++++++++++++++++++++ 1 file changed, 27 insertions(+) diff --git a/lfa2.scm b/lfa2.scm index e53ffe37..8cdcb728 100644 --- a/lfa2.scm +++ b/lfa2.scm @@ -117,6 +117,15 @@ ("C_i_portp" port) ("C_i_nullp" null))) +;; Maps foreign type checks to types + +(define +ffi-type-check-map+ + '(("C_i_foreign_fixnum_argumentp" fixnum) + ("C_i_foreign_integer_argumentp" integer fixnum bignum) + ("C_i_foreign_char_argumentp" char) + ("C_i_foreign_flonum_argumentp" flonum) + ("C_i_foreign_string_argumentp" string) + ("C_i_foreign_symbol_argumentp" symbol))) ;; Maps constructors to types @@ -313,6 +322,24 @@ ((member r1 (cdr a)) (extinguish! n "C_i_noop"))) '*))) + ((assoc (first params) +ffi-type-check-map+) => + (lambda (a) + (let ((arg (first subs)) + (r1 (walk (first subs) te ae))) + (cond + ((member r1 (cdr a)) + ;; The ffi checks return the object, so we can + ;; replace the check with the bare object. + (node-class-set! n (node-class arg)) + (node-parameters-set! n (node-parameters arg)) + (node-subexpressions-set! n (node-subexpressions arg)) + ;; The final type is as derived + r1) + (else + ;; The ffi checks are enforcing so we always + ;; end up with the correct type, even if we + ;; didn't rewrite the node. + (cons 'or (cdr a))))))) ((assoc (first params) +predicate-map+) => (lambda (a) (let ((arg (first subs))) -- 2.11.0