~ 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