~ chicken-core (chicken-5) dde0adcd543d4e3f93e60bfb198d0d43da4605e8

commit dde0adcd543d4e3f93e60bfb198d0d43da4605e8
Author:     Evan Hanson <evhan@foldling.org>
AuthorDate: Mon Jan 11 08:52:44 2016 +1300
Commit:     Evan Hanson <evhan@foldling.org>
CommitDate: Mon Jan 11 08:52:44 2016 +1300

    Use ##compiler#type-source property for type origin info (db local inference)

diff --git a/compiler.scm b/compiler.scm
index 00d09f0c..57dfcba9 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 -> 'from-db | 'local | 'implicit
+;   ##compiler#type-source -> 'db | 'local | 'inference
 
 ; - 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 'local)
+			      (mark-variable name '##compiler#type-source 'local)
 			      (when pure
 				(mark-variable name '##compiler#pure #t))
 			      (when pred
diff --git a/scrutinizer.scm b/scrutinizer.scm
index c9472211..8c9c32ef 100644
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -84,7 +84,7 @@
 ; global symbol properties:
 ;
 ;   ##compiler#type            ->  TYPESPEC
-;   ##compiler#declared-type   ->  'from-db | 'local | 'implicit
+;   ##compiler#type-source     ->  'db | 'local | 'inference
 ;   ##compiler#predicate       ->  TYPESPEC
 ;   ##compiler#specializations ->  (SPECIALIZATION ...)
 ;   ##compiler#local-specializations ->  (SPECIALIZATION ...)
@@ -190,7 +190,7 @@
       (cond ((blist-type id flow) => list)
 	    ((and (not strict-variable-types)
 		  (get db id 'assigned) 
-		  (not (variable-mark id '##compiler#declared-type)))
+		  (not (variable-mark id '##compiler#type-source)))
 	     '(*))
 	    ((assq id e) =>
 	     (lambda (a)
@@ -441,7 +441,7 @@
     (define (initial-argument-types dest vars argc)
       (if (and dest 
 	       strict-variable-types
-	       (variable-mark dest '##compiler#declared-type))
+	       (variable-mark dest '##compiler#type-source))
 	  (let* ((ptype (variable-mark dest '##compiler#type))
 		 (typeenv (type-typeenv ptype)))
 	    (if (procedure-type? ptype)
@@ -573,12 +573,12 @@
 					 #f #t (list initial-tag) #f)))
 			   #;(when (and specialize
 				      dest
-				      (variable-mark dest '##compiler#declared-type)
+				      (variable-mark dest '##compiler#type-source)
 				      (not unsafe))
 			     (debugging 'x "checks argument-types" dest) ;XXX
 			     ;; [1] this is subtle: we don't want argtype-checks to be 
 			     ;; generated for toplevel defs other than user-declared ones. 
-			     ;; But since the ##compiler#declared-type mark is set AFTER 
+			     ;; But since the ##compiler#type-source mark is set AFTER
 			     ;; the lambda has been walked (see below, [2]), nothing is added.
 			     (generate-type-checks! n dest vars inits))
 			   (list
@@ -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 'implicit)
+			      (mark-variable var '##compiler#type-source 'inference)
 			      (mark-variable var '##compiler#type rt))))))
 		    (when b
 		      (cond ((eq? 'undefined (cdr b)) (set-cdr! b rt))
@@ -1782,7 +1782,7 @@
 	     ;; 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))
+	       (mark-variable name '##compiler#type-source 'db))
 	     (when specs
 	       (install-specializations name specs)))))
        (read-file dbfile))
@@ -1796,8 +1796,7 @@
       (##sys#hash-table-for-each
        (lambda (sym plist)
 	 (when (and (variable-visible? sym)
-		    (memq (variable-mark sym '##compiler#declared-type)
-			  '(local implicit)))
+		    (memq (variable-mark sym '##compiler#type-source) '(local inference)))
 	   (let ((specs (or (variable-mark sym '##compiler#specializations) '()))
 		 (type (variable-mark sym '##compiler#type))
 		 (pred (variable-mark sym '##compiler#predicate))