~ chicken-core (chicken-5) abbffb094fa940dfa2145d043e5e6048bec5c021

commit abbffb094fa940dfa2145d043e5e6048bec5c021
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Wed Mar 9 09:35:47 2011 -0500
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Wed Mar 9 09:35:47 2011 -0500

    resolution bugs, load type files in correct order, types.db fixes

diff --git a/batch-driver.scm b/batch-driver.scm
index 04fa37bf..18a363b8 100644
--- a/batch-driver.scm
+++ b/batch-driver.scm
@@ -508,38 +508,7 @@
 	       (print-node "initial node tree" '|T| node0)
 	       (initialize-analysis-database)
 
-	       (when (or do-scrutinize do-specialize)
-		 ;;;XXX hardcoded database file name
-		 (unless (memq 'ignore-repository options)
-		   (load-type-database "types.db"))
-		 (for-each (cut load-type-database <> #f) (collect-options 'types))
-		 (begin-time)
-		 (set! first-analysis #f)
-		 (set! db (analyze 'scrutiny node0))
-		 (print-db "analysis" '|0| db 0)
-		 (end-time "pre-analysis (scrutiny)")
-		 (begin-time)
-		 (debugging 'p "performing scrutiny")
-		 (scrutinize node0 db do-scrutinize do-specialize)
-		 (end-time "scrutiny")
-		 (when do-specialize
-		   (print-node "specialization" '|P| node0))
-		 (set! first-analysis #t) )
-
-	       (when do-lambda-lifting
-		 (begin-time)
-		 (unless do-scrutinize ; no need to do analysis if already done
-		   (set! first-analysis #f) ; (and not specialized)
-		   (set! db (analyze 'lift node0))
-		   (print-db "analysis" '|0| db 0)
-		   (end-time "pre-analysis (lambda-lift)"))
-		 (begin-time)
-		 (perform-lambda-lifting! node0 db)
-		 (end-time "lambda lifting")
-		 (print-node "lambda lifted" '|L| node0) 
-		 (set! first-analysis #t) )
-	       
-	       ;; collect requirements and load inline and types files
+	       ;; collect requirements and load inline files
 	       (let* ((req (concatenate (vector->list file-requirements)))
 		      (mreq (concatenate (map cdr req))))
 		 (when (debugging 'M "; requirements:")
@@ -561,8 +530,43 @@
 		      (lambda (ilf)
 			(dribble "Loading inline file ~a ..." ilf)
 			(load-inline-file ilf) )
-		      ifs))))
+		      ifs)))
 
+		 (when (or do-scrutinize do-specialize)
+		   ;;XXX hardcoded database file name
+		   (unless (memq 'ignore-repository options)
+		     (load-type-database "types.db"))
+		   (for-each (cut load-type-database <> #f) (collect-options 'types))
+		   (for-each
+		    (lambda (id)
+		      (load-type-database (make-pathname #f (symbol->string id) "types")))
+		    mreq)
+		   (begin-time)
+		   (set! first-analysis #f)
+		   (set! db (analyze 'scrutiny node0))
+		   (print-db "analysis" '|0| db 0)
+		   (end-time "pre-analysis (scrutiny)")
+		   (begin-time)
+		   (debugging 'p "performing scrutiny")
+		   (scrutinize node0 db do-scrutinize do-specialize)
+		   (end-time "scrutiny")
+		   (when do-specialize
+		     (print-node "specialization" '|P| node0))
+		   (set! first-analysis #t) ) )
+
+	       (when do-lambda-lifting
+		 (begin-time)
+		 (unless do-scrutinize ; no need to do analysis if already done
+		   (set! first-analysis #f) ; (and not specialized)
+		   (set! db (analyze 'lift node0))
+		   (print-db "analysis" '|0| db 0)
+		   (end-time "pre-analysis (lambda-lift)"))
+		 (begin-time)
+		 (perform-lambda-lifting! node0 db)
+		 (end-time "lambda lifting")
+		 (print-node "lambda lifted" '|L| node0) 
+		 (set! first-analysis #t) )
+	       
 	       ;; lambda-lifting
 	       (when do-lambda-lifting
 		 (begin-time)
diff --git a/types.db b/types.db
index bfb8f1ad..8c96576b 100644
--- a/types.db
+++ b/types.db
@@ -158,11 +158,9 @@
 
 (+ (procedure + (#!rest number) number)
    (((or fixnum flonum number)) #(1))
-   ((fixnum fixnum) (##core#inline "C_u_fixnum_plus" #(1) #(2)))
    ((float float) (##core#inline_allocate ("C_a_i_flonum_plus" 4) #(1) #(2))))
 
 (- (procedure - (number #!rest number) number)
-   ((fixnum fixnum) (##core#inline "C_i_fixnum_difference" #(1) #(2)))
    ((fixnum) (##core#inline "C_u_fixnum_negate" #(1)))
    ((float float) (##core#inline_allocate ("C_a_i_flonum_difference" 4) 
 					  #(1) #(2)))
@@ -170,14 +168,10 @@
 
 (* (procedure * (#!rest number) number)
    (((or fixnum float number)) #(1))
-   ((fixnum fixnum) (##core#inline "C_fixnum_times" #(1) #(2)))
-   ((float float) (##core#inline_allocate ("C_a_i_flonum_times" 4) 
-					  #(1) #(2))))
+   ((float float) (##core#inline_allocate ("C_a_i_flonum_times" 4) #(1) #(2))))
 
 (/ (procedure / (number #!rest number) number)
-   ((fixnum fixnum) (##core#inline "C_fixnum_divide" #(1) #(2)))
-   ((float float) (##core#inline_allocate ("C_a_i_flonum_quotient" 4) 
-					  #(1) #(2))))
+   ((float float) (##core#inline_allocate ("C_a_i_flonum_quotient" 4) #(1) #(2))))
 
 (= (procedure = (#!rest number) boolean)
    ((fixnum fixnum) (eq? #(1) #(2)))