On Sun, Dec 20, 2015 at 06:11:24PM +1300, Evan Hanson wrote:
> Unfortunately the scrutinizer change is a bit hairier. One problem is
> that it causes the "-emit-types-file" option to include system-defined
> types (i.e. those that come from from types.db) in generated .types
> files, whereas it should only include those for values defined in the
> file under compilation. That file's entries are generated by walking the
> analysis database, so I don't think we'll be able to avoid keeping track
> of whether a given type came from the user or from a types file so that
> we can determine whether to generate a type for it in this situation.

I've now added this, see the attached patch.  It simply changes the
##compiler#declared-type from a boolean to a symbol indicating the origin
of the declaration.  The code in "scrutinize" for "set!" is a bit strange
in that it seems to automatically mark variables as declared even if they
are only inferred.  I don't completely understand this code, but I've
changed the marking to be 'implicit, so that we can differentiate between
these kinds of types and types that were actually declared by the user
using "the", ":" or "(declare (type ...))" syntaxes.

To keep the behaviour consistent, now -emit-type-file emits both 'implicit
and 'local types, thereby skipping the ones loaded from the db (which have
a 'from-db marking).

> There's also now the problem of what to do when the user redefines an
> identifier without redeclaring its type. For example, with this change,
> if I redefine string-split with a different signature, csc will produce
> inaccurate scrutiny warnings because calls to *my* string-split won't
> match core's but it'll still have a declared-type, now. I haven't dug
> into this too deeply yet (I'm hoping to take a crack at these issues
> over the holidays) but I do think we'll have to make a call about what's
> correct in this and similar situations.

I really want to apply this optimization to core, so for the time being
I decided that we can do this, but only when compiling core.  That means
that core is priviliged in being able to externally declare types for a
compilation units that it will compile.  In other words, if eggs have
types files, the specializations won't be applied when compiling the egg
itself.  I think this is an acceptable compromise.

We could make this more sophisticated by allowing namespaced identifiers
(i.e., with a "module#" prefix) to be specialised when compiling the
module as well.

For CHICKEN 5, we'll always apply the specializations, because we will
not have any toplevel identifiers in types.db anymore when it is
finished.

Cheers,
Peter
From fe88996d070b790633de2e36bd212f935150580d Mon Sep 17 00:00:00 2001
From: Peter Bex <pe...@more-magic.net>
Date: Wed, 18 Nov 2015 19:28:08 +0100
Subject: [PATCH] Mark external type declarations as declared.

By not being marked as "declared", types loaded from a types database
would be considered to be inferred via flow analysis.  When scrutinizing
procedure definitions, "initial-argument-types" and "variable-result"
would simply return '* or '(*) as the type, which doesn't match the
loaded declaration.  This had the effect of blocking specialization.

This fixes the most important part of #1219.
---
 core.scm                          | 4 ++--
 distribution/manifest             | 1 +
 scrutinizer.scm                   | 8 +++++---
 tests/runtests.bat                | 2 +-
 tests/runtests.sh                 | 2 +-
 tests/specialization-test-2.scm   | 6 ++++++
 tests/specialization-test-2.types | 3 +++
 7 files changed, 19 insertions(+), 7 deletions(-)
 create mode 100644 tests/specialization-test-2.types

diff --git a/core.scm b/core.scm
index f9ae772..aeca37c 100644
--- a/core.scm
+++ b/core.scm
@@ -91,7 +91,7 @@
 ;   ##compiler#pure -> BOOL                                 referentially transparent
 ;   ##compiler#clean -> BOOL                                does not modify local state
 ;   ##compiler#type -> TYPE
-;   ##compiler#declared-type -> BOOL
+;   ##compiler#declared-type -> 'from-db | 'local | 'implicit
 
 ; - Source language:
 ;
