From a7d5b1338828d047a0a479c67a97aec4e55229e9 Mon Sep 17 00:00:00 2001
From: LemonBoy <address@hidden>
Date: Sun, 28 May 2017 23:21:21 +0200
Subject: [PATCH 3/3] Fix the type inference with foreign types

We can't trust the returned values to be of the base type since we push
it trough the conversion procedures.
---
 core.scm    |  8 ++++----
 support.scm | 17 ++++++++++++-----
 2 files changed, 16 insertions(+), 9 deletions(-)

diff --git a/core.scm b/core.scm
index cc1dd9a5..ec56def4 100644
--- a/core.scm
+++ b/core.scm
@@ -556,7 +556,7 @@
 	    ((assq x foreign-variables)
 	     => (lambda (fv)
 		  (let* ((t (second fv))
-			 (ft (final-foreign-type t))
+			 (ft (final-foreign-type t #f))
 			 (body `(##core#inline_ref (,(third fv) ,t))))
 		    (walk
 		     (foreign-type-convert-result
@@ -566,7 +566,7 @@
 	    ((assq x location-pointer-map)
 	     => (lambda (a)
 		  (let* ((t (third a))
-			 (ft (final-foreign-type t))
+			 (ft (final-foreign-type t #f))
 			 (body `(##core#inline_loc_ref (,t) ,(second a))))
 		    (walk
 		     (foreign-type-convert-result
@@ -1379,7 +1379,7 @@
 						    var
 						    (foreign-type-convert-result
 						     (finish-foreign-result
-						      (final-foreign-type type)
+						      (final-foreign-type type #f)
 						      var)
 						     type) )
 						   (loop (cdr vars) (cdr types)) ) ) ) )
@@ -1826,7 +1826,7 @@
 	 ,@(if callback '((##sys#gc #f)) '())
 	 ,(if (zero? rsize)
 	      (foreign-type-convert-result (append head (cons '(##core#undefined) rest)) rtype)
-	      (let ([ft (final-foreign-type rtype)]
+	      (let ([ft (final-foreign-type rtype #f)]
 		    [ws (bytes->words rsize)] )
 		`(let ([,bufvar (##core#inline_allocate ("C_a_i_bytevector" ,(+ 2 ws)) ',ws)])
 		   ,(foreign-type-convert-result
diff --git a/support.scm b/support.scm
index 2c04d2e0..966cd06d 100644
--- a/support.scm
+++ b/support.scm
@@ -1131,14 +1131,21 @@
 	(list argconv a) )
       a) )
 
-(define (final-foreign-type t0)		; Used only in compiler.scm
+(define (final-foreign-type t0 mode) ; Used only in compiler.scm
   (follow-without-loop
    t0
    (lambda (t next)
      (cond ((and (symbol? t) (lookup-foreign-type t))
-	    => (lambda (t2) (next (vector-ref t2 0)) ) )
-	   (else t) ) )
-   (lambda () (quit-compiling "foreign type `~S' refers to itself" t0)) ) )
+	    => (lambda (t2)
+		 (cond
+		   ; If mode is not #f then we take into account the fact we
+		   ; can't have a precise type if there are user-specified
+		   ; conversion procedures
+		   ((and (eq? mode 'arg)    (vector-ref t2 1)) '*)
+		   ((and (eq? mode 'result) (vector-ref t2 2)) '*)
+		   (else (next (vector-ref t2 0))))))
+	   (else t)))
+   (lambda () (quit-compiling "foreign type `~S' refers to itself" t0))))
 
 
 ;;; Compute foreign result size:
@@ -1241,7 +1248,7 @@
 
 ;; Used only in chicken-ffi-syntax.scm; can we move it there?
 (define (foreign-type->scrutiny-type t mode) ; MODE = 'arg | 'result
-  (let ((ft (final-foreign-type t)))
+  (let ((ft (final-foreign-type t mode)))
     (case ft
       ((void) 'undefined)
       ((char unsigned-char) 'char)
-- 
2.13.0