~ chicken-core (chicken-5) 13eaedc7ff55da4cf62eaa2d2163af4639a8dd75


commit 13eaedc7ff55da4cf62eaa2d2163af4639a8dd75
Author:     felix <felix@z.(none)>
AuthorDate: Tue Mar 29 10:15:33 2011 +0200
Commit:     felix <felix@z.(none)>
CommitDate: Tue Mar 29 10:15:33 2011 +0200

    more conflict resolution

diff --git a/scrutinizer.scm b/scrutinizer.scm
index 11e7699c..0ec91a9a 100755
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -81,56 +81,6 @@
 (define-constant +fragment-max-depth+ 3)
 
 
-(define (scrutinize node db)
-  (let ((blist '()))
-    (define (constant-result lit)
-      (cond ((string? lit) 'string)
-	    ((symbol? lit) 'symbol)
-	    ((fixnum? lit) 'fixnum)
-	    ((flonum? lit) 'float)
-	    ((number? lit) 'number)	; in case...
-	    ((boolean? lit) 'boolean)
-	    ((list? lit) 'list)
-	    ((pair? lit) 'pair)
-	    ((eof-object? lit) 'eof)
-	    ((vector? lit) 'vector)
-	    ((and (not (##sys#immediate? lit)) ##sys#generic-structure? lit)
-	     `(struct ,(##sys#slot lit 0)))
-	    ((null? lit) 'null)
-	    ((char? lit) 'char)
-	    (else '*)))
-    (define (global-result id loc)
-      (cond ((##sys#get id '##compiler#type) =>
-	     (lambda (a) 
-	       (cond
-		#;((and (get db id 'assigned)      ; remove assigned global from type db
-		(not (##sys#get id '##core#declared-type)))
-		(##sys#put! id '##compiler#type #f)
-		'*)
-	       ((eq? a 'deprecated)
-		(report
-		 loc
-		 (sprintf "use of deprecated library procedure `~a'" id) )
-		'(*))
-	       ((and (pair? a) (eq? (car a) 'deprecated))
-		(report 
-		 loc
-		 (sprintf 
-		     "use of deprecated library procedure `~a' - consider using `~a' instead"
-		   id (cadr a)))
-		'(*))
-	       (else (list a)))))
-      (else '(*))))
-  (define (variable-result id e loc flow)
-    (cond ((find (lambda (b) 
-		   (and (eq? id (caar b))
-			(memq (cdar b) flow)) )
-		 blist)
-	   => (o list cdr))
-	  ((and (get db id 'assigned) 
-		(not (##sys#get id '##core#declared-type)) )
-	   '(*))
-=======
 (define specialization-statistics '())
 
 (define (scrutinize node db complain specialize)
@@ -155,27 +105,36 @@
 	  ((char? lit) 'char)
 	  (else '*)))
   (define (global-result id loc)
-    (cond ((##sys#get id '##core#type) =>
+    (cond ((##sys#get id '##compiler#type) =>
 	   (lambda (a) 
-	     (cond ((eq? a 'deprecated)
-		    (report
-		     loc
-		     (sprintf "use of deprecated library procedure `~a'" id) )
-		    '*)
-		   ((and (pair? a) (eq? (car a) 'deprecated))
-		    (report 
-		     loc
-		     (sprintf 
-			 "use of deprecated library procedure `~a' - consider using `~a' instead"
-		       id (cadr a)))
-		     '*)
-		   (else (list a)))))
-	  (else '*)))
-  (define (variable-result id e loc)
-    (cond ((and (get db id 'assigned) 
+	     (cond
+	      #;((and (get db id 'assigned)      ; remove assigned global from type db
+	      (not (##sys#get id '##compiler#declared-type)))
+	      (##sys#put! id '##compiler#type #f)
+	      '(*))
+	      ((eq? a 'deprecated)
+	       (report
+		loc
+		(sprintf "use of deprecated library procedure `~a'" id) )
+	       '(*))
+	      ((and (pair? a) (eq? (car a) 'deprecated))
+	       (report 
+		loc
+		(sprintf 
+		    "use of deprecated library procedure `~a' - consider using `~a' instead"
+		  id (cadr a)))
+	       '(*))
+	      (else (list a)))))
+	  (else '(*))))
+  (define (variable-result id e loc flow)
+    (cond ((find (lambda (b) 
+		   (and (eq? id (caar b))
+			(memq (cdar b) flow)) )
+		 blist)
+	   => (o list cdr))
+	  ((and (get db id 'assigned) 
 		(not (##sys#get id '##core#declared-type)))
-	   '*)
->>>>>>> specialization
+	   '(*)
 	  ((assq id e) =>
 	   (lambda (a)
 	     (cond ((eq? 'undefined (cdr a))
Trap