~ chicken-core (chicken-5) 9b21b70a4d195c5a4c9c49d05120579aa86ecb86

commit 9b21b70a4d195c5a4c9c49d05120579aa86ecb86
Author:     LemonBoy <thatlemon@gmail.com>
AuthorDate: Wed Jul 5 13:29:23 2017 +0200
Commit:     Evan Hanson <evhan@foldling.org>
CommitDate: Mon Jul 17 11:22:39 2017 +1200

    Elide pointless type checks in the lfa2 pass
    
    Some C_i_foreign_*_argumentp functions can be safely elided if we can
    prove the arguments have the correct type.
    
    Ranged integer checks can't be removed in general because the type
    system currently does not represent any range info. Integer literals
    could be removed, but doing so is not worth the added complexity right
    now.
    
    Signed-off-by: Peter Bex <peter@more-magic.net>
    Signed-off-by: Evan Hanson <evhan@foldling.org>

diff --git a/lfa2.scm b/lfa2.scm
index e53ffe37..a43d40cb 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,17 @@
 			    ((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)))
+		      (when (member r1 (cdr a))
+			(node-class-set! n (node-class arg))
+			(node-parameters-set! n (node-parameters arg))
+			(node-subexpressions-set! n (node-subexpressions arg)))
+		      ;; the ffi checks are enforcing so we always end up with
+		      ;; the correct type
+		      r1)))
 		 ((assoc (first params) +predicate-map+) =>
 		  (lambda (a)
 		    (let ((arg (first subs)))