@@ -1659,7 +1659,7 @@
 					 (symbol? (cadr type)))
 				(set-car! (cdr type) name))
 			      (mark-variable name '##compiler#type type)
-			      (mark-variable name '##compiler#declared-type)
+			      (mark-variable name '##compiler#declared-type 'local)
 			      (when pure
 				(mark-variable name '##compiler#pure #t))
 			      (when pred
diff --git a/distribution/manifest b/distribution/manifest
index 2b1c3bd..0160f89 100644
--- a/distribution/manifest
+++ b/distribution/manifest
@@ -176,6 +176,7 @@ tests/loopy-loop.scm
 tests/r5rs_pitfalls.scm
 tests/specialization-test-1.scm
 tests/specialization-test-2.scm
+tests/specialization-test-2.types
 tests/test-irregex.scm
 tests/re-tests.txt
 tests/lolevel-tests.scm
diff --git a/scrutinizer.scm b/scrutinizer.scm
index 81c2f82..fed2a7a 100644
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -88,7 +88,7 @@
 ; global symbol properties:
 ;
 ;   ##compiler#type            ->  TYPESPEC
-;   ##compiler#declared-type   ->  BOOL
+;   ##compiler#declared-type   ->  'from-db | 'local | 'implicit
 ;   ##compiler#predicate       ->  TYPESPEC
 ;   ##compiler#specializations ->  (SPECIALIZATION ...)
 ;   ##compiler#local-specializations ->  (SPECIALIZATION ...)
@@ -649,7 +649,7 @@
 			      ;; [2] sets property, but lambda has already been walked,
 			      ;; so no type-checks are generated (see also [1], above)
 			      ;; note that implicit declarations are not enforcing
-			      (mark-variable var '##compiler#declared-type)
+			      (mark-variable var '##compiler#declared-type 'implicit)
 			      (mark-variable var '##compiler#type rt))))))
 		    (when b
 		      (cond ((eq? 'undefined (cdr b)) (set-cdr! b rt))
@@ -1803,6 +1803,7 @@
 		    "type-definition `~a' for toplevel binding `~a' conflicts with previously loaded type `~a'"
 		  name new old)))
 	     (mark-variable name '##compiler#type t)
+	     (mark-variable name '##compiler#declared-type 'from-db)
 	     (when specs
 	       (install-specializations name specs)))))
        (read-file dbfile))
@@ -1816,7 +1817,8 @@
       (##sys#hash-table-for-each
        (lambda (sym plist)
 	 (when (and (variable-visible? sym block-compilation)
-		    (variable-mark sym '##compiler#declared-type))
+		    (memq (variable-mark sym '##compiler#declared-type)
+			  '(local implicit)))
 	   (let ((specs (or (variable-mark sym '##compiler#specializations) '()))
 		 (type (variable-mark sym '##compiler#type))
 		 (pred (variable-mark sym '##compiler#predicate))
diff --git a/tests/runtests.bat b/tests/runtests.bat
index 9511ca5..7458989 100644
--- a/tests/runtests.bat
+++ b/tests/runtests.bat
@@ -86,7 +86,7 @@ del /f /q foo.types foo.import.*
 if errorlevel 1 exit /b 1
 a.out
 if errorlevel 1 exit /b 1
-%compile% specialization-test-2.scm -types foo.types -specialize -debug ox
+%compile% specialization-test-2.scm -types foo.types -types specialization-test-2.types -specialize -debug ox
 if errorlevel 1 exit /b 1
 a.out
 if errorlevel 1 exit /b 1
diff --git a/tests/runtests.sh b/tests/runtests.sh
index 5b61404..b02b716 100755
--- a/tests/runtests.sh
+++ b/tests/runtests.sh
@@ -126,7 +126,7 @@ rm -f foo.types foo.import.*
 $compile specialization-test-1.scm -emit-type-file foo.types -specialize \
   -debug ox -emit-import-library foo
 ./a.out
-$compile specialization-test-2.scm -types foo.types -specialize -debug ox
+$compile specialization-test-2.scm -types foo.types -types specialization-test-2.types -specialize -debug ox
 ./a.out
 rm -f foo.types foo.import.*
 
diff --git a/tests/specialization-test-2.scm b/tests/specialization-test-2.scm
index e24e5cb..9b80922 100644
--- a/tests/specialization-test-2.scm
+++ b/tests/specialization-test-2.scm
@@ -26,3 +26,9 @@ return n;}
 
 (assert (handle-exceptions ex #t (bug855 '(#f)) #f))
 
+;; #1219: Specializations from databases loaded with "-types" should
+;; be applied.
+(define (specialize-me x)
+  (error "Not specialized!"))
+
+(assert (= (specialize-me 123) 123))
diff --git a/tests/specialization-test-2.types b/tests/specialization-test-2.types
new file mode 100644
index 0000000..7ca640d
--- /dev/null
+++ b/tests/specialization-test-2.types
@@ -0,0 +1,3 @@
+;; -*- Scheme -*-
+(specialize-me (procedure specialize-me (fixnum) fixnum)
+	       ((fixnum) #(1)))
-- 
2.1.4

From cf261b826a5af0395d16d15fc2d45f9693dceeea Mon Sep 17 00:00:00 2001
From: Peter Bex <pe...@more-magic.net>
Date: Wed, 18 Nov 2015 17:04:57 +0100
Subject: [PATCH] Mark external type declarations as declared.

By not being marked as "declared", types loaded from a types database
would be considered to be inferred via flow analysis.  When scrutinizing
procedure definitions, "initial-argument-types" and "variable-result"
would simply return '* or '(*) as the type, which doesn't match the
loaded declaration.  This had the effect of blocking specialization.

Because CHICKEN 4 doesn't use modules for its core procedures, we will
only do this when building CHICKEN itself.  User code may define toplevel
procedures which match names from core, if the matching units are not
loaded this is okay, but we can't apply the specializations in that case.

This fixes the most important part of #1219.
---
 compiler.scm                      |  4 ++--
 distribution/manifest             |  1 +
 scrutinizer.scm                   | 12 +++++++++---
 tests/runtests.bat                |  2 +-
 tests/runtests.sh                 |  2 +-
 tests/specialization-test-2.scm   |  6 ++++++
 tests/specialization-test-2.types |  3 +++
 7 files changed, 23 insertions(+), 7 deletions(-)
 create mode 100644 tests/specialization-test-2.types

diff --git a/compiler.scm b/compiler.scm
index b7bab0c..00d09f0 100644
--- a/compiler.scm
+++ b/compiler.scm
@@ -91,7 +91,7 @@
 ;   ##compiler#pure -> BOOL                                 referentially transparent
 ;   ##compiler#clean -> BOOL                                does not modify local state
 ;   ##compiler#type -> TYPE
-;   ##compiler#declared-type -> BOOL
+;   ##compiler#declared-type -> 'from-db | 'local | 'implicit
 
 ; - Source language:
 ;
@@ -1568,7 +1568,7 @@
 					 (symbol? (cadr type)))
 				(set-car! (cdr type) name))
 			      (mark-variable name '##compiler#type type)
-			      (mark-variable name '##compiler#declared-type)
+			      (mark-variable name '##compiler#declared-type 'local)
 			      (when pure
 				(mark-variable name '##compiler#pure #t))
 			      (when pred
diff --git a/distribution/manifest b/distribution/manifest
index c2f1553..1dd037f 100644
--- a/distribution/manifest
+++ b/distribution/manifest
@@ -178,6 +178,7 @@ tests/loopy-loop.scm
 tests/r5rs_pitfalls.scm
 tests/specialization-test-1.scm
 tests/specialization-test-2.scm
+tests/specialization-test-2.types
 tests/test-irregex.scm
 tests/re-tests.txt
 tests/lolevel-tests.scm
diff --git a/scrutinizer.scm b/scrutinizer.scm
index 99da823..c947221 100644
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -84,7 +84,7 @@
 ; global symbol properties:
 ;
 ;   ##compiler#type            ->  TYPESPEC
-;   ##compiler#declared-type   ->  BOOL
+;   ##compiler#declared-type   ->  'from-db | 'local | 'implicit
 ;   ##compiler#predicate       ->  TYPESPEC
 ;   ##compiler#specializations ->  (SPECIALIZATION ...)
 ;   ##compiler#local-specializations ->  (SPECIALIZATION ...)
@@ -643,7 +643,7 @@
 			      ;; [2] sets property, but lambda has already been walked,
 			      ;; so no type-checks are generated (see also [1], above)
 			      ;; note that implicit declarations are not enforcing
-			      (mark-variable var '##compiler#declared-type)
+			      (mark-variable var '##compiler#declared-type 'implicit)
 			      (mark-variable var '##compiler#type rt))))))
 		    (when b
 		      (cond ((eq? 'undefined (cdr b)) (set-cdr! b rt))
@@ -1778,6 +1778,11 @@
 		    "type-definition `~a' for toplevel binding `~a' conflicts with previously loaded type `~a'"
 		  name new old)))
 	     (mark-variable name '##compiler#type t)
+	     ;; We only allow db-loaded types to affect core code
+	     ;; because core isn't properly namespaced.  User code may
+	     ;; unwittingly redefine core procedures, causing issues.
+	     (when (feature? #:chicken-bootstrap)
+	       (mark-variable name '##compiler#declared-type 'from-db))
 	     (when specs
 	       (install-specializations name specs)))))
        (read-file dbfile))
@@ -1791,7 +1796,8 @@
       (##sys#hash-table-for-each
        (lambda (sym plist)
 	 (when (and (variable-visible? sym)
-		    (variable-mark sym '##compiler#declared-type))
+		    (memq (variable-mark sym '##compiler#declared-type)
+			  '(local implicit)))
 	   (let ((specs (or (variable-mark sym '##compiler#specializations) '()))
 		 (type (variable-mark sym '##compiler#type))
 		 (pred (variable-mark sym '##compiler#predicate))
diff --git a/tests/runtests.bat b/tests/runtests.bat
index 9539bd4..be587d4 100644
--- a/tests/runtests.bat
+++ b/tests/runtests.bat
@@ -73,7 +73,7 @@ del /f /q foo.types foo.import.*
 if errorlevel 1 exit /b 1
 a.out
 if errorlevel 1 exit /b 1
-%compile% specialization-test-2.scm -types foo.types -specialize -debug ox
+%compile% specialization-test-2.scm -types foo.types -types specialization-test-2.types -feature chicken-bootstrap -specialize -debug ox
 if errorlevel 1 exit /b 1
 a.out
 if errorlevel 1 exit /b 1
diff --git a/tests/runtests.sh b/tests/runtests.sh
index 4bbd171..e3aafdc 100755
--- a/tests/runtests.sh
+++ b/tests/runtests.sh
@@ -113,7 +113,7 @@ rm -f foo.types foo.import.*
 $compile specialization-test-1.scm -emit-type-file foo.types -specialize \
   -debug ox -emit-import-library foo
 ./a.out
-$compile specialization-test-2.scm -types foo.types -specialize -debug ox
+$compile specialization-test-2.scm -types foo.types -types specialization-test-2.types -feature chicken-bootstrap -specialize -debug ox
 ./a.out
 rm -f foo.types foo.import.*
 
diff --git a/tests/specialization-test-2.scm b/tests/specialization-test-2.scm
index e24e5cb..9b80922 100644
--- a/tests/specialization-test-2.scm
+++ b/tests/specialization-test-2.scm
@@ -26,3 +26,9 @@ return n;}
 
 (assert (handle-exceptions ex #t (bug855 '(#f)) #f))
 
+;; #1219: Specializations from databases loaded with "-types" should
+;; be applied.
+(define (specialize-me x)
+  (error "Not specialized!"))
+
+(assert (= (specialize-me 123) 123))
diff --git a/tests/specialization-test-2.types b/tests/specialization-test-2.types
new file mode 100644
index 0000000..7ca640d
--- /dev/null
+++ b/tests/specialization-test-2.types
@@ -0,0 +1,3 @@
+;; -*- Scheme -*-
+(specialize-me (procedure specialize-me (fixnum) fixnum)
+	       ((fixnum) #(1)))
-- 
2.1.4

Attachment: signature.asc
Description: Digital signature

_______________________________________________
Chicken-hackers mailing list
Chicken-hackers@nongnu.org
https://lists.nongnu.org/mailman/listinfo/chicken-hackers

Reply via email to